AST cleanup: first class expression and patterns for records with opt…

CHANGELOG.md

@@ -22,6 +22,7 @@
 - Added infra to modernise AST: theres' Parsetree, Parsetree0 (legacy), and conversion functions to keep compatibility with PPX. https://github.com/rescript-lang/rescript/pull/7185
 - Ast cleanup: remove exp object and exp unreachable. https://github.com/rescript-lang/rescript/pull/7189
 - Ast cleanup: explicit representation for optional record fields in types. https://github.com/rescript-lang/rescript/pull/7190 https://github.com/rescript-lang/rescript/pull/7191
+- AST cleanup: first-class expression and patterns for records with optional fields. https://github.com/rescript-lang/rescript/pull/7192
 
 
 # 12.0.0-alpha.5

analysis/reanalyze/src/Arnold.ml

@@ -947,7 +947,8 @@ module Compile = struct
          |> List.map
               (fun
                 ( _desc,
-                  (recordLabelDefinition : Typedtree.record_label_definition) )
+                  (recordLabelDefinition : Typedtree.record_label_definition),
+                  _ )
               ->
                 match recordLabelDefinition with
                 | Kept _typeExpr -> None

analysis/reanalyze/src/DeadValue.ml

@@ -192,7 +192,7 @@ let rec collectExpr super self (e : Typedtree.expression) =
       DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start
   | Texp_record {fields} ->
     fields
-    |> Array.iter (fun (_, record_label_definition) ->
+    |> Array.iter (fun (_, record_label_definition, _) ->
            match record_label_definition with
            | Typedtree.Overridden (_, ({exp_loc} as e)) when exp_loc.loc_ghost
              ->
@@ -219,7 +219,7 @@ let collectPattern : _ -> _ -> Typedtree.pattern -> Typedtree.pattern =
   (match pat.pat_desc with
   | Typedtree.Tpat_record (cases, _clodsedFlag) ->
     cases
-    |> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = posTo}}, _pat) ->
+    |> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = posTo}}, _pat, _) ->
            if !Config.analyzeTypes then
              DeadType.addTypeReference ~posFrom ~posTo)
   | _ -> ());

analysis/reanalyze/src/SideEffects.ml

@@ -75,7 +75,8 @@ and exprOptNoSideEffects eo =
   | None -> true
   | Some e -> e |> exprNoSideEffects
 
-and fieldNoSideEffects ((_ld, rld) : _ * Typedtree.record_label_definition) =
+and fieldNoSideEffects
+    ((_ld, rld, _) : _ * Typedtree.record_label_definition * _) =
   match rld with
   | Kept _typeExpr -> true
   | Overridden (_lid, e) -> e |> exprNoSideEffects

analysis/src/CompletionExpressions.ml

@@ -60,7 +60,7 @@ let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos
     let fieldWithCursor = ref None in
     let fieldWithExprHole = ref None in
     fields
