Nullable record pattern (#3481)

doc/content/language.md

@@ -1113,6 +1113,13 @@ let _.{foo, bar} = "aabbcc".{foo = 123, bar = "baz", gni = true}
 # Record capture with sub-patterns. Same works for module!
 let {foo = [x, y, z], gni} = {foo = [1, 2, 3], gni = "baz"}
 # foo = [1, 2, 3], x = 1, y = 2, z = 3, gni = "baz"
+
+# Record capture with optional methods:
+let { foo? } = ()
+# foo = null()
+
+let { foo? } = { foo = 123 }
+# foo = 123
 ```
 
 ## Combining patterns

src/lang/evaluation.ml

@@ -95,8 +95,15 @@ let rec eval_pat pat v =
           let env = match pat with None -> env | Some pat -> aux env pat v in
           List.fold_left
             (fun env (lbl, pat) ->
-              let v = List.assoc lbl m in
-              (match pat with None -> [] | Some pat -> eval_pat pat v)
+              let v =
+                try List.assoc lbl m
+                with Not_found when pat = `Nullable ->
+                  Value.
+                    { pos = v.Value.pos; value = Null; methods = Methods.empty }
+              in
+              (match pat with
+                | `None | `Nullable -> []
+                | `Pattern pat -> eval_pat pat v)
               @ [([lbl], v)]
               @ env)
             env l

src/lang/parser.mly

@@ -436,8 +436,9 @@ list_pattern:
   | LBRA pattern_list_with_spread RBRA { `PList $2 }
 
 meth_pattern_el:
-  | VAR              { $1, None }
-  | VAR GETS pattern { $1, Some $3 }
+  | VAR              { $1, `None }
+  | VAR QUESTION     { $1, `Nullable }
+  | VAR GETS pattern { $1, `Pattern $3 }
 
 meth_pattern_list:
   |                                         { [] }
@@ -456,12 +457,12 @@ record_spread_pattern:
   | LCUR meth_spread_list RCUR { $2 }
 
 meth_pattern:
-  | record_spread_pattern            { `PMeth $1                      }
-  | record_pattern                   { `PMeth (None,              $1) }
+  | record_spread_pattern            { `PMeth $1                       }
+  | record_pattern                   { `PMeth (None,               $1) }
   | VAR DOT record_pattern           { `PMeth (Some (`PVar [$1]),  $3) }
   | UNDERSCORE DOT record_pattern    { `PMeth (Some (`PVar ["_"]), $3) }
-  | tuple_pattern DOT record_pattern { `PMeth (Some $1,           $3) }
-  | list_pattern DOT record_pattern  { `PMeth (Some $1,           $3) }
+  | tuple_pattern DOT record_pattern { `PMeth (Some $1,            $3) }
+  | list_pattern DOT record_pattern  { `PMeth (Some $1,            $3) }
 
 var_pattern:
   | optvar { `PVar [$1] }

src/lang/parser_helper.ml

@@ -168,7 +168,8 @@ let mk_json_assoc_object_ty ~pos = function
   | _ -> raise (Term_base.Parse_error (pos, "Invalid type constructor"))
 
 type let_opt_el = string * Term.t
-type meth_pattern_el = string * Term.pattern option
+type meth_term_default = [ `Nullable | `Pattern of Term.pattern | `None ]
+type meth_pattern_el = string * meth_term_default
 
 let let_decoration_of_lexer_let_decoration = function
   | `Json_parse -> `Json_parse []

src/lang/parser_helper.mli

@@ -33,7 +33,8 @@ type lexer_let_decoration =
 type explicit_binding = [ `Def of Term._let | `Let of Term._let ]
 type binding = [ explicit_binding | `Binding of Term._let ]
 type let_opt_el = string * Term.t
-type meth_pattern_el = string * Term.pattern option
+type meth_term_default = [ `Nullable | `Pattern of Term.pattern | `None ]
+type meth_pattern_el = string * meth_term_default
 
 val clear_comments : unit -> unit
 val append_comment : pos:Pos.t -> string -> unit

src/lang/term/runtime_term.ml

@@ -14,9 +14,11 @@ type pattern =
   [ `PVar of string list  (** a field *)
   | `PTuple of pattern list  (** a tuple *)
   | `PList of pattern list * string option * pattern list  (** a list *)
-  | `PMeth of pattern option * (string * pattern option) list
+  | `PMeth of pattern option * (string * meth_term_default) list
     (** a value with methods *) ]
 
+and meth_term_default = [ `Nullable | `Pattern of pattern | `None ]
+
 type 'a term = { mutable t : Type.t; term : 'a; methods : 'a term Methods.t }
 
 (* ~l1:x1 .. ?li:(xi=defi) .. *)

src/lang/term/term_base.ml

@@ -208,8 +208,9 @@ let rec string_of_pat = function
           (List.map
              (fun (lbl, pat) ->
                match pat with
-                 | None -> lbl
-                 | Some pat -> lbl ^ ": " ^ string_of_pat pat)
+                 | `None -> lbl
+                 | `Nullable -> lbl ^ "?"
+                 | `Pattern pat -> lbl ^ ": " ^ string_of_pat pat)
              l)
       ^ "}"
 
@@ -292,7 +293,9 @@ let rec free_vars_pat = function
            (List.fold_left
               (fun cur (lbl, pat) ->
                 [`PVar [lbl]]
-                @ (match pat with None -> [] | Some pat -> [pat])
+                @ (match pat with
+                    | `None | `Nullable -> []
+                    | `Pattern pat -> [pat])
                 @ cur)
               [] l))
 
@@ -313,7 +316,9 @@ let rec bound_vars_pat = function
            (List.fold_left
               (fun cur (lbl, pat) ->
                 [`PVar [lbl]]
-                @ (match pat with None -> [] | Some pat -> [pat])
+                @ (match pat with
+                    | `None | `Nullable -> []
+                    | `Pattern pat -> [pat])
                 @ cur)
               [] l))
 

src/lang/typechecking.ml

@@ -109,25 +109,31 @@ let rec type_of_pat ~level ~pos = function
       let env, ty =
         List.fold_left
           (fun (env, ty) (lbl, p) ->
-            let env', a =
+            let env', a, optional =
               match p with
-                | None -> ([], Type.var ~level ?pos ())
-                | Some pat -> type_of_pat ~level ~pos pat
+                | `None -> ([], Type.var ~level ?pos (), false)
+                | `Nullable -> ([], Type.var ~level ?pos (), true)
+                | `Pattern pat ->
+                    let env', a = type_of_pat ~level ~pos pat in
+                    (env', a, false)
             in
             let ty =
               Type.make ?pos
                 Type.(
                   Meth
                     ( {
                         meth = lbl;
-                        optional = false;
+                        optional;
                         scheme = ([], a);
                         doc = "";
                         json_name = None;
                       },
                       ty ))
             in
-            (env' @ [([lbl], a)] @ env, ty))
+            let lbl_ty =
+              if optional then Type.(make ?pos (Nullable a)) else a
+            in
+            (env' @ [([lbl], lbl_ty)] @ env, ty))
           (env, ty) l
       in
       (env, ty)

src/tooling/parsed_json.ml

@@ -220,9 +220,12 @@ let rec base_json_of_pat = function
             `Tuple
               (List.map
                  (function
-                   | var, None ->
+                   | var, `None ->
                        `Assoc (ast_node ~typ:"var" [("value", `String var)])
-                   | var, Some pat ->
+                   | var, `Nullable ->
+                       `Assoc
+                         (ast_node ~typ:"var" [("value", `String (var ^ "?"))])
+                   | var, `Pattern pat ->
                        `Assoc
                          (ast_node ~typ:"infix"
                             [

tests/language/record.liq

@@ -248,6 +248,14 @@ def f() =
   # Allow optional trailing comma
   x = {foo="bar", gni=123}
   x = "aabb".{foo="bar", gni=123}
+
+  # Allow optional method extraction
+  let { x? } = ()
+  test.equals(x, null())
+
+  let { x? } = { x = 123 }
+  test.equals(x, 123)
+
   test.pass()
 end
 

tests/language/type_errors.liq

@@ -153,6 +153,12 @@ def f() =
   incorrect(
     "let v.{foo=123} = {foo=123}"
   )
+  incorrect("def f(x) =
+      let { foo? } = x
+      foo
+    end
+    f(()) + 123")
+
   section("ENCODERS")
   correct('%ffmpeg(%video(codec="h264_nvenc"))')
   correct('%ffmpeg(%video(codec="h264_nvenc",hwaccel="none"))')