Skip to content

Commit 49fc1b5

Browse files
poechselpoechsel
committed
flambda-backend: To upstream: Add attributes and bootstrap compiler
1 parent a4b9e0d commit 49fc1b5

5 files changed

Lines changed: 91 additions & 6 deletions

File tree

‎boot/ocamlc‎

10.5 KB
Binary file not shown.

‎boot/ocamllex‎

16 Bytes
Binary file not shown.

‎parsing/builtin_attributes.ml‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,11 +20,20 @@ let string_of_cst = function
2020
| Pconst_string(s, _, _) -> Some s
2121
| _ -> None
2222

23+
let int_of_cst = function
24+
| Pconst_integer(i, None) -> Some (int_of_string i)
25+
| _ -> None
26+
2327
let string_of_payload = function
2428
| PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant c},_)}] ->
2529
string_of_cst c
2630
| _ -> None
2731

32+
let int_of_payload = function
33+
| PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant c},_)}] ->
34+
int_of_cst c
35+
| _ -> None
36+
2837
let string_of_opt_payload p =
2938
match string_of_payload p with
3039
| Some s -> s
@@ -285,3 +294,73 @@ let has_unboxed attr =
285294

286295
let has_boxed attr =
287296
List.exists (check ["ocaml.boxed"; "boxed"]) attr
297+
298+
let parse_empty_payload attr =
299+
match attr.attr_payload with
300+
| PStr [] -> Some ()
301+
| _ ->
302+
warn_payload attr.attr_loc attr.attr_name.txt
303+
"No attribute payload was expected";
304+
None
305+
306+
let parse_int_payload attr =
307+
match int_of_payload attr.attr_payload with
308+
| Some i -> Some i
309+
| None ->
310+
warn_payload attr.attr_loc attr.attr_name.txt
311+
"A constant payload of type int was expected";
312+
None
313+
314+
let clflags_attribute_without_payload attr ~name clflags_ref =
315+
if String.equal attr.attr_name.txt name
316+
|| String.equal attr.attr_name.txt ("ocaml." ^ name)
317+
then begin
318+
match parse_empty_payload attr with
319+
| Some () -> clflags_ref := true
320+
| None -> ()
321+
end
322+
323+
let clflags_attribute_with_int_payload attr ~name clflags_ref =
324+
if String.equal attr.attr_name.txt name
325+
|| String.equal attr.attr_name.txt ("ocaml." ^ name)
326+
then begin
327+
match parse_int_payload attr with
328+
| Some i -> clflags_ref := i
329+
| None -> ()
330+
end
331+
332+
let nolabels_attribute attr =
333+
clflags_attribute_without_payload attr
334+
~name:"nolabels" Clflags.classic
335+
336+
let inline_attribute attr =
337+
if String.equal attr.attr_name.txt "inline"
338+
|| String.equal attr.attr_name.txt "ocaml.inline"
339+
then begin
340+
let err_msg =
341+
"Either specify an integer, or the form accepted by '-inline' in quotes"
342+
in
343+
match string_of_payload attr.attr_payload with
344+
| Some s ->
345+
Clflags.Float_arg_helper.parse s err_msg Clflags.inline_threshold
346+
| None ->
347+
match int_of_payload attr.attr_payload with
348+
| Some i ->
349+
let s = string_of_int i in
350+
Clflags.Float_arg_helper.parse s err_msg Clflags.inline_threshold
351+
| None -> warn_payload attr.attr_loc attr.attr_name.txt err_msg
352+
end
353+
354+
let afl_inst_ratio_attribute attr =
355+
clflags_attribute_with_int_payload attr
356+
~name:"afl_inst_ratio" Clflags.afl_inst_ratio
357+
358+
let parse_standard_interface_attributes attr =
359+
warning_attribute attr;
360+
nolabels_attribute attr
361+
362+
let parse_standard_implementation_attributes attr =
363+
warning_attribute attr;
364+
nolabels_attribute attr;
365+
inline_attribute attr;
366+
afl_inst_ratio_attribute attr

‎parsing/builtin_attributes.mli‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,9 @@
2727
- ocaml.immediate
2828
- ocaml.immediate64
2929
- ocaml.boxed / ocaml.unboxed
30+
- ocaml.nolabels
31+
- ocaml.inline
32+
- ocaml.afl_inst_ratio
3033
3134
{b Warning:} this module is unstable and part of
3235
{{!Compiler_libs}compiler-libs}.
@@ -82,3 +85,6 @@ val immediate64: Parsetree.attributes -> bool
8285

8386
val has_unboxed: Parsetree.attributes -> bool
8487
val has_boxed: Parsetree.attributes -> bool
88+
89+
val parse_standard_interface_attributes : Parsetree.attribute -> unit
90+
val parse_standard_implementation_attributes : Parsetree.attribute -> unit

‎typing/typemod.ml‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1476,10 +1476,10 @@ and transl_signature env sg =
14761476
:: trem
14771477
in
14781478
typedtree, sg, final_env
1479-
| Psig_attribute x ->
1480-
Builtin_attributes.warning_attribute x;
1479+
| Psig_attribute attr ->
1480+
Builtin_attributes.parse_standard_interface_attributes attr;
14811481
let (trem,rem, final_env) = transl_sig env srem in
1482-
mksig (Tsig_attribute x) env loc :: trem, rem, final_env
1482+
mksig (Tsig_attribute attr) env loc :: trem, rem, final_env
14831483
| Psig_extension (ext, _attrs) ->
14841484
raise (Error_forward (Builtin_attributes.error_of_extension ext))
14851485
in
@@ -2418,9 +2418,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
24182418
Tstr_include incl, sg, new_env
24192419
| Pstr_extension (ext, _attrs) ->
24202420
raise (Error_forward (Builtin_attributes.error_of_extension ext))
2421-
| Pstr_attribute x ->
2422-
Builtin_attributes.warning_attribute x;
2423-
Tstr_attribute x, [], env
2421+
| Pstr_attribute attr ->
2422+
Builtin_attributes.parse_standard_implementation_attributes attr;
2423+
Tstr_attribute attr, [], env
24242424
in
24252425
let rec type_struct env sstr =
24262426
match sstr with

0 commit comments

Comments
 (0)