Merge pull request ocaml#13845 from ccasin/untypeast-pprintast-polytype

Fix bug in untypeast/pprintast for value bindings with polymorphic type annotations

Author: Octachron

Changes

@@ -457,6 +457,10 @@ Working version
   the right-hand side of `_ as _`.
   (Samuel Vivien, review by Gabriel Scherer)
 
+- #13845: Fix bug in untypeast/pprintast for value bindings with polymorphic
+  type annotations.
+  (Chris Casinghino, review by Florian Angeletti and Gabriel Scherer)
+
 OCaml 5.3.0 (8 January 2025)
 ----------------------------
 

testsuite/tests/compiler-libs/test_untypeast.ml

@@ -37,3 +37,19 @@ run {| fun x y z -> (function w -> x y z w) |};;
 [%%expect{|
 - : string = "fun x y z -> (function | w -> x y z w)"
 |}];;
+
+(***********************************)
+(* Untypeast/pprintast correctly handle value binding type annotations. *)
+
+run {| let foo : 'a. 'a -> 'a = fun x -> x in foo |}
+
+[%%expect{|
+- : string = "let foo : 'a . 'a -> 'a = fun x -> x in foo"
+|}];;
+
+run {| let foo : type a . a -> a = fun x -> x in foo |}
+
+[%%expect{|
+- : string =
+"let foo : 'a . 'a -> 'a = fun (type a) -> (fun x -> x : a -> a) in foo"
+|}]

typing/untypeast.ml

@@ -387,9 +387,17 @@ let case : type k . mapper -> k case -> _ = fun sub {c_lhs; c_guard; c_rhs} ->
 let value_binding sub vb =
   let loc = sub.location sub vb.vb_loc in
   let attrs = sub.attributes sub vb.vb_attributes in
-  Vb.mk ~loc ~attrs
-    (sub.pat sub vb.vb_pat)
-    (sub.expr sub vb.vb_expr)
+  let pat = sub.pat sub vb.vb_pat in
+  let pat, value_constraint =
+    match pat.ppat_desc with
+    | Ppat_constraint (pat, ({ ptyp_desc = Ptyp_poly _; _ } as cty)) ->
+      let constr =
+        Pvc_constraint { locally_abstract_univars = []; typ = cty }
+      in
+      pat, Some constr
+    | _ -> pat, None
+  in
+  Vb.mk ~loc ~attrs ?value_constraint pat (sub.expr sub vb.vb_expr)
 
 let expression sub exp =
   let loc = sub.location sub exp.exp_loc in