diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/asmgen.ml ocaml-3.12.0+functor/asmcomp/asmgen.ml
*** ocaml-3.12.0/asmcomp/asmgen.ml	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/asmcomp/asmgen.ml	2011-06-06 14:45:13.425859003 +0200
***************
*** 104,108 ****
      Emitaux.output_channel := oc;
      Emit.begin_assembly();
!     Closure.intro size lam
      ++ Cmmgen.compunit size
      ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
--- 104,108 ----
      Emitaux.output_channel := oc;
      Emit.begin_assembly();
!     let (size, ulam) = Closure.intro size lam in ulam
      ++ Cmmgen.compunit size
      ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/asmpackager.ml ocaml-3.12.0+functor/asmcomp/asmpackager.ml
*** ocaml-3.12.0/asmcomp/asmpackager.ml	2010-05-19 13:29:38.000000000 +0200
--- ocaml-3.12.0+functor/asmcomp/asmpackager.ml	2011-06-06 14:33:18.175859003 +0200
***************
*** 80,84 ****
  (* Make the .o file for the package *)

! let make_package_object ppf members targetobj targetname coercion =
    let objtemp =
      if !Clflags.keep_asm_file
--- 80,84 ----
  (* Make the .o file for the package *)

! let make_package_object ppf members targetobj targetname coercion functor_info =
    let objtemp =
      if !Clflags.keep_asm_file
***************
*** 99,103 ****
      (chop_extension_if_any objtemp) ppf
      (Translmod.transl_store_package
!        components (Ident.create_persistent targetname) coercion);
    let objfiles =
      List.map
--- 99,103 ----
      (chop_extension_if_any objtemp) ppf
      (Translmod.transl_store_package
!        components (Ident.create_persistent targetname) coercion functor_info);
    let objfiles =
      List.map
***************
*** 112,116 ****
  (* Make the .cmx file for the package *)

! let build_package_cmx members cmxfile =
    let unit_names =
      List.map (fun m -> m.pm_name) members in
--- 112,116 ----
  (* Make the .cmx file for the package *)

! let build_package_cmx members cmxfile functor_args =
    let unit_names =
      List.map (fun m -> m.pm_name) members in
***************
*** 148,151 ****
--- 148,153 ----
        ui_force_link =
            List.exists (fun info -> info.ui_force_link) units;
+       ui_functor_parts = []; (* TODO *)
+       ui_functor_args = functor_args; (* TODO *)
      } in
    Compilenv.write_unit_info pkg_infos cmxfile
***************
*** 154,158 ****

  let package_object_files ppf files targetcmx
!                          targetobj targetname coercion =
    let pack_path =
      match !Clflags.for_package with
--- 156,160 ----

  let package_object_files ppf files targetcmx
!                          targetobj targetname coercion  (functor_info, functor_args) =
    let pack_path =
      match !Clflags.for_package with
***************
*** 161,170 ****
    let members = map_left_right (read_member_info pack_path) files in
    check_units members;
!   make_package_object ppf members targetobj targetname coercion;
!   build_package_cmx members targetcmx

  (* The entry point *)

! let package_files ppf files targetcmx =
    let files =
      List.map
--- 163,172 ----
    let members = map_left_right (read_member_info pack_path) files in
    check_units members;
!   make_package_object ppf members targetobj targetname coercion functor_info;
!   build_package_cmx members targetcmx functor_args

  (* The entry point *)

! let package_files ppf files targetcmx functor_name =
    let files =
      List.map
***************
*** 181,187 ****
    (* Set the name of the current compunit *)
    Compilenv.reset ?packname:!Clflags.for_package targetname;
    try
!     let coercion = Typemod.package_units files targetcmi targetname in
      package_object_files ppf files targetcmx targetobj targetname coercion
    with x ->
      remove_file targetcmx; remove_file targetobj;
--- 183,194 ----
    (* Set the name of the current compunit *)
    Compilenv.reset ?packname:!Clflags.for_package targetname;
+   let functor_id = match functor_name with
+       None -> None
+     | Some modname -> Some (Ident.create modname) in
    try
!     let (coercion, functor_info, functor_args) =
!       Typemod.package_units files targetcmi targetname functor_id in
      package_object_files ppf files targetcmx targetobj targetname coercion
+       (functor_info, functor_args)
    with x ->
      remove_file targetcmx; remove_file targetobj;
diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/asmpackager.mli ocaml-3.12.0+functor/asmcomp/asmpackager.mli
*** ocaml-3.12.0/asmcomp/asmpackager.mli	2005-08-01 17:51:09.000000000 +0200
--- ocaml-3.12.0+functor/asmcomp/asmpackager.mli	2011-06-06 14:33:18.175859003 +0200
***************
*** 16,20 ****
     original compilation units as sub-modules. *)

! val package_files: Format.formatter -> string list -> string -> unit

  type error =
--- 16,20 ----
     original compilation units as sub-modules. *)

! val package_files: Format.formatter -> string list -> string -> string option -> unit

  type error =
diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/closure.ml ocaml-3.12.0+functor/asmcomp/closure.ml
*** ocaml-3.12.0/asmcomp/closure.ml	2008-08-01 14:52:14.000000000 +0200
--- ocaml-3.12.0+functor/asmcomp/closure.ml	2011-06-06 14:33:18.175859003 +0200
***************
*** 42,46 ****
     contain the right names if the -for-pack option is active. *)

! let getglobal id =
    Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global id)),
          [], Debuginfo.none)
--- 42,50 ----
     contain the right names if the -for-pack option is active. *)

! let getglobal cenv id =
!   if Ident.is_functor_part id then
!     let id = Env.get_functor_part (Ident.name id) in
!     try Tbl.find id cenv with Not_found -> Uvar id
!   else
      Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global id)),
            [], Debuginfo.none)
***************
*** 566,570 ****
    | Lprim(Pgetglobal id, []) as lam ->
        check_constant_result lam
!                             (getglobal id)
                              (Compilenv.global_approx id)
    | Lprim(Pmakeblock(tag, mut) as prim, lams) ->
--- 570,574 ----
    | Lprim(Pgetglobal id, []) as lam ->
        check_constant_result lam
!                             (getglobal cenv id)
                              (Compilenv.global_approx id)
    | Lprim(Pmakeblock(tag, mut) as prim, lams) ->
***************
*** 585,589 ****
        let (ulam, approx) = close fenv cenv lam in
        (!global_approx).(n) <- approx;
!       (Uprim(Psetfield(n, false), [getglobal id; ulam], Debuginfo.none),
         Value_unknown)
    | Lprim(Praise, [Levent(arg, ev)]) ->
--- 589,593 ----
        let (ulam, approx) = close fenv cenv lam in
        (!global_approx).(n) <- approx;
!       (Uprim(Psetfield(n, false), [getglobal cenv id; ulam], Debuginfo.none),
         Value_unknown)
    | Lprim(Praise, [Levent(arg, ev)]) ->
***************
*** 801,803 ****
    let (ulam, approx) = close Tbl.empty Tbl.empty lam in
    global_approx := [||];
!   ulam
--- 805,816 ----
    let (ulam, approx) = close Tbl.empty Tbl.empty lam in
    global_approx := [||];
!   if !Clflags.functors <> [] then begin
!     (1,
!      Uprim(Psetfield(0, false), [
!            Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global
! 							(Ident.create_persistent (Compilenv.current_unit_name ())))),
! 		 [], Debuginfo.none);
!        ulam], Debuginfo.none)
!     )
!   end else
!     (size, ulam)
diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/closure.mli ocaml-3.12.0+functor/asmcomp/closure.mli
*** ocaml-3.12.0/asmcomp/closure.mli	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/asmcomp/closure.mli	2011-06-06 14:33:18.175859003 +0200
***************
*** 15,17 ****
  (* Introduction of closures, uncurrying, recognition of direct calls *)

! val intro: int -> Lambda.lambda -> Clambda.ulambda
--- 15,17 ----
  (* Introduction of closures, uncurrying, recognition of direct calls *)

! val intro: int -> Lambda.lambda -> int * Clambda.ulambda
diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/cmmgen.ml ocaml-3.12.0+functor/asmcomp/cmmgen.ml
*** ocaml-3.12.0/asmcomp/cmmgen.ml	2010-05-19 13:29:38.000000000 +0200
--- ocaml-3.12.0+functor/asmcomp/cmmgen.ml	2011-06-06 14:36:42.535858999 +0200
***************
*** 801,804 ****
--- 801,807 ----
      Uvar id ->
        Cvar id
+   | Uprim(Pgetglobal id, [], _ ) when Ident.is_functor_part id ->
+       let exp = Uvar (Env.get_functor_part (Ident.name id)) in
+       transl exp
    | Uconst sc ->
        transl_constant sc
diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/cmx_format.mli ocaml-3.12.0+functor/asmcomp/cmx_format.mli
*** ocaml-3.12.0/asmcomp/cmx_format.mli	2010-05-19 13:29:38.000000000 +0200
--- ocaml-3.12.0+functor/asmcomp/cmx_format.mli	2011-06-06 14:33:18.185859004 +0200
***************
*** 35,38 ****
--- 35,40 ----
      mutable ui_apply_fun: int list;             (* Apply functions needed *)
      mutable ui_send_fun: int list;              (* Send functions needed *)
+     mutable ui_functor_parts : (string * (string * Digest.t) list) list;
+     mutable ui_functor_args : (string * Digest.t) list;
      mutable ui_force_link: bool }               (* Always linked *)

diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/compilenv.ml ocaml-3.12.0+functor/asmcomp/compilenv.ml
*** ocaml-3.12.0/asmcomp/compilenv.ml	2010-05-19 13:29:38.000000000 +0200
--- ocaml-3.12.0+functor/asmcomp/compilenv.ml	2011-06-06 15:36:16.965859002 +0200
***************
*** 40,43 ****
--- 40,45 ----
      ui_apply_fun = [];
      ui_send_fun = [];
+     ui_functor_parts = [];
+     ui_functor_args = [];
      ui_force_link = false }

***************
*** 149,153 ****

  let global_approx id =
!   if Ident.is_predef_exn id then Value_unknown
    else try Hashtbl.find toplevel_approx (Ident.name id)
    with Not_found ->
--- 151,155 ----

  let global_approx id =
!   if Ident.is_predef_exn id || Ident.is_functor_arg id then Value_unknown
    else try Hashtbl.find toplevel_approx (Ident.name id)
    with Not_found ->
***************
*** 199,202 ****
--- 201,206 ----
  let save_unit_info filename =
    current_unit.ui_imports_cmi <- Env.imported_units();
+   current_unit.ui_functor_args <- Env.get_functor_args ();
+   current_unit.ui_functor_parts <- Env.get_functor_parts ();
    write_unit_info current_unit filename

Binary files ocaml-3.12.0/boot/ocamlc and ocaml-3.12.0+functor/boot/ocamlc differ
Binary files ocaml-3.12.0/boot/ocamldep and ocaml-3.12.0+functor/boot/ocamldep differ
Binary files ocaml-3.12.0/boot/ocamllex and ocaml-3.12.0+functor/boot/ocamllex differ
diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/bytegen.ml ocaml-3.12.0+functor/bytecomp/bytegen.ml
*** ocaml-3.12.0/bytecomp/bytegen.ml	2009-05-20 13:52:42.000000000 +0200
--- ocaml-3.12.0+functor/bytecomp/bytegen.ml	2011-06-06 15:36:30.825859004 +0200
***************
*** 409,412 ****
--- 409,415 ----
          fatal_error ("Bytegen.comp_expr: var " ^ Ident.unique_name id)
        end
+     | Lprim(Pgetglobal id, []) when Ident.is_functor_part id ->
+       let exp = Lvar (Env.get_functor_part (Ident.name id)) in
+       comp_expr env exp sz cont
    | Lconst cst ->
        Kconst cst :: cont
diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/bytepackager.ml ocaml-3.12.0+functor/bytecomp/bytepackager.ml
*** ocaml-3.12.0/bytecomp/bytepackager.ml	2010-05-21 14:00:49.000000000 +0200
--- ocaml-3.12.0+functor/bytecomp/bytepackager.ml	2011-06-06 14:33:18.185859004 +0200
***************
*** 156,160 ****
  (* Generate the code that builds the tuple representing the package module *)

! let build_global_target oc target_name members mapping pos coercion =
    let components =
      List.map2
--- 156,165 ----
  (* Generate the code that builds the tuple representing the package module *)

! let print_if ppf flag printer arg =
!   if !flag then Format.fprintf ppf "%a@." printer arg
!
! let ppf = Format.err_formatter
!
! let build_global_target oc target_name members mapping pos coercion functor_info =
    let components =
      List.map2
***************
*** 166,172 ****
    let lam =
      Translmod.transl_package
!       components (Ident.create_persistent target_name) coercion in
    let instrs =
      Bytegen.compile_implementation target_name lam in
    let rel =
      Emitcode.to_packed_file oc instrs in
