port to the latest ocaml (2004/06/18)gcaml

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gcaml@6419 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 15 insertions, 9 deletions

diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index e2afb162ba..2da6af3926 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -138,21 +138,21 @@ let init_value modl =
                     [Lvar undef_function_id])
           | _ -> raise Not_found in
         init_v :: init_value_struct env rem
-    | Tsig_type(id, tdecl) :: rem ->
+    | Tsig_type(id, tdecl, _) :: rem ->
         init_value_struct (Env.add_type id tdecl env) rem
     | Tsig_exception(id, edecl) :: rem ->
         transl_exception
           id (Some Predef.path_undefined_recursive_module) edecl ::
         init_value_struct env rem
-    | Tsig_module(id, mty) :: rem ->
+    | Tsig_module(id, mty, _) :: rem ->
         init_value_mod env mty ::
         init_value_struct (Env.add_module id mty env) rem
     | Tsig_modtype(id, minfo) :: rem ->
         init_value_struct (Env.add_modtype id minfo env) rem
-    | Tsig_class(id, cdecl) :: rem ->
+    | Tsig_class(id, cdecl, _) :: rem ->
         Translclass.dummy_class (Lvar undef_function_id) ::
         init_value_struct env rem
-    | Tsig_cltype(id, ctyp) :: rem ->
+    | Tsig_cltype(id, ctyp, _) :: rem ->
         init_value_struct env rem
   in
   try
@@ -550,7 +550,9 @@ let transl_store_implementation module_name (str, restr) =
   primitive_declarations := [];
   let module_id = Ident.create_persistent module_name in
   let (map, prims, size) = build_ident_map restr (defined_idents str) in
-  (size, transl_label_init (transl_store_structure module_id map prims str))
+  transl_store_label_init module_id size
+    (transl_store_structure module_id map prims) str
+  (*size, transl_label_init (transl_store_structure module_id map prims str)*)
 
 (* Compile a toplevel phrase *)
 
@@ -654,15 +656,19 @@ let transl_toplevel_definition str =
 
 (* Compile the initialization code for a packed library *)
 
+let get_component = function
+    None -> Lconst const_unit
+  | Some id -> Lprim(Pgetglobal id, []) 
+
 let transl_package component_names target_name coercion =
   let components =
     match coercion with
       Tcoerce_none ->
-        List.map (fun id -> Lprim(Pgetglobal id, [])) component_names
+        List.map get_component 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), [])))
+          (fun (pos, cc) -> apply_coercion cc (get_component g.(pos)))
           pos_cc_list
     | _ ->
         assert false in
@@ -680,7 +686,7 @@ let transl_store_package component_names target_name coercion =
          (fun pos id ->
            Lprim(Psetfield(pos, false),
                  [Lprim(Pgetglobal target_name, []);
-                  Lprim(Pgetglobal id, [])]))
+                  get_component id]))
          0 component_names)
   | Tcoerce_structure pos_cc_list ->
       let id = Array.of_list component_names in
@@ -689,7 +695,7 @@ let transl_store_package component_names target_name coercion =
          (fun dst (src, cc) ->
            Lprim(Psetfield(dst, false),
                  [Lprim(Pgetglobal target_name, []);
-                  apply_coercion cc (Lprim(Pgetglobal id.(src), []))]))
+                  apply_coercion cc (get_component id.(src))]))
          0 pos_cc_list)
   | _ -> assert false