Skip to content

Commit 58fd6c5

Browse files
cristianoccristianoc
committed
AST cleanup: first class expression and patterns for records with optional fields.
1 parent 6cc7343 commit 58fd6c5

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

63 files changed

+397
-341
lines changed

‎analysis/reanalyze/src/Arnold.ml

+2-1
Original file line numberDiff line numberDiff line change
@@ -947,7 +947,8 @@ module Compile = struct
947947
|> List.map
948948
(fun
949949
( _desc,
950-
(recordLabelDefinition : Typedtree.record_label_definition) )
950+
(recordLabelDefinition : Typedtree.record_label_definition),
951+
_ )
951952
->
952953
match recordLabelDefinition with
953954
| Kept _typeExpr -> None

‎analysis/reanalyze/src/DeadValue.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -192,7 +192,7 @@ let rec collectExpr super self (e : Typedtree.expression) =
192192
DeadType.addTypeReference ~posTo ~posFrom:locFrom.loc_start
193193
| Texp_record {fields} ->
194194
fields
195-
|> Array.iter (fun (_, record_label_definition) ->
195+
|> Array.iter (fun (_, record_label_definition, _) ->
196196
match record_label_definition with
197197
| Typedtree.Overridden (_, ({exp_loc} as e)) when exp_loc.loc_ghost
198198
->
@@ -219,7 +219,7 @@ let collectPattern : _ -> _ -> Typedtree.pattern -> Typedtree.pattern =
219219
(match pat.pat_desc with
220220
| Typedtree.Tpat_record (cases, _clodsedFlag) ->
221221
cases
222-
|> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = posTo}}, _pat) ->
222+
|> List.iter (fun (_loc, {Types.lbl_loc = {loc_start = posTo}}, _pat, _) ->
223223
if !Config.analyzeTypes then
224224
DeadType.addTypeReference ~posFrom ~posTo)
225225
| _ -> ());

‎analysis/reanalyze/src/SideEffects.ml

+2-1
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,8 @@ and exprOptNoSideEffects eo =
7575
| None -> true
7676
| Some e -> e |> exprNoSideEffects
7777

78-
and fieldNoSideEffects ((_ld, rld) : _ * Typedtree.record_label_definition) =
78+
and fieldNoSideEffects
79+
((_ld, rld, _) : _ * Typedtree.record_label_definition * _) =
7980
match rld with
8081
| Kept _typeExpr -> true
8182
| Overridden (_lid, e) -> e |> exprNoSideEffects