--- 171,180 ----
    let lam =
      Translmod.transl_package
!       components (Ident.create_persistent target_name) coercion functor_info in
!   print_if ppf Clflags.dump_lambda Printlambda.lambda lam;
!   print_if ppf Clflags.dump_rawlambda Printlambda.lambda lam;
    let instrs =
      Bytegen.compile_implementation target_name lam in
+   print_if ppf Clflags.dump_instr Printinstr.instrlist instrs;
    let rel =
      Emitcode.to_packed_file oc instrs in
***************
*** 175,179 ****
  (* Build the .cmo file obtained by packaging the given .cmo files. *)

! let package_object_files files targetfile targetname coercion =
    let members =
      map_left_right read_member_info files in
--- 183,187 ----
  (* Build the .cmo file obtained by packaging the given .cmo files. *)

! let package_object_files files targetfile targetname coercion (functor_info, functor_args) =
    let members =
      map_left_right read_member_info files in
***************
*** 193,197 ****
      let pos_code = pos_out oc in
      let ofs = rename_append_bytecode_list oc mapping [] 0 targetname Subst.identity members in
!     build_global_target oc targetname members mapping ofs coercion;
      let pos_debug = pos_out oc in
      if !Clflags.debug && !events <> [] then
--- 201,205 ----
      let pos_code = pos_out oc in
      let ofs = rename_append_bytecode_list oc mapping [] 0 targetname Subst.identity members in
!     build_global_target oc targetname members mapping ofs coercion functor_info;
      let pos_debug = pos_out oc in
      if !Clflags.debug && !events <> [] then
***************
*** 211,214 ****
--- 219,224 ----
          cu_force_link = !force_link;
          cu_debug = if pos_final > pos_debug then pos_debug else 0;
+ 	cu_functor_parts = []; (* TODO : add functor parts from submodules *)
+ 	cu_functor_args = functor_args;
          cu_debugsize = pos_final - pos_debug } in
      output_value oc compunit;
***************
*** 222,226 ****
  (* The entry point *)

! let package_files files targetfile =
    let files =
      List.map
--- 232,236 ----
  (* The entry point *)

! let package_files files targetfile functor_name =
    let files =
      List.map
***************
*** 232,238 ****
    let targetcmi = prefix ^ ".cmi" in
    let targetname = String.capitalize(Filename.basename prefix) in
    try
!     let coercion = Typemod.package_units files targetcmi targetname in
!     package_object_files files targetfile targetname coercion
    with x ->
      remove_file targetfile; raise x
--- 242,253 ----
    let targetcmi = prefix ^ ".cmi" in
    let targetname = String.capitalize(Filename.basename prefix) in
+   let functor_id = match functor_name with
+       None -> None
+     | Some modname -> Some (Ident.create modname) in
    try
!     let (coercion, functor_info, functor_args) =
!       Typemod.package_units files targetcmi targetname functor_id in
!     package_object_files files targetfile targetname coercion (functor_info, functor_args)
!
    with x ->
      remove_file targetfile; raise x
diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/bytepackager.mli ocaml-3.12.0+functor/bytecomp/bytepackager.mli
*** ocaml-3.12.0/bytecomp/bytepackager.mli	2002-02-08 17:55:44.000000000 +0100
--- ocaml-3.12.0+functor/bytecomp/bytepackager.mli	2011-06-06 14:33:18.185859004 +0200
***************
*** 16,20 ****
     original compilation units as sub-modules. *)

! val package_files: string list -> string -> unit

  type error =
--- 16,20 ----
     original compilation units as sub-modules. *)

! val package_files: string list -> string -> string option -> unit

  type error =
diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/cmo_format.mli ocaml-3.12.0+functor/bytecomp/cmo_format.mli
*** ocaml-3.12.0/bytecomp/cmo_format.mli	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/bytecomp/cmo_format.mli	2011-06-06 14:33:18.185859004 +0200
***************
*** 34,37 ****
--- 34,39 ----
      mutable cu_force_link: bool;        (* Must be linked even if unref'ed *)
      mutable cu_debug: int;              (* Position of debugging info, or 0 *)
+     mutable cu_functor_parts : (string * (string * Digest.t) list) list;
+     mutable cu_functor_args : (string * Digest.t) list;
      cu_debugsize: int }                 (* Length of debugging info *)

diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/emitcode.ml ocaml-3.12.0+functor/bytecomp/emitcode.ml
*** ocaml-3.12.0/bytecomp/emitcode.ml	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/bytecomp/emitcode.ml	2011-06-06 14:33:18.185859004 +0200
***************
*** 376,379 ****
--- 376,381 ----
        cu_primitives = List.map Primitive.byte_name !Translmod.primitive_declarations;
        cu_force_link = false;
+       cu_functor_parts = Env.get_functor_parts ();
+       cu_functor_args = Env.get_functor_args ();
        cu_debug = pos_debug;
        cu_debugsize = size_debug } in
diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/lambda.ml ocaml-3.12.0+functor/bytecomp/lambda.ml
*** ocaml-3.12.0/bytecomp/lambda.ml	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/bytecomp/lambda.ml	2011-06-06 14:33:18.185859004 +0200
***************
*** 318,322 ****

  let free_variables l =
!   free_ids (function Lvar id -> [id] | _ -> []) l

  let free_methods l =
--- 318,325 ----

  let free_variables l =
!   free_ids (function Lvar id -> [id]
!     | Lprim( (Pgetglobal id | Psetglobal id), _) when Ident.is_functor_part id ->
!       [Env.get_functor_part (Ident.name id)]
!     | _ -> []) l

  let free_methods l =
diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/translmod.ml ocaml-3.12.0+functor/bytecomp/translmod.ml
*** ocaml-3.12.0/bytecomp/translmod.ml	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/bytecomp/translmod.ml	2011-06-06 15:36:43.625859004 +0200
***************
*** 346,356 ****
  (* Compile an implementation *)

  let transl_implementation module_name (str, cc) =
    reset_labels ();
    primitive_declarations := [];
    let module_id = Ident.create_persistent module_name in
    Lprim(Psetglobal module_id,
!         [transl_label_init
!             (transl_structure [] cc (global_path module_id) str)])

  (* A variant of transl_structure used to compile toplevel structure definitions
--- 346,377 ----
  (* Compile an implementation *)

+ (* TODO: check what happens if a module has the same name as a module given as
+    argument *)
+
+ let transl_functor_unit functor_env modname str =
+   let ids = Env.get_functor_parts () in
+   let (str, _) = List.fold_left (fun (str, tbl) (name, parts) ->
+     if name = modname || Tbl.mem name tbl then (str, tbl) else
+       let id = Env.get_functor_part name in
+       let str = Llet(Strict, id,
+ 	 Lapply(mod_prim "find_functor_arg", [
+ 	   Lconst(Const_base (Const_string (Ident.name id)));
+ 	   Lvar functor_env;
+ 	 ], Location.none), str) in
+       (str, Tbl.add name id tbl)
+   ) (str, Tbl.empty) ids
+   in
+   Lfunction(Curried, [ functor_env ], str)
+
  let transl_implementation module_name (str, cc) =
    reset_labels ();
    primitive_declarations := [];
    let module_id = Ident.create_persistent module_name in
+   let str = transl_label_init (transl_structure [] cc (global_path module_id) str) in
    Lprim(Psetglobal module_id,
! 	[if !Clflags.functors <> [] then
! 	    let functor_env = Ident.create "functor_env" in
! 	  Lprim(Pmakeblock(0, Immutable), [transl_functor_unit functor_env module_name str])
! 	else str])

  (* A variant of transl_structure used to compile toplevel structure definitions
***************
*** 501,504 ****
--- 522,526 ----
    | Tstr_include(modl, ids) :: rem -> ids @ defined_idents rem

+
  (* Transform a coercion and the list of value identifiers defined by
     a toplevel structure into a table [id -> (pos, coercion)],
***************
*** 544,547 ****
--- 566,570 ----
    primitive_declarations := [];
    let module_id = Ident.create_persistent module_name in
+   if !Clflags.functors <> [] then Ident.make_functor_part module_id;
    let (map, prims, size) = build_ident_map restr (defined_idents str) in
    let f = function
***************
*** 561,565 ****
    let r = transl_store_gen module_name (str, restr) false in
    transl_store_subst := s;
!   r

  (* Compile a toplevel phrase *)
--- 584,597 ----
    let r = transl_store_gen module_name (str, restr) false in
    transl_store_subst := s;
!   if !Clflags.functors <> [] then
!     let (size, str) = r in
!     let id = Env.get_functor_part module_name in
!     let str = Llet(Strict, id,
! 		   Lprim(Pmakeblock(0, Immutable), Array.to_list (Array.create size lambda_unit)),
! 		   Lsequence (str, Lvar id) ) in
!     let functor_env = Ident.create "functor_env" in
!     let str = transl_functor_unit functor_env module_name str in
!     (size, str)
!   else r

  (* Compile a toplevel phrase *)
***************
*** 665,668 ****
--- 697,763 ----
    | Some id -> Lprim(Pgetglobal id, [])

+ let const_string s =
+   Lconst(Const_base (Const_string s))
+
+ let const_pack_unit_name id =
+   let name = Ident.name id in
+   let name = try
+ 	       let pos = String.rindex name '.' in
+ 	       String.sub name (pos+1) (String.length name - pos - 1)
+     with Not_found -> name
+   in
+   const_string name
+
+ let transl_functor_package component_names target_name coercion
+     (functor_id, functor_arg) initial_env =
+       let env0_id = Ident.create "functor_env0" in
+       let env1_id = Ident.create "functor_env1" in
+       let rec eval_components env comps evaluated =
+ 	match comps with
+ 	    [] ->
+ 	      let component_names = List.rev evaluated in
+ 	      let components =
+ 		match coercion with
+ 		    Tcoerce_none ->
+ 		      component_names
+ 		  | Tcoerce_structure pos_cc_list ->
+ 		    let g = Array.of_list component_names in
+ 		    List.map
+ 		      (fun (pos, cc) -> apply_coercion cc (g.(pos)))
+ 		      pos_cc_list
+ 		  | _ ->
+ 		    assert false in
+ 	      Lprim(Pmakeblock(0, Immutable), components)
+ 	  | None :: tail ->
+ 	    eval_components env tail evaluated
+ 	  | Some comp :: tail ->
+ 	    Ident.make_functor_arg comp;
+ 	    let comp_id = Ident.create (Ident.name comp) in
+ 	    let newenv = Ident.create "env" in
+ 	    Llet(Strict,
+ 		 comp_id, Lapply(
+ 		   Lprim(Pfield 0, [Lprim(Pgetglobal comp, [])]),
+ 		   [Lvar env], Location.none),
+ 		 Llet(Strict,
+ 		      newenv, Lapply(mod_prim "add_functor_arg",
+ 				     [const_pack_unit_name comp;
+ 				      Lvar comp_id; Lvar env], Location.none),
+ 		      eval_components newenv tail (Lvar comp_id :: evaluated)))
+       in
+       let components = eval_components env1_id component_names [] in
+       let functor_body =
+ 	Llet(Strict, env0_id, initial_env,
+ 	     Llet(Strict, env1_id,
+ 		  Lapply(mod_prim "add_functor_arg",
+ 			 [const_pack_unit_name functor_arg; Lvar functor_arg; Lvar env0_id],
+ 			 Location.none),
+ 		  components))
+       in
+ (*	Llet(Strict, functor_id, *)
+ 	     Lfunction(Curried, [functor_arg], functor_body)
+ 	       (* , store_global functor_id) *)
+
+ let gen_new_env () = Lapply(mod_prim "create_functor_env",[lambda_unit], Location.none)
+
  let transl_package component_names target_name coercion =
    let components =
***************
*** 679,682 ****
--- 774,793 ----
    Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])

+ let transl_package component_names target_name coercion functor_info =
+   match functor_info with
+       None -> transl_package component_names target_name coercion
+     | Some (functor_id, functor_arg) ->
+       let functor_env = Ident.create "functor_env" in
+       let str =
+ 	transl_functor_package component_names target_name coercion  (functor_id, functor_arg)
+       (if Env.get_functor_args () <> [] then Lvar functor_env else gen_new_env ())
+       in
+       Lprim(Psetglobal target_name,
+ 	    [Lprim(Pmakeblock(0, Immutable),
+ 		  [if !Clflags.functors <> [] then
+ 		      let str = Lprim(Pmakeblock(0, Immutable),[str]) in
+ 		      transl_functor_unit functor_env (Ident.name target_name) str
+ 		    else str])])
+
  let transl_store_package component_names target_name coercion =
    let rec make_sequence fn pos arg =
***************
*** 704,707 ****
--- 815,840 ----
    | _ -> assert false

+
+ let transl_store_package component_names target_name coercion functor_info =
+   match functor_info with
+       None -> transl_store_package component_names target_name coercion
+     | Some (functor_id, functor_arg) ->
+       let functor_env = Ident.create "functor_env" in
+       let str =
+ 	transl_functor_package component_names target_name coercion  (functor_id, functor_arg)
+ 	  (if Env.get_functor_args () <> [] then Lvar functor_env else gen_new_env ())
+       in
+       (1,
+ 	if !Clflags.functors <> [] then
+ 	  let module_name = Ident.name target_name in
+ 	  let str = Lprim(Pmakeblock(0, Immutable), [str]) in
+ 	  let str = transl_functor_unit functor_env module_name str in
+ 	  str
+ 	else
+           Lprim(Psetfield(0, false),
+ 		[Lprim(Pgetglobal target_name, []);
+ 		 str]))
+
+
  (* Error report *)

diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/translmod.mli ocaml-3.12.0+functor/bytecomp/translmod.mli
*** ocaml-3.12.0/bytecomp/translmod.mli	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/bytecomp/translmod.mli	2011-06-06 14:33:18.185859004 +0200
***************
*** 25,31 ****
  val transl_toplevel_definition: structure -> lambda
  val transl_package:
!       Ident.t option list -> Ident.t -> module_coercion -> lambda
  val transl_store_package:
!       Ident.t option list -> Ident.t -> module_coercion -> int * lambda

  val toplevel_name: Ident.t -> string
--- 25,33 ----
  val transl_toplevel_definition: structure -> lambda
  val transl_package:
!       Ident.t option list -> Ident.t -> module_coercion ->
!   (Ident.t * Ident.t) option -> lambda
  val transl_store_package:
!       Ident.t option list -> Ident.t -> module_coercion ->
!   (Ident.t * Ident.t) option -> int * lambda

  val toplevel_name: Ident.t -> string
***************
*** 34,37 ****
--- 36,41 ----
  val primitive_declarations: Primitive.description list ref

+ (*val mod_prim : string -> Lambda.lambda *)
+
  type error =
    Circular_dependency of Ident.t
diff -C 2 -N -r -w ocaml-3.12.0/debugger/Makefile.shared ocaml-3.12.0+functor/debugger/Makefile.shared
*** ocaml-3.12.0/debugger/Makefile.shared	2010-05-17 17:49:53.000000000 +0200
--- ocaml-3.12.0+functor/debugger/Makefile.shared	2011-06-06 14:33:18.185859004 +0200
***************
*** 36,40 ****
    ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
    ../typing/subst.cmo ../typing/predef.cmo \
!   ../typing/datarepr.cmo ../typing/env.cmo ../typing/oprint.cmo \
    ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
    ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
--- 36,41 ----
    ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
    ../typing/subst.cmo ../typing/predef.cmo \
!   ../typing/datarepr.cmo ../typing/cmi_format.cmo \
!   ../typing/env.cmo ../typing/oprint.cmo \
    ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
    ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
diff -C 2 -N -r -w ocaml-3.12.0/.depend ocaml-3.12.0+functor/.depend
*** ocaml-3.12.0/.depend	2010-07-23 17:30:37.000000000 +0200
--- ocaml-3.12.0+functor/.depend	2011-06-06 14:45:21.255858999 +0200
***************
*** 66,69 ****
--- 66,70 ----
  typing/annot.cmi: parsing/location.cmi
  typing/btype.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
+ typing/cmi_format.cmi: typing/types.cmi typing/ident.cmi
  typing/ctype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \
      typing/env.cmi parsing/asttypes.cmi
***************
*** 114,117 ****
--- 115,122 ----
  typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \
      typing/btype.cmi
+ typing/cmi_format.cmo: typing/types.cmi typing/ident.cmi \
+     typing/cmi_format.cmi
+ typing/cmi_format.cmx: typing/types.cmx typing/ident.cmx \
+     typing/cmi_format.cmi
  typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
      utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
***************
*** 127,137 ****
      typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
      typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
!     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
!     typing/env.cmi
  typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
      typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
      typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
!     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
!     typing/env.cmi
  typing/ident.cmo: typing/ident.cmi
  typing/ident.cmx: typing/ident.cmi
--- 132,142 ----
      typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
      typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
!     typing/cmi_format.cmi utils/clflags.cmi typing/btype.cmi \
!     parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
  typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
      typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
      typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
!     typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \
!     parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
  typing/ident.cmo: typing/ident.cmi
  typing/ident.cmx: typing/ident.cmi
***************
*** 252,257 ****
  typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
      typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
!     typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/path.cmi \
!     parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
      parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
      typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
--- 257,262 ----
  typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
      typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
!     utils/tbl.cmi typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
!     typing/path.cmi parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
      parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
      typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
***************
*** 260,265 ****
  typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
      typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
!     typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/path.cmx \
!     parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
      parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
      typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
--- 265,270 ----
  typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
      typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
!     utils/tbl.cmx typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \
!     typing/path.cmx parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
      parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
      typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
***************
*** 319,327 ****
  bytecomp/bytegen.cmo: typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \
      typing/stypes.cmi typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \
!     bytecomp/instruct.cmi typing/ident.cmi utils/config.cmi \
      parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  bytecomp/bytegen.cmx: typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \
      typing/stypes.cmx typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \
!     bytecomp/instruct.cmx typing/ident.cmx utils/config.cmx \
      parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \
--- 324,332 ----
  bytecomp/bytegen.cmo: typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \
      typing/stypes.cmi typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \
!     bytecomp/instruct.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \
      parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  bytecomp/bytegen.cmx: typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \
      typing/stypes.cmx typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \
!     bytecomp/instruct.cmx typing/ident.cmx typing/env.cmx utils/config.cmx \
      parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \
***************
*** 342,352 ****
      bytecomp/bytelink.cmi
  bytecomp/bytepackager.cmo: typing/typemod.cmi bytecomp/translmod.cmi \
!     typing/subst.cmi typing/path.cmi utils/misc.cmi bytecomp/instruct.cmi \
!     typing/ident.cmi typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \
      bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \
      bytecomp/bytegen.cmi bytecomp/bytepackager.cmi
  bytecomp/bytepackager.cmx: typing/typemod.cmx bytecomp/translmod.cmx \
!     typing/subst.cmx typing/path.cmx utils/misc.cmx bytecomp/instruct.cmx \
!     typing/ident.cmx typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
      bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \
      bytecomp/bytegen.cmx bytecomp/bytepackager.cmi
--- 347,359 ----
      bytecomp/bytelink.cmi
  bytecomp/bytepackager.cmo: typing/typemod.cmi bytecomp/translmod.cmi \
!     typing/subst.cmi bytecomp/printlambda.cmi bytecomp/printinstr.cmi \
!     typing/path.cmi utils/misc.cmi bytecomp/instruct.cmi typing/ident.cmi \
!     typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \
      bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \
      bytecomp/bytegen.cmi bytecomp/bytepackager.cmi
  bytecomp/bytepackager.cmx: typing/typemod.cmx bytecomp/translmod.cmx \
!     typing/subst.cmx bytecomp/printlambda.cmx bytecomp/printinstr.cmx \
!     typing/path.cmx utils/misc.cmx bytecomp/instruct.cmx typing/ident.cmx \
!     typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
      bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \
      bytecomp/bytegen.cmx bytecomp/bytepackager.cmi
***************
*** 447,460 ****
  bytecomp/translmod.cmo: typing/types.cmi typing/typedtree.cmi \
      bytecomp/translobj.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
!     typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
      typing/path.cmi typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
      parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
!     typing/ctype.cmi parsing/asttypes.cmi bytecomp/translmod.cmi
  bytecomp/translmod.cmx: typing/types.cmx typing/typedtree.cmx \
      bytecomp/translobj.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \
!     typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
      typing/path.cmx typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
      parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \
!     typing/ctype.cmx parsing/asttypes.cmi bytecomp/translmod.cmi
  bytecomp/translobj.cmo: typing/primitive.cmi utils/misc.cmi \
      parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
--- 454,469 ----
  bytecomp/translmod.cmo: typing/types.cmi typing/typedtree.cmi \
      bytecomp/translobj.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
!     utils/tbl.cmi typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
      typing/path.cmi typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
      parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
!     typing/ctype.cmi utils/clflags.cmi parsing/asttypes.cmi \
!     bytecomp/translmod.cmi
  bytecomp/translmod.cmx: typing/types.cmx typing/typedtree.cmx \
      bytecomp/translobj.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \
!     utils/tbl.cmx typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
      typing/path.cmx typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
      parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \
!     typing/ctype.cmx utils/clflags.cmx parsing/asttypes.cmi \
!     bytecomp/translmod.cmi
  bytecomp/translobj.cmo: typing/primitive.cmi utils/misc.cmi \
      parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
***************
*** 566,576 ****
      asmcomp/debuginfo.cmx parsing/asttypes.cmi asmcomp/clambda.cmi
  asmcomp/closure.cmo: utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \
!     utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
!     asmcomp/compilenv.cmi utils/clflags.cmi asmcomp/clambda.cmi \
!     parsing/asttypes.cmi asmcomp/closure.cmi
  asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \
!     utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
!     asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \
!     parsing/asttypes.cmi asmcomp/closure.cmi
  asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \
      asmcomp/cmm.cmi
--- 575,585 ----
      asmcomp/debuginfo.cmx parsing/asttypes.cmi asmcomp/clambda.cmi
  asmcomp/closure.cmo: utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \
!     utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
!     asmcomp/debuginfo.cmi asmcomp/compilenv.cmi utils/clflags.cmi \
!     asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/closure.cmi
  asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \
!     utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \
!     asmcomp/debuginfo.cmx asmcomp/compilenv.cmx utils/clflags.cmx \
!     asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/closure.cmi
  asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \
      asmcomp/cmm.cmi
***************
*** 579,592 ****
  asmcomp/cmmgen.cmo: typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \
      typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \
!     asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \
!     asmcomp/cmx_format.cmi asmcomp/cmm.cmi utils/clflags.cmi \
!     asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/arch.cmo \
!     asmcomp/cmmgen.cmi
  asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \
      typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \
!     asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
!     asmcomp/cmx_format.cmi asmcomp/cmm.cmx utils/clflags.cmx \
!     asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \
!     asmcomp/cmmgen.cmi
  asmcomp/codegen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \
      asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \
--- 588,601 ----
  asmcomp/cmmgen.cmo: typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \
      typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \
!     typing/env.cmi asmcomp/debuginfo.cmi utils/config.cmi \
!     asmcomp/compilenv.cmi asmcomp/cmx_format.cmi asmcomp/cmm.cmi \
!     utils/clflags.cmi asmcomp/clambda.cmi parsing/asttypes.cmi \
!     asmcomp/arch.cmo asmcomp/cmmgen.cmi
  asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \
      typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \
!     typing/env.cmx asmcomp/debuginfo.cmx utils/config.cmx \
!     asmcomp/compilenv.cmx asmcomp/cmx_format.cmi asmcomp/cmm.cmx \
!     utils/clflags.cmx asmcomp/clambda.cmx parsing/asttypes.cmi \
!     asmcomp/arch.cmx asmcomp/cmmgen.cmi
  asmcomp/codegen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \
      asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \
***************
*** 741,752 ****
      typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \
      bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi
! driver/main.cmo: utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \
!     driver/errors.cmi utils/config.cmi driver/compile.cmi utils/clflags.cmi \
!     bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \
!     bytecomp/bytelibrarian.cmi driver/main.cmi
! driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \
!     driver/errors.cmx utils/config.cmx driver/compile.cmx utils/clflags.cmx \
!     bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \
!     bytecomp/bytelibrarian.cmx driver/main.cmi
  driver/main_args.cmo: utils/warnings.cmi driver/main_args.cmi
  driver/main_args.cmx: utils/warnings.cmx driver/main_args.cmi
--- 750,761 ----
      typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \
      bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi
! driver/main.cmo: utils/warnings.cmi typing/typemod.cmi utils/misc.cmi \
!     driver/main_args.cmi driver/errors.cmi typing/env.cmi utils/config.cmi \
!     driver/compile.cmi utils/clflags.cmi bytecomp/bytepackager.cmi \
!     bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi driver/main.cmi
! driver/main.cmx: utils/warnings.cmx typing/typemod.cmx utils/misc.cmx \
!     driver/main_args.cmx driver/errors.cmx typing/env.cmx utils/config.cmx \
!     driver/compile.cmx utils/clflags.cmx bytecomp/bytepackager.cmx \
!     bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/main.cmi
  driver/main_args.cmo: utils/warnings.cmi driver/main_args.cmi
  driver/main_args.cmx: utils/warnings.cmx driver/main_args.cmi
***************
*** 781,794 ****
      asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
      asmcomp/asmgen.cmx driver/opterrors.cmi
! driver/optmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \
!     driver/opterrors.cmi driver/optcompile.cmi utils/misc.cmi \
!     driver/main_args.cmi utils/config.cmi utils/clflags.cmi \
!     asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \
!     asmcomp/arch.cmo driver/optmain.cmi
! driver/optmain.cmx: utils/warnings.cmx asmcomp/printmach.cmx \
!     driver/opterrors.cmx driver/optcompile.cmx utils/misc.cmx \
!     driver/main_args.cmx utils/config.cmx utils/clflags.cmx \
!     asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
!     asmcomp/arch.cmx driver/optmain.cmi
  driver/pparse.cmo: utils/misc.cmi parsing/location.cmi utils/clflags.cmi \
      utils/ccomp.cmi driver/pparse.cmi
--- 790,803 ----
      asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
      asmcomp/asmgen.cmx driver/opterrors.cmi
! driver/optmain.cmo: utils/warnings.cmi typing/typemod.cmi \
!     asmcomp/printmach.cmi driver/opterrors.cmi driver/optcompile.cmi \
!     utils/misc.cmi driver/main_args.cmi typing/env.cmi utils/config.cmi \
!     utils/clflags.cmi asmcomp/asmpackager.cmi asmcomp/asmlink.cmi \
!     asmcomp/asmlibrarian.cmi asmcomp/arch.cmo driver/optmain.cmi
! driver/optmain.cmx: utils/warnings.cmx typing/typemod.cmx \
!     asmcomp/printmach.cmx driver/opterrors.cmx driver/optcompile.cmx \
!     utils/misc.cmx driver/main_args.cmx typing/env.cmx utils/config.cmx \
!     utils/clflags.cmx asmcomp/asmpackager.cmx asmcomp/asmlink.cmx \
!     asmcomp/asmlibrarian.cmx asmcomp/arch.cmx driver/optmain.cmi
  driver/pparse.cmo: utils/misc.cmi parsing/location.cmi utils/clflags.cmi \
      utils/ccomp.cmi driver/pparse.cmi
diff -C 2 -N -r -w ocaml-3.12.0/driver/compile.ml ocaml-3.12.0+functor/driver/compile.ml
*** ocaml-3.12.0/driver/compile.ml	2008-10-06 15:53:54.000000000 +0200
--- ocaml-3.12.0+functor/driver/compile.ml	2011-06-06 14:33:18.185859004 +0200
***************
*** 43,49 ****
    Ident.reinit();
    try
      if !Clflags.nopervasives
!     then Env.initial
!     else Env.open_pers_signature "Pervasives" Env.initial
    with Not_found ->
      fatal_error "cannot open pervasives.cmi"
--- 43,50 ----
    Ident.reinit();
    try
+     let env = Env.initial in
      if !Clflags.nopervasives
!     then env
!     else Env.open_pers_signature "Pervasives" env
    with Not_found ->
      fatal_error "cannot open pervasives.cmi"
***************
*** 84,87 ****
--- 85,89 ----
        Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
      if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
+     Env.add_functor_arguments modulename;
      let sg = Typemod.transl_signature (initial_env()) ast in
      if !Clflags.print_types then
***************
*** 112,115 ****
--- 114,118 ----
    Env.set_unit_name modulename;
    let inputfile = Pparse.preprocess sourcefile in
+   Env.add_functor_arguments modulename;
    let env = initial_env() in
    if !Clflags.print_types then begin
diff -C 2 -N -r -w ocaml-3.12.0/driver/main_args.ml ocaml-3.12.0+functor/driver/main_args.ml
*** ocaml-3.12.0/driver/main_args.ml	2010-07-06 16:05:26.000000000 +0200
--- ocaml-3.12.0+functor/driver/main_args.ml	2011-06-06 14:33:18.185859004 +0200
***************
*** 193,196 ****
--- 193,202 ----
  ;;

+ let mk_functor f =
+   "-functor", Arg.String f, " <file.mli> : signature of functor argument"
+
+ let mk_pack_functor f =
+   "-pack-functor", Arg.String f, "<modname> : name of functor"
+
  let mk_pp f =
    "-pp", Arg.String f, "<command>  Pipe sources through preprocessor <command>"
***************
*** 400,403 ****
--- 406,411 ----
    val _output_obj : unit -> unit
    val _pack : unit -> unit
+   val _pack_functor : string -> unit
+   val _functor : string -> unit
    val _pp : string -> unit
    val _principal : unit -> unit
***************
*** 483,486 ****
--- 491,496 ----
    val _p : unit -> unit
    val _pack : unit -> unit
+   val _pack_functor : string -> unit
+   val _functor : string -> unit
    val _pp : string -> unit
    val _principal : unit -> unit
***************
*** 602,605 ****
--- 612,617 ----
      mk_output_obj F._output_obj;
      mk_pack_byt F._pack;
+     mk_pack_functor F._pack_functor;
+     mk_functor F._functor;
      mk_pp F._pp;
      mk_principal F._principal;
***************
*** 693,696 ****
--- 705,710 ----
      mk_p F._p;
      mk_pack_opt F._pack;
+     mk_pack_functor F._pack_functor;
+     mk_functor F._functor;
      mk_pp F._pp;
      mk_principal F._principal;
diff -C 2 -N -r -w ocaml-3.12.0/driver/main_args.mli ocaml-3.12.0+functor/driver/main_args.mli
*** ocaml-3.12.0/driver/main_args.mli	2010-05-20 16:06:29.000000000 +0200
--- ocaml-3.12.0+functor/driver/main_args.mli	2011-06-06 14:33:18.195859009 +0200
***************
*** 42,45 ****
--- 42,47 ----
      val _output_obj : unit -> unit
      val _pack : unit -> unit
+     val _pack_functor : string -> unit
+     val _functor : string -> unit
      val _pp : string -> unit
      val _principal : unit -> unit
***************
*** 126,129 ****
--- 128,133 ----
    val _p : unit -> unit
    val _pack : unit -> unit
+   val _pack_functor : string -> unit
+   val _functor : string -> unit
    val _pp : string -> unit
    val _principal : unit -> unit
diff -C 2 -N -r -w ocaml-3.12.0/driver/main.ml ocaml-3.12.0+functor/driver/main.ml
*** ocaml-3.12.0/driver/main.ml	2010-05-20 16:06:29.000000000 +0200
--- ocaml-3.12.0+functor/driver/main.ml	2011-06-06 15:37:02.775859002 +0200
***************
*** 48,52 ****
    else if Filename.check_suffix name ".cmi" && !make_package then
      objfiles := name :: !objfiles
!   else if Filename.check_suffix name ext_obj
         || Filename.check_suffix name ext_lib then
      ccobjs := name :: !ccobjs
--- 48,55 ----
    else if Filename.check_suffix name ".cmi" && !make_package then
      objfiles := name :: !objfiles
!   else if Filename.check_suffix name ".cmi" && !print_types then begin
!     Compile.init_path ();
!     Typemod.print_types ppf name
!   end else if Filename.check_suffix name ext_obj
         || Filename.check_suffix name ext_lib then
      ccobjs := name :: !ccobjs
***************
*** 117,120 ****
--- 120,127 ----
    let _output_obj () = output_c_object := true; custom_runtime := true
    let _pack = set make_package
+   let _pack_functor s =
+     set make_package ();
+     pack_functor := Some s
+   let _functor s = functors := s :: !functors
    let _pp s = preprocessor := Some s
    let _principal = set principal
***************
*** 154,157 ****
--- 161,167 ----
    | None -> Config.default_executable_name

+ let module_name filename =
+   String.capitalize (Misc.chop_extensions (Filename.basename filename))
+
  let main () =
    try
***************
*** 174,179 ****
      else if !make_package then begin
        Compile.init_path();
        Bytepackager.package_files (List.rev !objfiles)
!                                  (extract_output !output_name)
      end
      else if not !compile_only && !objfiles <> [] then begin
--- 184,195 ----
      else if !make_package then begin
        Compile.init_path();
+       let target = extract_output !output_name in
+       Env.add_functor_arguments (module_name target);
+       if Filename.check_suffix target ".cmi" then
+ 	Typemod.package_interfaces (List.rev !objfiles)
+           target !pack_functor
+       else
  	Bytepackager.package_files (List.rev !objfiles)
!           target !pack_functor
      end
      else if not !compile_only && !objfiles <> [] then begin
***************
*** 202,204 ****
      exit 2

! let _ = main ()
--- 218,222 ----
      exit 2

! let _ =
!   main ()
!
diff -C 2 -N -r -w ocaml-3.12.0/driver/optcompile.ml ocaml-3.12.0+functor/driver/optcompile.ml
*** ocaml-3.12.0/driver/optcompile.ml	2008-12-03 19:09:09.000000000 +0100
--- ocaml-3.12.0+functor/driver/optcompile.ml	2011-06-06 14:33:18.195859009 +0200
***************
*** 40,46 ****
    Ident.reinit();
    try
      if !Clflags.nopervasives
!     then Env.initial
!     else Env.open_pers_signature "Pervasives" Env.initial
    with Not_found ->
      fatal_error "cannot open pervasives.cmi"
--- 40,47 ----
    Ident.reinit();
    try
+     let env = Env.initial in
      if !Clflags.nopervasives
!     then env
!     else Env.open_pers_signature "Pervasives" env
    with Not_found ->
      fatal_error "cannot open pervasives.cmi"
***************
*** 81,84 ****
--- 82,86 ----
        Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
      if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
+     Env.add_functor_arguments modulename;
      let sg = Typemod.transl_signature (initial_env()) ast in
      if !Clflags.print_types then
***************
*** 113,116 ****
--- 115,119 ----
    let inputfile = Pparse.preprocess sourcefile in
    let env = initial_env() in
+   Env.add_functor_arguments modulename;
    Compilenv.reset ?packname:!Clflags.for_package modulename;
    let cmxfile = outputprefix ^ ".cmx" in
***************
*** 138,141 ****
--- 141,145 ----
      Stypes.dump (outputprefix ^ ".annot");
    with x ->
+     Printexc.print_backtrace stderr;
      remove_file objfile;
      remove_file cmxfile;
***************
*** 146,147 ****
--- 150,153 ----
  let c_file name =
    if Ccomp.compile_file name <> 0 then exit 2
+
+
diff -C 2 -N -r -w ocaml-3.12.0/driver/optmain.ml ocaml-3.12.0+functor/driver/optmain.ml
*** ocaml-3.12.0/driver/optmain.ml	2010-05-20 16:06:29.000000000 +0200
--- ocaml-3.12.0+functor/driver/optmain.ml	2011-06-06 15:37:10.035859003 +0200
***************
*** 45,48 ****
--- 45,52 ----
    else if Filename.check_suffix name ".cmi" && !make_package then
      objfiles := name :: !objfiles
+   else if Filename.check_suffix name ".cmi" && !print_types then begin
+     Optcompile.init_path ();
+     Typemod.print_types ppf name
+   end
    else if Filename.check_suffix name ext_obj
         || Filename.check_suffix name ext_lib then
***************
*** 126,129 ****
--- 130,137 ----
    let _p = set gprofile
    let _pack = set make_package
+   let _pack_functor s =
+     set make_package ();
+     pack_functor := Some s
+   let _functor s = functors := s :: !functors
    let _pp s = preprocessor := Some s
    let _principal = set principal
***************
*** 164,167 ****
--- 172,178 ----
  end);;

