Skip to content

Commit b3447db

Browse files
stedolanstedolan
committed
Ensure new local attributes are namespaced properly
1 parent 7f213fc commit b3447db

10 files changed

Lines changed: 5231 additions & 5236 deletions

File tree

‎boot/menhir/parser.ml‎

Lines changed: 5169 additions & 5168 deletions
Large diffs are not rendered by default.

‎parsing/builtin_attributes.ml‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -400,8 +400,11 @@ let parse_standard_implementation_attributes attr =
400400
flambda_o3_attribute attr;
401401
flambda_oclassic_attribute attr
402402

403-
let has_curry attr =
404-
List.exists (check ["ocaml.curry"; "curry"]) attr
403+
(* curry/local are generated by the parser and not usually written directly,
404+
so they do not have a short form. *)
405+
let has_curry attr = List.exists (check ["ocaml.curry"]) attr
406+
407+
let has_local attr = List.exists (check ["ocaml.local"]) attr
405408

406409
let has_local_opt attr =
407410
List.exists (check ["ocaml.local_opt"; "local_opt"]) attr

‎parsing/builtin_attributes.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,4 +92,5 @@ val parse_standard_interface_attributes : Parsetree.attribute -> unit
9292
val parse_standard_implementation_attributes : Parsetree.attribute -> unit
9393

9494
val has_curry: Parsetree.attributes -> bool
95+
val has_local: Parsetree.attributes -> bool
9596
val has_local_opt: Parsetree.attributes -> bool

‎parsing/parser.mly‎

Lines changed: 29 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -158,43 +158,44 @@ let mkuplus ~oploc name arg =
158158
Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
159159

160160

161-
let stack_loc = mknoloc "stack"
161+
let local_loc = mknoloc "ocaml.local"
162+
let local_ext_loc = mknoloc "extension.local"
162163

163-
let stack_attr =
164-
Attr.mk ~loc:Location.none stack_loc (PStr [])
164+
let local_attr =
165+
Attr.mk ~loc:Location.none local_loc (PStr [])
165166

166-
let stack_extension =
167-
Exp.mk ~loc:Location.none (Pexp_extension(stack_loc, PStr []))
167+
let local_extension =
168+
Exp.mk ~loc:Location.none (Pexp_extension(local_ext_loc, PStr []))
168169

169170
let mkexp_stack ~loc exp =
170-
ghexp ~loc (Pexp_apply(stack_extension, [Nolabel, exp]))
171+
ghexp ~loc (Pexp_apply(local_extension, [Nolabel, exp]))
171172

172173
let mkpat_stack pat =
173-
{pat with ppat_attributes = stack_attr :: pat.ppat_attributes}
174+
{pat with ppat_attributes = local_attr :: pat.ppat_attributes}
174175

175176
let mktyp_stack typ =
176-
{typ with ptyp_attributes = stack_attr :: typ.ptyp_attributes}
177+
{typ with ptyp_attributes = local_attr :: typ.ptyp_attributes}
177178

178179
let wrap_exp_stack exp =
179-
{exp with pexp_attributes = stack_attr :: exp.pexp_attributes}
180+
{exp with pexp_attributes = local_attr :: exp.pexp_attributes}
180181

181-
let mkexp_stack_if p ~loc exp =
182+
let mkexp_local_if p ~loc exp =
182183
if p then mkexp_stack ~loc exp else exp
183184

184-
let mkpat_stack_if p pat =
185+
let mkpat_local_if p pat =
185186
if p then mkpat_stack pat else pat
186187

187-
let mktyp_stack_if p typ =
188+
let mktyp_local_if p typ =
188189
if p then mktyp_stack typ else typ
189190

190-
let wrap_exp_stack_if p exp =
191+
let wrap_exp_local_if p exp =
191192
if p then wrap_exp_stack exp else exp
192193

193194
let curry_attr =
194-
Attr.mk ~loc:Location.none (mknoloc "curry") (PStr [])
195+
Attr.mk ~loc:Location.none (mknoloc "ocaml.curry") (PStr [])
195196

