Allow declaring wildcard parameters as moved

lib/ast.ml

@@ -78,7 +78,7 @@ and pattern =
   | Pctor of ident * pattern option
   | Pvar of ident * decl_attr
   | Ptup of loc * (loc * pattern) list * decl_attr
-  | Pwildcard of loc
+  | Pwildcard of loc * decl_attr
   | Precord of loc * (ident * pattern option) list * decl_attr
   | Plit_int of loc * int
   | Plit_char of loc * char

lib/parser.mly

@@ -47,6 +47,8 @@
          passed expression, meaning the right side. This function achieves that. *)
       | { loc; pattern = Pvar (id, Dmove); annot }, { pattr = Dnorm; pexpr } ->
           ({ loc; pattern = Pvar (id, Dnorm); annot }, { pattr = Dmove; pexpr })
+      | { loc; pattern = Pwildcard (l, Dmove); annot }, { pattr = Dnorm; pexpr } ->
+         ({ loc; pattern = Pwildcard (l, Dnorm); annot }, { pattr = Dmove; pexpr })
       | pattern, passed_expr -> (pattern, passed_expr)
 %}
 
@@ -297,10 +299,6 @@ sexp_decl:
   | bracks(sexp_decl_typed) { $1 }
   | pattern = sexp_pattern { {loc = $loc; pattern; annot = None} }
 
-param:
-  | bracks(sexp_decl_typed) { $1 }
-  | pattern = sexp_pattern; { {loc = $loc; pattern; annot = None} }
-
 sexp_decl_typed:
   | pattern = sexp_pattern; annot = sexp_type_expr
     { { loc = $loc; pattern; annot = Some annot } }
@@ -310,7 +308,7 @@ sexp_decl_typed:
 
 %inline sexp_fun:
   | Defn; name = ident; attr = list(attr); option(String_lit);
-      params = parens(list(param)); body = list(stmt)
+      params = parens(list(sexp_decl)); body = list(stmt)
     { ($loc, { name; params; return_annot = None; body; attr }) }
 
 %inline attr:
@@ -408,7 +406,7 @@ sexp_cond:
   | else_ = option(parens(cond_else)) { [$loc, Lit($loc, Unit), else_] }
 
 %inline sexp_lambda:
-  | Fn; attr = list(attr); params = parens(list(param)); body = list(stmt)
+  | Fn; attr = list(attr); params = parens(list(sexp_decl)); body = list(stmt)
     { Lambda ($loc, params, attr, body) }
 
 %inline sexp_field_set:
@@ -463,7 +461,9 @@ sexp_pattern:
   | ident; %prec below_Ampersand { Pvar ((fst $1, snd $1), Dnorm) }
   | ident; Ampersand { Pvar ((fst $1, snd $1), Dmut) }
   | ident; Exclamation { Pvar ((fst $1, snd $1), Dmove) }
-  | Wildcard { Pwildcard $loc }
+  | Wildcard; %prec below_Ampersand { Pwildcard ($loc, Dnorm) }
+  | Wildcard; Exclamation { Pwildcard ($loc, Dmove) }
+  | Wildcard; Ampersand { Pwildcard ($loc, Dmut) }
   | items = bracs(nonempty_list(record_item_pattern)); %prec below_Ampersand { Precord ($loc, items, Dnorm) }
   | items = bracs(nonempty_list(record_item_pattern)); Exclamation { Precord ($loc, items, Dmove) }
   | i = Int { Plit_int ($loc, i) }

lib/syntax_errors.messages

@@ -166,6 +166,10 @@ prog: Lpar Match False Lpar Unknown_sized_ident
 
 Expecting pattern
 
+prog: Lpar Def Wildcard Type
+
+Expecting expression
+
 prog: Lpar Def Lpar Wildcard
 
 Expecting a pattern

lib/typing/patternmatching.ml

@@ -723,7 +723,7 @@ module Make (C : Core) (R : Recs) = struct
         let ptyp = path_typ loc env path in
         let pat = Tp_var (loc, name, dattr) in
         [ (path, { ptyp; pat }) ]
-    | Pwildcard loc ->
+    | Pwildcard (loc, _) ->
         let ptyp = path_typ loc env path in
         let pat = Tp_wildcard loc in
         [ (path, { ptyp; pat }) ]
@@ -1231,7 +1231,7 @@ module Make (C : Core) (R : Recs) = struct
     | Ast.Pvar ((loc, id), dattr) -> (id, loc, false, dattr)
     | Ptup (loc, _, dattr) | Precord (loc, _, dattr) ->
         (expr_name [ i ], loc, true, dattr)
-    | Pwildcard loc -> (expr_name [ i ], loc, true, Dnorm)
+    | Pwildcard (loc, dattr) -> (expr_name [ i ], loc, true, dattr)
     | Pctor ((loc, _), _) | Plit_int (loc, _) | Plit_char (loc, _) | Por (loc, _)
       ->
         raise (Error (loc, "Unexpected pattern in declaration"))
@@ -1327,7 +1327,7 @@ module Make (C : Core) (R : Recs) = struct
     let f (env, i, ret) decl =
       match Ast.(decl.pattern) with
       | Ast.Pvar _ -> (env, i + 1, ret)
-      | Pwildcard loc ->
+      | Pwildcard (loc, _) ->
           (* expr_name was added before to env in [handle_param].
              Make sure it's marked as used *)
           ignore (Env.query_val_opt loc (Path.Pid (expr_name [ i ])) env);

test/typing.ml

@@ -619,6 +619,13 @@ let test_pattern_decl_nested_mutation () =
   test_exn "Mutation not supported here yet"
     "(type record {:a& int :b float}) (def {:a c& :b} {:a 20 :b 17.0})"
 
+let test_pattern_decl_wildcard_move () =
+  test "(fun 'a 'b! unit)" "(defn func (_ _!) ()) func"
+
+let test_pattern_decl_tuple_move () =
+  test "(fun 'a {'b 'c}! unit)"
+    "(defn func (_ {a b}!) (ignore a) (ignore b)) func"
+
 let test_signature_only () = test "unit" "(signature (type t int))"
 
 let test_signature_simple () =
@@ -1323,6 +1330,8 @@ let () =
           case "tuple missing" test_pattern_decl_tuple_missing;
           case "tuple exhaust" test_pattern_decl_tuple_exhaust;
           case "nested mutation" test_pattern_decl_nested_mutation;
+          case "wildcard move" test_pattern_decl_wildcard_move;
+          case "tuple move" test_pattern_decl_tuple_move;
         ] );
       ( "signature",
         [