+ let module_name filename =
+   String.capitalize (Misc.chop_extensions (Filename.basename filename))
+
  let main () =
    native_code := true;
***************
*** 183,187 ****
        Optcompile.init_path();
        let target = extract_output !output_name in
!       Asmpackager.package_files ppf (List.rev !objfiles) target;
      end
      else if !shared then begin
--- 194,203 ----
        Optcompile.init_path();
        let target = extract_output !output_name in
! 	  Env.add_functor_arguments (module_name target);
!       if Filename.check_suffix target ".cmi" then
! 	Typemod.package_interfaces (List.rev !objfiles)
!           target !pack_functor
!       else
!       Asmpackager.package_files ppf (List.rev !objfiles) target !pack_functor;
      end
      else if !shared then begin
***************
*** 214,216 ****
      exit 2

! let _ = main ()
--- 230,234 ----
      exit 2

!
! let _ =
!   main ()
diff -C 2 -N -r -w ocaml-3.12.0/Makefile ocaml-3.12.0+functor/Makefile
*** ocaml-3.12.0/Makefile	2010-06-16 03:32:26.000000000 +0200
--- ocaml-3.12.0+functor/Makefile	2011-06-06 14:33:18.175859003 +0200
***************
*** 20,25 ****
  CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
  CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
! COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES)
! LINKFLAGS=

  CAMLYACC=boot/ocamlyacc
--- 20,25 ----
  CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
  CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
! COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES) -g
! LINKFLAGS=-g

  CAMLYACC=boot/ocamlyacc
***************
*** 49,53 ****
    typing/btype.cmo typing/oprint.cmo \
    typing/subst.cmo typing/predef.cmo \