‎analysis/src/CompletionExpressions.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos
6060
let fieldWithCursor = ref None in
6161
let fieldWithExprHole = ref None in
6262
fields
63-
|> List.iter (fun (fname, exp) ->
63+
|> List.iter (fun (fname, exp, _) ->
6464
match
6565
( fname.Location.txt,
6666
exp.Parsetree.pexp_loc |> CursorPosition.classifyLoc ~pos )
@@ -72,7 +72,7 @@ let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos
7272
| _ -> ());
7373
let seenFields =
7474
fields
75-
|> List.filter_map (fun (fieldName, _f) ->
75+
|> List.filter_map (fun (fieldName, _f, _) ->
7676
match fieldName with
7777
| {Location.txt = Longident.Lident fieldName} -> Some fieldName
7878
| _ -> None)

‎analysis/src/CompletionFrontEnd.ml

+3-2
Original file line numberDiff line numberDiff line change
@@ -473,7 +473,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
473473
?contextPath p
474474
| Ppat_record (fields, _) ->
475475
fields
476-
|> List.iter (fun (fname, p) ->
476+
|> List.iter (fun (fname, p, _) ->
477477
match fname with
478478
| {Location.txt = Longident.Lident fname} ->
479479
scopePattern
@@ -879,7 +879,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
879879
Pstr_eval
880880
( {
881881
pexp_desc =
882-
Pexp_record (({txt = Lident "from"}, fromExpr) :: _, _);
882+
Pexp_record
883+
(({txt = Lident "from"}, fromExpr, _) :: _, _);
883884
},
884885
_ );
885886
};

‎analysis/src/CompletionPatterns.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor
112112
let fieldWithCursor = ref None in
113113
let fieldWithPatHole = ref None in
114114
fields
115-
|> List.iter (fun (fname, f) ->
115+
|> List.iter (fun (fname, f, _) ->
116116
match
117117
( fname.Location.txt,
118118
f.Parsetree.ppat_loc
@@ -125,7 +125,7 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor
125125
| _ -> ());
126126
let seenFields =
127127
fields
128-
|> List.filter_map (fun (fieldName, _f) ->
128+
|> List.filter_map (fun (fieldName, _f, _) ->
129129
match fieldName with
130130
| {Location.txt = Longident.Lident fieldName} -> Some fieldName
131131
| _ -> None)

‎analysis/src/DumpAst.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,7 @@ let rec printPattern pattern ~pos ~indentation =
104104
^ addIndentation (indentation + 1)
105105
^ "fields:\n"
106106
^ (fields
107-
|> List.map (fun ((Location.{txt} as loc), pat) ->
107+
|> List.map (fun ((Location.{txt} as loc), pat, _) ->
108108
addIndentation (indentation + 2)
109109
^ (loc |> printLocDenominatorLoc ~pos)
110110
^ (Utils.flattenLongIdent txt |> ident |> str)
@@ -245,7 +245,7 @@ and printExprItem expr ~pos ~indentation =
245245
^ addIndentation (indentation + 1)
246246
^ "fields:\n"
247247
^ (fields
248-
|> List.map (fun ((Location.{txt} as loc), expr) ->
248+
|> List.map (fun ((Location.{txt} as loc), expr, _) ->
249249
addIndentation (indentation + 2)
250250
^ (loc |> printLocDenominatorLoc ~pos)
251251
^ (Utils.flattenLongIdent txt |> ident |> str)

‎analysis/src/Hint.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ let inlay ~path ~pos ~maxLength ~debug =
4444
match pat.ppat_desc with
4545
| Ppat_tuple pl -> pl |> List.iter processPattern
4646
| Ppat_record (fields, _) ->
47-
fields |> List.iter (fun (_, p) -> processPattern p)
47+
fields |> List.iter (fun (_, p, _) -> processPattern p)
4848
| Ppat_array fields -> fields |> List.iter processPattern
4949
| Ppat_var {loc} -> push loc Type
5050
| _ -> ()

‎analysis/src/ProcessCmt.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -459,7 +459,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
459459
pats |> List.iter (fun p -> handlePattern [] p)
460460
| Tpat_or (p, _, _) -> handlePattern [] p
461461
| Tpat_record (items, _) ->
462-
items |> List.iter (fun (_, _, p) -> handlePattern [] p)
462+
items |> List.iter (fun (_, _, p, _) -> handlePattern [] p)
463463
| Tpat_lazy p -> handlePattern [] p
464464
| Tpat_variant (_, Some p, _) -> handlePattern [] p
465465
| Tpat_variant (_, None, _) | Tpat_any | Tpat_constant _ -> ()

‎analysis/src/ProcessExtra.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -237,7 +237,7 @@ let addForRecord ~env ~extra ~recordType items =
237237
| Tconstr (path, _args, _memo) ->
238238
let t = getTypeAtPath ~env path in
239239
items
240-
|> List.iter (fun ({Asttypes.txt; loc}, _, _) ->
240+
|> List.iter (fun ({Asttypes.txt; loc}, _, _, _) ->
241241
(* let name = Longident.last(txt); *)
242242
let name = handleConstructor txt in
243243
let nameLoc = Utils.endOfLocation loc (String.length name) in
@@ -394,9 +394,9 @@ let expr ~env ~(extra : extra) (iter : Tast_iterator.iterator)
394394
| Texp_record {fields} ->
395395
addForRecord ~env ~extra ~recordType:expression.exp_type
396396
(fields |> Array.to_list
397-
|> Utils.filterMap (fun (desc, item) ->
397+
|> Utils.filterMap (fun (desc, item, opt) ->
398398
match item with
399-
| Typedtree.Overridden (loc, _) -> Some (loc, desc, ())
399+
| Typedtree.Overridden (loc, _) -> Some (loc, desc, (), opt)
400400
| _ -> None))
401401
| Texp_constant constant ->
402402
addLocItem extra expression.exp_loc (Constant constant)

‎analysis/src/SemanticTokens.ml

+3-2
Original file line numberDiff line numberDiff line change
@@ -226,7 +226,8 @@ let command ~debug ~emitter ~path =
226226
Ast_iterator.default_iterator.pat iterator p
227227
| Ppat_record (cases, _) ->
228228
cases
229-
|> List.iter (fun (label, _) -> emitter |> emitRecordLabel ~label ~debug);
229+
|> List.iter (fun (label, _, _) ->
230+
emitter |> emitRecordLabel ~label ~debug);
230231
Ast_iterator.default_iterator.pat iterator p
231232
| Ppat_construct (name, _) ->
232233
emitter |> emitVariant ~name ~debug;
@@ -309,7 +310,7 @@ let command ~debug ~emitter ~path =
309310
Ast_iterator.default_iterator.expr iterator e
310311
| Pexp_record (cases, _) ->
311312
cases
312-
|> List.filter_map (fun ((label : Longident.t Location.loc), _) ->
313+
|> List.filter_map (fun ((label : Longident.t Location.loc), _, _) ->
313314
match label.txt with
314315
| Longident.Lident s when not (Utils.isFirstCharUppercase s) ->
315316
Some label

‎analysis/src/SignatureHelp.ml

+6-4
Original file line numberDiff line numberDiff line change
@@ -637,8 +637,10 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
637637
fields
638638
|> List.find_map
639639
(fun
640-
(({loc; txt}, expr) :
641-
Longident.t Location.loc * Parsetree.expression)
640+
(({loc; txt}, expr, _) :
641+
Longident.t Location.loc
642+
* Parsetree.expression
643+
* bool)
642644
->
643645
if
644646
posBeforeCursor >= Pos.ofLexing loc.loc_start
@@ -679,8 +681,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
679681
fields
680682
|> List.find_map
681683
(fun
682-
(({loc; txt}, pat) :
683-
Longident.t Location.loc * Parsetree.pattern)
684+
(({loc; txt}, pat, _) :
685+
Longident.t Location.loc * Parsetree.pattern * bool)
684686
->
685687
if
686688
posBeforeCursor >= Pos.ofLexing loc.loc_start

‎analysis/src/Xform.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -78,10 +78,10 @@ module IfThenElse = struct
7878
| None -> None
7979
| Some patList -> Some (mkPat (Ppat_tuple patList)))
8080
| Pexp_record (items, None) -> (
81-
let itemToPat (x, e) =
81+
let itemToPat (x, e, o) =
8282
match expToPat e with
8383
| None -> None
84-
| Some p -> Some (x, p)
84+
| Some p -> Some (x, p, o)
8585
in
8686
match listToPat ~itemToPat items with
8787
| None -> None

‎compiler/common/pattern_printer.ml

+2-1
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,8 @@ let untype typed =
3232
| Tpat_record (subpatterns, closed_flag) ->
3333
let fields =
3434
List.map
35-
(fun (_, lbl, p) -> (mknoloc (Longident.Lident lbl.lbl_name), loop p))
35+
(fun (_, lbl, p, opt) ->
36+
(mknoloc (Longident.Lident lbl.lbl_name), loop p, opt))
3637
subpatterns
3738
in
3839
mkpat (Ppat_record (fields, closed_flag))

‎compiler/frontend/ast_derive_js_mapper.ml

+4-3
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,8 @@ let handle_config (config : Parsetree.expression option) =
4444
( Pexp_construct
4545
({txt = Lident (("true" | "false") as x)}, None)
4646
| Pexp_ident {txt = Lident ("newType" as x)} );
47-
} );
47+
},
48+
_ );
4849
],
4950
None ) ->
5051
not (x = "false")
@@ -193,7 +194,7 @@ let init () =
193194
txt = Longident.Lident txt;
194195
}
195196
in
196-
(label, Exp.field exp_param label)))
197+
(label, Exp.field exp_param label, false)))
197198
None);
198199
] ))
199200
in
@@ -205,7 +206,7 @@ let init () =
205206
let label =
206207
{Asttypes.loc; txt = Longident.Lident txt}
207208
in
208-
(label, js_field exp_param label)))
209+
(label, js_field exp_param label, false)))
209210
None
210211
in
211212
let from_js =

