Skip to content

Commit 59701eb

Browse files
bobzhangbobzhang
committed
internal clean up, precise location
1 parent 346d575 commit 59701eb

14 files changed

+155
-164
lines changed

‎jscomp/syntax/ast_compatible.ml‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -159,14 +159,13 @@ let apply_labels
159159
let object_
160160
?(loc= default_loc)
161161
?(attrs = [])
162-
(fields : (string * attributes * core_type) list)
163-
(* FIXME after upgrade *)
162+
(fields : (Asttypes.label Asttypes.loc * attributes * core_type) list)
164163
flg : core_type =
165164
{
166165
ptyp_desc =
167166
Ptyp_object(
168167
Ext_list.map fields (fun (a,b,c) ->
169-
Parsetree.Otag ({txt = a; loc = c.ptyp_loc},b,c)),flg);
168+
Parsetree.Otag (a,b,c)),flg);
170169
ptyp_loc = loc;
171170
ptyp_attributes = attrs
172171
}

‎jscomp/syntax/ast_compatible.mli‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -145,8 +145,7 @@ val opt_arrow:
145145
val object_:
146146
?loc:loc ->
147147
?attrs:attrs ->
148-
(string * attributes * core_type) list ->
149-
(*FIXME shall we use [string loc] instead?*)
148+
(string Asttypes.loc * attributes * core_type) list ->
150149
Asttypes.closed_flag ->
151150
core_type
152151

