diff options
| -rw-r--r-- | bytecomp/bytepackager.ml | 2 | ||||
| -rw-r--r-- | bytecomp/translmod.ml | 19 |
2 files changed, 21 insertions, 0 deletions
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index 8ba2f5321..9c9c1b842 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -182,6 +182,8 @@ let build_global_target oc target_name members mapping pos coercion = let lam = Translmod.transl_package components (Ident.create_persistent target_name) coercion in + if !Clflags.dump_lambda then + Format.printf "%a@." Printlambda.lambda lam; let instrs = Bytegen.compile_implementation target_name lam in let rel = diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index a74dcab34..8957e7542 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -822,6 +822,10 @@ let get_component = function let transl_package component_names target_name coercion = let components = + Lprim(Pmakeblock(0, Immutable), List.map get_component component_names) in + Lprim(Psetglobal target_name, [apply_coercion Strict coercion components]) + (* + let components = match coercion with Tcoerce_none -> List.map get_component component_names @@ -834,6 +838,7 @@ let transl_package component_names target_name coercion = | _ -> 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 = @@ -850,6 +855,19 @@ let transl_store_package component_names target_name coercion = get_component id])) 0 component_names) | Tcoerce_structure (pos_cc_list, id_pos_list) -> + let components = + Lprim(Pmakeblock(0, Immutable), List.map get_component component_names) + in + let blk = Ident.create "block" in + (List.length pos_cc_list, + Llet (Strict, blk, apply_coercion Strict coercion components, + make_sequence + (fun pos id -> + Lprim(Psetfield(pos, false), + [Lprim(Pgetglobal target_name, []); + Lprim(Pfield pos, [Lvar blk])])) + 0 pos_cc_list)) + (* (* ignore id_pos_list as the ids are already bound *) let id = Array.of_list component_names in (List.length pos_cc_list, @@ -859,6 +877,7 @@ let transl_store_package component_names target_name coercion = [Lprim(Pgetglobal target_name, []); apply_coercion Strict cc (get_component id.(src))])) 0 pos_cc_list) + *) | _ -> assert false (* Error report *) |