Let-punning: allow "let x" syntax without an explicit binding.

Changes

@@ -3,6 +3,9 @@ Working version
 
 ### Language features:
 
+- #??: Let-punning
+  (Stephen Dolan, review by ??)
+
 ### Runtime system:
 
 ### Code generation and optimizations:

parsing/parser.mly

@@ -2421,6 +2421,9 @@ labeled_simple_expr:
 let_binding_body:
     let_ident strict_binding
       { ($1, $2) }
+  | val_ident %prec below_HASH
+      (* Let-punning *)
+      { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1) }
   | let_ident type_constraint EQUAL seq_expr
       { let v = $1 in (* PR#7344 *)
         let t =
@@ -2485,6 +2488,9 @@ and_let_binding:
 letop_binding_body:
     pat = let_ident exp = strict_binding
       { (pat, exp) }
+  | val_ident
+      (* Let-punning *)
+      { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1) }
   | 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) }

parsing/pprintast.ml

@@ -1282,9 +1282,9 @@ and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
     (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
     end
   | None -> begin
-      match p with
+      match p, x with
       | {ppat_desc=Ppat_constraint(p ,ty);
-         ppat_attributes=[]} -> (* special case for the first*)
+         ppat_attributes=[]}, _ -> (* special case for the first*)
           begin match ty with
           | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
               pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
@@ -1293,7 +1293,11 @@ and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
               pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
                 (core_type ctxt) ty (expression ctxt) x
           end
-      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
+      | {ppat_desc=Ppat_var {txt=pvar; _}; ppat_attributes=[]; _},
+        {pexp_desc=Pexp_ident {txt=Lident evar; _}; pexp_attributes=[]; _}
+           when pvar = evar ->
+          pp f "%s" evar
+      | {ppat_desc=Ppat_var _; ppat_attributes=[]}, _ ->
           pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
       | _ ->
           pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
@@ -1314,8 +1318,14 @@ and bindings ctxt f (rf,l) =
         (list ~sep:"@," (binding "and" Nonrecursive)) xs
 
 and binding_op ctxt f x =
-  pp f "@[<2>%s %a@;=@;%a@]"
-    x.pbop_op.txt (pattern ctxt) x.pbop_pat (expression ctxt) x.pbop_exp
+  match x.pbop_pat, x.pbop_exp with
+  | {ppat_desc = Ppat_var { txt=pvar; _ }; ppat_attributes = []; _},
+    {pexp_desc = Pexp_ident { txt=Lident evar; _}; pexp_attributes = []; _}
+       when pvar = evar ->
+     pp f "@[<2>%s %s@]" x.pbop_op.txt evar
+  | pat, exp ->
+     pp f "@[<2>%s %a@;=@;%a@]"
+       x.pbop_op.txt (pattern ctxt) pat (expression ctxt) exp
 
 and structure_item ctxt f x =
   match x.pstr_desc with

testsuite/tests/parsetree/source.ml

@@ -7414,3 +7414,15 @@ let test = function
 
 let test = function
   | (`A | `B) as x | `C -> ()
+
+(* Let-punning *)
+module M = struct
+  open List
+  let iter and filter and mem
+
+  let (let*) x f = f x
+  let (and*) a b = (a, b)
+  let x = 1 and y = 2 and z = 3
+  let p =
+    let* x and* y and* z in (x,y,z)
+end