!   typing/datarepr.cmo typing/env.cmo \
    typing/typedtree.cmo typing/ctype.cmo \
    typing/printtyp.cmo typing/includeclass.cmo \
--- 49,53 ----
    typing/btype.cmo typing/oprint.cmo \
    typing/subst.cmo typing/predef.cmo \
!   typing/datarepr.cmo typing/cmi_format.cmo typing/env.cmo \
    typing/typedtree.cmo typing/ctype.cmo \
    typing/printtyp.cmo typing/includeclass.cmo \
***************
*** 546,550 ****
  tools/cvt_emit: tools/cvt_emit.mll
  	cd tools; \
! 	$(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit

  # The "expunge" utility
--- 546,550 ----
  tools/cvt_emit: tools/cvt_emit.mll
  	cd tools; \
! 	$(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../boot" cvt_emit

  # The "expunge" utility
diff -C 2 -N -r -w ocaml-3.12.0/ocamldoc/Makefile ocaml-3.12.0+functor/ocamldoc/Makefile
*** ocaml-3.12.0/ocamldoc/Makefile	2010-06-16 13:38:22.000000000 +0200
--- ocaml-3.12.0+functor/ocamldoc/Makefile	2011-06-06 14:33:18.195859009 +0200
***************
*** 154,157 ****
--- 154,158 ----
  	$(OCAMLSRCDIR)/typing/datarepr.cmo \
  	$(OCAMLSRCDIR)/typing/subst.cmo \
+ 	$(OCAMLSRCDIR)/typing/cmi_format.cmo \
  	$(OCAMLSRCDIR)/typing/env.cmo \
  	$(OCAMLSRCDIR)/typing/ctype.cmo \
diff -C 2 -N -r -w ocaml-3.12.0/ocamldoc/Makefile.nt ocaml-3.12.0+functor/ocamldoc/Makefile.nt
*** ocaml-3.12.0/ocamldoc/Makefile.nt	2010-05-28 13:21:46.000000000 +0200
--- ocaml-3.12.0+functor/ocamldoc/Makefile.nt	2011-06-06 14:33:18.195859009 +0200
***************
*** 149,152 ****
--- 149,153 ----
  	$(OCAMLSRCDIR)/typing/datarepr.cmo \
  	$(OCAMLSRCDIR)/typing/subst.cmo \
+ 	$(OCAMLSRCDIR)/typing/cmi_format.cmo \
  	$(OCAMLSRCDIR)/typing/env.cmo \
  	$(OCAMLSRCDIR)/typing/ctype.cmo \
diff -C 2 -N -r -w ocaml-3.12.0/otherlibs/dynlink/Makefile ocaml-3.12.0+functor/otherlibs/dynlink/Makefile
*** ocaml-3.12.0/otherlibs/dynlink/Makefile	2010-05-28 17:09:22.000000000 +0200
--- ocaml-3.12.0+functor/otherlibs/dynlink/Makefile	2011-06-06 14:33:18.195859009 +0200
***************
*** 34,38 ****
    ../../typing/primitive.cmo ../../typing/types.cmo \
    ../../typing/btype.cmo ../../typing/subst.cmo ../../typing/predef.cmo \
!   ../../typing/datarepr.cmo ../../typing/env.cmo \
    ../../bytecomp/lambda.cmo ../../bytecomp/instruct.cmo \
    ../../bytecomp/cmo_format.cmi ../../bytecomp/opcodes.cmo \
--- 34,40 ----
    ../../typing/primitive.cmo ../../typing/types.cmo \
    ../../typing/btype.cmo ../../typing/subst.cmo ../../typing/predef.cmo \
!   ../../typing/datarepr.cmo \
!   ../../typing/cmi_format.cmo \
!   ../../typing/env.cmo \
    ../../bytecomp/lambda.cmo ../../bytecomp/instruct.cmo \
    ../../bytecomp/cmo_format.cmi ../../bytecomp/opcodes.cmo \
diff -C 2 -N -r -w ocaml-3.12.0/parsing/location.ml ocaml-3.12.0+functor/parsing/location.ml
*** ocaml-3.12.0/parsing/location.ml	2008-01-11 17:13:18.000000000 +0100
--- ocaml-3.12.0+functor/parsing/location.ml	2011-06-06 14:33:18.195859009 +0200
***************
*** 206,210 ****
  let get_pos_info pos =
    let (filename, linenum, linebeg) =
!     if pos.pos_fname = "" && !input_name = "" then
        ("", -1, 0)
      else if pos.pos_fname = "" then
--- 206,210 ----
  let get_pos_info pos =
    let (filename, linenum, linebeg) =
!     if pos.pos_fname = "" && (!input_name = "" || !input_name = "_none_") then
        ("", -1, 0)
      else if pos.pos_fname = "" then
diff -C 2 -N -r -w ocaml-3.12.0/stdlib/camlinternalMod.ml ocaml-3.12.0+functor/stdlib/camlinternalMod.ml
*** ocaml-3.12.0/stdlib/camlinternalMod.ml	2008-01-11 17:13:18.000000000 +0100
--- ocaml-3.12.0+functor/stdlib/camlinternalMod.ml	2011-06-06 14:33:18.195859009 +0200
***************
*** 67,68 ****
--- 67,76 ----
          update_mod comps.(i) (Obj.field o i) (Obj.field n i)
        done
+
+ module StringMap = Map.Make(String)
+
+ type functor_arg
+ type functor_env = functor_arg StringMap.t
+ let create_functor_env () = StringMap.empty
+ let find_functor_arg = StringMap.find
+ let add_functor_arg = StringMap.add
diff -C 2 -N -r -w ocaml-3.12.0/stdlib/camlinternalMod.mli ocaml-3.12.0+functor/stdlib/camlinternalMod.mli
*** ocaml-3.12.0/stdlib/camlinternalMod.mli	2004-08-12 14:57:00.000000000 +0200
--- ocaml-3.12.0+functor/stdlib/camlinternalMod.mli	2011-06-06 14:33:18.195859009 +0200
***************
*** 22,23 ****
--- 22,29 ----
  val init_mod: string * int * int -> shape -> Obj.t
  val update_mod: shape -> Obj.t -> Obj.t -> unit
+
+ type functor_env
+ type functor_arg
+ val create_functor_env : unit -> functor_env
+ val find_functor_arg :  string -> functor_env -> functor_arg
+ val add_functor_arg : string -> functor_arg -> functor_env -> functor_env
diff -C 2 -N -r -w ocaml-3.12.0/tools/Makefile.shared ocaml-3.12.0+functor/tools/Makefile.shared
*** ocaml-3.12.0/tools/Makefile.shared	2010-06-07 08:58:41.000000000 +0200
--- ocaml-3.12.0+functor/tools/Makefile.shared	2011-06-06 14:33:18.205858999 +0200
***************
*** 234,238 ****

  OBJINFO=../utils/misc.cmo ../utils/config.cmo ../bytecomp/bytesections.cmo \
!         objinfo.cmo

  objinfo: objinfo_helper$(EXE) $(OBJINFO)
--- 234,238 ----

  OBJINFO=../utils/misc.cmo ../utils/config.cmo ../bytecomp/bytesections.cmo \
!         ../typing/cmi_format.cmo objinfo.cmo

  objinfo: objinfo_helper$(EXE) $(OBJINFO)
diff -C 2 -N -r -w ocaml-3.12.0/tools/objinfo.ml ocaml-3.12.0+functor/tools/objinfo.ml
*** ocaml-3.12.0/tools/objinfo.ml	2010-05-24 16:27:50.000000000 +0200
--- ocaml-3.12.0+functor/tools/objinfo.ml	2011-06-06 14:33:18.205858999 +0200
***************
*** 24,27 ****
--- 24,28 ----
  open Cmo_format
  open Clambda
+ open Cmi_format

  let input_stringlist ic len =
***************
*** 45,52 ****
--- 46,65 ----
    printf "\t%s\n" name

+ let print_functor_infos functor_args functor_parts =
+   if functor_args <> [] then begin
+     printf "Functor args:\n";
+     List.iter print_name_crc functor_args;
+     printf "Functors parts:\n";
+     List.iter (fun (id, deps) ->
+       printf "\t%s\n" ( id);
+       List.iter (fun (id, crc) -> printf "\t\t(%s:%s)\n" (id) (Digest.to_hex crc)) deps;
+     ) functor_parts
+   end
+
  let print_cmo_infos cu =
    printf "Unit name: %s\n" cu.cu_name;
    print_string "Interfaces imported:\n";
    List.iter print_name_crc cu.cu_imports;
+   print_functor_infos cu.cu_functor_args cu.cu_functor_parts;
    printf "Uses unsafe features: ";
    match cu.cu_primitives with
***************
*** 98,105 ****
    List.iter print_cmo_infos lib.lib_units

! let print_cmi_infos name sign comps crcs =
!   printf "Unit name: %s\n" name;
    printf "Interfaces imported:\n";
!   List.iter print_name_crc crcs

  let print_general_infos name crc defines cmi cmx =
--- 111,119 ----
    List.iter print_cmo_infos lib.lib_units

! let print_cmi_infos cmi cmi_crc =
!   printf "Unit name: %s\n" cmi.cmi_name;
    printf "Interfaces imported:\n";
!   List.iter print_name_crc cmi.cmi_crcs;
!   print_functor_infos cmi.cmi_functor_args cmi.cmi_functor_parts

  let print_general_infos name crc defines cmi cmx =
***************
*** 118,121 ****
--- 132,136 ----
    print_general_infos
      ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx;
+   print_functor_infos ui.ui_functor_args ui.ui_functor_parts;
    printf "Approximation:\n";
    Format.fprintf Format.std_formatter "  %a@." print_approx_infos ui.ui_approx;
***************
*** 223,230 ****
      print_cma_infos toc
    end else if magic_number = cmi_magic_number then begin
!     let (name, sign, comps) = input_value ic in
!     let crcs = input_value ic in
      close_in ic;
!     print_cmi_infos name sign comps crcs
    end else if magic_number = cmx_magic_number then begin
      let ui = (input_value ic : unit_infos) in
--- 238,244 ----
      print_cma_infos toc
    end else if magic_number = cmi_magic_number then begin
!     let (cmi, cmi_crc) = Cmi_format.input_cmi_info ic in
      close_in ic;
!     print_cmi_infos cmi cmi_crc
    end else if magic_number = cmx_magic_number then begin
      let ui = (input_value ic : unit_infos) in
diff -C 2 -N -r -w ocaml-3.12.0/tools/ocamlcp.ml ocaml-3.12.0+functor/tools/ocamlcp.ml
*** ocaml-3.12.0/tools/ocamlcp.ml	2010-05-20 16:06:29.000000000 +0200
--- ocaml-3.12.0+functor/tools/ocamlcp.ml	2011-06-06 14:33:18.205858999 +0200
***************
*** 71,74 ****
--- 71,76 ----
    let _output_obj = option "-output-obj"
    let _pack = option "-pack"
+   let _pack_functor = option_with_arg "-pack-functor"
+   let _functor = option_with_arg "-functor"
    let _pp s = incompatible "-pp"
    let _principal = option "-principal"
diff -C 2 -N -r -w ocaml-3.12.0/typing/cmi_format.ml ocaml-3.12.0+functor/typing/cmi_format.ml
*** ocaml-3.12.0/typing/cmi_format.ml	1970-01-01 01:00:00.000000000 +0100
--- ocaml-3.12.0+functor/typing/cmi_format.ml	2011-06-06 14:33:18.205858999 +0200
***************
*** 0 ****
--- 1,24 ----
+ type pers_flags = Rectypes
+
+ type cmi_info = {
+     cmi_name : string;
+     cmi_sig : Types.signature_item list;
+     mutable cmi_crcs : (string * Digest.t) list;
+     cmi_flags : pers_flags list;
+     cmi_arg_id : Ident.t;
+     cmi_functor_args : (string * Digest.t) list;
+     cmi_functor_parts : (string * (string * Digest.t) list) list;
+ }
+
+ let input_cmi_info ic =
+   let cmi = (input_value ic : cmi_info) in
+   let cmi_crc = (input_value ic : Digest.t) in
+   cmi, cmi_crc
+
+ let output_cmi_info oc cmi =
+   let s = Marshal.to_string cmi [] in
+   let crc = Digest.string s in
+   output_string oc s;
+   output_value oc crc;
+   crc
+
diff -C 2 -N -r -w ocaml-3.12.0/typing/cmi_format.mli ocaml-3.12.0+functor/typing/cmi_format.mli
*** ocaml-3.12.0/typing/cmi_format.mli	1970-01-01 01:00:00.000000000 +0100
--- ocaml-3.12.0+functor/typing/cmi_format.mli	2011-06-06 14:33:18.205858999 +0200
***************
*** 0 ****
--- 1,21 ----
+ type pers_flags = Rectypes
+
+ type cmi_info = {
+     cmi_name : string;
+     cmi_sig : Types.signature_item list;
+     mutable cmi_crcs : (string * Digest.t) list;
+     cmi_flags : pers_flags list;
+     cmi_arg_id : Ident.t;
+ (* For functors: this interface corresponds to a file that depends
+    on these arguments, with the corresponding digests.
+ *)
+     cmi_functor_args : (string * Digest.t) list;
+ (* For functors: this interface corresponds to a file that depends
+    on these units, with the corresponding argument dependencies.
+    The dependencies should be a suffix of the current dependencies.
+ *)
+     cmi_functor_parts : (string * (string * Digest.t) list) list;
+ }
+
+ val input_cmi_info : in_channel -> cmi_info * Digest.t
+ val output_cmi_info : out_channel -> cmi_info -> Digest.t
diff -C 2 -N -r -w ocaml-3.12.0/typing/ctype.ml ocaml-3.12.0+functor/typing/ctype.ml
*** ocaml-3.12.0/typing/ctype.ml	2010-06-24 10:43:39.000000000 +0200
--- ocaml-3.12.0+functor/typing/ctype.ml	2011-06-06 14:33:18.205858999 +0200
***************
*** 3474,3475 ****
--- 3474,3576 ----
  let collapse_conj_params env params =
    List.iter (collapse_conj env []) params
+
+ module PrintDebugType = struct
+
+   type context = {
+     table : (int, string) Hashtbl.t;
+   }
+
+   let rec type_expr c t =
+     try
+       Hashtbl.find c.table t.id
+     with Not_found ->
+       Hashtbl.add c.table t.id (Printf.sprintf "{ty.id = %d}" t.id);
+       let b = Buffer.create 100 in
+       Printf.bprintf b "{ desc = %s;\n" (type_desc c t.desc);
+       Printf.bprintf b "  level = %d;\n" t.level;
+       Printf.bprintf b "  id = %d }" t.id;
+       let s = Buffer.contents b in
+       Hashtbl.add c.table t.id s;
+       s
+
+   and type_desc c t =
+     match t with
+ 	Tvar -> "Tvar"
+       | Tarrow _ -> "Tarrow"
+       | Ttuple _ -> "Ttuple"
+       | Tconstr _ -> "Tconstr"
+       | Tobject _ -> "Tobject"
+       | Tfield _ -> "Tfield"
+       | Tnil -> "Tnil"
+       | Tlink _ -> "Tlink"
+       | Tsubst _ -> "Tsubst"
+       | Tvariant _ -> "Tvariant"
+       | Tunivar -> "Tunivar"
+       | Tpoly _ -> "Tpoly"
+       | Tpackage _ -> "Tpackage"
+
+ (*
+       | Tarrow of label * type_expr * type_expr * commutable
+       | Ttuple of type_expr list
+       | Tconstr of Path.t * type_expr list * abbrev_memo ref
+       | Tobject of type_expr * (Path.t * type_expr list) option ref
+       | Tfield of string * field_kind * type_expr * type_expr
+       | Tnil
+       | Tlink of type_expr
+       | Tsubst of type_expr         (* for copying *)
+       | Tvariant of row_desc
+       | Tunivar
+       | Tpoly of type_expr * type_expr list
+       | Tpackage of Path.t * string list * type_expr list
+ *)
+
+ (*
+ and row_desc =
+     { row_fields: (label * row_field) list;
+       row_more: type_expr;
+       row_bound: unit;
+       row_closed: bool;
+       row_fixed: bool;
+       row_name: (Path.t * type_expr list) option }
+
+ and row_field =
+     Rpresent of type_expr option
+   | Reither of bool * type_expr list * bool * row_field option ref
+         (* 1st true denotes a constant constructor *)
+         (* 2nd true denotes a tag in a pattern matching, and
+            is erased later *)
+   | Rabsent
+
+ and abbrev_memo =
+     Mnil
+   | Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
+   | Mlink of abbrev_memo ref
+
+ and field_kind =
+     Fvar of field_kind option ref
+   | Fpresent
+   | Fabsent
+
+ and commutable =
+     Cok
+   | Cunknown
+   | Clink of commutable ref
+ *)
+
+   let type_expr t = type_expr { table = Hashtbl.create 13 } t
+
+ end
+
+ let _ =
+   Printexc.register_printer (fun e ->
+     match e with
+ 	Unify list ->
+ 	  let b = Buffer.create 100 in
+ 	  Printf.bprintf b "Ctype.Unify [\n";
+ 	  List.iter (fun (t1, t2) ->
+ 	    Printf.bprintf b "      (%s,\n" (PrintDebugType.type_expr t1);
+ 	    Printf.bprintf b "       %s)\n" (PrintDebugType.type_expr t2);
+ 	  ) list;
+ 	  Printf.bprintf b "            ]\n";
+ 	  Some (Buffer.contents b)
+       | _ -> None)
diff -C 2 -N -r -w ocaml-3.12.0/typing/env.ml ocaml-3.12.0+functor/typing/env.ml
*** ocaml-3.12.0/typing/env.ml	2010-04-30 03:56:21.000000000 +0200
--- ocaml-3.12.0+functor/typing/env.ml	2011-06-06 15:35:45.245858999 +0200
***************
*** 22,25 ****
--- 22,26 ----
  open Types

+ type intf_info = string * Digest.t

  type error =
***************
*** 28,31 ****
--- 29,33 ----
    | Illegal_renaming of string * string
    | Inconsistent_import of string * string * string
+   | Inconsistent_arguments of string * intf_info list * intf_info list
    | Need_recursive_types of string * string

***************
*** 135,141 ****
  let current_unit = ref ""

  (* Persistent structure descriptions *)

! type pers_flags = Rectypes

  type pers_struct =
--- 137,153 ----
  let current_unit = ref ""

+ let functor_args = ref ([] : (string * Digest.t) list)
+ let functor_arg_crcs = (Hashtbl.create 17 : (string, Digest.t * string) Hashtbl.t)
+ let functor_parts = ref ([] : (string * (string * Digest.t) list) list)
+ let functor_parts_table = (Hashtbl.create 17 : (string, Ident.t) Hashtbl.t)
+
  (* Persistent structure descriptions *)

! (* type pers_flags = Rectypes moved to Cmi_format *)
!
! type ps_kind =
!     PersistentStructureDependency
!   | PersistentStructureArgument
!   | PersistentStructureUnit

  type pers_struct =
***************
*** 145,152 ****
      ps_crcs: (string * Digest.t) list;
      ps_filename: string;
!     ps_flags: pers_flags list }

! let persistent_structures =
!   (Hashtbl.create 17 : (string, pers_struct) Hashtbl.t)

  (* Consistency between persistent structures *)
--- 157,169 ----
      ps_crcs: (string * Digest.t) list;
      ps_filename: string;
!     ps_flags: Cmi_format.pers_flags list;
!     ps_id : Ident.t;
!     ps_kind : ps_kind;
!     ps_crc : Digest.t;
!     ps_functor_args : (string * Digest.t) list;
!     ps_functor_parts : (string * (string * Digest.t) list) list;
!  }