‎compiler/frontend/ast_external_process.ml

+6-4
Original file line numberDiff line numberDiff line change
@@ -266,8 +266,8 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
266266
fields
267267
|> List.iter
268268
(fun
269-
((l, exp) :
270-
Longident.t Location.loc * Parsetree.expression)
269+
((l, exp, _) :
270+
Longident.t Location.loc * Parsetree.expression * bool)
271271
->
272272
match (l, exp.pexp_desc) with
273273
| ( {txt = Lident "from"; _},
@@ -293,8 +293,10 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string)
293293
with_fields
294294
|> List.filter_map
295295
(fun
296-
((l, exp) :
297-
Longident.t Location.loc * Parsetree.expression)
296+
((l, exp, _) :
297+
Longident.t Location.loc
298+
* Parsetree.expression
299+
* bool)
298300
->
299301
match exp.pexp_desc with
300302
| Pexp_constant (Pconst_string (s, _)) -> (

‎compiler/frontend/ast_tuple_pattern_flatten.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ let flattern_tuple_pattern_vb (self : Bs_ast_mapper.mapper)
6565
:: acc)
6666
| _ -> {pvb_pat; pvb_expr; pvb_loc = vb.pvb_loc; pvb_attributes} :: acc)
6767
| Ppat_record (lid_pats, _), Pexp_pack {pmod_desc = Pmod_ident id} ->
68-
Ext_list.map_append lid_pats acc (fun (lid, pat) ->
68+
Ext_list.map_append lid_pats acc (fun (lid, pat, _) ->
6969
match lid.txt with
7070
| Lident s ->
7171
{

‎compiler/frontend/ast_uncurry_gen.ml

+3-1
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,9 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
5757
( Nolabel,
5858
Exp.constraint_ ~loc
5959
(Exp.record ~loc
60-
[({loc; txt = Ast_literal.Lid.hidden_field arity_s}, body)]
60+
[
61+
({loc; txt = Ast_literal.Lid.hidden_field arity_s}, body, false);
62+
]
6163
None)
6264
(Typ.constr ~loc
6365
{

‎compiler/frontend/ast_util.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25-
type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
25+
type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression * bool) list
2626

2727
let js_property loc obj (name : string) =
2828
Parsetree.Pexp_send (obj, {loc; txt = name})
@@ -31,7 +31,7 @@ let record_as_js_object loc (self : Bs_ast_mapper.mapper)
3131
(label_exprs : label_exprs) : Parsetree.expression_desc =
3232
let labels, args, arity =
3333
Ext_list.fold_right label_exprs ([], [], 0)
34-
(fun ({txt; loc}, e) (labels, args, i) ->
34+
(fun ({txt; loc}, e, _) (labels, args, i) ->
3535
match txt with
3636
| Lident x ->
3737
( {Asttypes.loc; txt = x} :: labels,

‎compiler/frontend/ast_util.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@
2828
- convert a uncuried application to normal
2929
*)
3030

31-
type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
31+
type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression * bool) list
3232

3333
val record_as_js_object :
3434
Location.t -> Bs_ast_mapper.mapper -> label_exprs -> Parsetree.expression_desc

‎compiler/frontend/bs_ast_mapper.ml

+3-2
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ type mapper = {
6969
with_constraint: mapper -> with_constraint -> with_constraint;
7070
}
7171

72+
let id x = x
7273
let map_fst f (x, y) = (f x, y)
7374
let map_snd f (x, y) = (x, f y)
7475
let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
@@ -331,7 +332,7 @@ module E = struct
331332
variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
332333
| Pexp_record (l, eo) ->
333334
record ~loc ~attrs
334-
(List.map (map_tuple (map_loc sub) (sub.expr sub)) l)
335+
(List.map (map_tuple3 (map_loc sub) (sub.expr sub) id) l)
335336
(map_opt (sub.expr sub) eo)
336337
| Pexp_field (e, lid) ->
337338
field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
@@ -397,7 +398,7 @@ module P = struct
397398
| Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
398399
| Ppat_record (lpl, cf) ->
399400
record ~loc ~attrs
400-
(List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl)
401+
(List.map (map_tuple3 (map_loc sub) (sub.pat sub) id) lpl)
401402
cf
402403
| Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl)
403404
| Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)

‎compiler/ml/ast_helper.mli

+6-2
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,11 @@ module Pat : sig
9999
val construct : ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
100100
val variant : ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
101101
val record :
102-
?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern
102+
?loc:loc ->
103+
?attrs:attrs ->
104+
(lid * pattern * bool) list ->
105+
closed_flag ->
106+
pattern
103107
val array : ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
104108
val or_ : ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
105109
val constraint_ : ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
@@ -150,7 +154,7 @@ module Exp : sig
150154
val record :
151155
?loc:loc ->
152156
?attrs:attrs ->
153-
(lid * expression) list ->
157+
(lid * expression * bool) list ->
154158
expression option ->
155159
expression
156160
val field : ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression

‎compiler/ml/ast_iterator.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -302,7 +302,7 @@ module E = struct
302302
iter_opt (sub.expr sub) arg
303303
| Pexp_variant (_lab, eo) -> iter_opt (sub.expr sub) eo
304304
| Pexp_record (l, eo) ->
305-
List.iter (iter_tuple (iter_loc sub) (sub.expr sub)) l;
305+
List.iter (iter_tuple3 (iter_loc sub) (sub.expr sub) (fun _ -> ())) l;
306306
iter_opt (sub.expr sub) eo
307307
| Pexp_field (e, lid) ->
308308
sub.expr sub e;
@@ -380,7 +380,7 @@ module P = struct
380380
iter_opt (sub.pat sub) p
381381
| Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
382382
| Ppat_record (lpl, _cf) ->
383-
List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl
383+
List.iter (iter_tuple3 (iter_loc sub) (sub.pat sub) (fun _ -> ())) lpl
384384
| Ppat_array pl -> List.iter (sub.pat sub) pl
385385
| Ppat_or (p1, p2) ->
386386
sub.pat sub p1;

0 commit comments

Comments
 (0)