diff options
Diffstat (limited to 'bytecomp/translmod.ml')
| -rw-r--r-- | bytecomp/translmod.ml | 55 |
1 files changed, 50 insertions, 5 deletions
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index 99e1e89aec..e49a049d1a 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -378,8 +378,9 @@ let toploop_setvalue_pos = 1 (* position of setvalue in module Toploop *) let aliased_idents = ref Ident.empty -let set_toplevel_name id name = - aliased_idents := Ident.add id name !aliased_idents +let set_toplevel_unique_name id = + aliased_idents := + Ident.add id (Ident.unique_toplevel_name id) !aliased_idents let toplevel_name id = try Ident.find_same id !aliased_idents @@ -417,6 +418,9 @@ let transl_toplevel_item = function | Tstr_exn_rebind(id, path) -> toploop_setvalue id (transl_path path) | Tstr_module(id, modl) -> + (* we need to use the unique name for the module because of issues + with "open" (PR#1672) *) + set_toplevel_unique_name id; toploop_setvalue id (transl_module Tcoerce_none (Some(Pident id)) modl) | Tstr_modtype(id, decl) -> @@ -424,10 +428,10 @@ let transl_toplevel_item = function | Tstr_open path -> lambda_unit | Tstr_class cl_list -> + (* we need to use unique names for the classes because there might + be a value named identically *) let ids = List.map (fun (i, _, _, _) -> i) cl_list in - List.iter - (fun id -> set_toplevel_name id (Ident.name id ^ "(c)")) - ids; + List.iter set_toplevel_unique_name ids; Lletrec(List.map (fun (id, arity, meths, cl) -> (id, transl_class ids id arity meths cl)) @@ -453,3 +457,44 @@ let transl_toplevel_item_and_close itm = let transl_toplevel_definition str = reset_labels (); make_sequence transl_toplevel_item_and_close str + +(* Compile the initialization code for a packed library *) + +let transl_package component_names target_name coercion = + let components = + match coercion with + Tcoerce_none -> + List.map (fun id -> Lprim(Pgetglobal id, [])) component_names + | Tcoerce_structure pos_cc_list -> + let g = Array.of_list component_names in + List.map + (fun (pos, cc) -> apply_coercion cc (Lprim(Pgetglobal g.(pos), []))) + pos_cc_list + | _ -> + assert false in + Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)]) + +let transl_store_package component_names target_name coercion = + let rec make_sequence fn pos arg = + match arg with + [] -> lambda_unit + | hd :: tl -> Lsequence(fn pos hd, make_sequence fn (pos + 1) tl) in + match coercion with + Tcoerce_none -> + (List.length component_names, + make_sequence + (fun pos id -> + Lprim(Psetfield(pos, false), + [Lprim(Pgetglobal target_name, []); + Lprim(Pgetglobal id, [])])) + 0 component_names) + | Tcoerce_structure pos_cc_list -> + let id = Array.of_list component_names in + (List.length pos_cc_list, + make_sequence + (fun dst (src, cc) -> + Lprim(Psetfield(dst, false), + [Lprim(Pgetglobal target_name, []); + apply_coercion cc (Lprim(Pgetglobal id.(src), []))])) + 0 pos_cc_list) + | _ -> assert false |