196197
let is_curry_attr attr =
197-
attr.attr_name.txt = "curry"
198+
attr.attr_name.txt = "ocaml.curry"
198199

199200
let mkexp_curry exp =
200201
{exp with pexp_attributes = curry_attr :: exp.pexp_attributes}
@@ -209,12 +210,12 @@ let maybe_curry_typ typ =
209210
else mktyp_curry typ
210211
| _ -> typ
211212

212-
let global_loc = mknoloc "global"
213+
let global_loc = mknoloc "ocaml.global"
213214

214215
let global_attr =
215216
Attr.mk ~loc:Location.none global_loc (PStr [])
216217

217-
let nonlocal_loc = mknoloc "nonlocal"
218+
let nonlocal_loc = mknoloc "ocaml.nonlocal"
218219

219220
let nonlocal_attr =
220221
Attr.mk ~loc:Location.none nonlocal_loc (PStr [])
@@ -2171,15 +2172,15 @@ seq_expr:
21712172
;
21722173
labeled_simple_pattern:
21732174
QUESTION LPAREN optional_local label_let_pattern opt_default RPAREN
2174-
{ (Optional (fst $4), $5, mkpat_stack_if $3 (snd $4)) }
2175+
{ (Optional (fst $4), $5, mkpat_local_if $3 (snd $4)) }
21752176
| QUESTION label_var
21762177
{ (Optional (fst $2), None, snd $2) }
21772178
| OPTLABEL LPAREN optional_local let_pattern opt_default RPAREN
2178-
{ (Optional $1, $5, mkpat_stack_if $3 $4) }
2179+
{ (Optional $1, $5, mkpat_local_if $3 $4) }
21792180
| OPTLABEL pattern_var
21802181
{ (Optional $1, None, $2) }
21812182
| TILDE LPAREN optional_local label_let_pattern RPAREN
2182-
{ (Labelled (fst $4), None, mkpat_stack_if $3 (snd $4)) }
2183+
{ (Labelled (fst $4), None, mkpat_local_if $3 (snd $4)) }
21832184
| TILDE label_var
21842185
{ (Labelled (fst $2), None, snd $2) }
21852186
| LABEL simple_pattern
@@ -2559,11 +2560,11 @@ let_binding_body:
25592560
let typ = ghtyp ~loc (Ptyp_poly([],t)) in
25602561
let patloc = ($startpos($2), $endpos($3)) in
25612562
let pat =
2562-
mkpat_stack_if $1 (ghpat ~loc:patloc (Ppat_constraint(v, typ)))
2563+
mkpat_local_if $1 (ghpat ~loc:patloc (Ppat_constraint(v, typ)))
25632564
in
25642565
let exp =
2565-
mkexp_stack_if $1 ~loc:$sloc
2566-
(wrap_exp_stack_if $1 (mkexp_constraint ~loc:$sloc $5 $3))
2566+
mkexp_local_if $1 ~loc:$sloc
2567+
(wrap_exp_local_if $1 (mkexp_constraint ~loc:$sloc $5 $3))
25672568
in
25682569
(pat, exp) }
25692570
| optional_local let_ident COLON typevar_list DOT core_type EQUAL seq_expr
@@ -2573,11 +2574,11 @@ let_binding_body:
25732574
{ let typloc = ($startpos($4), $endpos($6)) in
25742575
let patloc = ($startpos($2), $endpos($6)) in
25752576
let pat =
2576-
mkpat_stack_if $1
2577+
mkpat_local_if $1
25772578
(ghpat ~loc:patloc
25782579
(Ppat_constraint($2, ghtyp ~loc:typloc (Ptyp_poly($4,$6)))))
25792580
in
2580-
let exp = mkexp_stack_if $1 ~loc:$sloc $8 in
2581+
let exp = mkexp_local_if $1 ~loc:$sloc $8 in
25812582
(pat, exp) }
25822583
| let_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
25832584
{ let exp, poly =
@@ -3397,7 +3398,7 @@ strict_function_type:
33973398
domain = extra_rhs(tuple_type)
33983399
MINUSGREATER
33993400
codomain = strict_function_type
3400-
{ Ptyp_arrow(label, mktyp_stack_if local domain, codomain) }
3401+
{ Ptyp_arrow(label, mktyp_local_if local domain, codomain) }
34013402
)
34023403
{ $1 }
34033404
| mktyp(
@@ -3409,8 +3410,8 @@ strict_function_type:
34093410
codomain = tuple_type
34103411
%prec MINUSGREATER
34113412
{ Ptyp_arrow(label,
3412-
mktyp_stack_if arg_local domain,
3413-
mktyp_stack_if ret_local (maybe_curry_typ codomain)) }
3413+
mktyp_local_if arg_local domain,
3414+
mktyp_local_if ret_local (maybe_curry_typ codomain)) }
34143415
)
34153416
{ $1 }
34163417
;

