AST-38: Significant parenthesis around tuple patterns in func arguments

src/arrange.ml

@@ -8,17 +8,17 @@ let rec exp e = match e.it with
   | VarE i              -> "VarE"    $$ [id i]
   | LitE l              -> "LitE"    $$ [lit !l]
   | UnE (ot, uo, e)     -> "UnE"     $$ [operator_type !ot; unop uo; exp e]
-  | BinE (ot, e1, bo, e2) -> "BinE"    $$ [operator_type !ot; exp e1; binop bo; exp e2]
-  | RelE (ot, e1, ro, e2) -> "RelE"    $$ [operator_type !ot; exp e1; relop ro; exp e2]
+  | BinE (ot, e1, bo, e2) -> "BinE"  $$ [operator_type !ot; exp e1; binop bo; exp e2]
+  | RelE (ot, e1, ro, e2) -> "RelE"  $$ [operator_type !ot; exp e1; relop ro; exp e2]
   | TupE es             -> "TupE"    $$ List.map exp es
   | ProjE (e, i)        -> "ProjE"   $$ [exp e; Atom (string_of_int i)]
   | ObjE (s, i, efs)    -> "ObjE"    $$ [obj_sort s; id i] @ List.map exp_field efs
-  | DotE (e, sr, n)         -> "DotE"    $$ [exp e; obj_sort' !sr; name n]
+  | DotE (e, sr, n)     -> "DotE"    $$ [exp e; obj_sort' !sr; name n]
   | AssignE (e1, e2)    -> "AssignE" $$ [exp e1; exp e2]
   | ArrayE (m, es)      -> "ArrayE"  $$ [mut m] @ List.map exp es
   | IdxE (e1, e2)       -> "IdxE"    $$ [exp e1; exp e2]
   | CallE (e1, ts, e2)  -> "CallE"   $$ [exp e1] @ List.map typ ts @ [exp e2]
-  | BlockE (ds, ot)      -> "BlockE"  $$ List.map dec ds @ [operator_type (!ot)]
+  | BlockE (ds, ot)     -> "BlockE"  $$ List.map dec ds @ [operator_type (!ot)]
   | NotE e              -> "NotE"    $$ [exp e]
   | AndE (e1, e2)       -> "AndE"    $$ [exp e1; exp e2]
   | OrE (e1, e2)        -> "OrE"     $$ [exp e1; exp e2]
@@ -48,6 +48,7 @@ and pat p = match p.it with
   | SignP (uo, l) -> "SignP"      $$ [ unop uo ; lit !l ]
   | OptP p        -> "OptP"       $$ [ pat p ]
   | AltP (p1,p2)  -> "AltP"       $$ [ pat p1; pat p2 ]
+  | ParP p        -> "ParP"       $$ [ pat p ]
 
 and lit (l:lit) = match l with
   | NullLit       -> Atom "NullLit"

src/coverage.ml

@@ -90,7 +90,8 @@ let rec match_pat ce ctxt desc pat t sets =
   | AltP (pat1, pat2) ->
     sets.alts <- AtSet.add pat1.at (AtSet.add pat2.at sets.alts);
     match_pat ce (InAlt1 (ctxt, pat1.at, pat2, t)) desc pat1 t sets
-  | AnnotP (pat1, _) ->
+  | AnnotP (pat1, _)
+  | ParP pat1 ->
     match_pat ce ctxt desc pat1 t sets
 
 and match_lit ce ctxt desc v t sets =

src/definedness.ml

@@ -126,7 +126,8 @@ and pat msgs p : fd = match p.it with
   | WildP         -> (M.empty, S.empty)
   | VarP i        -> (M.empty, S.singleton i.it)
   | TupP ps       -> pats msgs ps
-  | AnnotP (p, t) -> pat msgs p
+  | AnnotP (p, _)
+  | ParP p        -> pat msgs p
   | LitP l        -> (M.empty, S.empty)
   | SignP (uo, l) -> (M.empty, S.empty)
   | OptP p        -> pat msgs p

src/desugar.ml

@@ -203,6 +203,7 @@ and pat' = function
   | S.OptP p -> I.OptP (pat p)
   | S.AltP (p1, p2) -> I.AltP (pat p1, pat p2)
   | S.AnnotP (p, _) -> pat' p.it
+  | S.ParP p -> pat' p.it
 
 and prog p = (decs p.it,
   { I.has_await = true

src/interpret.ml

@@ -435,6 +435,7 @@ and declare_pat pat : val_env =
   | OptP pat1 -> declare_pat pat1
   | AltP (pat1, pat2) -> declare_pat pat1
   | AnnotP (pat1, _typ) -> declare_pat pat1
+  | ParP pat1 -> declare_pat pat1
 
 and declare_pats pats ve : val_env =
   match pats with
@@ -464,6 +465,7 @@ and define_pat env pat v =
     | _ -> assert false
     )
   | AnnotP (pat1, _typ) -> define_pat env pat1 v
+  | ParP pat -> define_pat env pat v
 
 and define_pats env pats vs =
   List.iter2 (define_pat env) pats vs
@@ -509,8 +511,9 @@ and match_pat pat v : val_env option =
     | None -> match_pat pat2 v
     | some -> some
     )
-  | AnnotP (pat1, _typ) ->
-    match_pat pat1 v
+  | AnnotP (pat1, _)
+  | ParP pat1 ->
+     match_pat pat1 v
 
 and match_pats pats vs ve : val_env option =
   match pats, vs with

src/parser.mly

@@ -475,18 +475,34 @@ exp_field :
 
 (* Patterns *)
 
-pat_nullary :
+(* pat_top is needed because top-level parentheses around tuples (unit, 1-ary, pair, etc.)
+   are significant in function arguments, signifying a unary function which matches on a
+   first-class (i.e. consed) tuple *)
+pat_top :
+  | LPAR p=pat RPAR
+    { match p.it with
+      | TupP _ -> { p with it = ParP p }
+      | _ -> p
+    }
+  | p=pat_simple
+    { p }
+
+pat_simple :
   | UNDERSCORE
     { WildP @! at $sloc }
   | x=id
     { VarP(x) @! at $sloc }
   | l=lit
     { LitP(ref l) @! at $sloc }
-  | LPAR p=pat RPAR
-    { p }
   | LPAR ps=seplist1(pat_bin, COMMA) RPAR
     { TupP(ps) @! at $sloc }
 
+pat_nullary :
+  | LPAR p=pat RPAR
+    { p }
+  | p=pat_simple
+    { p }
+
 pat_un :
   | p=pat_nullary
     { p }
@@ -535,7 +551,7 @@ dec_nonvar :
     { (fd s (xf "func" $sloc)).it @? at $sloc }
   | TYPE x=con_id tps=typ_params_opt EQ t=typ
     { TypD(x, tps, t) @? at $sloc }
-  | s=obj_sort_opt CLASS xf=id_opt tps=typ_params_opt p=pat_nullary xefs=class_body
+  | s=obj_sort_opt CLASS xf=id_opt tps=typ_params_opt p=pat_top xefs=class_body
     { let x, efs = xefs in
       let efs' =
         if s.it = Type.Object Type.Local
@@ -572,7 +588,7 @@ dec :
         LetD(p, ObjE(s, x, efs') @? r) @? r }
 
 func_dec :
-  | tps=typ_params_opt p=pat_nullary rt=return_typ? fb=func_body
+  | tps=typ_params_opt p=pat_top rt=return_typ? fb=func_body
     { let t = Lib.Option.get rt (TupT([]) @! no_region) in
       (* This is a hack to support local func declarations that return a computed async.
          These should be defined using RHS syntax EQ e to avoid the implicit AsyncE introduction

src/syntax.ml

@@ -107,6 +107,7 @@ and pat' =
   | OptP of pat                                (* option *)
   | AltP of pat * pat                          (* disjunctive *)
   | AnnotP of pat * typ                        (* type annotation *)
+  | ParP of pat                                (* toplevel parenthesis *)
 (*
   | AsP of pat * pat                           (* conjunctive *)
   | ObjP of pat_field list                     (* object *)

src/typing.ml

@@ -710,7 +710,8 @@ and gather_pat env ve0 pat : val_env =
     | AltP (pat1, pat2) ->
       go ve pat1
     | OptP pat1
-    | AnnotP (pat1, _) ->
+    | AnnotP (pat1, _)
+    | ParP pat1 ->
       go ve pat1
   in T.Env.adjoin ve0 (go T.Env.empty pat)
 
@@ -761,6 +762,7 @@ and infer_pat' env pat : T.typ * val_env =
   | AnnotP (pat1, typ) ->
     let t = check_typ env typ in
     t, check_pat env t pat1
+  | ParP pat1 -> infer_pat env pat1
 
 and infer_pats at env pats ts ve : T.typ list * val_env =
   match pats with

test/run/empty-tup-args.as

@@ -1,9 +1,63 @@
 func f() {};
 func g(()) {};
+func g1((())) {}; // only top-level parenthesis signifies arity
 func h(u:()) {};
+func h1((u:())) {}; // dito, intermediate parentheses are redundant
+
 let _ = f : () -> ();
-let _ = g : () -> ();
+let _ = g : (()) -> ();
 let _ = h : (()) -> ();
+
+let _ : [() -> ()] = [f];
+let gh : [(()) -> ()] = [g, g1, h, h1];
+
 f();
-g();
-h();
+g(); // accepted, because "At calls there is an implicit coercion
+     //                    between tuples and n-ary arguments"
+h(); // dito
+gh[0](); // dito
+gh[1](); // dito
+
+// Correct:
+g(());
+h(());
+gh[0](());
+gh[1](());
+
+func j(a:Int) {};
+func k(a:(Int)) {};
+func l(a:((Int))) {};
+
+let jkl : [Int -> ()] = [j, k, l];
+
+j(5);
+k(8);
+l(13);
+jkl[1](21);
+
+func m((a:Int, b:Bool)) {};
+func m1((a:Int, b:Bool,)) {};
+let ms : [((Int, Bool)) -> ()] = [m, m1];
+
+func n(a:Int, b:Bool) {};
+func n1(a:Int, b:Bool,) {};
+
+let ns : [(Int, Bool) -> ()] = [n, n1];
+
+func o((a:Int,)) {};
+let os : [((Int,)) -> ()] = [o];
+
+// class tests, these have the same argument regime
+class F() {};
+class G(()) {};
+class H(a:()) {};
+class G1((())) {};
+class H1((u:())) {};
+let _ : [() -> F] = [F];
+let _ : [(()) -> G] = [G];
+let _ : [(()) -> G1] = [G1];
+let _ : [(()) -> H] = [H];
+let _ : [(()) -> H1] = [H1];
+
+func annih<A,B>(f : A -> B) : (A -> ()) { func (a : A) { ignore (f a) } };
+let _ : [(()) -> ()] = [annih<(),G> G, annih<(),G1> G1, annih<(),H> H, annih<(),H1> H1];