Syntax proposal: let punning (ocaml#10013)

Let-punning: allow "let* x" and "let%foo x" syntax without an explicit binding.

Changes

@@ -3,6 +3,11 @@ Working version
 
 ### Language features:
 
+- #10013: Let-punning
+  Allow 'let* x in ...' and 'let%ext x in ...' as shorthand for
+    'let* x = x in ...' and 'let%ext x = x in ...' respectively.
+  (Stephen Dolan, review by Gabriel Scherer)
+
 ### Runtime system:
 
 - #10025: Track custom blocks (e.g. Bigarray) with Statmemprof

parsing/parser.mly

@@ -458,6 +458,7 @@ let extra_rhs_core_type ct ~pos =
 type let_binding =
   { lb_pattern: pattern;
     lb_expression: expression;
+    lb_is_pun: bool;
     lb_attributes: attributes;
     lb_docs: docs Lazy.t;
     lb_text: text Lazy.t;
@@ -469,27 +470,30 @@ type let_bindings =
     lbs_extension: string Asttypes.loc option;
     lbs_loc: Location.t }
 
-let mklb first ~loc (p, e) attrs =
+let mklb first ~loc (p, e, is_pun) attrs =
   {
     lb_pattern = p;
     lb_expression = e;
+    lb_is_pun = is_pun;
     lb_attributes = attrs;
     lb_docs = symbol_docs_lazy loc;
     lb_text = (if first then empty_text_lazy
                else symbol_text_lazy (fst loc));
     lb_loc = make_loc loc;
   }
 
+let addlb lbs lb =
+  if lb.lb_is_pun && lbs.lbs_extension = None then syntax_error ();
+  { lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+
 let mklbs ~loc ext rf lb =
-  {
-    lbs_bindings = [lb];
+  let lbs = {
+    lbs_bindings = [];
     lbs_rec = rf;
     lbs_extension = ext ;
     lbs_loc = make_loc loc;
-  }
-
-let addlb lbs lb =
-  { lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+  } in
+  addlb lbs lb
 
 let val_of_let_bindings ~loc lbs =
   let bindings =
@@ -2418,7 +2422,7 @@ labeled_simple_expr:
 %inline let_ident:
     val_ident { mkpatvar ~loc:$sloc $1 }
 ;
-let_binding_body:
+let_binding_body_no_punning:
     let_ident strict_binding
       { ($1, $2) }
   | let_ident type_constraint EQUAL seq_expr
@@ -2454,6 +2458,12 @@ let_binding_body:
       { let loc = ($startpos($1), $endpos($3)) in
         (ghpat ~loc (Ppat_constraint($1, $3)), $5) }
 ;
+let_binding_body:
+  | let_binding_body_no_punning
+      { let p,e = $1 in (p,e,false) }
+  | val_ident %prec below_HASH
+      { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1, true) }
+;
 (* The formal parameter EXT can be instantiated with ext or no_ext
    so as to indicate whether an extension is allowed or disallowed. *)
 let_bindings(EXT):
@@ -2485,6 +2495,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) }
@@ -2495,7 +2508,7 @@ letop_bindings:
     body = letop_binding_body
       { let let_pat, let_exp = body in
         let_pat, let_exp, [] }
-  | bindings = letop_bindings pbop_op = mkrhs(ANDOP) body = let_binding_body
+  | 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 pbop_loc = make_loc $sloc in

parsing/pprintast.ml

@@ -1314,8 +1314,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,14 @@ let test = function
 
 let test = function
   | (`A | `B) as x | `C -> ()
+
+(* Let-punning *)
+module M = struct
+  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)
+  let q =
+    let%foo x and y and z in (x,y,z)
+end