Change compilation order of toplevel definitions. (#1649)
Control compilation order better. This change applies to the compilation phase from typed tree to lambda code, on the path used by the bytecode compiler. - Change transl_let (in translcore.ml) so that the body of a let construct and the bindindgs can be evaluated in one order or the other. - Enforce top to bottom order for (bytecode) compilation of toplevel definitions (in translmod.ml). As a result, warnings from different toplevel definitions emitted during this compilation phase should should appear by increasing location. Furthermore, this was already the compilation order of toplevel definition by the native code compiler. Thus, console output of both compiler now are closer one to the other than before. Also notice that the flambda compilers behave like the non-flambda bytecode compiler as regards the compilation order of toplevel definitions.master
parent
d2e0f93e6f
commit
965dd7df38
4
Changes
4
Changes
|
@ -128,6 +128,10 @@ Working version
|
|||
- GPR#1618: add the -dno-unique-ids and -dunique-ids compiler flags
|
||||
(Sébastien Hinderer, review by Leo White and Damien Doligez)
|
||||
|
||||
- GPR#1649 change compilation order of toplevel definitions, so that some warnings
|
||||
emitted by the bytecode compiler appear more in-order than before.
|
||||
(Luc Maranget, advice and review by Damien Doligez)
|
||||
|
||||
### Code generation and optimizations:
|
||||
|
||||
- GPR#1370: Fix code duplication in Cmmgen
|
||||
|
|
|
@ -1209,12 +1209,18 @@ and transl_function loc untuplify_fn repr partial param cases =
|
|||
Matching.for_function loc repr (Lvar param)
|
||||
(transl_cases cases) partial)
|
||||
|
||||
and transl_let rec_flag pat_expr_list body =
|
||||
(*
|
||||
Notice: transl_let consumes (ie compiles) its pat_expr_list argument,
|
||||
and returns a function that will take the body of the lambda-let construct.
|
||||
This complication allows choosing any compilation order for the
|
||||
bindings and body of let constructs.
|
||||
*)
|
||||
and transl_let rec_flag pat_expr_list =
|
||||
match rec_flag with
|
||||
Nonrecursive ->
|
||||
let rec transl = function
|
||||
[] ->
|
||||
body
|
||||
fun body -> body
|
||||
| {vb_pat=pat; vb_expr=expr; vb_attributes=attr; vb_loc} :: rem ->
|
||||
let lam = transl_exp expr in
|
||||
let lam =
|
||||
|
@ -1223,7 +1229,8 @@ and transl_let rec_flag pat_expr_list body =
|
|||
let lam =
|
||||
Translattribute.add_specialise_attribute lam vb_loc attr
|
||||
in
|
||||
Matching.for_let pat.pat_loc lam pat (transl rem)
|
||||
let mk_body = transl rem in
|
||||
fun body -> Matching.for_let pat.pat_loc lam pat (mk_body body)
|
||||
in transl pat_expr_list
|
||||
| Recursive ->
|
||||
let idlist =
|
||||
|
@ -1244,7 +1251,8 @@ and transl_let rec_flag pat_expr_list body =
|
|||
vb_attributes
|
||||
in
|
||||
(id, lam) in
|
||||
Lletrec(List.map2 transl_case pat_expr_list idlist, body)
|
||||
let lam_bds = List.map2 transl_case pat_expr_list idlist in
|
||||
fun body -> Lletrec(lam_bds, body)
|
||||
|
||||
and transl_setinstvar loc self var expr =
|
||||
Lprim(Psetfield_computed (maybe_pointer expr, Assignment),
|
||||
|
|
|
@ -456,6 +456,9 @@ and transl_module cc rootpath mexp =
|
|||
and transl_struct loc fields cc rootpath str =
|
||||
transl_structure loc fields cc rootpath str.str_final_env str.str_items
|
||||
|
||||
(* The function transl_structure is called by the bytecode compiler.
|
||||
Some effort is made to compile in top to bottom order, in order to display
|
||||
warning by increasing locations. *)
|
||||
and transl_structure loc fields cc rootpath final_env = function
|
||||
[] ->
|
||||
let body, size =
|
||||
|
@ -512,11 +515,14 @@ and transl_structure loc fields cc rootpath final_env = function
|
|||
in
|
||||
Lsequence(transl_exp expr, body), size
|
||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
||||
(* Translate bindings first *)
|
||||
let mk_lam_let = transl_let rec_flag pat_expr_list in
|
||||
let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
|
||||
(* Then, translate remainder of struct *)
|
||||
let body, size =
|
||||
transl_structure loc ext_fields cc rootpath final_env rem
|
||||
in
|
||||
transl_let rec_flag pat_expr_list body, size
|
||||
mk_lam_let body, size
|
||||
| Tstr_primitive descr ->
|
||||
record_primitive descr.val_val;
|
||||
transl_structure loc fields cc rootpath final_env rem
|
||||
|
@ -540,9 +546,7 @@ and transl_structure loc fields cc rootpath final_env = function
|
|||
size
|
||||
| Tstr_module mb ->
|
||||
let id = mb.mb_id in
|
||||
let body, size =
|
||||
transl_structure loc (id :: fields) cc rootpath final_env rem
|
||||
in
|
||||
(* Translate module first *)
|
||||
let module_body =
|
||||
transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr
|
||||
in
|
||||
|
@ -550,6 +554,10 @@ and transl_structure loc fields cc rootpath final_env = function
|
|||
Translattribute.add_inline_attribute module_body mb.mb_loc
|
||||
mb.mb_attributes
|
||||
in
|
||||
(* Translate remainder second *)
|
||||
let body, size =
|
||||
transl_structure loc (id :: fields) cc rootpath final_env rem
|
||||
in
|
||||
let module_body =
|
||||
Levent (module_body, {
|
||||
lev_loc = mb.mb_loc;
|
||||
|
|
|
@ -1,15 +1,15 @@
|
|||
File "w47_inline.ml", line 13, characters 15-22:
|
||||
Warning 47: illegal payload for attribute 'inlined'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
File "w47_inline.ml", line 8, characters 23-29:
|
||||
Warning 47: illegal payload for attribute 'inline'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
File "w47_inline.ml", line 7, characters 23-29:
|
||||
File "w47_inline.ml", line 5, characters 23-29:
|
||||
Warning 47: illegal payload for attribute 'inline'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
File "w47_inline.ml", line 6, characters 23-29:
|
||||
Warning 47: illegal payload for attribute 'inline'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
File "w47_inline.ml", line 5, characters 23-29:
|
||||
File "w47_inline.ml", line 7, characters 23-29:
|
||||
Warning 47: illegal payload for attribute 'inline'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
File "w47_inline.ml", line 8, characters 23-29:
|
||||
Warning 47: illegal payload for attribute 'inline'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
File "w47_inline.ml", line 13, characters 15-22:
|
||||
Warning 47: illegal payload for attribute 'inlined'.
|
||||
It must be either empty, 'always' or 'never'
|
||||
|
|
|
@ -1,26 +1,26 @@
|
|||
File "w53.ml", line 2, characters 4-5:
|
||||
Warning 32: unused value h.
|
||||
File "w53.ml", line 31, characters 17-29:
|
||||
File "w53.ml", line 2, characters 14-20:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 3, characters 14-26:
|
||||
Warning 53: the "ocaml.inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 30, characters 16-22:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 24, characters 0-39:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 23, characters 0-32:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 15, characters 16-24:
|
||||
Warning 53: the "tailcall" attribute cannot appear in this context
|
||||
File "w53.ml", line 12, characters 14-28:
|
||||
Warning 53: the "ocaml.tailcall" attribute cannot appear in this context
|
||||
File "w53.ml", line 11, characters 14-22:
|
||||
Warning 53: the "tailcall" attribute cannot appear in this context
|
||||
File "w53.ml", line 9, characters 16-23:
|
||||
File "w53.ml", line 5, characters 14-21:
|
||||
Warning 53: the "inlined" attribute cannot appear in this context
|
||||
File "w53.ml", line 6, characters 14-27:
|
||||
Warning 53: the "ocaml.inlined" attribute cannot appear in this context
|
||||
File "w53.ml", line 5, characters 14-21:
|
||||
File "w53.ml", line 9, characters 16-23:
|
||||
Warning 53: the "inlined" attribute cannot appear in this context
|
||||
File "w53.ml", line 3, characters 14-26:
|
||||
Warning 53: the "ocaml.inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 2, characters 14-20:
|
||||
File "w53.ml", line 11, characters 14-22:
|
||||
Warning 53: the "tailcall" attribute cannot appear in this context
|
||||
File "w53.ml", line 12, characters 14-28:
|
||||
Warning 53: the "ocaml.tailcall" attribute cannot appear in this context
|
||||
File "w53.ml", line 15, characters 16-24:
|
||||
Warning 53: the "tailcall" attribute cannot appear in this context
|
||||
File "w53.ml", line 23, characters 0-32:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 24, characters 0-39:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 30, characters 16-22:
|
||||
Warning 53: the "inline" attribute cannot appear in this context
|
||||
File "w53.ml", line 31, characters 17-29:
|
||||
Warning 53: the "ocaml.inline" attribute cannot appear in this context
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
File "w54.ml", line 9, characters 0-43:
|
||||
Warning 54: the "inline" attribute is used more than once on this expression
|
||||
File "w54.ml", line 5, characters 26-39:
|
||||
Warning 54: the "ocaml.inlined" attribute is used more than once on this expression
|
||||
File "w54.ml", line 3, characters 51-63:
|
||||
Warning 54: the "ocaml.inline" attribute is used more than once on this expression
|
||||
File "w54.ml", line 2, characters 33-39:
|
||||
Warning 54: the "inline" attribute is used more than once on this expression
|
||||
File "w54.ml", line 3, characters 51-63:
|
||||
Warning 54: the "ocaml.inline" attribute is used more than once on this expression
|
||||
File "w54.ml", line 5, characters 26-39:
|
||||
Warning 54: the "ocaml.inlined" attribute is used more than once on this expression
|
||||
File "w54.ml", line 9, characters 0-43:
|
||||
Warning 54: the "inline" attribute is used more than once on this expression
|
||||
|
|
Loading…
Reference in New Issue