‎jscomp/syntax/ast_core_type.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,7 @@ let from_labels ~loc arity labels
105105
let result_type =
106106
Ast_comb.to_js_type loc
107107
(Ast_compatible.object_ ~loc
108-
(Ext_list.map2 labels tyvars (fun x y -> x.Asttypes.txt ,[], y)) Closed)
108+
(Ext_list.map2 labels tyvars (fun x y -> x ,[], y)) Closed)
109109
in
110110
Ext_list.fold_right2 labels tyvars result_type
111111
(fun label (* {loc ; txt = label }*)

‎jscomp/syntax/ast_core_type.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ val from_labels :
4747

4848
val make_obj :
4949
loc:Location.t ->
50-
(string * Parsetree.attributes * t) list ->
50+
(string Asttypes.loc * Parsetree.attributes * t) list ->
5151
t
5252

5353
val is_user_option : t -> bool

‎jscomp/syntax/ast_derive_js_mapper.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -437,8 +437,8 @@ let init () =
437437
Ast_comb.to_js_type loc @@
438438
Ast_compatible.object_
439439
(Ext_list.map label_declarations
440-
(fun {pld_name = {loc; txt }; pld_type } ->
441-
txt, [], pld_type))
440+
(fun {pld_name ; pld_type } ->
441+
pld_name, [], pld_type))
442442
flag in
443443
newTypeStr +?
444444
[

‎jscomp/syntax/ast_external_process.ml‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -415,6 +415,7 @@ let process_obj
415415
Ext_list.fold_right arg_types_ty ( [], [], [])
416416
(fun param_type ( arg_labels, (arg_types : Ast_compatible.param_type list), result_types) ->
417417
let arg_label = param_type.label in
418+
let loc = param_type.loc in
418419
let ty = param_type.ty in
419420
let new_arg_label, new_arg_types, output_tys =
420421
match arg_label with
@@ -436,22 +437,22 @@ let process_obj
436437
{arg_label = External_arg_spec.label s (Some i);
437438
arg_type },
438439
arg_types, (* ignored in [arg_types], reserved in [result_types] *)
439-
((name , [], new_ty) :: result_types)
440+
(({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
440441
| Nothing ->
441442
let s = (Lam_methname.translate ~loc name) in
442443
{arg_label = External_arg_spec.label s None ; arg_type },
443444
{param_type with ty = new_ty}::arg_types,
444-
((name , [], new_ty) :: result_types)
445+
(({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
445446
| Int _ ->
446447
let s = Lam_methname.translate ~loc name in
447448
{arg_label = External_arg_spec.label s None; arg_type},
448449
{param_type with ty = new_ty}::arg_types,
449-
((name, [], Ast_literal.type_int ~loc ()) :: result_types)
450+
(({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
450451
| NullString _ ->
451452
let s = Lam_methname.translate ~loc name in
452453
{arg_label = External_arg_spec.label s None; arg_type},
453454
{param_type with ty = new_ty }::arg_types,
454-
((name, [], Ast_literal.type_string ~loc ()) :: result_types)
455+
(({Asttypes.txt = name; loc}, [], Ast_literal.type_string ~loc ()) :: result_types)
455456
| Fn_uncurry_arity _ ->
456457
Location.raise_errorf ~loc
457458
"The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
@@ -474,17 +475,17 @@ let process_obj
474475
let s = (Lam_methname.translate ~loc name) in
475476
{arg_label = External_arg_spec.optional s; arg_type},
476477
param_type :: arg_types,
477-
( (name, [], Ast_comb.to_undefined_type loc ty) :: result_types)
478+
( ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc ty) :: result_types)
478479
| Int _ ->
479480
let s = Lam_methname.translate ~loc name in
480481
{arg_label = External_arg_spec.optional s ; arg_type },
481482
param_type :: arg_types,
482-
((name, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
483+
(({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
483484
| NullString _ ->
484485
let s = Lam_methname.translate ~loc name in
485486
{arg_label = External_arg_spec.optional s ; arg_type },
486487
param_type::arg_types,
487-
((name, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
488+
(({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
488489
| Arg_cst _
489490
->
490491
Location.raise_errorf ~loc "bs.as is not supported with optional yet"

‎jscomp/syntax/ast_util.ml‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -386,13 +386,13 @@ let ocaml_obj_as_js_object
386386

387387
let generate_val_method_pair
388388
loc (mapper : Bs_ast_mapper.mapper)
389-
val_name is_mutable =
389+
(val_name : string Asttypes.loc) is_mutable =
390390

391-
let result = Typ.var ~loc val_name in
391+
let result = Typ.var ~loc val_name.txt in
392392
result ,
393393
((val_name , [], result ) ::
394394
(if is_mutable then
395-
[val_name ^ Literals.setter_suffix,[],
395+
[{val_name with txt = val_name.txt ^ Literals.setter_suffix},[],
396396
to_method_type loc mapper Nolabel result (Ast_literal.type_unit ~loc ()) ]
397397
else
398398
[]) )
@@ -475,9 +475,9 @@ let ocaml_obj_as_js_object
475475
let arity = Ast_pat.arity_of_fun pat e in
476476
let method_type =
477477
generate_arg_type x.pcf_loc mapper label.txt arity in
478-
((label.Asttypes.txt, [], method_type) :: label_attr_types),
478+
((label, [], method_type) :: label_attr_types),
479479
(if public_flag = Public then
480-
(label.Asttypes.txt, [], method_type) :: public_label_attr_types
480+
(label, [], method_type) :: public_label_attr_types
481481
else
482482
public_label_attr_types)
483483

@@ -492,7 +492,7 @@ let ocaml_obj_as_js_object
492492
end
493493
| Pcf_val (label, mutable_flag, Cfk_concrete(Fresh, val_exp)) ->
494494
let label_type, label_attr =
495-
generate_val_method_pair x.pcf_loc mapper label.txt
495+
generate_val_method_pair x.pcf_loc mapper label
496496
(mutable_flag = Mutable )
497497
in
498498
(Ext_list.append label_attr label_attr_types, public_label_attr_types)
@@ -564,7 +564,7 @@ let ocaml_obj_as_js_object
564564
end
565565
| Pcf_val (label, mutable_flag, Cfk_concrete(Fresh, val_exp)) ->
566566
let label_type, label_attr =
567-
generate_val_method_pair x.pcf_loc mapper label.txt
567+
generate_val_method_pair x.pcf_loc mapper label
568568
(mutable_flag = Mutable )
569569
in
570570
(label::labels,

‎lib/4.06.1/bsdep.ml‎

Lines changed: 22 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -32886,8 +32886,7 @@ val opt_arrow:
3288632886
val object_:
3288732887
?loc:loc ->
3288832888
?attrs:attrs ->
32889-
(string * attributes * core_type) list ->
32890-
(*FIXME shall we use [string loc] instead?*)
32889+
(string Asttypes.loc * attributes * core_type) list ->
3289132890
Asttypes.closed_flag ->
3289232891
core_type
3289332892

@@ -33101,14 +33100,13 @@ let apply_labels
3310133100
let object_
3310233101
?(loc= default_loc)
3310333102
?(attrs = [])
33104-
(fields : (string * attributes * core_type) list)
33105-
(* FIXME after upgrade *)
33103+
(fields : (Asttypes.label Asttypes.loc * attributes * core_type) list)
3310633104
flg : core_type =
3310733105
{
3310833106
ptyp_desc =
3310933107
Ptyp_object(
3311033108
Ext_list.map fields (fun (a,b,c) ->
33111-
Parsetree.Otag ({txt = a; loc = c.ptyp_loc},b,c)),flg);
33109+
Parsetree.Otag (a,b,c)),flg);
3311233110
ptyp_loc = loc;
3311333111
ptyp_attributes = attrs
3311433112
}
@@ -34834,7 +34832,7 @@ val from_labels :
3483434832

3483534833
val make_obj :
3483634834
loc:Location.t ->
34837-
(string * Parsetree.attributes * t) list ->
34835+
(string Asttypes.loc * Parsetree.attributes * t) list ->
3483834836
t
3483934837

3484034838
val is_user_option : t -> bool
@@ -34969,7 +34967,7 @@ let from_labels ~loc arity labels
3496934967
let result_type =
3497034968
Ast_comb.to_js_type loc
3497134969
(Ast_compatible.object_ ~loc
34972-
(Ext_list.map2 labels tyvars (fun x y -> x.Asttypes.txt ,[], y)) Closed)
34970+
(Ext_list.map2 labels tyvars (fun x y -> x ,[], y)) Closed)
3497334971
in
3497434972
Ext_list.fold_right2 labels tyvars result_type
3497534973
(fun label (* {loc ; txt = label }*)
@@ -42093,6 +42091,7 @@ let process_obj
4209342091
Ext_list.fold_right arg_types_ty ( [], [], [])
4209442092
(fun param_type ( arg_labels, (arg_types : Ast_compatible.param_type list), result_types) ->
4209542093
let arg_label = param_type.label in
42094+
let loc = param_type.loc in
4209642095
let ty = param_type.ty in
4209742096
let new_arg_label, new_arg_types, output_tys =
4209842097
match arg_label with
@@ -42114,22 +42113,22 @@ let process_obj
4211442113
{arg_label = External_arg_spec.label s (Some i);
4211542114
arg_type },
4211642115
arg_types, (* ignored in [arg_types], reserved in [result_types] *)
42117-
((name , [], new_ty) :: result_types)
42116+
(({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
4211842117
| Nothing ->
4211942118
let s = (Lam_methname.translate ~loc name) in
4212042119
{arg_label = External_arg_spec.label s None ; arg_type },
4212142120
{param_type with ty = new_ty}::arg_types,
42122-
((name , [], new_ty) :: result_types)
42121+
(({Asttypes.txt = name; loc} , [], new_ty) :: result_types)
4212342122
| Int _ ->
4212442123
let s = Lam_methname.translate ~loc name in
4212542124
{arg_label = External_arg_spec.label s None; arg_type},
4212642125
{param_type with ty = new_ty}::arg_types,
42127-
((name, [], Ast_literal.type_int ~loc ()) :: result_types)
42126+
(({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
4212842127
| NullString _ ->
4212942128
let s = Lam_methname.translate ~loc name in
4213042129
{arg_label = External_arg_spec.label s None; arg_type},
4213142130
{param_type with ty = new_ty }::arg_types,
42132-
((name, [], Ast_literal.type_string ~loc ()) :: result_types)
42131+
(({Asttypes.txt = name; loc}, [], Ast_literal.type_string ~loc ()) :: result_types)
4213342132
| Fn_uncurry_arity _ ->
4213442133
Location.raise_errorf ~loc
4213542134
"The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
@@ -42152,17 +42151,17 @@ let process_obj
4215242151
let s = (Lam_methname.translate ~loc name) in
4215342152
{arg_label = External_arg_spec.optional s; arg_type},
4215442153
param_type :: arg_types,
42155-
( (name, [], Ast_comb.to_undefined_type loc ty) :: result_types)
42154+
( ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc ty) :: result_types)
4215642155
| Int _ ->
4215742156
let s = Lam_methname.translate ~loc name in
4215842157
{arg_label = External_arg_spec.optional s ; arg_type },
4215942158
param_type :: arg_types,
42160-
((name, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
42159+
(({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
4216142160
| NullString _ ->
4216242161
let s = Lam_methname.translate ~loc name in
4216342162
{arg_label = External_arg_spec.optional s ; arg_type },
4216442163
param_type::arg_types,
42165-
((name, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
42164+
(({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
4216642165
| Arg_cst _
4216742166
->
4216842167
Location.raise_errorf ~loc "bs.as is not supported with optional yet"
@@ -43392,13 +43391,13 @@ let ocaml_obj_as_js_object
4339243391

4339343392
let generate_val_method_pair
4339443393
loc (mapper : Bs_ast_mapper.mapper)
43395-
val_name is_mutable =
43394+
(val_name : string Asttypes.loc) is_mutable =
4339643395

43397-
let result = Typ.var ~loc val_name in
43396+
let result = Typ.var ~loc val_name.txt in
4339843397
result ,
4339943398
((val_name , [], result ) ::
4340043399
(if is_mutable then
43401-
[val_name ^ Literals.setter_suffix,[],
43400+
[{val_name with txt = val_name.txt ^ Literals.setter_suffix},[],
4340243401
to_method_type loc mapper Nolabel result (Ast_literal.type_unit ~loc ()) ]
4340343402
else
4340443403
[]) )
@@ -43481,9 +43480,9 @@ let ocaml_obj_as_js_object
4348143480
let arity = Ast_pat.arity_of_fun pat e in
4348243481
let method_type =
4348343482
generate_arg_type x.pcf_loc mapper label.txt arity in
43484-
((label.Asttypes.txt, [], method_type) :: label_attr_types),
43483+
((label, [], method_type) :: label_attr_types),
4348543484
(if public_flag = Public then
43486-
(label.Asttypes.txt, [], method_type) :: public_label_attr_types
43485+
(label, [], method_type) :: public_label_attr_types
4348743486
else
4348843487
public_label_attr_types)
4348943488

@@ -43498,7 +43497,7 @@ let ocaml_obj_as_js_object
4349843497
end
4349943498
| Pcf_val (label, mutable_flag, Cfk_concrete(Fresh, val_exp)) ->
4350043499
let label_type, label_attr =
43501-
generate_val_method_pair x.pcf_loc mapper label.txt
43500+
generate_val_method_pair x.pcf_loc mapper label
4350243501
(mutable_flag = Mutable )
4350343502
in
4350443503
(Ext_list.append label_attr label_attr_types, public_label_attr_types)
@@ -43570,7 +43569,7 @@ let ocaml_obj_as_js_object
4357043569
end
4357143570
| Pcf_val (label, mutable_flag, Cfk_concrete(Fresh, val_exp)) ->
4357243571
let label_type, label_attr =
43573-
generate_val_method_pair x.pcf_loc mapper label.txt
43572+
generate_val_method_pair x.pcf_loc mapper label
4357443573
(mutable_flag = Mutable )
4357543574
in
4357643575
(label::labels,
@@ -44970,8 +44969,8 @@ let init () =
4497044969
Ast_comb.to_js_type loc @@
4497144970
Ast_compatible.object_
4497244971
(Ext_list.map label_declarations
44973-
(fun {pld_name = {loc; txt }; pld_type } ->
44974-
txt, [], pld_type))
44972+
(fun {pld_name ; pld_type } ->
44973+
pld_name, [], pld_type))
4497544974
flag in
4497644975
newTypeStr +?
4497744976
[

0 commit comments

Comments
 (0)