-    |> List.iter (fun (fname, exp) ->
+    |> List.iter (fun (fname, exp, _) ->
            match
              ( fname.Location.txt,
                exp.Parsetree.pexp_loc |> CursorPosition.classifyLoc ~pos )
@@ -72,7 +72,7 @@ let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos
            | _ -> ());
     let seenFields =
       fields
-      |> List.filter_map (fun (fieldName, _f) ->
+      |> List.filter_map (fun (fieldName, _f, _) ->
              match fieldName with
              | {Location.txt = Longident.Lident fieldName} -> Some fieldName
              | _ -> None)

analysis/src/CompletionFrontEnd.ml

@@ -473,7 +473,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
         ?contextPath p
     | Ppat_record (fields, _) ->
       fields
-      |> List.iter (fun (fname, p) ->
+      |> List.iter (fun (fname, p, _) ->
              match fname with
              | {Location.txt = Longident.Lident fname} ->
                scopePattern
@@ -879,7 +879,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
                  Pstr_eval
                    ( {
                        pexp_desc =
-                         Pexp_record (({txt = Lident "from"}, fromExpr) :: _, _);
+                         Pexp_record
+                           (({txt = Lident "from"}, fromExpr, _) :: _, _);
                      },
                      _ );
              };

analysis/src/CompletionPatterns.ml

@@ -112,7 +112,7 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor
     let fieldWithCursor = ref None in
     let fieldWithPatHole = ref None in
     fields
-    |> List.iter (fun (fname, f) ->
+    |> List.iter (fun (fname, f, _) ->
            match
              ( fname.Location.txt,
                f.Parsetree.ppat_loc
@@ -125,7 +125,7 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor
            | _ -> ());
     let seenFields =
       fields
-      |> List.filter_map (fun (fieldName, _f) ->
+      |> List.filter_map (fun (fieldName, _f, _) ->
              match fieldName with
              | {Location.txt = Longident.Lident fieldName} -> Some fieldName
              | _ -> None)

analysis/src/DumpAst.ml

@@ -104,7 +104,7 @@ let rec printPattern pattern ~pos ~indentation =
     ^ addIndentation (indentation + 1)
     ^ "fields:\n"
     ^ (fields
-      |> List.map (fun ((Location.{txt} as loc), pat) ->
+      |> List.map (fun ((Location.{txt} as loc), pat, _) ->
              addIndentation (indentation + 2)
              ^ (loc |> printLocDenominatorLoc ~pos)
              ^ (Utils.flattenLongIdent txt |> ident |> str)
@@ -245,7 +245,7 @@ and printExprItem expr ~pos ~indentation =
     ^ addIndentation (indentation + 1)
     ^ "fields:\n"
     ^ (fields
-      |> List.map (fun ((Location.{txt} as loc), expr) ->
+      |> List.map (fun ((Location.{txt} as loc), expr, _) ->
              addIndentation (indentation + 2)
              ^ (loc |> printLocDenominatorLoc ~pos)
              ^ (Utils.flattenLongIdent txt |> ident |> str)

analysis/src/Hint.ml

@@ -44,7 +44,7 @@ let inlay ~path ~pos ~maxLength ~debug =
     match pat.ppat_desc with
     | Ppat_tuple pl -> pl |> List.iter processPattern
     | Ppat_record (fields, _) ->
-      fields |> List.iter (fun (_, p) -> processPattern p)
+      fields |> List.iter (fun (_, p, _) -> processPattern p)
     | Ppat_array fields -> fields |> List.iter processPattern
     | Ppat_var {loc} -> push loc Type
     | _ -> ()

analysis/src/ProcessCmt.ml

@@ -459,7 +459,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         pats |> List.iter (fun p -> handlePattern [] p)
       | Tpat_or (p, _, _) -> handlePattern [] p
       | Tpat_record (items, _) ->
-        items |> List.iter (fun (_, _, p) -> handlePattern [] p)
+        items |> List.iter (fun (_, _, p, _) -> handlePattern [] p)
       | Tpat_lazy p -> handlePattern [] p
       | Tpat_variant (_, Some p, _) -> handlePattern [] p
       | Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> ()

analysis/src/ProcessExtra.ml

@@ -237,7 +237,7 @@ let addForRecord ~env ~extra ~recordType items =
   | Tconstr (path, _args, _memo) ->
     let t = getTypeAtPath ~env path in
     items
-    |> List.iter (fun ({Asttypes.txt; loc}, _, _) ->
+    |> List.iter (fun ({Asttypes.txt; loc}, _, _, _) ->
            (* let name = Longident.last(txt); *)
            let name = handleConstructor txt in
            let nameLoc = Utils.endOfLocation loc (String.length name) in
@@ -394,9 +394,9 @@ let expr ~env ~(extra : extra) (iter : Tast_iterator.iterator)
   | Texp_record {fields} ->
     addForRecord ~env ~extra ~recordType:expression.exp_type
       (fields |> Array.to_list
-      |> Utils.filterMap (fun (desc, item) ->
+      |> Utils.filterMap (fun (desc, item, opt) ->
              match item with
-             | Typedtree.Overridden (loc, _) -> Some (loc, desc, ())
+             | Typedtree.Overridden (loc, _) -> Some (loc, desc, (), opt)
              | _ -> None))
   | Texp_constant constant ->
     addLocItem extra expression.exp_loc (Constant constant)

analysis/src/SemanticTokens.ml

@@ -226,7 +226,8 @@ let command ~debug ~emitter ~path =
       Ast_iterator.default_iterator.pat iterator p
     | Ppat_record (cases, _) ->
       cases
-      |> List.iter (fun (label, _) -> emitter |> emitRecordLabel ~label ~debug);
+      |> List.iter (fun (label, _, _) ->
+             emitter |> emitRecordLabel ~label ~debug);
       Ast_iterator.default_iterator.pat iterator p
     | Ppat_construct (name, _) ->
       emitter |> emitVariant ~name ~debug;
@@ -309,7 +310,7 @@ let command ~debug ~emitter ~path =
       Ast_iterator.default_iterator.expr iterator e
     | Pexp_record (cases, _) ->
       cases
-      |> List.filter_map (fun ((label : Longident.t Location.loc), _) ->
+      |> List.filter_map (fun ((label : Longident.t Location.loc), _, _) ->
              match label.txt with
              | Longident.Lident s when not (Utils.isFirstCharUppercase s) ->
                Some label

analysis/src/SignatureHelp.ml

@@ -637,8 +637,10 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                   fields
                   |> List.find_map
                        (fun
-                         (({loc; txt}, expr) :
-                           Longident.t Location.loc * Parsetree.expression)
+                         (({loc; txt}, expr, _) :
+                           Longident.t Location.loc
+                           * Parsetree.expression
+                           * bool)
                        ->
                          if
                            posBeforeCursor >= Pos.ofLexing loc.loc_start
@@ -679,8 +681,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                   fields
                   |> List.find_map
                        (fun
-                         (({loc; txt}, pat) :
-                           Longident.t Location.loc * Parsetree.pattern)
+                         (({loc; txt}, pat, _) :
+                           Longident.t Location.loc * Parsetree.pattern * bool)
                        ->
                          if
                            posBeforeCursor >= Pos.ofLexing loc.loc_start

analysis/src/Xform.ml

@@ -78,10 +78,10 @@ module IfThenElse = struct
       | None -> None
       | Some patList -> Some (mkPat (Ppat_tuple patList)))
     | Pexp_record (items, None) -> (
-      let itemToPat (x, e) =
+      let itemToPat (x, e, o) =
         match expToPat e with
         | None -> None
-        | Some p -> Some (x, p)
+        | Some p -> Some (x, p, o)
       in
       match listToPat ~itemToPat items with
       | None -> None

compiler/common/pattern_printer.ml

@@ -32,7 +32,8 @@ let untype typed =
     | Tpat_record (subpatterns, closed_flag) ->
       let fields =
         List.map
-          (fun (_, lbl, p) -> (mknoloc (Longident.Lident lbl.lbl_name), loop p))
+          (fun (_, lbl, p, opt) ->
+            (mknoloc (Longident.Lident lbl.lbl_name), loop p, opt))
           subpatterns
       in
       mkpat (Ppat_record (fields, closed_flag))

compiler/frontend/ast_derive_js_mapper.ml

@@ -44,7 +44,8 @@ let handle_config (config : Parsetree.expression option) =
                   ( Pexp_construct
                       ({txt = Lident (("true" | "false") as x)}, None)
                   | Pexp_ident {txt = Lident ("newType" as x)} );
-              } );
+              },
+              _ );
           ],
           None ) ->
       not (x = "false")
@@ -193,7 +194,7 @@ let init () =
                                            txt = Longident.Lident txt;
                                          }
                                        in
-                                       (label, Exp.field exp_param label)))
+                                       (label, Exp.field exp_param label, false)))
                                   None);
                            ] ))
                 in
@@ -205,7 +206,7 @@ let init () =
                          let label =
                            {Asttypes.loc; txt = Longident.Lident txt}
                          in
-                         (label, js_field exp_param label)))
+                         (label, js_field exp_param label, false)))
                     None
                 in
                 let from_js =

