Skip to content

Commit 986f857

Browse files
bobzhangbobzhang
committed
not allowing built-in primitive types to be redefined
1 parent 480004b commit 986f857

File tree

3 files changed

+99
-24
lines changed

3 files changed

+99
-24
lines changed

‎jscomp/frontend/bs_ast_invariant.ml

Lines changed: 33 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,7 @@ let warn_discarded_unused_attributes (attrs : Parsetree.attributes) =
7777

7878

7979
type iterator = Ast_iterator.iterator
80-
let default_iterator = Ast_iterator.default_iterator
80+
let super = Ast_iterator.default_iterator
8181

8282
let check_constant loc kind (const : Parsetree.constant) =
8383
match const with
@@ -114,20 +114,45 @@ let check_constant loc kind (const : Parsetree.constant) =
114114
rolling our own*)
115115
let emit_external_warnings : iterator=
116116
{
117-
default_iterator with
117+
super with
118+
type_declaration = (fun self ptyp ->
119+
let txt = ptyp.ptype_name.txt in
120+
(match txt with
121+
| "int"
122+
| "char"
123+
| "bytes"
124+
| "float"
125+
| "bool"
126+
| "unit"
127+
| "exn"
128+
| "int32"
129+
| "int64"
130+
| "string"
131+
(* not adding parametric types yet
132+
| "array"
133+
| "list"
134+
| "option"
135+
*)
136+
->
137+
Location.raise_errorf ~loc:ptyp.ptype_loc
138+
"built-in type `%s` can not be redefined " txt
139+
| _ -> ()
140+
);
141+
super.type_declaration self ptyp
142+
);
118143
attribute = (fun _ attr -> warn_unused_attribute attr);
119144
structure_item = (fun self str_item ->
120145
match str_item.pstr_desc with
121146
| Pstr_type (Nonrecursive, [{ptype_kind = Ptype_variant ({pcd_res = Some _} :: _)}])
122147
when !Config.syntax_kind = `rescript ->
123148
Location.raise_errorf ~loc:str_item.pstr_loc
124149
"GADT has to be recursive types, please try `type rec'"
125-
| _ -> default_iterator.structure_item self str_item
150+
| _ -> super.structure_item self str_item
126151
);
127152
expr = (fun self a ->
128153
match a.pexp_desc with
129154
| Pexp_constant(const) -> check_constant a.pexp_loc `expr const
130-
| _ -> default_iterator.expr self a
155+
| _ -> super.expr self a
131156
);
132157
label_declaration = (fun self lbl ->
133158

@@ -137,7 +162,7 @@ let emit_external_warnings : iterator=
137162
| {txt = "bs.as" | "as"}, _ -> mark_used_bs_attribute attr
138163
| _ -> ()
139164
);
140-
default_iterator.label_declaration self lbl
165+
super.label_declaration self lbl
141166
);
142167
constructor_declaration = (fun self ({pcd_name = {txt;loc}} as ctr) ->
143168
(match txt with
@@ -146,7 +171,7 @@ let emit_external_warnings : iterator=
146171
| "()" ->
147172
Location.raise_errorf ~loc:loc "%s can not be redefined " txt
148173
| _ -> ());
149-
default_iterator.constructor_declaration self ctr
174+
super.constructor_declaration self ctr
150175
);
151176
value_description =
152177
(fun self v ->
@@ -164,13 +189,13 @@ let emit_external_warnings : iterator=
164189
~loc:pval_loc
165190
"%%identity expect its type to be of form 'a -> 'b (arity 1)"
166191
| _ ->
167-
default_iterator.value_description self v
192+
super.value_description self v
168193
);
169194
pat = begin fun self (pat : Parsetree.pattern) ->
170195
match pat.ppat_desc with
171196
| Ppat_constant(constant) ->
172197
check_constant pat.ppat_loc `pat constant
173-
| _ -> default_iterator.pat self pat
198+
| _ -> super.pat self pat
174199
end
175200
}
176201

‎lib/4.06.1/unstable/js_compiler.ml

Lines changed: 33 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -400083,7 +400083,7 @@ let warn_discarded_unused_attributes (attrs : Parsetree.attributes) =
400083400083

400084400084

400085400085
type iterator = Ast_iterator.iterator
400086-
let default_iterator = Ast_iterator.default_iterator
400086+
let super = Ast_iterator.default_iterator
400087400087

400088400088
let check_constant loc kind (const : Parsetree.constant) =
400089400089
match const with
@@ -400120,20 +400120,45 @@ let check_constant loc kind (const : Parsetree.constant) =
400120400120
rolling our own*)
400121400121
let emit_external_warnings : iterator=
400122400122
{
400123-
default_iterator with
400123+
super with
400124+
type_declaration = (fun self ptyp ->
400125+
let txt = ptyp.ptype_name.txt in
400126+
(match txt with
400127+
| "int"
400128+
| "char"
400129+
| "bytes"
400130+
| "float"
400131+
| "bool"
400132+
| "unit"
400133+
| "exn"
400134+
| "int32"
400135+
| "int64"
400136+
| "string"
400137+
(* not adding parametric types yet
400138+
| "array"
400139+
| "list"
400140+
| "option"
400141+
*)
400142+
->
400143+
Location.raise_errorf ~loc:ptyp.ptype_loc
400144+
"built-in type `%s` can not be redefined " txt
400145+
| _ -> ()
400146+
);
400147+
super.type_declaration self ptyp
400148+
);
400124400149
attribute = (fun _ attr -> warn_unused_attribute attr);
400125400150
structure_item = (fun self str_item ->
400126400151
match str_item.pstr_desc with
400127400152
| Pstr_type (Nonrecursive, [{ptype_kind = Ptype_variant ({pcd_res = Some _} :: _)}])
400128400153
when !Config.syntax_kind = `rescript ->
400129400154
Location.raise_errorf ~loc:str_item.pstr_loc
400130400155
"GADT has to be recursive types, please try `type rec'"
400131-
| _ -> default_iterator.structure_item self str_item
400156+
| _ -> super.structure_item self str_item
400132400157
);
400133400158
expr = (fun self a ->
400134400159
match a.pexp_desc with
400135400160
| Pexp_constant(const) -> check_constant a.pexp_loc `expr const
400136-
| _ -> default_iterator.expr self a
400161+
| _ -> super.expr self a
400137400162
);
400138400163
label_declaration = (fun self lbl ->
400139400164

@@ -400143,7 +400168,7 @@ let emit_external_warnings : iterator=
400143400168
| {txt = "bs.as" | "as"}, _ -> mark_used_bs_attribute attr
400144400169
| _ -> ()
400145400170
);
400146-
default_iterator.label_declaration self lbl
400171+
super.label_declaration self lbl
400147400172
);
400148400173
constructor_declaration = (fun self ({pcd_name = {txt;loc}} as ctr) ->
400149400174
(match txt with
@@ -400152,7 +400177,7 @@ let emit_external_warnings : iterator=
400152400177
| "()" ->
400153400178
Location.raise_errorf ~loc:loc "%s can not be redefined " txt
400154400179
| _ -> ());
400155-
default_iterator.constructor_declaration self ctr
400180+
super.constructor_declaration self ctr
400156400181
);
400157400182
value_description =
400158400183
(fun self v ->
@@ -400170,13 +400195,13 @@ let emit_external_warnings : iterator=
400170400195
~loc:pval_loc
400171400196
"%%identity expect its type to be of form 'a -> 'b (arity 1)"
400172400197
| _ ->
400173-
default_iterator.value_description self v
400198+
super.value_description self v
400174400199
);
400175400200
pat = begin fun self (pat : Parsetree.pattern) ->
400176400201
match pat.ppat_desc with
400177400202
| Ppat_constant(constant) ->
400178400203
check_constant pat.ppat_loc `pat constant
400179-
| _ -> default_iterator.pat self pat
400204+
| _ -> super.pat self pat
400180400205
end
400181400206
}
400182400207

‎lib/4.06.1/whole_compiler.ml

Lines changed: 33 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -294095,7 +294095,7 @@ let warn_discarded_unused_attributes (attrs : Parsetree.attributes) =
294095294095

294096294096

294097294097
type iterator = Ast_iterator.iterator
294098-
let default_iterator = Ast_iterator.default_iterator
294098+
let super = Ast_iterator.default_iterator
294099294099

294100294100
let check_constant loc kind (const : Parsetree.constant) =
294101294101
match const with
@@ -294132,20 +294132,45 @@ let check_constant loc kind (const : Parsetree.constant) =
294132294132
rolling our own*)
294133294133
let emit_external_warnings : iterator=
294134294134
{
294135-
default_iterator with
294135+
super with
294136+
type_declaration = (fun self ptyp ->
294137+
let txt = ptyp.ptype_name.txt in
294138+
(match txt with
294139+
| "int"
294140+
| "char"
294141+
| "bytes"
294142+
| "float"
294143+
| "bool"
294144+
| "unit"
294145+
| "exn"
294146+
| "int32"
294147+
| "int64"
294148+
| "string"
294149+
(* not adding parametric types yet
294150+
| "array"
294151+
| "list"
294152+
| "option"
294153+
*)
294154+
->
294155+
Location.raise_errorf ~loc:ptyp.ptype_loc
294156+
"built-in type `%s` can not be redefined " txt
294157+
| _ -> ()
294158+
);
294159+
super.type_declaration self ptyp
294160+
);
294136294161
attribute = (fun _ attr -> warn_unused_attribute attr);
294137294162
structure_item = (fun self str_item ->
294138294163
match str_item.pstr_desc with
294139294164
| Pstr_type (Nonrecursive, [{ptype_kind = Ptype_variant ({pcd_res = Some _} :: _)}])
294140294165
when !Config.syntax_kind = `rescript ->
294141294166
Location.raise_errorf ~loc:str_item.pstr_loc
294142294167
"GADT has to be recursive types, please try `type rec'"
294143-
| _ -> default_iterator.structure_item self str_item
294168+
| _ -> super.structure_item self str_item
294144294169
);
294145294170
expr = (fun self a ->
294146294171
match a.pexp_desc with
294147294172
| Pexp_constant(const) -> check_constant a.pexp_loc `expr const
294148-
| _ -> default_iterator.expr self a
294173+
| _ -> super.expr self a
294149294174
);
294150294175
label_declaration = (fun self lbl ->
294151294176

@@ -294155,7 +294180,7 @@ let emit_external_warnings : iterator=
294155294180
| {txt = "bs.as" | "as"}, _ -> mark_used_bs_attribute attr
294156294181
| _ -> ()
294157294182
);
294158-
default_iterator.label_declaration self lbl
294183+
super.label_declaration self lbl
294159294184
);
294160294185
constructor_declaration = (fun self ({pcd_name = {txt;loc}} as ctr) ->
294161294186
(match txt with
@@ -294164,7 +294189,7 @@ let emit_external_warnings : iterator=
294164294189
| "()" ->
294165294190
Location.raise_errorf ~loc:loc "%s can not be redefined " txt
294166294191
| _ -> ());
294167-
default_iterator.constructor_declaration self ctr
294192+
super.constructor_declaration self ctr
294168294193
);
294169294194
value_description =
294170294195
(fun self v ->
@@ -294182,13 +294207,13 @@ let emit_external_warnings : iterator=
294182294207
~loc:pval_loc
294183294208
"%%identity expect its type to be of form 'a -> 'b (arity 1)"
294184294209
| _ ->
294185-
default_iterator.value_description self v
294210+
super.value_description self v
294186294211
);
294187294212
pat = begin fun self (pat : Parsetree.pattern) ->
294188294213
match pat.ppat_desc with
294189294214
| Ppat_constant(constant) ->
294190294215
check_constant pat.ppat_loc `pat constant
294191-
| _ -> default_iterator.pat self pat
294216+
| _ -> super.pat self pat
294192294217
end
294193294218
}
294194294219

0 commit comments

Comments
 (0)