! let persistent_structures = (Hashtbl.create 17 : (string, pers_struct) Hashtbl.t)

  (* Consistency between persistent structures *)
***************
*** 162,168 ****
      raise(Error(Inconsistent_import(name, auth, source)))

  (* Reading persistent structures from .cmi files *)

! let read_pers_struct modname filename =
    let ic = open_in_bin filename in
    try
--- 179,223 ----
      raise(Error(Inconsistent_import(name, auth, source)))

+ let check_functor_args filename crcs =
+   if crcs <> [] then
+     let rec iter current_crcs =
+       match current_crcs with
+ 	  [] ->
+ 	    raise(Error(Inconsistent_arguments(filename, crcs, !functor_args)))
+ 	| _ :: tail ->
+ 	  if current_crcs = crcs then () else
+ 	    iter tail
+
+     in
+     iter !functor_args
+
  (* Reading persistent structures from .cmi files *)

! open Cmi_format
!
! (* TODO: check the case where two modules have inconsistent
!    assumptions on a module: one uses it as an argument, the other one as
!    a dependency. This should fail. *)
!
! let add_functor_arg id =
!   Ident.make_functor_part id;
!   Ident.make_functor_arg id;
!   let name = Ident.name id in
!   functor_parts := (Ident.name id, []) :: !functor_parts;
!   if not (Hashtbl.mem functor_parts_table name) then
!     Hashtbl.add functor_parts_table name (Ident.create name)
!
! let add_functor_part id deps =
!   Ident.make_functor_part id;
!   let name = Ident.name id in
!   functor_parts := (Ident.name id, deps) :: !functor_parts;
!   if not (Hashtbl.mem functor_parts_table name) then
!     Hashtbl.add functor_parts_table name (Ident.create name)
!
! let get_functor_part name = Hashtbl.find functor_parts_table name
!
! let get_functor_parts () = !functor_parts
!
! let read_pers_struct modname filename ps_kind =
    let ic = open_in_bin filename in
    try
***************
*** 173,193 ****
        raise(Error(Not_an_interface filename))
      end;
!     let (name, sign) = input_value ic in
!     let crcs = input_value ic in
!     let flags = input_value ic in
      close_in ic;
      let comps =
        !components_of_module' empty Subst.identity