‎parsing/pprintast.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ let protect_longident ppf print_longident longprefix txt =
112112

113113
let is_curry_attr attr =
114114
match attr.attr_name.txt with
115-
| "curry" -> true
115+
| "ocaml.curry" -> true
116116
| _ -> false
117117

118118
let filter_curry_attrs attrs =

‎testsuite/tests/parsetree/locations_test.compilers.reference‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -262,13 +262,13 @@ Ptop_def
262262
core_type (//toplevel//[2,1+21]..[2,1+22])
263263
Ptyp_var a
264264
expression (//toplevel//[2,1+4]..[2,1+35])
265-
attribute "curry"
265+
attribute "ocaml.curry"
266266
[]
267267
Pexp_newtype "a"
268268
expression (//toplevel//[2,1+4]..[2,1+35])
269269
Pexp_constraint
270270
expression (//toplevel//[2,1+25]..[2,1+35])
271-
attribute "curry"
271+
attribute "ocaml.curry"
272272
[]
273273
Pexp_fun
274274
Nolabel
@@ -311,13 +311,13 @@ Ptop_def
311311
expression (//toplevel//[3,16+18]..[4,46+14]) ghost
312312
Pexp_poly
313313
expression (//toplevel//[3,16+9]..[4,46+14])
314-
attribute "curry"
314+
attribute "ocaml.curry"
315315
[]
316316
Pexp_newtype "a"
317317
expression (//toplevel//[3,16+9]..[4,46+14])
318318
Pexp_constraint
319319
expression (//toplevel//[4,46+4]..[4,46+14])
320-
attribute "curry"
320+
attribute "ocaml.curry"
321321
[]
322322
Pexp_fun
323323
Nolabel

‎testsuite/tests/parsing/shortcut_ext_attr.compilers.reference‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@
7171
structure_item (shortcut_ext_attr.ml[14,294+3]..[14,294+24])
7272
Pstr_eval
7373
expression (shortcut_ext_attr.ml[14,294+3]..[14,294+24])
74-
attribute "curry"
74+
attribute "ocaml.curry"
7575
[]
7676
attribute "foo"
7777
[]

‎typing/typecore.ml‎

Lines changed: 16 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -459,15 +459,9 @@ let extract_label_names env ty =
459459
with Not_found ->
460460
assert false
461461

462-
let has_stack_attr_pat ppat =
463-
List.exists
464-
(fun attr -> String.equal attr.attr_name.txt "stack")
465-
ppat.ppat_attributes
462+
let has_local_attr_pat ppat = Builtin_attributes.has_local ppat.ppat_attributes
466463

467-
let has_stack_attr_exp pexp =
468-
List.exists
469-
(fun attr -> String.equal attr.attr_name.txt "stack")
470-
pexp.pexp_attributes
464+
let has_local_attr_exp pexp = Builtin_attributes.has_local pexp.pexp_attributes
471465

472466
(* Typing of patterns *)
473467

@@ -1698,7 +1692,7 @@ and type_pat_aux
16981692
(* explicitly polymorphic type *)
16991693
assert construction_not_used_in_counterexamples;
17001694
let type_mode =
1701-
if has_stack_attr_pat sp then Alloc_mode.Local
1695+
if has_local_attr_pat sp then Alloc_mode.Local
17021696
else Alloc_mode.Global
17031697
in
17041698
let cty, ty, force =
@@ -2114,7 +2108,7 @@ and type_pat_aux
21142108
(* Pretend separate = true *)
21152109
begin_def();
21162110
let type_mode =
2117-
if has_stack_attr_pat sp then Alloc_mode.Local
2111+
if has_local_attr_pat sp then Alloc_mode.Local
21182112
else Alloc_mode.Global
21192113
in
21202114
let cty, ty, force =
@@ -2841,7 +2835,7 @@ let is_local_returning_expr e =
28412835
let rec loop e =
28422836
match e.pexp_desc with
28432837
| Pexp_apply
2844-
({ pexp_desc = Pexp_extension({txt = "stack"}, PStr []) },
2838+
({ pexp_desc = Pexp_extension({txt = "extension.local"}, PStr []) },
28452839
[Nolabel, _]) ->
28462840
true, e.pexp_loc
28472841
| Pexp_ident _ | Pexp_constant _ | Pexp_apply _ | Pexp_tuple _
@@ -2934,7 +2928,7 @@ let rec type_approx env sexp =
29342928
Pexp_let (_, _, e) -> type_approx env e
29352929
| Pexp_fun (p, _, spat, e) ->
29362930
let marg =
2937-
if has_stack_attr_pat spat then Alloc_mode.local
2931+
if has_local_attr_pat spat then Alloc_mode.local
29382932
else Alloc_mode.newvar ()
29392933
in
29402934
let mret = Alloc_mode.newvar () in
@@ -2970,11 +2964,11 @@ let rec type_approx env sexp =
29702964
end;
29712965
ty2
29722966
| Pexp_apply
2973-
({ pexp_desc = Pexp_extension({txt = "stack"}, PStr []) },
2967+
({ pexp_desc = Pexp_extension({txt = "extension.local"}, PStr []) },
29742968
[Nolabel, e]) ->
29752969
type_approx env e
29762970
| Pexp_apply
2977-
({ pexp_desc = Pexp_extension({txt = "escape"}, PStr []) },
2971+
({ pexp_desc = Pexp_extension({txt = "extension.escape"}, PStr []) },
29782972
[Nolabel, e]) ->
29792973
type_approx env e
29802974
| _ -> newvar ()
@@ -3420,7 +3414,7 @@ and type_expect_
34203414
(Pat.construct ~loc:default_loc
34213415
(mknoloc (Longident.(Ldot (Lident "*predef*", "None"))))
34223416
None)
3423-
(Exp.apply (Exp.extension (mknoloc "escape", PStr []))
3417+
(Exp.apply (Exp.extension (mknoloc "extension.escape", PStr []))
34243418
[Nolabel, default]);
34253419
]
34263420
in
@@ -3440,12 +3434,12 @@ and type_expect_
34403434
~attrs:[Attr.mk (mknoloc "#default") (PStr [])]
34413435
[Vb.mk spat smatch] sbody
34423436
in
3443-
let has_local = has_stack_attr_pat spat in
3437+
let has_local = has_local_attr_pat spat in
34443438
type_function ?in_function loc sexp.pexp_attributes env
34453439
expected_mode ty_expected_explained
34463440
l has_local [Exp.case pat body]
34473441
| Pexp_fun (l, None, spat, sbody) ->
3448-
let has_local = has_stack_attr_pat spat in
3442+
let has_local = has_local_attr_pat spat in
34493443
type_function ?in_function loc sexp.pexp_attributes env
34503444
expected_mode ty_expected_explained l has_local
34513445
[Ast_helper.Exp.case spat sbody]
@@ -3454,7 +3448,7 @@ and type_expect_
34543448
loc sexp.pexp_attributes env expected_mode
34553449
ty_expected_explained Nolabel false caselist
34563450
| Pexp_apply
3457-
({ pexp_desc = Pexp_extension({txt = "stack"}, PStr []) },
3451+
({ pexp_desc = Pexp_extension({txt = "extension.local"}, PStr []) },
34583452
[Nolabel, sbody]) ->
34593453
submode ~loc ~env Value_mode.local expected_mode;
34603454
let exp =
@@ -3463,7 +3457,7 @@ and type_expect_
34633457
in
34643458
{ exp with exp_loc = loc }
34653459
| Pexp_apply
3466-
({ pexp_desc = Pexp_extension({txt = "escape"}, PStr []) },
3460+
({ pexp_desc = Pexp_extension({txt = "extension.escape"}, PStr []) },
34673461
[Nolabel, sbody]) ->
34683462
let exp =
34693463
type_expect ?in_function ~recarg env mode_global sbody
@@ -3941,7 +3935,7 @@ and type_expect_
39413935
(* Pretend separate = true, 1% slowdown for lablgtk *)
39423936
begin_def ();
39433937
let type_mode =
3944-
if has_stack_attr_exp sexp then Alloc_mode.Local
3938+
if has_local_attr_exp sexp then Alloc_mode.Local
39453939
else Alloc_mode.Global
39463940
in
39473941
let cty = Typetexp.transl_simple_type env false type_mode sty in
@@ -3965,7 +3959,7 @@ and type_expect_
39653959
(* Also see PR#7199 for a problem with the following:
39663960
let separate = !Clflags.principal || Env.has_local_constraints env in*)
39673961
let type_mode =
3968-
if has_stack_attr_exp sexp then Alloc_mode.Local
3962+
if has_local_attr_exp sexp then Alloc_mode.Local
39693963
else Alloc_mode.Global
39703964
in
39713965
let (arg, ty',cty,cty') =
@@ -5761,7 +5755,7 @@ and type_let
57615755
| Pexp_constraint (e, _)
57625756
| Pexp_newtype (_, e)
57635757
| Pexp_apply
5764-
({ pexp_desc = Pexp_extension({txt = "stack"}, PStr []) },
5758+
({ pexp_desc = Pexp_extension({txt = "extension.local"}, PStr []) },
57655759
[Nolabel, e]) -> sexp_is_fun e
57665760
| _ -> false
57675761
in

‎typing/typedecl.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -202,12 +202,12 @@ let make_params env params =
202202

203203
let has_global_attr attributes =
204204
List.exists
205-
(fun attr -> String.equal attr.attr_name.txt "global")
205+
(fun attr -> String.equal attr.attr_name.txt "ocaml.global")
206206
attributes
207207

208208
let has_nonlocal_attr attributes =
209209
List.exists
210-
(fun attr -> String.equal attr.attr_name.txt "nonlocal")
210+
(fun attr -> String.equal attr.attr_name.txt "ocaml.nonlocal")
211211
attributes
212212

213213
let transl_labels env closed lbls =

‎typing/typetexp.ml‎

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -156,27 +156,22 @@ let transl_type_param env styp =
156156
Builtin_attributes.warning_scope styp.ptyp_attributes
157157
(fun () -> transl_type_param env styp)
158158

159-
let has_attr s styp =
160-
List.exists
161-
(fun attr -> String.equal attr.attr_name.txt s)
162-
styp.ptyp_attributes
163-
164159
let rec extract_params styp =
165160
let final styp =
166161
let ret_mode =
167-
if has_attr "stack" styp then Alloc_mode.Local
162+
if Builtin_attributes.has_local styp.ptyp_attributes then Alloc_mode.Local
168163
else Alloc_mode.Global
169164
in
170165
[], styp, ret_mode
171166
in
172167
match styp.ptyp_desc with
173168
| Ptyp_arrow (l, a, r) ->
174169
let arg_mode =
175-
if has_attr "stack" a then Alloc_mode.Local
170+
if Builtin_attributes.has_local a.ptyp_attributes then Alloc_mode.Local
176171
else Alloc_mode.Global
177172
in
178173
let params, ret, ret_mode =
179-
if has_attr "curry" r then final r
174+
if Builtin_attributes.has_curry r.ptyp_attributes then final r
180175
else extract_params r
181176
in
182177
(l, arg_mode, a) :: params, ret, ret_mode

0 commit comments

Comments
 (0)