AST cleanup: first class expression and patterns for records with optional fields.

Author: cristianoc

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)