!                              (Pident(Ident.create_persistent name))
!                              (Tmty_signature sign) in
!     let ps = { ps_name = name;
!                ps_sig = sign;
                 ps_comps = comps;
!                ps_crcs = crcs;
                 ps_filename = filename;
!                ps_flags = flags } in
      if ps.ps_name <> modname then
        raise(Error(Illegal_renaming(ps.ps_name, filename)));
      check_consistency filename ps.ps_crcs;
      List.iter
        (function Rectypes ->
--- 228,262 ----
        raise(Error(Not_an_interface filename))
      end;
!     let (cmi, crc) = Cmi_format.input_cmi_info ic in
      close_in ic;
+     let ps_id = Ident.create_persistent cmi.cmi_name in
+     begin
+       match ps_kind with
+ 	| PersistentStructureArgument -> add_functor_arg ps_id
+ 	| PersistentStructureDependency ->
+ 	  if cmi.cmi_functor_args <> [] then add_functor_part ps_id cmi.cmi_functor_args
+ 	| PersistentStructureUnit -> ()
+     end;
      let comps =
        !components_of_module' empty Subst.identity
!         (Pident ps_id)
!         (Tmty_signature cmi.cmi_sig) in
!     let ps = { ps_name = cmi.cmi_name;
!                ps_sig = cmi.cmi_sig;
                 ps_comps = comps;
!                ps_crcs = (cmi.cmi_name, crc) :: cmi.cmi_crcs;
! 	       ps_crc = crc;
                 ps_filename = filename;
!                ps_flags = cmi.cmi_flags;
! 	       ps_kind = ps_kind;
! 	       ps_id = ps_id;
! 	       ps_functor_args = cmi.cmi_functor_args;
! 	       ps_functor_parts = cmi.cmi_functor_parts;
! 	     } in
      if ps.ps_name <> modname then
        raise(Error(Illegal_renaming(ps.ps_name, filename)));
      check_consistency filename ps.ps_crcs;
+     if ps_kind <> PersistentStructureUnit then
+       check_functor_args filename ps.ps_functor_args;
      List.iter
        (function Rectypes ->
***************
*** 206,213 ****
--- 275,287 ----
    with Not_found ->
      read_pers_struct name (find_in_path_uncap !load_path (name ^ ".cmi"))
+       PersistentStructureDependency

  let reset_cache () =
    current_unit := "";
    Hashtbl.clear persistent_structures;
+   functor_args := [];
+   functor_parts := [];
+   Hashtbl.clear functor_parts_table;
+   Hashtbl.clear functor_arg_crcs;
    Consistbl.clear crc_units

***************
*** 226,230 ****
          if Ident.persistent id
          then (find_pers_struct (Ident.name id)).ps_comps
!         else raise Not_found
        end
    | Pdot(p, s, pos) ->
--- 300,306 ----
          if Ident.persistent id
          then (find_pers_struct (Ident.name id)).ps_comps
!         else begin
! 	  raise Not_found
! 	end
        end
    | Pdot(p, s, pos) ->
***************
*** 312,316 ****
            let ps = find_pers_struct (Ident.name id) in
            Tmty_signature(ps.ps_sig)
!         else raise Not_found
        end
    | Pdot(p, s, pos) ->
--- 388,394 ----
            let ps = find_pers_struct (Ident.name id) in
            Tmty_signature(ps.ps_sig)
!         else begin
! 	  raise Not_found
! 	end
        end
    | Pdot(p, s, pos) ->
***************
*** 334,338 ****
          if s = !current_unit then raise Not_found;
          let ps = find_pers_struct s in
!         (Pident(Ident.create_persistent s), ps.ps_comps)
        end
    | Ldot(l, s) ->
--- 412,416 ----
          if s = !current_unit then raise Not_found;
          let ps = find_pers_struct s in
!         (Pident ps.ps_id, ps.ps_comps)
        end
    | Ldot(l, s) ->
***************
*** 364,368 ****
          if s = !current_unit then raise Not_found;
          let ps = find_pers_struct s in
!         (Pident(Ident.create_persistent s), Tmty_signature ps.ps_sig)
        end
    | Ldot(l, s) ->
--- 442,446 ----
          if s = !current_unit then raise Not_found;
          let ps = find_pers_struct s in
!         (Pident ps.ps_id, Tmty_signature ps.ps_sig)
        end
    | Ldot(l, s) ->
***************
*** 783,792 ****
  let open_pers_signature name env =
    let ps = find_pers_struct name in
!   open_signature (Pident(Ident.create_persistent name)) ps.ps_sig env

  (* Read a signature from a file *)

  let read_signature modname filename =
!   let ps = read_pers_struct modname filename in ps.ps_sig

  (* Return the CRC of the interface of the given compilation unit *)
--- 861,881 ----
  let open_pers_signature name env =
    let ps = find_pers_struct name in
!   open_signature (Pident ps.ps_id) ps.ps_sig env

  (* Read a signature from a file *)

  let read_signature modname filename =
!   let ps = read_pers_struct modname filename PersistentStructureDependency in
!   ps.ps_sig
!
! let read_my_signature modname filename =
!   let ps = read_pers_struct modname filename PersistentStructureDependency in
!   if ps.ps_functor_args <> !functor_args then
!     raise (Error(Inconsistent_arguments (filename, ps.ps_functor_args, !functor_args)));
!   ps.ps_sig
!
! let read_signature_and_args modname filename =
!   let ps = read_pers_struct modname filename PersistentStructureUnit in
!   (ps.ps_sig, ps.ps_functor_args, ps.ps_functor_parts)

  (* Return the CRC of the interface of the given compilation unit *)
***************
*** 813,836 ****
    try
      output_string oc cmi_magic_number;
!     output_value oc (modname, sg);
!     flush oc;
!     let crc = Digest.file filename in
!     let crcs = (modname, crc) :: imports in
!     output_value oc crcs;
!     let flags = if !Clflags.recursive_types then [Rectypes] else [] in
!     output_value oc flags;
      close_out oc;
      (* Enter signature in persistent table so that imported_unit()
         will also return its crc *)
      let comps =
        components_of_module empty Subst.identity
!         (Pident(Ident.create_persistent modname)) (Tmty_signature sg) in
      let ps =
        { ps_name = modname;
          ps_sig = sg;
          ps_comps = comps;
!         ps_crcs = crcs;
          ps_filename = filename;
!         ps_flags = flags } in
      Hashtbl.add persistent_structures modname ps;
      Consistbl.set crc_units modname crc filename
--- 902,935 ----
    try
      output_string oc cmi_magic_number;
!     let cmi = {
!       cmi_name = modname;
!       cmi_sig = sg;
!       cmi_crcs = imports;
!       cmi_functor_args = !functor_args;
!       cmi_arg_id = Ident.create modname;
!       cmi_flags = (if !Clflags.recursive_types then [Rectypes] else []);
!       cmi_functor_parts = !functor_parts;
!     } in
!     let crc = output_cmi_info oc cmi in
      close_out oc;
      (* Enter signature in persistent table so that imported_unit()
         will also return its crc *)
+     let ps_pers_id = Ident.create_persistent modname in
      let comps =
        components_of_module empty Subst.identity
!         (Pident ps_pers_id) (Tmty_signature sg) in
      let ps =
        { ps_name = modname;
          ps_sig = sg;
          ps_comps = comps;
!         ps_crcs = (modname, crc) :: cmi.cmi_crcs;
! 	ps_crc = crc;
          ps_filename = filename;
!         ps_flags = cmi.cmi_flags;
! 	ps_id = ps_pers_id;
! 	ps_kind = PersistentStructureDependency;
! 	ps_functor_args = cmi.cmi_functor_args;
! 	ps_functor_parts = cmi.cmi_functor_parts;
!       } in
      Hashtbl.add persistent_structures modname ps;
      Consistbl.set crc_units modname crc filename
***************
*** 845,848 ****
--- 944,970 ----
  (* Make the initial environment *)

+ (* TODO Add checks: identifiers loaded for functor arguments should not conflict
+ with any local identifier. This is simply done in the case of persistent modules,
+ as their identifier is marked persistent. This is harder:
+ - for namespaces (check !!!)
+ - for these local identifiers
+ *)
+
+ let add_functor_arguments modname =
+   if !Clflags.functors <> [] then begin
+     add_functor_part (Ident.create_persistent modname) [];
+     functor_args := [];
+     List.iter (fun filename ->
+       let filename = Filename.chop_suffix filename ".mli" (* could be .cmi *) in
+       let modname = String.capitalize  (Filename.basename filename) in
+       let filename = filename ^ ".cmi" in
+       let ps = read_pers_struct modname filename PersistentStructureArgument in
+       functor_args := (Ident.name ps.ps_id, ps.ps_crc) :: !functor_args;
+       Hashtbl.add functor_arg_crcs (Ident.name ps.ps_id) (ps.ps_crc, filename);
+     ) !Clflags.functors
+   end
+
+ let get_functor_args () = !functor_args
+
  let initial = Predef.build_initial_env add_type add_exception empty

***************
*** 867,870 ****
--- 989,1000 ----
                make inconsistent assumptions@ over interface %s@]"
        source1 source2 name
+   | Inconsistent_arguments(filename, file_functor_args, current_functor_args) ->
+     fprintf ppf
+       "@[<hov>Inconsistent functor arguments with file %s@." filename;
+     fprintf ppf "File arguments:";
+     List.iter (fun (id,_) -> fprintf ppf "(%s)" id) file_functor_args;
+     fprintf ppf "@.Current arguments:";
+     List.iter (fun (id,_) -> fprintf ppf "(%s)" id) current_functor_args;
+     fprintf ppf "@]"
    | Need_recursive_types(import, export) ->
        fprintf ppf
diff -C 2 -N -r -w ocaml-3.12.0/typing/env.mli ocaml-3.12.0+functor/typing/env.mli
*** ocaml-3.12.0/typing/env.mli	2008-10-06 15:53:54.000000000 +0200
--- ocaml-3.12.0+functor/typing/env.mli	2011-06-06 14:33:18.205858999 +0200
***************
*** 19,24 ****
--- 19,30 ----
  type t

+ type intf_info = string * Digest.t
+
  val empty: t
  val initial: t
+ val add_functor_arguments : string -> unit
+ val get_functor_args : unit -> (string * Digest.t) list
+ val get_functor_parts : unit -> (string  * (string * Digest.t) list) list
+ val get_functor_part : string -> Ident.t
  val diff: t -> t -> Ident.t list

***************
*** 91,94 ****
--- 97,103 ----

  val read_signature: string -> string -> signature
+ val read_my_signature: string -> string -> signature
+ val read_signature_and_args: string -> string ->
+   signature * (string * Digest.t) list * (string * (string * Digest.t) list) list
          (* Arguments: module name, file name. Results: signature. *)
  val save_signature: signature -> string -> string -> unit
***************
*** 134,137 ****
--- 143,147 ----
    | Illegal_renaming of string * string
    | Inconsistent_import of string * string * string
+   | Inconsistent_arguments of string * intf_info list * intf_info list
    | Need_recursive_types of string * string

diff -C 2 -N -r -w ocaml-3.12.0/typing/ident.ml ocaml-3.12.0+functor/typing/ident.ml
*** ocaml-3.12.0/typing/ident.ml	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/typing/ident.ml	2011-06-06 14:33:18.205858999 +0200
***************
*** 19,22 ****
--- 19,24 ----
  let global_flag = 1
  let predef_exn_flag = 2
+ let functor_part_flag = 4
+ let functor_arg_flag = 8

  (* A stamp of 0 denotes a persistent identifier *)
***************
*** 43,48 ****
  let stamp i = i.stamp

- let unique_name i = i.name ^ "_" ^ string_of_int i.stamp
-
  let unique_toplevel_name i = i.name ^ "/" ^ string_of_int i.stamp

--- 45,48 ----
***************
*** 78,81 ****
--- 78,93 ----
    (i.flags land global_flag) <> 0

+ let make_functor_part i =
+   i.flags <- i.flags lor functor_part_flag
+
+ let is_functor_part i =
+   (i.flags land functor_part_flag) <> 0
+
+ let make_functor_arg i =
+   i.flags <- i.flags lor functor_arg_flag
+
+ let is_functor_arg i =
+   (i.flags land functor_arg_flag) <> 0
+
  let is_predef_exn i =
    (i.flags land predef_exn_flag) <> 0
***************
*** 83,90 ****
  let print ppf i =
    match i.stamp with
!   | 0 -> fprintf ppf "%s!" i.name
    | -1 -> fprintf ppf "%s#" i.name
    | n -> fprintf ppf "%s/%i%s" i.name n (if global i then "g" else "")

  type 'a tbl =
      Empty
--- 95,108 ----
  let print ppf i =
    match i.stamp with
!   | 0 -> fprintf ppf "%s!%s" i.name (if is_functor_arg i then "@" else if is_functor_part i then "$" else "")
    | -1 -> fprintf ppf "%s#" i.name
    | n -> fprintf ppf "%s/%i%s" i.name n (if global i then "g" else "")

+
+ let unique_name i = i.name ^ "_" ^ string_of_int i.stamp ^
+   (if is_functor_arg i then "a" else "") ^
+   (if is_functor_part i then "p" else "") ^
+   (if is_functor_arg i then "g" else "")
+
  type 'a tbl =
      Empty
diff -C 2 -N -r -w ocaml-3.12.0/typing/ident.mli ocaml-3.12.0+functor/typing/ident.mli
*** ocaml-3.12.0/typing/ident.mli	2010-01-22 13:48:24.000000000 +0100
--- ocaml-3.12.0+functor/typing/ident.mli	2011-06-06 14:33:18.205858999 +0200
***************
*** 41,44 ****
--- 41,48 ----
  val make_global: t -> unit
  val global: t -> bool
+ val make_functor_part: t -> unit
+ val is_functor_part: t -> bool
+ val make_functor_arg: t -> unit
+ val is_functor_arg: t -> bool
  val is_predef_exn: t -> bool

diff -C 2 -N -r -w ocaml-3.12.0/typing/printtyp.ml ocaml-3.12.0+functor/typing/printtyp.ml
*** ocaml-3.12.0/typing/printtyp.ml	2010-04-30 09:11:27.000000000 +0200
--- ocaml-3.12.0+functor/typing/printtyp.ml	2011-06-06 14:33:18.205858999 +0200
***************
*** 36,40 ****
  let unique_names = ref Ident.empty

! let ident_name id =
    try Ident.find_same id !unique_names with Not_found -> Ident.name id

--- 36,40 ----
  let unique_names = ref Ident.empty

! let ident_name id = (* Ident.unique_name id *)
    try Ident.find_same id !unique_names with Not_found -> Ident.name id

diff -C 2 -N -r -w ocaml-3.12.0/typing/typemod.ml ocaml-3.12.0+functor/typing/typemod.ml
*** ocaml-3.12.0/typing/typemod.ml	2010-06-07 10:24:02.000000000 +0200
--- ocaml-3.12.0+functor/typing/typemod.ml	2011-06-06 14:39:22.775859001 +0200
***************
*** 40,43 ****
--- 40,47 ----
    | Not_allowed_in_functor_body
    | With_need_typeconstr
+   | Inconsistent_functor_arguments of string * string
+   | No_functor_argument
+   | Functor_argument_not_found of string
+   | File_not_found of string

  exception Error of Location.t * error
***************
*** 996,999 ****
--- 1000,1015 ----
    end

+ let module_name filename =
+   String.capitalize (Misc.chop_extensions (Filename.basename filename))
+
+ let print_types ppf f =
+   let filename =
+     try find_in_path !Config.load_path f
+     with Not_found -> raise(Error(Location.none, File_not_found f))
+   in
+   let (sg,_,_) = Env.read_signature_and_args (module_name filename) filename in
+   fprintf ppf "%a@." Printtyp.signature sg
+
+
  (* "Packaging" of several compilation units into one unit
     having them as sub-modules.  *)
***************
*** 1001,1013 ****
  let rec package_signatures subst = function
      [] -> []
!   | (name, sg) :: rem ->
        let sg' = Subst.signature subst sg in
!       let oldid = Ident.create_persistent name
!       and newid = Ident.create name in
        Tsig_module(newid, Tmty_signature sg', Trec_not) ::
        package_signatures (Subst.add_module oldid (Pident newid) subst) rem

! let package_units objfiles cmifile modulename =
    (* Read the signatures of the units *)
    let units =
      List.map
--- 1017,1033 ----
  let rec package_signatures subst = function
      [] -> []
!   | (name, sg, parts) :: rem ->
        let sg' = Subst.signature subst sg in
!       let oldid = Ident.create_persistent name in
!       if parts <> [] then Ident.make_functor_part oldid;
!       let newid = Ident.create name in
        Tsig_module(newid, Tmty_signature sg', Trec_not) ::
        package_signatures (Subst.add_module oldid (Pident newid) subst) rem

! let package_units objfiles cmifile modulename functor_id =
    (* Read the signatures of the units *)
+   let needed_impl = ref Tbl.empty in
+   let provided_impl = ref Tbl.empty in
+   let functor_args = ref None in
    let units =
      List.map
***************
*** 1015,1030 ****
           let pref = chop_extensions f in
           let modname = String.capitalize(Filename.basename pref) in
!          let sg = Env.read_signature modname (pref ^ ".cmi") in
!          if Filename.check_suffix f ".cmi" &&
!             not(Mtype.no_code_needed_sig Env.initial sg)
!          then raise(Error(Location.none, Implementation_is_required f));
!          (modname, Env.read_signature modname (pref ^ ".cmi")))
        objfiles in
    (* Compute signature of packaged unit *)
    Ident.reinit();
!   let sg = package_signatures Subst.identity units in
    (* See if explicit interface is provided *)
    let mlifile =
      chop_extension_if_any cmifile ^ !Config.interface_suffix in
    if Sys.file_exists mlifile then begin
      if not (Sys.file_exists cmifile) then begin
--- 1035,1107 ----
           let pref = chop_extensions f in
           let modname = String.capitalize(Filename.basename pref) in
!          let (sg, f_args, f_parts) =
! 	   Env.read_signature_and_args modname (pref ^ ".cmi") in
!          if Filename.check_suffix f ".cmi" then begin
! 	   if not(Mtype.no_code_needed_sig Env.initial sg)
!            then needed_impl := Tbl.add modname f !needed_impl
! 	 end else
! 	   provided_impl := Tbl.remove modname !provided_impl;
!
! 	 begin match !functor_args with
! 	     None -> functor_args := Some (f, f_args)
! 	   | Some (f1, f_args1) ->
! 	     if f_args1 <> f_args then
! 	       raise (Error(Location.none,
! 			    Inconsistent_functor_arguments(f1, f)));
! 	 end;
! (* TODO: fix the double read of the signature in the trunk *)
!          (modname, sg, f_parts))
        objfiles in
+   Tbl.iter (fun modname f ->
+     if not (Tbl.mem modname !provided_impl) then
+       raise(Error(Location.none, Implementation_is_required f));
+     ) !needed_impl;
+   let (functor_args, functor_info) =
+     match !functor_args, functor_id with
+ 	None, None -> ([], None)
+       | Some (_, fargs), None -> (fargs, None)
+       | (None | Some (_, [])), Some id ->
+ 	raise (Error (Location.none, No_functor_argument))
+       | Some (_, (name,_) :: fargs), Some id ->
+ 	let newarg = Ident.create name in
+ 	let arg = Ident.create_persistent name in
+ 	Ident.make_functor_arg arg;
+ 	Ident.make_functor_part arg;
+ 	(fargs, Some (id, arg, newarg))
+   in
    (* Compute signature of packaged unit *)
    Ident.reinit();
!   let subst = Subst.identity in
!   let (subst, functor_info) = match functor_info with
!       None -> (subst, None)
!     | Some (functor_id, functor_oldarg, functor_newarg) ->
!       let subst = Subst.add_module functor_oldarg (Pident functor_newarg) subst in
!       (subst, Some (functor_id, functor_newarg))
!   in
!   let sg = package_signatures subst units in
!   let sg = match functor_info with
!       None -> sg
!     | Some (functor_id, functor_arg_id) ->
!       let functor_arg_name = Ident.name functor_arg_id in
!       let functor_arg_file =
!         try
!           find_in_path_uncap !Config.load_path (functor_arg_name ^ ".cmi")
!         with Not_found ->
! 	  raise (Error(Location.none, Functor_argument_not_found functor_arg_name))
!       in
! (* TODO: check consistency of arguments ? *)
!       let (functor_arg_sg, _, _) = Env.read_signature_and_args functor_arg_name functor_arg_file
!       in
!       [
! 	Tsig_module(functor_id,
! 		    Tmty_functor(functor_arg_id,
! 				 Tmty_signature functor_arg_sg,
! 				 Tmty_signature sg), Trec_not)
!       ]
!   in
    (* See if explicit interface is provided *)
    let mlifile =
      chop_extension_if_any cmifile ^ !Config.interface_suffix in
+   let cc =
    if Sys.file_exists mlifile then begin
      if not (Sys.file_exists cmifile) then begin
***************
*** 1035,1039 ****
    end else begin
      (* Determine imports *)
!     let unit_names = List.map fst units in
      let imports =
        List.filter
--- 1112,1116 ----
    end else begin
      (* Determine imports *)
!     let unit_names = List.map (fun (name, _, _) -> name) units in
      let imports =
        List.filter
***************
*** 1044,1047 ****
--- 1121,1213 ----
      Tcoerce_none
    end
+   in
+   (cc, functor_info, functor_args)
+
+ let package_interfaces objfiles targetfile functor_name =
+   let objfiles =
+     List.map
+       (fun f ->
+         try find_in_path !Config.load_path f
+         with Not_found -> raise(Error(Location.none, File_not_found f)))
+       objfiles in
+   let prefix = chop_extensions targetfile in
+   let targetcmi = prefix ^ ".cmi" in
+   let targetname = String.capitalize(Filename.basename prefix) in
+   let functor_id = match functor_name with
+       None -> None
+     | Some modname -> Some (Ident.create modname) in
+   try
+
+     (* Read the signatures of the units *)
+     let functor_args = ref None in
+     let units =
+       List.map
+ 	(fun f ->
+           let pref = chop_extensions f in
+           let modname = String.capitalize(Filename.basename pref) in
+           let (sg, f_args, f_parts) = Env.read_signature_and_args modname f in
+ 	  begin match !functor_args with
+ 	      None -> functor_args := Some (f, f_args)
+ 	    | Some (f1, f_args1) ->
+ 	      if f_args1 <> f_args then
+ 		raise (Error(Location.none,
+ 			     Inconsistent_functor_arguments(f1, f)));
+ 	  end;
+           (modname, sg, f_parts))
+ 	objfiles in
+   let (functor_args, functor_info) =
+     match !functor_args, functor_id with
+ 	None, None -> ([], None)
+       | Some (_, fargs), None -> (fargs, None)
+       | (None | Some (_, [])), Some id ->
+ 	raise (Error (Location.none, No_functor_argument))
+       | Some (_, (name,_) :: fargs), Some id ->
+ 	let newarg = Ident.create name in
+ 	let arg = Ident.create_persistent name in
+ 	Ident.make_functor_arg arg;
+ 	Ident.make_functor_part arg;
+ 	(fargs, Some (id, arg, newarg))
+   in
+   (* Compute signature of packaged unit *)
+   Ident.reinit();
+   let subst = Subst.identity in
+   let (subst, functor_info) = match functor_info with
+       None -> (subst, None)
+     | Some (functor_id, functor_oldarg, functor_newarg) ->
+       let subst = Subst.add_module functor_oldarg (Pident functor_newarg) subst in
+       (subst, Some (functor_id, functor_newarg))
+   in
+   let sg = package_signatures subst units in
+   let sg = match functor_info with
+       None -> sg
+     | Some (functor_id, functor_arg_id) ->
+       let functor_arg_name = Ident.name functor_arg_id in
+       let functor_arg_file =
+         try
+           find_in_path_uncap !Config.load_path (functor_arg_name ^ ".cmi")
+         with Not_found ->
+ 	  raise (Error(Location.none, Functor_argument_not_found functor_arg_name))
+       in
+       let (functor_arg_sg, _, _) = Env.read_signature_and_args functor_arg_name functor_arg_file
+       in
+       [
+ 	Tsig_module(functor_id,
+ 		    Tmty_functor(functor_arg_id,
+ 				 Tmty_signature functor_arg_sg,
+ 				 Tmty_signature sg), Trec_not)
+       ]
+   in
+
+     (* Determine imports *)
+   let unit_names = List.map (fun (name, _, _) -> name) units in
+   let imports =
+     List.filter
+       (fun (name, crc) -> not (List.mem name unit_names))
+       (Env.imported_units()) in
+     (* Write packaged signature *)
+   Env.save_signature_with_imports sg targetname targetcmi imports
+
+   with x ->
+     remove_file targetfile; raise x

  (* Error report *)
***************
*** 1107,1108 ****
--- 1273,1283 ----
        fprintf ppf
          "Only type constructors with identical parameters can be substituted."
+   | Inconsistent_functor_arguments (f1, f2) ->
+       fprintf ppf
+         "Files %s and %s make inconsistent assumptions on their arguments" f1 f2
+   | No_functor_argument ->
+       fprintf ppf "Cannot build a functor with toplevel modules"
+   | Functor_argument_not_found s ->
+       fprintf ppf "Compiled interface for functor argument %s could not be found" s
+   | File_not_found file ->
+       fprintf ppf "File %s not found" file
diff -C 2 -N -r -w ocaml-3.12.0/typing/typemod.mli ocaml-3.12.0+functor/typing/typemod.mli
*** ocaml-3.12.0/typing/typemod.mli	2010-05-18 19:18:24.000000000 +0200
--- ocaml-3.12.0+functor/typing/typemod.mli	2011-06-06 14:39:39.595859002 +0200
***************
*** 33,38 ****
  val simplify_signature: signature -> signature

  val package_units:
!         string list -> string -> string -> Typedtree.module_coercion

  type error =
--- 33,44 ----
  val simplify_signature: signature -> signature

+ val package_interfaces:
+   (* objfiles *) string list -> (* target *) string -> (* pack_functor *) string option -> unit
+
  val package_units:
!   string list -> string -> string -> Ident.t option ->
!     Typedtree.module_coercion * (Ident.t * Ident.t) option * (string * Digest.t) list
!
! val print_types : formatter -> string -> unit

  type error =
***************
*** 52,55 ****
--- 58,65 ----
    | Not_allowed_in_functor_body
    | With_need_typeconstr
+   | Inconsistent_functor_arguments of string * string
+   | No_functor_argument
+   | Functor_argument_not_found of string
+   | File_not_found of string

  exception Error of Location.t * error
diff -C 2 -N -r -w ocaml-3.12.0/utils/clflags.ml ocaml-3.12.0+functor/utils/clflags.ml
*** ocaml-3.12.0/utils/clflags.ml	2009-12-09 10:17:12.000000000 +0100
--- ocaml-3.12.0+functor/utils/clflags.ml	2011-06-06 14:33:18.215859000 +0200
***************
*** 93,94 ****
--- 93,98 ----
  let shared = ref false (* -shared *)
  let dlcode = ref true (* not -nodynlink *)
+
+
+ let pack_functor = ref None (* module name of functor *)
+ let functors = ref []       (* list of interface files, used as functor argument spec *)
diff -C 2 -N -r -w ocaml-3.12.0/utils/clflags.mli ocaml-3.12.0+functor/utils/clflags.mli
*** ocaml-3.12.0/utils/clflags.mli	2009-12-09 10:17:12.000000000 +0100
--- ocaml-3.12.0+functor/utils/clflags.mli	2011-06-06 14:33:18.215859000 +0200
***************
*** 77,78 ****
--- 77,82 ----
  val shared : bool ref
  val dlcode : bool ref
+
+ val pack_functor : string option ref (* module name of functor *)
+ val functors : string list ref       (* list of interface files, used as functor argument spec *)
+
diff -C 2 -N -r -w ocaml-3.12.0/utils/config.mlp ocaml-3.12.0+functor/utils/config.mlp
*** ocaml-3.12.0/utils/config.mlp	2010-05-19 13:29:38.000000000 +0200
--- ocaml-3.12.0+functor/utils/config.mlp	2011-06-06 15:31:17.035859008 +0200
***************
*** 51,62 ****

  let exec_magic_number = "Caml1999X008"
! and cmi_magic_number = "Caml1999I012"
! and cmo_magic_number = "Caml1999O007"
! and cma_magic_number = "Caml1999A008"
! and cmx_magic_number = "Caml1999Y011"
! and cmxa_magic_number = "Caml1999Z010"
  and ast_impl_magic_number = "Caml1999M013"
  and ast_intf_magic_number = "Caml1999N012"
! and cmxs_magic_number = "Caml2007D001"

  let load_path = ref ([] : string list)
--- 51,62 ----

  let exec_magic_number = "Caml1999X008"
! and cmi_magic_number = "Caml1999I013"
! and cmo_magic_number = "Caml1999O008"
! and cma_magic_number = "Caml1999A009"
! and cmx_magic_number = "Caml1999Y012"
! and cmxa_magic_number = "Caml1999Z011"
  and ast_impl_magic_number = "Caml1999M013"
  and ast_intf_magic_number = "Caml1999N012"
! and cmxs_magic_number = "Caml2007D002"

  let load_path = ref ([] : string list)