Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix untypeast/pprintast bug (backport upstream 13845) #3663

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open

Fix untypeast/pprintast bug (backport upstream 13845) #3663

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
3d20281
failing test
ccasin Mar 4, 2025
f227150
Fix untypeast handling of pvb_constraint
ccasin Mar 4, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 31 additions & 0 deletions testsuite/tests/compiler-libs/test_untypeast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,3 +60,34 @@ 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 : value) . 'a -> 'a = fun x -> x in foo"
|}];;

run {| let foo : type a . a -> a = fun x -> x in foo |}

[%%expect{|
- : string =
"let foo : ('a : value) . 'a -> 'a = fun (type a) -> ( (fun x -> x : a -> a)) in\nfoo"
|}];;

(* CR: untypeast/pprintast are totally busted on programs with modes in value
bindings. Fix this. *)
run {| let foo : 'a -> 'a @@ portable = fun x -> x in foo |}

[%%expect{|
>> Fatal error: Unrecognized mode portable - should not parse
Exception: Misc.Fatal_error.
|}];;

run {| let foo : 'a . 'a -> 'a @@ portable = fun x -> x in foo |}

[%%expect{|
- : string = "let foo : ('a : value) . 'a -> 'a = fun x -> x in foo"
|}];;
13 changes: 10 additions & 3 deletions typing/untypeast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -437,9 +437,16 @@ 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, modes =
match pat.ppat_desc with
| Ppat_constraint (pat, Some ({ ptyp_desc = Ptyp_poly _; _ } as cty),
modes) ->
let constr = Pvc_constraint {locally_abstract_univars = []; typ = cty } in
pat, Some constr, modes
| _ -> pat, None, []
in
Vb.mk ~loc ~attrs ?value_constraint ~modes pat (sub.expr sub vb.vb_expr)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This currently drops vb.pvb_modes. If you are fine with that since modes are broken anyways then that's fine, but wanted to point it out.


let comprehension sub comp =
let iterator = function
Expand Down