compiler/frontend/ast_external_process.ml

@@ -266,8 +266,8 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
               fields
               |> List.iter
                    (fun
-                     ((l, exp) :
-                       Longident.t Location.loc * Parsetree.expression)
+                     ((l, exp, _) :
+                       Longident.t Location.loc * Parsetree.expression * bool)
                    ->
                      match (l, exp.pexp_desc) with
                      | ( {txt = Lident "from"; _},
@@ -293,8 +293,10 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
                   with_fields
                   |> List.filter_map
                        (fun
-                         ((l, exp) :
-                           Longident.t Location.loc * Parsetree.expression)
+                         ((l, exp, _) :
+                           Longident.t Location.loc
+                           * Parsetree.expression
+                           * bool)
                        ->
                          match exp.pexp_desc with
                          | Pexp_constant (Pconst_string (s, _)) -> (

compiler/frontend/ast_tuple_pattern_flatten.ml

@@ -65,7 +65,7 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
           :: acc)
     | _ -> {pvb_pat; pvb_expr; pvb_loc = vb.pvb_loc; pvb_attributes} :: acc)
   | Ppat_record (lid_pats, _), Pexp_pack {pmod_desc = Pmod_ident id} ->
-    Ext_list.map_append lid_pats acc (fun (lid, pat) ->
+    Ext_list.map_append lid_pats acc (fun (lid, pat, _) ->
         match lid.txt with
         | Lident s ->
           {

compiler/frontend/ast_uncurry_gen.ml

@@ -57,7 +57,9 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
         ( Nolabel,
           Exp.constraint_ ~loc
             (Exp.record ~loc
-               [({loc; txt = Ast_literal.Lid.hidden_field arity_s}, body)]
+               [
+                 ({loc; txt = Ast_literal.Lid.hidden_field arity_s}, body, false);
+               ]
                None)
             (Typ.constr ~loc
                {

compiler/frontend/ast_util.ml

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
+type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression * bool) list
 
 let js_property loc obj (name : string) =
   Parsetree.Pexp_send (obj, {loc; txt = name})
@@ -31,7 +31,7 @@ let record_as_js_object loc (self : Bs_ast_mapper.mapper)
     (label_exprs : label_exprs) : Parsetree.expression_desc =
   let labels, args, arity =
     Ext_list.fold_right label_exprs ([], [], 0)
-      (fun ({txt; loc}, e) (labels, args, i) ->
+      (fun ({txt; loc}, e, _) (labels, args, i) ->
         match txt with
         | Lident x ->
           ( {Asttypes.loc; txt = x} :: labels,

compiler/frontend/ast_util.mli

@@ -28,7 +28,7 @@
     - convert a uncuried application to normal 
 *)
 
-type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
+type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression * bool) list
 
 val record_as_js_object :
   Location.t -> Bs_ast_mapper.mapper -> label_exprs -> Parsetree.expression_desc

compiler/frontend/bs_ast_mapper.ml

@@ -69,6 +69,7 @@ type mapper = {
   with_constraint: mapper -> with_constraint -> with_constraint;
 }
 
+let id x = x
 let map_fst f (x, y) = (f x, y)
 let map_snd f (x, y) = (x, f y)
 let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
@@ -331,7 +332,7 @@ module E = struct
       variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
     | Pexp_record (l, eo) ->
       record ~loc ~attrs
-        (List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
+        (List.map (map_tuple3 (map_loc sub) (sub.expr sub) id) l)
         (map_opt (sub.expr sub) eo)
     | Pexp_field (e, lid) ->
       field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
@@ -397,7 +398,7 @@ module P = struct
     | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
     | Ppat_record (lpl, cf) ->
       record ~loc ~attrs
-        (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl)
+        (List.map (map_tuple3 (map_loc sub) (sub.pat sub) id) lpl)
         cf
     | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl)
     | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)

compiler/ml/ast_helper.mli

@@ -99,7 +99,11 @@ module Pat : sig
   val construct : ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
   val variant : ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
   val record :
-    ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern
+    ?loc:loc ->
+    ?attrs:attrs ->
+    (lid * pattern * bool) list ->
+    closed_flag ->
+    pattern
   val array : ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
   val or_ : ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
   val constraint_ : ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
@@ -150,7 +154,7 @@ module Exp : sig
   val record :
     ?loc:loc ->
     ?attrs:attrs ->
-    (lid * expression) list ->
+    (lid * expression * bool) list ->
     expression option ->
     expression
   val field : ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression

compiler/ml/ast_iterator.ml

@@ -302,7 +302,7 @@ module E = struct
       iter_opt (sub.expr sub) arg
     | Pexp_variant (_lab, eo) -> iter_opt (sub.expr sub) eo
     | Pexp_record (l, eo) ->
-      List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l;
+      List.iter (iter_tuple3 (iter_loc sub) (sub.expr sub) (fun _ -> ())) l;
       iter_opt (sub.expr sub) eo
     | Pexp_field (e, lid) ->
       sub.expr sub e;
@@ -380,7 +380,7 @@ module P = struct
       iter_opt (sub.pat sub) p
     | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
     | Ppat_record (lpl, _cf) ->
-      List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl
+      List.iter (iter_tuple3 (iter_loc sub) (sub.pat sub) (fun _ -> ())) lpl
     | Ppat_array pl -> List.iter (sub.pat sub) pl
     | Ppat_or (p1, p2) ->
       sub.pat sub p1;