cslopt: modif. initialisation des structures toplevel
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@639 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
dc0b7b9b98
commit
27d6fd6d66
|
@ -116,7 +116,7 @@ and transl_structure fields cc = function
|
|||
| Tstr_eval expr :: rem ->
|
||||
Lsequence(transl_exp expr, transl_structure fields cc rem)
|
||||
| Tstr_value(rec_flag, pat_expr_list) :: rem ->
|
||||
let ext_fields = let_bound_idents pat_expr_list @ fields in
|
||||
let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
|
||||
transl_let rec_flag pat_expr_list (transl_structure ext_fields cc rem)
|
||||
| Tstr_primitive(id, descr) :: rem ->
|
||||
begin match descr.val_prim with
|
||||
|
@ -145,6 +145,100 @@ let transl_implementation module_name str cc =
|
|||
let module_id = Ident.new_persistent module_name in
|
||||
Lprim(Psetglobal module_id, [transl_structure [] cc str])
|
||||
|
||||
(* A variant of transl_structure used to compile toplevel structure definitions
|
||||
for the native-code compiler. Store the defined values in the fields
|
||||
of the global as soon as they are defined, in order to reduce register
|
||||
pressure.
|
||||
"map" is a table from idents to (position in global block, coercion). *)
|
||||
|
||||
let rec transl_store_structure glob map = function
|
||||
[] ->
|
||||
lambda_unit
|
||||
| Tstr_eval expr :: rem ->
|
||||
Lsequence(transl_exp expr, transl_store_structure glob map rem)
|
||||
| Tstr_value(rec_flag, pat_expr_list) :: rem ->
|
||||
transl_let rec_flag pat_expr_list
|
||||
(store_idents glob map (let_bound_idents pat_expr_list)
|
||||
(transl_store_structure glob map rem))
|
||||
| Tstr_primitive(id, descr) :: rem ->
|
||||
begin match descr.val_prim with
|
||||
None -> ()
|
||||
| Some p -> primitive_declarations :=
|
||||
p.Primitive.prim_name :: !primitive_declarations
|
||||
end;
|
||||
store_ident glob map id (transl_store_structure glob map rem)
|
||||
| Tstr_type(decls) :: rem ->
|
||||
transl_store_structure glob map rem
|
||||
| Tstr_exception(id, decl) :: rem ->
|
||||
Llet(Strict, id, transl_exception id decl,
|
||||
store_ident glob map id (transl_store_structure glob map rem))
|
||||
| Tstr_module(id, modl) :: rem ->
|
||||
Llet(Strict, id, transl_module Tcoerce_none modl,
|
||||
store_ident glob map id (transl_store_structure glob map rem))
|
||||
| Tstr_modtype(id, decl) :: rem ->
|
||||
transl_store_structure glob map rem
|
||||
| Tstr_open path :: rem ->
|
||||
transl_store_structure glob map rem
|
||||
|
||||
and store_ident glob map id cont =
|
||||
try
|
||||
let (pos, cc) = Ident.find_same id map in
|
||||
let init_val =
|
||||
match cc with
|
||||
Tcoerce_primitive p -> transl_primitive p
|
||||
| _ -> apply_coercion cc (Lvar id) in
|
||||
Lsequence
|
||||
(Lprim(Psetfield(pos, false), [Lprim(Pgetglobal glob, []); init_val]),
|
||||
cont)
|
||||
with Not_found ->
|
||||
cont
|
||||
|
||||
and store_idents glob map idlist cont =
|
||||
List.fold_right (store_ident glob map) idlist cont
|
||||
|
||||
(* Build the list of value identifiers defined by a toplevel structure *)
|
||||
|
||||
let rec defined_idents = function
|
||||
[] -> []
|
||||
| Tstr_eval expr :: rem -> defined_idents rem
|
||||
| Tstr_value(rec_flag, pat_expr_list) :: rem ->
|
||||
let_bound_idents pat_expr_list @ defined_idents rem
|
||||
| Tstr_primitive(id, descr) :: rem -> defined_idents rem
|
||||
| Tstr_type decls :: rem -> defined_idents rem
|
||||
| Tstr_exception(id, decl) :: rem -> id :: defined_idents rem
|
||||
| Tstr_module(id, modl) :: rem -> id :: defined_idents rem
|
||||
| Tstr_modtype(id, decl) :: rem -> defined_idents rem
|
||||
| Tstr_open path :: rem -> defined_idents rem
|
||||
|
||||
(* Distribute a coercion over the list of value identifiers built above. *)
|
||||
|
||||
let distribute_coercion restr idlist =
|
||||
match restr with
|
||||
Tcoerce_none ->
|
||||
List.map (fun id -> (id, Tcoerce_none)) idlist
|
||||
| Tcoerce_structure pos_cc_list ->
|
||||
let idarray = Array.of_list idlist in
|
||||
List.map (fun (pos, cc) -> (idarray.(pos), cc)) pos_cc_list
|
||||
| _->
|
||||
fatal_error "Translmod.distribute_coercion"
|
||||
|
||||
(* Transform the list (id, coercion) built above into a table
|
||||
id -> (pos, coercion). *)
|
||||
|
||||
let rec build_ident_map pos = function
|
||||
[] -> Ident.empty
|
||||
| (id, cc) :: rem -> Ident.add id (pos, cc) (build_ident_map (pos+1) rem)
|
||||
|
||||
(* Compile an implementation using transl_store_structure
|
||||
(for the native-code compiler). *)
|
||||
|
||||
let transl_store_implementation module_name str cc =
|
||||
primitive_declarations := [];
|
||||
let module_id = Ident.new_persistent module_name in
|
||||
let id_cc_list = distribute_coercion cc (defined_idents str) in
|
||||
let map = build_ident_map 0 id_cc_list in
|
||||
(List.length id_cc_list, transl_store_structure module_id map str)
|
||||
|
||||
(* Compile a sequence of expressions *)
|
||||
|
||||
let rec make_sequence fn = function
|
||||
|
@ -159,9 +253,11 @@ let transl_toplevel_item = function
|
|||
transl_exp expr
|
||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
||||
let idents = let_bound_idents pat_expr_list in
|
||||
let lam =
|
||||
transl_let rec_flag pat_expr_list
|
||||
(make_sequence (fun id -> Lprim(Psetglobal id, [Lvar id])) idents) in
|
||||
List.iter Ident.make_global idents;
|
||||
transl_let rec_flag pat_expr_list
|
||||
(make_sequence (fun id -> Lprim(Psetglobal id, [Lvar id])) idents)
|
||||
lam
|
||||
| Tstr_primitive(id, descr) ->
|
||||
lambda_unit
|
||||
| Tstr_type(decls) ->
|
||||
|
|
|
@ -18,6 +18,8 @@ open Typedtree
|
|||
open Lambda
|
||||
|
||||
val transl_implementation: string -> structure -> module_coercion -> lambda
|
||||
val transl_store_implementation:
|
||||
string -> structure -> module_coercion -> int * lambda
|
||||
val transl_toplevel_definition: structure -> lambda
|
||||
|
||||
val primitive_declarations: string list ref
|
||||
|
|
|
@ -86,11 +86,12 @@ let implementation sourcefile =
|
|||
(Tcoerce_none, crc)
|
||||
end in
|
||||
Compilenv.reset modulename crc;
|
||||
Asmgen.compile_implementation prefixname
|
||||
let (compunit_size, lam) =
|
||||
Translmod.transl_store_implementation modulename str coercion in
|
||||
Asmgen.compile_implementation prefixname compunit_size
|
||||
(print_if Clflags.dump_lambda Printlambda.lambda
|
||||
(Simplif.simplify_lambda
|
||||
(print_if Clflags.dump_rawlambda Printlambda.lambda
|
||||
(Translmod.transl_implementation modulename str coercion))));
|
||||
(print_if Clflags.dump_rawlambda Printlambda.lambda lam)));
|
||||
Compilenv.save_unit_info (prefixname ^ ".cmx");
|
||||
close_in ic
|
||||
with x ->
|
||||
|
|
Loading…
Reference in New Issue