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:

boot/menhir/menhirLib.ml

@@ -43,7 +43,7 @@ let rec uniq1 cmp x ys =
       []
   | y :: ys ->
       if cmp x y = 0 then
-        uniq1 compare x ys
+        uniq1 cmp x ys
       else
         y :: uniq1 cmp y ys
 
@@ -85,7 +85,6 @@ let rec foldr f xs accu =
       accu
   | Cons (x, xs) ->
       f x (foldr f xs accu)
-
 end
 module Convert = struct
 (******************************************************************************)
@@ -3133,8 +3132,14 @@ module Make
   type item =
       int * int
 
+  let low_bits =
+    10
+
+  let low_limit =
+    1 lsl low_bits
+
   let export t : item =
-    (t lsr 7, t mod 128)
+    (t lsr low_bits, t mod low_limit)
 
   let items s =
     (* Map [s] to its LR(0) core. *)
@@ -3513,5 +3518,5 @@ module MakeEngineTable (T : TableFormat.TABLES) = struct
 end
 end
 module StaticVersion = struct
-let require_20190924 = ()
+let require_20200624 = ()
 end

boot/menhir/menhirLib.mli

@@ -1701,5 +1701,5 @@ module MakeEngineTable
      and type nonterminal = int
 end
 module StaticVersion : sig
-val require_20190924 : unit
+val require_20200624: unit
 end

parsing/parser.mly

@@ -2485,6 +2485,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 +2498,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,12 @@ 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)
+end