diff --git a/lib/Sugar.ml b/lib/Sugar.ml index a8a160e973..f96bbb3e61 100644 --- a/lib/Sugar.ml +++ b/lib/Sugar.ml @@ -311,11 +311,7 @@ module Let_binding = struct ; lb_args ; lb_typ ; lb_exp - ; lb_pun= - ( match (lb_pat.ast.ppat_desc, lb_exp.ast.pexp_desc) with - | Ppat_var {txt= v; _}, Pexp_ident {txt= Lident e; _} -> - String.equal v e - | _ -> false ) + ; lb_pun= bo.pbop_is_pun ; lb_attrs= [] ; lb_loc= bo.pbop_loc } ) end diff --git a/vendor/parser-extended/ast_helper.ml b/vendor/parser-extended/ast_helper.ml index 130031920f..5394625dd5 100644 --- a/vendor/parser-extended/ast_helper.ml +++ b/vendor/parser-extended/ast_helper.ml @@ -175,11 +175,12 @@ module Exp = struct pc_rhs = rhs; } - let binding_op op pat exp loc = + let binding_op op pat exp pun loc = { pbop_op = op; pbop_pat = pat; pbop_exp = exp; + pbop_is_pun = pun; pbop_loc = loc; } end diff --git a/vendor/parser-extended/ast_mapper.ml b/vendor/parser-extended/ast_mapper.ml index 1d8f9f30b3..20f4f9ce86 100644 --- a/vendor/parser-extended/ast_mapper.ml +++ b/vendor/parser-extended/ast_mapper.ml @@ -605,13 +605,13 @@ module E = struct | Pexp_infix (op, e1, e2) -> infix ~loc ~attrs (map_loc sub op) (sub.expr sub e1) (sub.expr sub e2) - let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = + let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_is_pun; pbop_loc} = let open Exp in let op = map_loc sub pbop_op in let pat = sub.pat sub pbop_pat in let exp = sub.expr sub pbop_exp in let loc = sub.location sub pbop_loc in - binding_op op pat exp loc + binding_op op pat exp pbop_is_pun loc end diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly index 62ff0d7912..b3f3de6719 100644 --- a/vendor/parser-extended/parser.mly +++ b/vendor/parser-extended/parser.mly @@ -2231,10 +2231,10 @@ expr: | let_bindings(ext) IN seq_expr { expr_of_let_bindings ~loc:$sloc $1 $3 } | pbop_op = mkrhs(LETOP) bindings = letop_bindings IN body = seq_expr - { let (pbop_pat, pbop_exp, rev_ands) = bindings in + { let (pbop_pat, pbop_exp, pbop_is_pun, rev_ands) = bindings in let ands = List.rev rev_ands in let pbop_loc = make_loc $sloc in - let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in + let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_is_pun; pbop_loc} in mkexp ~loc:$sloc (Pexp_letop{ let_; ands; body}) } | expr COLONCOLON e = expr { match e.pexp_desc, e.pexp_attributes with @@ -2548,26 +2548,26 @@ and_let_binding: ; letop_binding_body: pat = let_ident exp = strict_binding - { (pat, exp) } + { (pat, exp, false) } | val_ident (* Let-punning *) - { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1) } + { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1, true) } | pat = simple_pattern COLON typ = core_type EQUAL exp = seq_expr { let loc = ($startpos(pat), $endpos(typ)) in - (ghpat ~loc (Ppat_constraint(pat, typ)), exp) } + (ghpat ~loc (Ppat_constraint(pat, typ)), exp, false) } | pat = pattern_no_exn EQUAL exp = seq_expr - { (pat, exp) } + { (pat, exp, false) } ; letop_bindings: body = letop_binding_body - { let let_pat, let_exp = body in - let_pat, let_exp, [] } + { let let_pat, let_exp, let_is_pun = body in + let_pat, let_exp, let_is_pun, [] } | bindings = letop_bindings pbop_op = mkrhs(ANDOP) body = letop_binding_body - { let let_pat, let_exp, rev_ands = bindings in - let pbop_pat, pbop_exp = body in + { let let_pat, let_exp, let_is_pun, rev_ands = bindings in + let pbop_pat, pbop_exp, pbop_is_pun = body in let pbop_loc = make_loc $sloc in - let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in - let_pat, let_exp, and_ :: rev_ands } + let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_is_pun; pbop_loc} in + let_pat, let_exp, let_is_pun, and_ :: rev_ands } ; fun_binding: strict_binding diff --git a/vendor/parser-extended/parsetree.mli b/vendor/parser-extended/parsetree.mli index 3725a4e02f..f1c8ed17fe 100644 --- a/vendor/parser-extended/parsetree.mli +++ b/vendor/parser-extended/parsetree.mli @@ -483,6 +483,7 @@ and binding_op = pbop_op : string loc; pbop_pat : pattern; pbop_exp : expression; + pbop_is_pun: bool; pbop_loc : Location.t; }