daily pastebin goal
85%
SHARE
TWEET

Untitled

a guest Feb 16th, 2019 74 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/asmgen.ml ocaml-3.12.0+functor/asmcomp/asmgen.ml
  2. *** ocaml-3.12.0/asmcomp/asmgen.ml  2010-01-22 13:48:24.000000000 +0100
  3. --- ocaml-3.12.0+functor/asmcomp/asmgen.ml  2011-06-06 14:45:13.425859003 +0200
  4. ***************
  5. *** 104,108 ****
  6.       Emitaux.output_channel := oc;
  7.       Emit.begin_assembly();
  8. !     Closure.intro size lam
  9.       ++ Cmmgen.compunit size
  10.       ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
  11. --- 104,108 ----
  12.       Emitaux.output_channel := oc;
  13.       Emit.begin_assembly();
  14. !     let (size, ulam) = Closure.intro size lam in ulam
  15.       ++ Cmmgen.compunit size
  16.       ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
  17. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/asmpackager.ml ocaml-3.12.0+functor/asmcomp/asmpackager.ml
  18. *** ocaml-3.12.0/asmcomp/asmpackager.ml 2010-05-19 13:29:38.000000000 +0200
  19. --- ocaml-3.12.0+functor/asmcomp/asmpackager.ml 2011-06-06 14:33:18.175859003 +0200
  20. ***************
  21. *** 80,84 ****
  22.   (* Make the .o file for the package *)
  23.  
  24. ! let make_package_object ppf members targetobj targetname coercion =
  25.     let objtemp =
  26.       if !Clflags.keep_asm_file
  27. --- 80,84 ----
  28.   (* Make the .o file for the package *)
  29.  
  30. ! let make_package_object ppf members targetobj targetname coercion functor_info =
  31.     let objtemp =
  32.       if !Clflags.keep_asm_file
  33. ***************
  34. *** 99,103 ****
  35.       (chop_extension_if_any objtemp) ppf
  36.       (Translmod.transl_store_package
  37. !        components (Ident.create_persistent targetname) coercion);
  38.     let objfiles =
  39.       List.map
  40. --- 99,103 ----
  41.       (chop_extension_if_any objtemp) ppf
  42.       (Translmod.transl_store_package
  43. !        components (Ident.create_persistent targetname) coercion functor_info);
  44.     let objfiles =
  45.       List.map
  46. ***************
  47. *** 112,116 ****
  48.   (* Make the .cmx file for the package *)
  49.  
  50. ! let build_package_cmx members cmxfile =
  51.     let unit_names =
  52.       List.map (fun m -> m.pm_name) members in
  53. --- 112,116 ----
  54.   (* Make the .cmx file for the package *)
  55.  
  56. ! let build_package_cmx members cmxfile functor_args =
  57.     let unit_names =
  58.       List.map (fun m -> m.pm_name) members in
  59. ***************
  60. *** 148,151 ****
  61. --- 148,153 ----
  62.         ui_force_link =
  63.             List.exists (fun info -> info.ui_force_link) units;
  64. +       ui_functor_parts = []; (* TODO *)
  65. +       ui_functor_args = functor_args; (* TODO *)
  66.       } in
  67.     Compilenv.write_unit_info pkg_infos cmxfile
  68. ***************
  69. *** 154,158 ****
  70.  
  71.   let package_object_files ppf files targetcmx
  72. !                          targetobj targetname coercion =
  73.     let pack_path =
  74.       match !Clflags.for_package with
  75. --- 156,160 ----
  76.  
  77.   let package_object_files ppf files targetcmx
  78. !                          targetobj targetname coercion  (functor_info, functor_args) =
  79.     let pack_path =
  80.       match !Clflags.for_package with
  81. ***************
  82. *** 161,170 ****
  83.     let members = map_left_right (read_member_info pack_path) files in
  84.     check_units members;
  85. !   make_package_object ppf members targetobj targetname coercion;
  86. !   build_package_cmx members targetcmx
  87.  
  88.   (* The entry point *)
  89.  
  90. ! let package_files ppf files targetcmx =
  91.     let files =
  92.       List.map
  93. --- 163,172 ----
  94.     let members = map_left_right (read_member_info pack_path) files in
  95.     check_units members;
  96. !   make_package_object ppf members targetobj targetname coercion functor_info;
  97. !   build_package_cmx members targetcmx functor_args
  98.  
  99.   (* The entry point *)
  100.  
  101. ! let package_files ppf files targetcmx functor_name =
  102.     let files =
  103.       List.map
  104. ***************
  105. *** 181,187 ****
  106.     (* Set the name of the current compunit *)
  107.     Compilenv.reset ?packname:!Clflags.for_package targetname;
  108.     try
  109. !     let coercion = Typemod.package_units files targetcmi targetname in
  110.       package_object_files ppf files targetcmx targetobj targetname coercion
  111.     with x ->
  112.       remove_file targetcmx; remove_file targetobj;
  113. --- 183,194 ----
  114.     (* Set the name of the current compunit *)
  115.     Compilenv.reset ?packname:!Clflags.for_package targetname;
  116. +   let functor_id = match functor_name with
  117. +       None -> None
  118. +     | Some modname -> Some (Ident.create modname) in
  119.     try
  120. !     let (coercion, functor_info, functor_args) =
  121. !       Typemod.package_units files targetcmi targetname functor_id in
  122.       package_object_files ppf files targetcmx targetobj targetname coercion
  123. +       (functor_info, functor_args)
  124.     with x ->
  125.       remove_file targetcmx; remove_file targetobj;
  126. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/asmpackager.mli ocaml-3.12.0+functor/asmcomp/asmpackager.mli
  127. *** ocaml-3.12.0/asmcomp/asmpackager.mli    2005-08-01 17:51:09.000000000 +0200
  128. --- ocaml-3.12.0+functor/asmcomp/asmpackager.mli    2011-06-06 14:33:18.175859003 +0200
  129. ***************
  130. *** 16,20 ****
  131.      original compilation units as sub-modules. *)
  132.  
  133. ! val package_files: Format.formatter -> string list -> string -> unit
  134.  
  135.   type error =
  136. --- 16,20 ----
  137.      original compilation units as sub-modules. *)
  138.  
  139. ! val package_files: Format.formatter -> string list -> string -> string option -> unit
  140.  
  141.   type error =
  142. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/closure.ml ocaml-3.12.0+functor/asmcomp/closure.ml
  143. *** ocaml-3.12.0/asmcomp/closure.ml 2008-08-01 14:52:14.000000000 +0200
  144. --- ocaml-3.12.0+functor/asmcomp/closure.ml 2011-06-06 14:33:18.175859003 +0200
  145. ***************
  146. *** 42,46 ****
  147.      contain the right names if the -for-pack option is active. *)
  148.  
  149. ! let getglobal id =
  150.     Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global id)),
  151.           [], Debuginfo.none)
  152. --- 42,50 ----
  153.      contain the right names if the -for-pack option is active. *)
  154.  
  155. ! let getglobal cenv id =
  156. !   if Ident.is_functor_part id then
  157. !     let id = Env.get_functor_part (Ident.name id) in
  158. !     try Tbl.find id cenv with Not_found -> Uvar id
  159. !   else
  160.       Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global id)),
  161.             [], Debuginfo.none)
  162. ***************
  163. *** 566,570 ****
  164.     | Lprim(Pgetglobal id, []) as lam ->
  165.         check_constant_result lam
  166. !                             (getglobal id)
  167.                               (Compilenv.global_approx id)
  168.     | Lprim(Pmakeblock(tag, mut) as prim, lams) ->
  169. --- 570,574 ----
  170.     | Lprim(Pgetglobal id, []) as lam ->
  171.         check_constant_result lam
  172. !                             (getglobal cenv id)
  173.                               (Compilenv.global_approx id)
  174.     | Lprim(Pmakeblock(tag, mut) as prim, lams) ->
  175. ***************
  176. *** 585,589 ****
  177.         let (ulam, approx) = close fenv cenv lam in
  178.         (!global_approx).(n) <- approx;
  179. !       (Uprim(Psetfield(n, false), [getglobal id; ulam], Debuginfo.none),
  180.          Value_unknown)
  181.     | Lprim(Praise, [Levent(arg, ev)]) ->
  182. --- 589,593 ----
  183.         let (ulam, approx) = close fenv cenv lam in
  184.         (!global_approx).(n) <- approx;
  185. !       (Uprim(Psetfield(n, false), [getglobal cenv id; ulam], Debuginfo.none),
  186.          Value_unknown)
  187.     | Lprim(Praise, [Levent(arg, ev)]) ->
  188. ***************
  189. *** 801,803 ****
  190.     let (ulam, approx) = close Tbl.empty Tbl.empty lam in
  191.     global_approx := [||];
  192. !   ulam
  193. --- 805,816 ----
  194.     let (ulam, approx) = close Tbl.empty Tbl.empty lam in
  195.     global_approx := [||];
  196. !   if !Clflags.functors <> [] then begin
  197. !     (1,
  198. !      Uprim(Psetfield(0, false), [
  199. !            Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global
  200. !                           (Ident.create_persistent (Compilenv.current_unit_name ())))),
  201. !        [], Debuginfo.none);
  202. !        ulam], Debuginfo.none)
  203. !     )
  204. !   end else
  205. !     (size, ulam)
  206. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/closure.mli ocaml-3.12.0+functor/asmcomp/closure.mli
  207. *** ocaml-3.12.0/asmcomp/closure.mli    2010-01-22 13:48:24.000000000 +0100
  208. --- ocaml-3.12.0+functor/asmcomp/closure.mli    2011-06-06 14:33:18.175859003 +0200
  209. ***************
  210. *** 15,17 ****
  211.   (* Introduction of closures, uncurrying, recognition of direct calls *)
  212.  
  213. ! val intro: int -> Lambda.lambda -> Clambda.ulambda
  214. --- 15,17 ----
  215.   (* Introduction of closures, uncurrying, recognition of direct calls *)
  216.  
  217. ! val intro: int -> Lambda.lambda -> int * Clambda.ulambda
  218. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/cmmgen.ml ocaml-3.12.0+functor/asmcomp/cmmgen.ml
  219. *** ocaml-3.12.0/asmcomp/cmmgen.ml  2010-05-19 13:29:38.000000000 +0200
  220. --- ocaml-3.12.0+functor/asmcomp/cmmgen.ml  2011-06-06 14:36:42.535858999 +0200
  221. ***************
  222. *** 801,804 ****
  223. --- 801,807 ----
  224.       Uvar id ->
  225.         Cvar id
  226. +   | Uprim(Pgetglobal id, [], _ ) when Ident.is_functor_part id ->
  227. +       let exp = Uvar (Env.get_functor_part (Ident.name id)) in
  228. +       transl exp
  229.     | Uconst sc ->
  230.         transl_constant sc
  231. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/cmx_format.mli ocaml-3.12.0+functor/asmcomp/cmx_format.mli
  232. *** ocaml-3.12.0/asmcomp/cmx_format.mli 2010-05-19 13:29:38.000000000 +0200
  233. --- ocaml-3.12.0+functor/asmcomp/cmx_format.mli 2011-06-06 14:33:18.185859004 +0200
  234. ***************
  235. *** 35,38 ****
  236. --- 35,40 ----
  237.       mutable ui_apply_fun: int list;             (* Apply functions needed *)
  238.       mutable ui_send_fun: int list;              (* Send functions needed *)
  239. +     mutable ui_functor_parts : (string * (string * Digest.t) list) list;
  240. +     mutable ui_functor_args : (string * Digest.t) list;
  241.       mutable ui_force_link: bool }               (* Always linked *)
  242.  
  243. diff -C 2 -N -r -w ocaml-3.12.0/asmcomp/compilenv.ml ocaml-3.12.0+functor/asmcomp/compilenv.ml
  244. *** ocaml-3.12.0/asmcomp/compilenv.ml   2010-05-19 13:29:38.000000000 +0200
  245. --- ocaml-3.12.0+functor/asmcomp/compilenv.ml   2011-06-06 15:36:16.965859002 +0200
  246. ***************
  247. *** 40,43 ****
  248. --- 40,45 ----
  249.       ui_apply_fun = [];
  250.       ui_send_fun = [];
  251. +     ui_functor_parts = [];
  252. +     ui_functor_args = [];
  253.       ui_force_link = false }
  254.  
  255. ***************
  256. *** 149,153 ****
  257.  
  258.   let global_approx id =
  259. !   if Ident.is_predef_exn id then Value_unknown
  260.     else try Hashtbl.find toplevel_approx (Ident.name id)
  261.     with Not_found ->
  262. --- 151,155 ----
  263.  
  264.   let global_approx id =
  265. !   if Ident.is_predef_exn id || Ident.is_functor_arg id then Value_unknown
  266.     else try Hashtbl.find toplevel_approx (Ident.name id)
  267.     with Not_found ->
  268. ***************
  269. *** 199,202 ****
  270. --- 201,206 ----
  271.   let save_unit_info filename =
  272.     current_unit.ui_imports_cmi <- Env.imported_units();
  273. +   current_unit.ui_functor_args <- Env.get_functor_args ();
  274. +   current_unit.ui_functor_parts <- Env.get_functor_parts ();
  275.     write_unit_info current_unit filename
  276.  
  277. Binary files ocaml-3.12.0/boot/ocamlc and ocaml-3.12.0+functor/boot/ocamlc differ
  278. Binary files ocaml-3.12.0/boot/ocamldep and ocaml-3.12.0+functor/boot/ocamldep differ
  279. Binary files ocaml-3.12.0/boot/ocamllex and ocaml-3.12.0+functor/boot/ocamllex differ
  280. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/bytegen.ml ocaml-3.12.0+functor/bytecomp/bytegen.ml
  281. *** ocaml-3.12.0/bytecomp/bytegen.ml    2009-05-20 13:52:42.000000000 +0200
  282. --- ocaml-3.12.0+functor/bytecomp/bytegen.ml    2011-06-06 15:36:30.825859004 +0200
  283. ***************
  284. *** 409,412 ****
  285. --- 409,415 ----
  286.           fatal_error ("Bytegen.comp_expr: var " ^ Ident.unique_name id)
  287.         end
  288. +     | Lprim(Pgetglobal id, []) when Ident.is_functor_part id ->
  289. +       let exp = Lvar (Env.get_functor_part (Ident.name id)) in
  290. +       comp_expr env exp sz cont
  291.     | Lconst cst ->
  292.         Kconst cst :: cont
  293. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/bytepackager.ml ocaml-3.12.0+functor/bytecomp/bytepackager.ml
  294. *** ocaml-3.12.0/bytecomp/bytepackager.ml   2010-05-21 14:00:49.000000000 +0200
  295. --- ocaml-3.12.0+functor/bytecomp/bytepackager.ml   2011-06-06 14:33:18.185859004 +0200
  296. ***************
  297. *** 156,160 ****
  298.   (* Generate the code that builds the tuple representing the package module *)
  299.  
  300. ! let build_global_target oc target_name members mapping pos coercion =
  301.     let components =
  302.       List.map2
  303. --- 156,165 ----
  304.   (* Generate the code that builds the tuple representing the package module *)
  305.  
  306. ! let print_if ppf flag printer arg =
  307. !   if !flag then Format.fprintf ppf "%a@." printer arg
  308. !
  309. ! let ppf = Format.err_formatter
  310. !
  311. ! let build_global_target oc target_name members mapping pos coercion functor_info =
  312.     let components =
  313.       List.map2
  314. ***************
  315. *** 166,172 ****
  316.     let lam =
  317.       Translmod.transl_package
  318. !       components (Ident.create_persistent target_name) coercion in
  319.     let instrs =
  320.       Bytegen.compile_implementation target_name lam in
  321.     let rel =
  322.       Emitcode.to_packed_file oc instrs in
  323. --- 171,180 ----
  324.     let lam =
  325.       Translmod.transl_package
  326. !       components (Ident.create_persistent target_name) coercion functor_info in
  327. !   print_if ppf Clflags.dump_lambda Printlambda.lambda lam;
  328. !   print_if ppf Clflags.dump_rawlambda Printlambda.lambda lam;
  329.     let instrs =
  330.       Bytegen.compile_implementation target_name lam in
  331. +   print_if ppf Clflags.dump_instr Printinstr.instrlist instrs;
  332.     let rel =
  333.       Emitcode.to_packed_file oc instrs in
  334. ***************
  335. *** 175,179 ****
  336.   (* Build the .cmo file obtained by packaging the given .cmo files. *)
  337.  
  338. ! let package_object_files files targetfile targetname coercion =
  339.     let members =
  340.       map_left_right read_member_info files in
  341. --- 183,187 ----
  342.   (* Build the .cmo file obtained by packaging the given .cmo files. *)
  343.  
  344. ! let package_object_files files targetfile targetname coercion (functor_info, functor_args) =
  345.     let members =
  346.       map_left_right read_member_info files in
  347. ***************
  348. *** 193,197 ****
  349.       let pos_code = pos_out oc in
  350.       let ofs = rename_append_bytecode_list oc mapping [] 0 targetname Subst.identity members in
  351. !     build_global_target oc targetname members mapping ofs coercion;
  352.       let pos_debug = pos_out oc in
  353.       if !Clflags.debug && !events <> [] then
  354. --- 201,205 ----
  355.       let pos_code = pos_out oc in
  356.       let ofs = rename_append_bytecode_list oc mapping [] 0 targetname Subst.identity members in
  357. !     build_global_target oc targetname members mapping ofs coercion functor_info;
  358.       let pos_debug = pos_out oc in
  359.       if !Clflags.debug && !events <> [] then
  360. ***************
  361. *** 211,214 ****
  362. --- 219,224 ----
  363.           cu_force_link = !force_link;
  364.           cu_debug = if pos_final > pos_debug then pos_debug else 0;
  365. +   cu_functor_parts = []; (* TODO : add functor parts from submodules *)
  366. +   cu_functor_args = functor_args;
  367.           cu_debugsize = pos_final - pos_debug } in
  368.       output_value oc compunit;
  369. ***************
  370. *** 222,226 ****
  371.   (* The entry point *)
  372.  
  373. ! let package_files files targetfile =
  374.     let files =
  375.       List.map
  376. --- 232,236 ----
  377.   (* The entry point *)
  378.  
  379. ! let package_files files targetfile functor_name =
  380.     let files =
  381.       List.map
  382. ***************
  383. *** 232,238 ****
  384.     let targetcmi = prefix ^ ".cmi" in
  385.     let targetname = String.capitalize(Filename.basename prefix) in
  386.     try
  387. !     let coercion = Typemod.package_units files targetcmi targetname in
  388. !     package_object_files files targetfile targetname coercion
  389.     with x ->
  390.       remove_file targetfile; raise x
  391. --- 242,253 ----
  392.     let targetcmi = prefix ^ ".cmi" in
  393.     let targetname = String.capitalize(Filename.basename prefix) in
  394. +   let functor_id = match functor_name with
  395. +       None -> None
  396. +     | Some modname -> Some (Ident.create modname) in
  397.     try
  398. !     let (coercion, functor_info, functor_args) =
  399. !       Typemod.package_units files targetcmi targetname functor_id in
  400. !     package_object_files files targetfile targetname coercion (functor_info, functor_args)
  401. !
  402.     with x ->
  403.       remove_file targetfile; raise x
  404. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/bytepackager.mli ocaml-3.12.0+functor/bytecomp/bytepackager.mli
  405. *** ocaml-3.12.0/bytecomp/bytepackager.mli  2002-02-08 17:55:44.000000000 +0100
  406. --- ocaml-3.12.0+functor/bytecomp/bytepackager.mli  2011-06-06 14:33:18.185859004 +0200
  407. ***************
  408. *** 16,20 ****
  409.      original compilation units as sub-modules. *)
  410.  
  411. ! val package_files: string list -> string -> unit
  412.  
  413.   type error =
  414. --- 16,20 ----
  415.      original compilation units as sub-modules. *)
  416.  
  417. ! val package_files: string list -> string -> string option -> unit
  418.  
  419.   type error =
  420. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/cmo_format.mli ocaml-3.12.0+functor/bytecomp/cmo_format.mli
  421. *** ocaml-3.12.0/bytecomp/cmo_format.mli    2010-01-22 13:48:24.000000000 +0100
  422. --- ocaml-3.12.0+functor/bytecomp/cmo_format.mli    2011-06-06 14:33:18.185859004 +0200
  423. ***************
  424. *** 34,37 ****
  425. --- 34,39 ----
  426.       mutable cu_force_link: bool;        (* Must be linked even if unref'ed *)
  427.       mutable cu_debug: int;              (* Position of debugging info, or 0 *)
  428. +     mutable cu_functor_parts : (string * (string * Digest.t) list) list;
  429. +     mutable cu_functor_args : (string * Digest.t) list;
  430.       cu_debugsize: int }                 (* Length of debugging info *)
  431.  
  432. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/emitcode.ml ocaml-3.12.0+functor/bytecomp/emitcode.ml
  433. *** ocaml-3.12.0/bytecomp/emitcode.ml   2010-01-22 13:48:24.000000000 +0100
  434. --- ocaml-3.12.0+functor/bytecomp/emitcode.ml   2011-06-06 14:33:18.185859004 +0200
  435. ***************
  436. *** 376,379 ****
  437. --- 376,381 ----
  438.         cu_primitives = List.map Primitive.byte_name !Translmod.primitive_declarations;
  439.         cu_force_link = false;
  440. +       cu_functor_parts = Env.get_functor_parts ();
  441. +       cu_functor_args = Env.get_functor_args ();
  442.         cu_debug = pos_debug;
  443.         cu_debugsize = size_debug } in
  444. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/lambda.ml ocaml-3.12.0+functor/bytecomp/lambda.ml
  445. *** ocaml-3.12.0/bytecomp/lambda.ml 2010-01-22 13:48:24.000000000 +0100
  446. --- ocaml-3.12.0+functor/bytecomp/lambda.ml 2011-06-06 14:33:18.185859004 +0200
  447. ***************
  448. *** 318,322 ****
  449.  
  450.   let free_variables l =
  451. !   free_ids (function Lvar id -> [id] | _ -> []) l
  452.  
  453.   let free_methods l =
  454. --- 318,325 ----
  455.  
  456.   let free_variables l =
  457. !   free_ids (function Lvar id -> [id]
  458. !     | Lprim( (Pgetglobal id | Psetglobal id), _) when Ident.is_functor_part id ->
  459. !       [Env.get_functor_part (Ident.name id)]
  460. !     | _ -> []) l
  461.  
  462.   let free_methods l =
  463. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/translmod.ml ocaml-3.12.0+functor/bytecomp/translmod.ml
  464. *** ocaml-3.12.0/bytecomp/translmod.ml  2010-01-22 13:48:24.000000000 +0100
  465. --- ocaml-3.12.0+functor/bytecomp/translmod.ml  2011-06-06 15:36:43.625859004 +0200
  466. ***************
  467. *** 346,356 ****
  468.   (* Compile an implementation *)
  469.  
  470.   let transl_implementation module_name (str, cc) =
  471.     reset_labels ();
  472.     primitive_declarations := [];
  473.     let module_id = Ident.create_persistent module_name in
  474.     Lprim(Psetglobal module_id,
  475. !         [transl_label_init
  476. !             (transl_structure [] cc (global_path module_id) str)])
  477.  
  478.   (* A variant of transl_structure used to compile toplevel structure definitions
  479. --- 346,377 ----
  480.   (* Compile an implementation *)
  481.  
  482. + (* TODO: check what happens if a module has the same name as a module given as
  483. +    argument *)
  484. +
  485. + let transl_functor_unit functor_env modname str =
  486. +   let ids = Env.get_functor_parts () in
  487. +   let (str, _) = List.fold_left (fun (str, tbl) (name, parts) ->
  488. +     if name = modname || Tbl.mem name tbl then (str, tbl) else
  489. +       let id = Env.get_functor_part name in
  490. +       let str = Llet(Strict, id,
  491. +    Lapply(mod_prim "find_functor_arg", [
  492. +      Lconst(Const_base (Const_string (Ident.name id)));
  493. +      Lvar functor_env;
  494. +    ], Location.none), str) in
  495. +       (str, Tbl.add name id tbl)
  496. +   ) (str, Tbl.empty) ids
  497. +   in
  498. +   Lfunction(Curried, [ functor_env ], str)
  499. +
  500.   let transl_implementation module_name (str, cc) =
  501.     reset_labels ();
  502.     primitive_declarations := [];
  503.     let module_id = Ident.create_persistent module_name in
  504. +   let str = transl_label_init (transl_structure [] cc (global_path module_id) str) in
  505.     Lprim(Psetglobal module_id,
  506. !   [if !Clflags.functors <> [] then
  507. !       let functor_env = Ident.create "functor_env" in
  508. !     Lprim(Pmakeblock(0, Immutable), [transl_functor_unit functor_env module_name str])
  509. !   else str])
  510.  
  511.   (* A variant of transl_structure used to compile toplevel structure definitions
  512. ***************
  513. *** 501,504 ****
  514. --- 522,526 ----
  515.     | Tstr_include(modl, ids) :: rem -> ids @ defined_idents rem
  516.  
  517. +
  518.   (* Transform a coercion and the list of value identifiers defined by
  519.      a toplevel structure into a table [id -> (pos, coercion)],
  520. ***************
  521. *** 544,547 ****
  522. --- 566,570 ----
  523.     primitive_declarations := [];
  524.     let module_id = Ident.create_persistent module_name in
  525. +   if !Clflags.functors <> [] then Ident.make_functor_part module_id;
  526.     let (map, prims, size) = build_ident_map restr (defined_idents str) in
  527.     let f = function
  528. ***************
  529. *** 561,565 ****
  530.     let r = transl_store_gen module_name (str, restr) false in
  531.     transl_store_subst := s;
  532. !   r
  533.  
  534.   (* Compile a toplevel phrase *)
  535. --- 584,597 ----
  536.     let r = transl_store_gen module_name (str, restr) false in
  537.     transl_store_subst := s;
  538. !   if !Clflags.functors <> [] then
  539. !     let (size, str) = r in
  540. !     let id = Env.get_functor_part module_name in
  541. !     let str = Llet(Strict, id,
  542. !          Lprim(Pmakeblock(0, Immutable), Array.to_list (Array.create size lambda_unit)),
  543. !          Lsequence (str, Lvar id) ) in
  544. !     let functor_env = Ident.create "functor_env" in
  545. !     let str = transl_functor_unit functor_env module_name str in
  546. !     (size, str)
  547. !   else r
  548.  
  549.   (* Compile a toplevel phrase *)
  550. ***************
  551. *** 665,668 ****
  552. --- 697,763 ----
  553.     | Some id -> Lprim(Pgetglobal id, [])
  554.  
  555. + let const_string s =
  556. +   Lconst(Const_base (Const_string s))
  557. +
  558. + let const_pack_unit_name id =
  559. +   let name = Ident.name id in
  560. +   let name = try
  561. +          let pos = String.rindex name '.' in
  562. +          String.sub name (pos+1) (String.length name - pos - 1)
  563. +     with Not_found -> name
  564. +   in
  565. +   const_string name
  566. +
  567. + let transl_functor_package component_names target_name coercion
  568. +     (functor_id, functor_arg) initial_env =
  569. +       let env0_id = Ident.create "functor_env0" in
  570. +       let env1_id = Ident.create "functor_env1" in
  571. +       let rec eval_components env comps evaluated =
  572. +   match comps with
  573. +       [] ->
  574. +         let component_names = List.rev evaluated in
  575. +         let components =
  576. +       match coercion with
  577. +           Tcoerce_none ->
  578. +             component_names
  579. +         | Tcoerce_structure pos_cc_list ->
  580. +           let g = Array.of_list component_names in
  581. +           List.map
  582. +             (fun (pos, cc) -> apply_coercion cc (g.(pos)))
  583. +             pos_cc_list
  584. +         | _ ->
  585. +           assert false in
  586. +         Lprim(Pmakeblock(0, Immutable), components)
  587. +     | None :: tail ->
  588. +       eval_components env tail evaluated
  589. +     | Some comp :: tail ->
  590. +       Ident.make_functor_arg comp;
  591. +       let comp_id = Ident.create (Ident.name comp) in
  592. +       let newenv = Ident.create "env" in
  593. +       Llet(Strict,
  594. +        comp_id, Lapply(
  595. +          Lprim(Pfield 0, [Lprim(Pgetglobal comp, [])]),
  596. +          [Lvar env], Location.none),
  597. +        Llet(Strict,
  598. +             newenv, Lapply(mod_prim "add_functor_arg",
  599. +                    [const_pack_unit_name comp;
  600. +                     Lvar comp_id; Lvar env], Location.none),
  601. +             eval_components newenv tail (Lvar comp_id :: evaluated)))
  602. +       in
  603. +       let components = eval_components env1_id component_names [] in
  604. +       let functor_body =
  605. +   Llet(Strict, env0_id, initial_env,
  606. +        Llet(Strict, env1_id,
  607. +         Lapply(mod_prim "add_functor_arg",
  608. +            [const_pack_unit_name functor_arg; Lvar functor_arg; Lvar env0_id],
  609. +            Location.none),
  610. +         components))
  611. +       in
  612. + (*    Llet(Strict, functor_id, *)
  613. +        Lfunction(Curried, [functor_arg], functor_body)
  614. +          (* , store_global functor_id) *)
  615. +
  616. + let gen_new_env () = Lapply(mod_prim "create_functor_env",[lambda_unit], Location.none)
  617. +
  618.   let transl_package component_names target_name coercion =
  619.     let components =
  620. ***************
  621. *** 679,682 ****
  622. --- 774,793 ----
  623.     Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
  624.  
  625. + let transl_package component_names target_name coercion functor_info =
  626. +   match functor_info with
  627. +       None -> transl_package component_names target_name coercion
  628. +     | Some (functor_id, functor_arg) ->
  629. +       let functor_env = Ident.create "functor_env" in
  630. +       let str =
  631. +   transl_functor_package component_names target_name coercion  (functor_id, functor_arg)
  632. +       (if Env.get_functor_args () <> [] then Lvar functor_env else gen_new_env ())
  633. +       in
  634. +       Lprim(Psetglobal target_name,
  635. +       [Lprim(Pmakeblock(0, Immutable),
  636. +         [if !Clflags.functors <> [] then
  637. +             let str = Lprim(Pmakeblock(0, Immutable),[str]) in
  638. +             transl_functor_unit functor_env (Ident.name target_name) str
  639. +           else str])])
  640. +
  641.   let transl_store_package component_names target_name coercion =
  642.     let rec make_sequence fn pos arg =
  643. ***************
  644. *** 704,707 ****
  645. --- 815,840 ----
  646.     | _ -> assert false
  647.  
  648. +
  649. + let transl_store_package component_names target_name coercion functor_info =
  650. +   match functor_info with
  651. +       None -> transl_store_package component_names target_name coercion
  652. +     | Some (functor_id, functor_arg) ->
  653. +       let functor_env = Ident.create "functor_env" in
  654. +       let str =
  655. +   transl_functor_package component_names target_name coercion  (functor_id, functor_arg)
  656. +     (if Env.get_functor_args () <> [] then Lvar functor_env else gen_new_env ())
  657. +       in
  658. +       (1,
  659. +   if !Clflags.functors <> [] then
  660. +     let module_name = Ident.name target_name in
  661. +     let str = Lprim(Pmakeblock(0, Immutable), [str]) in
  662. +     let str = transl_functor_unit functor_env module_name str in
  663. +     str
  664. +   else
  665. +           Lprim(Psetfield(0, false),
  666. +       [Lprim(Pgetglobal target_name, []);
  667. +        str]))
  668. +
  669. +
  670.   (* Error report *)
  671.  
  672. diff -C 2 -N -r -w ocaml-3.12.0/bytecomp/translmod.mli ocaml-3.12.0+functor/bytecomp/translmod.mli
  673. *** ocaml-3.12.0/bytecomp/translmod.mli 2010-01-22 13:48:24.000000000 +0100
  674. --- ocaml-3.12.0+functor/bytecomp/translmod.mli 2011-06-06 14:33:18.185859004 +0200
  675. ***************
  676. *** 25,31 ****
  677.   val transl_toplevel_definition: structure -> lambda
  678.   val transl_package:
  679. !       Ident.t option list -> Ident.t -> module_coercion -> lambda
  680.   val transl_store_package:
  681. !       Ident.t option list -> Ident.t -> module_coercion -> int * lambda
  682.  
  683.   val toplevel_name: Ident.t -> string
  684. --- 25,33 ----
  685.   val transl_toplevel_definition: structure -> lambda
  686.   val transl_package:
  687. !       Ident.t option list -> Ident.t -> module_coercion ->
  688. !   (Ident.t * Ident.t) option -> lambda
  689.   val transl_store_package:
  690. !       Ident.t option list -> Ident.t -> module_coercion ->
  691. !   (Ident.t * Ident.t) option -> int * lambda
  692.  
  693.   val toplevel_name: Ident.t -> string
  694. ***************
  695. *** 34,37 ****
  696. --- 36,41 ----
  697.   val primitive_declarations: Primitive.description list ref
  698.  
  699. + (*val mod_prim : string -> Lambda.lambda *)
  700. +
  701.   type error =
  702.     Circular_dependency of Ident.t
  703. diff -C 2 -N -r -w ocaml-3.12.0/debugger/Makefile.shared ocaml-3.12.0+functor/debugger/Makefile.shared
  704. *** ocaml-3.12.0/debugger/Makefile.shared   2010-05-17 17:49:53.000000000 +0200
  705. --- ocaml-3.12.0+functor/debugger/Makefile.shared   2011-06-06 14:33:18.185859004 +0200
  706. ***************
  707. *** 36,40 ****
  708.     ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
  709.     ../typing/subst.cmo ../typing/predef.cmo \
  710. !   ../typing/datarepr.cmo ../typing/env.cmo ../typing/oprint.cmo \
  711.     ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
  712.     ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
  713. --- 36,41 ----
  714.     ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
  715.     ../typing/subst.cmo ../typing/predef.cmo \
  716. !   ../typing/datarepr.cmo ../typing/cmi_format.cmo \
  717. !   ../typing/env.cmo ../typing/oprint.cmo \
  718.     ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \
  719.     ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \
  720. diff -C 2 -N -r -w ocaml-3.12.0/.depend ocaml-3.12.0+functor/.depend
  721. *** ocaml-3.12.0/.depend    2010-07-23 17:30:37.000000000 +0200
  722. --- ocaml-3.12.0+functor/.depend    2011-06-06 14:45:21.255858999 +0200
  723. ***************
  724. *** 66,69 ****
  725. --- 66,70 ----
  726.   typing/annot.cmi: parsing/location.cmi
  727.   typing/btype.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
  728. + typing/cmi_format.cmi: typing/types.cmi typing/ident.cmi
  729.   typing/ctype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \
  730.       typing/env.cmi parsing/asttypes.cmi
  731. ***************
  732. *** 114,117 ****
  733. --- 115,122 ----
  734.   typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \
  735.       typing/btype.cmi
  736. + typing/cmi_format.cmo: typing/types.cmi typing/ident.cmi \
  737. +     typing/cmi_format.cmi
  738. + typing/cmi_format.cmx: typing/types.cmx typing/ident.cmx \
  739. +     typing/cmi_format.cmi
  740.   typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
  741.       utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
  742. ***************
  743. *** 127,137 ****
  744.       typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
  745.       typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
  746. !     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
  747. !     typing/env.cmi
  748.   typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
  749.       typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
  750.       typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
  751. !     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
  752. !     typing/env.cmi
  753.   typing/ident.cmo: typing/ident.cmi
  754.   typing/ident.cmx: typing/ident.cmi
  755. --- 132,142 ----
  756.       typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
  757.       typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
  758. !     typing/cmi_format.cmi utils/clflags.cmi typing/btype.cmi \
  759. !     parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
  760.   typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
  761.       typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
  762.       typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
  763. !     typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \
  764. !     parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
  765.   typing/ident.cmo: typing/ident.cmi
  766.   typing/ident.cmx: typing/ident.cmi
  767. ***************
  768. *** 252,257 ****
  769.   typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
  770.       typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
  771. !     typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/path.cmi \
  772. !     parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
  773.       parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
  774.       typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
  775. --- 257,262 ----
  776.   typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
  777.       typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
  778. !     utils/tbl.cmi typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
  779. !     typing/path.cmi parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
  780.       parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
  781.       typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
  782. ***************
  783. *** 260,265 ****
  784.   typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
  785.       typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
  786. !     typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/path.cmx \
  787. !     parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
  788.       parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
  789.       typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
  790. --- 265,270 ----
  791.   typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
  792.       typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
  793. !     utils/tbl.cmx typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \
  794. !     typing/path.cmx parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
  795.       parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
  796.       typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
  797. ***************
  798. *** 319,327 ****
  799.   bytecomp/bytegen.cmo: typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \
  800.       typing/stypes.cmi typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \
  801. !     bytecomp/instruct.cmi typing/ident.cmi utils/config.cmi \
  802.       parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  803.   bytecomp/bytegen.cmx: typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \
  804.       typing/stypes.cmx typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \
  805. !     bytecomp/instruct.cmx typing/ident.cmx utils/config.cmx \
  806.       parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  807.   bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \
  808. --- 324,332 ----
  809.   bytecomp/bytegen.cmo: typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \
  810.       typing/stypes.cmi typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \
  811. !     bytecomp/instruct.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \
  812.       parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  813.   bytecomp/bytegen.cmx: typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \
  814.       typing/stypes.cmx typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \
  815. !     bytecomp/instruct.cmx typing/ident.cmx typing/env.cmx utils/config.cmx \
  816.       parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
  817.   bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \
  818. ***************
  819. *** 342,352 ****
  820.       bytecomp/bytelink.cmi
  821.   bytecomp/bytepackager.cmo: typing/typemod.cmi bytecomp/translmod.cmi \
  822. !     typing/subst.cmi typing/path.cmi utils/misc.cmi bytecomp/instruct.cmi \
  823. !     typing/ident.cmi typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \
  824.       bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \
  825.       bytecomp/bytegen.cmi bytecomp/bytepackager.cmi
  826.   bytecomp/bytepackager.cmx: typing/typemod.cmx bytecomp/translmod.cmx \
  827. !     typing/subst.cmx typing/path.cmx utils/misc.cmx bytecomp/instruct.cmx \
  828. !     typing/ident.cmx typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
  829.       bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \
  830.       bytecomp/bytegen.cmx bytecomp/bytepackager.cmi
  831. --- 347,359 ----
  832.       bytecomp/bytelink.cmi
  833.   bytecomp/bytepackager.cmo: typing/typemod.cmi bytecomp/translmod.cmi \
  834. !     typing/subst.cmi bytecomp/printlambda.cmi bytecomp/printinstr.cmi \
  835. !     typing/path.cmi utils/misc.cmi bytecomp/instruct.cmi typing/ident.cmi \
  836. !     typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \
  837.       bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \
  838.       bytecomp/bytegen.cmi bytecomp/bytepackager.cmi
  839.   bytecomp/bytepackager.cmx: typing/typemod.cmx bytecomp/translmod.cmx \
  840. !     typing/subst.cmx bytecomp/printlambda.cmx bytecomp/printinstr.cmx \
  841. !     typing/path.cmx utils/misc.cmx bytecomp/instruct.cmx typing/ident.cmx \
  842. !     typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
  843.       bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \
  844.       bytecomp/bytegen.cmx bytecomp/bytepackager.cmi
  845. ***************
  846. *** 447,460 ****
  847.   bytecomp/translmod.cmo: typing/types.cmi typing/typedtree.cmi \
  848.       bytecomp/translobj.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
  849. !     typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
  850.       typing/path.cmi typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
  851.       parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
  852. !     typing/ctype.cmi parsing/asttypes.cmi bytecomp/translmod.cmi
  853.   bytecomp/translmod.cmx: typing/types.cmx typing/typedtree.cmx \
  854.       bytecomp/translobj.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \
  855. !     typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
  856.       typing/path.cmx typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
  857.       parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \
  858. !     typing/ctype.cmx parsing/asttypes.cmi bytecomp/translmod.cmi
  859.   bytecomp/translobj.cmo: typing/primitive.cmi utils/misc.cmi \
  860.       parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
  861. --- 454,469 ----
  862.   bytecomp/translmod.cmo: typing/types.cmi typing/typedtree.cmi \
  863.       bytecomp/translobj.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
  864. !     utils/tbl.cmi typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
  865.       typing/path.cmi typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
  866.       parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
  867. !     typing/ctype.cmi utils/clflags.cmi parsing/asttypes.cmi \
  868. !     bytecomp/translmod.cmi
  869.   bytecomp/translmod.cmx: typing/types.cmx typing/typedtree.cmx \
  870.       bytecomp/translobj.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \
  871. !     utils/tbl.cmx typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
  872.       typing/path.cmx typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
  873.       parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \
  874. !     typing/ctype.cmx utils/clflags.cmx parsing/asttypes.cmi \
  875. !     bytecomp/translmod.cmi
  876.   bytecomp/translobj.cmo: typing/primitive.cmi utils/misc.cmi \
  877.       parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
  878. ***************
  879. *** 566,576 ****
  880.       asmcomp/debuginfo.cmx parsing/asttypes.cmi asmcomp/clambda.cmi
  881.   asmcomp/closure.cmo: utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \
  882. !     utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
  883. !     asmcomp/compilenv.cmi utils/clflags.cmi asmcomp/clambda.cmi \
  884. !     parsing/asttypes.cmi asmcomp/closure.cmi
  885.   asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \
  886. !     utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
  887. !     asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \
  888. !     parsing/asttypes.cmi asmcomp/closure.cmi
  889.   asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \
  890.       asmcomp/cmm.cmi
  891. --- 575,585 ----
  892.       asmcomp/debuginfo.cmx parsing/asttypes.cmi asmcomp/clambda.cmi
  893.   asmcomp/closure.cmo: utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \
  894. !     utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
  895. !     asmcomp/debuginfo.cmi asmcomp/compilenv.cmi utils/clflags.cmi \
  896. !     asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/closure.cmi
  897.   asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \
  898. !     utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \
  899. !     asmcomp/debuginfo.cmx asmcomp/compilenv.cmx utils/clflags.cmx \
  900. !     asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/closure.cmi
  901.   asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \
  902.       asmcomp/cmm.cmi
  903. ***************
  904. *** 579,592 ****
  905.   asmcomp/cmmgen.cmo: typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \
  906.       typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \
  907. !     asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \
  908. !     asmcomp/cmx_format.cmi asmcomp/cmm.cmi utils/clflags.cmi \
  909. !     asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/arch.cmo \
  910. !     asmcomp/cmmgen.cmi
  911.   asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \
  912.       typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \
  913. !     asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
  914. !     asmcomp/cmx_format.cmi asmcomp/cmm.cmx utils/clflags.cmx \
  915. !     asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \
  916. !     asmcomp/cmmgen.cmi
  917.   asmcomp/codegen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \
  918.       asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \
  919. --- 588,601 ----
  920.   asmcomp/cmmgen.cmo: typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \
  921.       typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \
  922. !     typing/env.cmi asmcomp/debuginfo.cmi utils/config.cmi \
  923. !     asmcomp/compilenv.cmi asmcomp/cmx_format.cmi asmcomp/cmm.cmi \
  924. !     utils/clflags.cmi asmcomp/clambda.cmi parsing/asttypes.cmi \
  925. !     asmcomp/arch.cmo asmcomp/cmmgen.cmi
  926.   asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \
  927.       typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \
  928. !     typing/env.cmx asmcomp/debuginfo.cmx utils/config.cmx \
  929. !     asmcomp/compilenv.cmx asmcomp/cmx_format.cmi asmcomp/cmm.cmx \
  930. !     utils/clflags.cmx asmcomp/clambda.cmx parsing/asttypes.cmi \
  931. !     asmcomp/arch.cmx asmcomp/cmmgen.cmi
  932.   asmcomp/codegen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \
  933.       asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \
  934. ***************
  935. *** 741,752 ****
  936.       typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \
  937.       bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi
  938. ! driver/main.cmo: utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \
  939. !     driver/errors.cmi utils/config.cmi driver/compile.cmi utils/clflags.cmi \
  940. !     bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \
  941. !     bytecomp/bytelibrarian.cmi driver/main.cmi
  942. ! driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \
  943. !     driver/errors.cmx utils/config.cmx driver/compile.cmx utils/clflags.cmx \
  944. !     bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \
  945. !     bytecomp/bytelibrarian.cmx driver/main.cmi
  946.   driver/main_args.cmo: utils/warnings.cmi driver/main_args.cmi
  947.   driver/main_args.cmx: utils/warnings.cmx driver/main_args.cmi
  948. --- 750,761 ----
  949.       typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \
  950.       bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi
  951. ! driver/main.cmo: utils/warnings.cmi typing/typemod.cmi utils/misc.cmi \
  952. !     driver/main_args.cmi driver/errors.cmi typing/env.cmi utils/config.cmi \
  953. !     driver/compile.cmi utils/clflags.cmi bytecomp/bytepackager.cmi \
  954. !     bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi driver/main.cmi
  955. ! driver/main.cmx: utils/warnings.cmx typing/typemod.cmx utils/misc.cmx \
  956. !     driver/main_args.cmx driver/errors.cmx typing/env.cmx utils/config.cmx \
  957. !     driver/compile.cmx utils/clflags.cmx bytecomp/bytepackager.cmx \
  958. !     bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/main.cmi
  959.   driver/main_args.cmo: utils/warnings.cmi driver/main_args.cmi
  960.   driver/main_args.cmx: utils/warnings.cmx driver/main_args.cmi
  961. ***************
  962. *** 781,794 ****
  963.       asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
  964.       asmcomp/asmgen.cmx driver/opterrors.cmi
  965. ! driver/optmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \
  966. !     driver/opterrors.cmi driver/optcompile.cmi utils/misc.cmi \
  967. !     driver/main_args.cmi utils/config.cmi utils/clflags.cmi \
  968. !     asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \
  969. !     asmcomp/arch.cmo driver/optmain.cmi
  970. ! driver/optmain.cmx: utils/warnings.cmx asmcomp/printmach.cmx \
  971. !     driver/opterrors.cmx driver/optcompile.cmx utils/misc.cmx \
  972. !     driver/main_args.cmx utils/config.cmx utils/clflags.cmx \
  973. !     asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
  974. !     asmcomp/arch.cmx driver/optmain.cmi
  975.   driver/pparse.cmo: utils/misc.cmi parsing/location.cmi utils/clflags.cmi \
  976.       utils/ccomp.cmi driver/pparse.cmi
  977. --- 790,803 ----
  978.       asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
  979.       asmcomp/asmgen.cmx driver/opterrors.cmi
  980. ! driver/optmain.cmo: utils/warnings.cmi typing/typemod.cmi \
  981. !     asmcomp/printmach.cmi driver/opterrors.cmi driver/optcompile.cmi \
  982. !     utils/misc.cmi driver/main_args.cmi typing/env.cmi utils/config.cmi \
  983. !     utils/clflags.cmi asmcomp/asmpackager.cmi asmcomp/asmlink.cmi \
  984. !     asmcomp/asmlibrarian.cmi asmcomp/arch.cmo driver/optmain.cmi
  985. ! driver/optmain.cmx: utils/warnings.cmx typing/typemod.cmx \
  986. !     asmcomp/printmach.cmx driver/opterrors.cmx driver/optcompile.cmx \
  987. !     utils/misc.cmx driver/main_args.cmx typing/env.cmx utils/config.cmx \
  988. !     utils/clflags.cmx asmcomp/asmpackager.cmx asmcomp/asmlink.cmx \
  989. !     asmcomp/asmlibrarian.cmx asmcomp/arch.cmx driver/optmain.cmi
  990.   driver/pparse.cmo: utils/misc.cmi parsing/location.cmi utils/clflags.cmi \
  991.       utils/ccomp.cmi driver/pparse.cmi
  992. diff -C 2 -N -r -w ocaml-3.12.0/driver/compile.ml ocaml-3.12.0+functor/driver/compile.ml
  993. *** ocaml-3.12.0/driver/compile.ml  2008-10-06 15:53:54.000000000 +0200
  994. --- ocaml-3.12.0+functor/driver/compile.ml  2011-06-06 14:33:18.185859004 +0200
  995. ***************
  996. *** 43,49 ****
  997.     Ident.reinit();
  998.     try
  999.       if !Clflags.nopervasives
  1000. !     then Env.initial
  1001. !     else Env.open_pers_signature "Pervasives" Env.initial
  1002.     with Not_found ->
  1003.       fatal_error "cannot open pervasives.cmi"
  1004. --- 43,50 ----
  1005.     Ident.reinit();
  1006.     try
  1007. +     let env = Env.initial in
  1008.       if !Clflags.nopervasives
  1009. !     then env
  1010. !     else Env.open_pers_signature "Pervasives" env
  1011.     with Not_found ->
  1012.       fatal_error "cannot open pervasives.cmi"
  1013. ***************
  1014. *** 84,87 ****
  1015. --- 85,89 ----
  1016.         Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
  1017.       if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
  1018. +     Env.add_functor_arguments modulename;
  1019.       let sg = Typemod.transl_signature (initial_env()) ast in
  1020.       if !Clflags.print_types then
  1021. ***************
  1022. *** 112,115 ****
  1023. --- 114,118 ----
  1024.     Env.set_unit_name modulename;
  1025.     let inputfile = Pparse.preprocess sourcefile in
  1026. +   Env.add_functor_arguments modulename;
  1027.     let env = initial_env() in
  1028.     if !Clflags.print_types then begin
  1029. diff -C 2 -N -r -w ocaml-3.12.0/driver/main_args.ml ocaml-3.12.0+functor/driver/main_args.ml
  1030. *** ocaml-3.12.0/driver/main_args.ml    2010-07-06 16:05:26.000000000 +0200
  1031. --- ocaml-3.12.0+functor/driver/main_args.ml    2011-06-06 14:33:18.185859004 +0200
  1032. ***************
  1033. *** 193,196 ****
  1034. --- 193,202 ----
  1035.   ;;
  1036.  
  1037. + let mk_functor f =
  1038. +   "-functor", Arg.String f, " <file.mli> : signature of functor argument"
  1039. +
  1040. + let mk_pack_functor f =
  1041. +   "-pack-functor", Arg.String f, "<modname> : name of functor"
  1042. +
  1043.   let mk_pp f =
  1044.     "-pp", Arg.String f, "<command>  Pipe sources through preprocessor <command>"
  1045. ***************
  1046. *** 400,403 ****
  1047. --- 406,411 ----
  1048.     val _output_obj : unit -> unit
  1049.     val _pack : unit -> unit
  1050. +   val _pack_functor : string -> unit
  1051. +   val _functor : string -> unit
  1052.     val _pp : string -> unit
  1053.     val _principal : unit -> unit
  1054. ***************
  1055. *** 483,486 ****
  1056. --- 491,496 ----
  1057.     val _p : unit -> unit
  1058.     val _pack : unit -> unit
  1059. +   val _pack_functor : string -> unit
  1060. +   val _functor : string -> unit
  1061.     val _pp : string -> unit
  1062.     val _principal : unit -> unit
  1063. ***************
  1064. *** 602,605 ****
  1065. --- 612,617 ----
  1066.       mk_output_obj F._output_obj;
  1067.       mk_pack_byt F._pack;
  1068. +     mk_pack_functor F._pack_functor;
  1069. +     mk_functor F._functor;
  1070.       mk_pp F._pp;
  1071.       mk_principal F._principal;
  1072. ***************
  1073. *** 693,696 ****
  1074. --- 705,710 ----
  1075.       mk_p F._p;
  1076.       mk_pack_opt F._pack;
  1077. +     mk_pack_functor F._pack_functor;
  1078. +     mk_functor F._functor;
  1079.       mk_pp F._pp;
  1080.       mk_principal F._principal;
  1081. diff -C 2 -N -r -w ocaml-3.12.0/driver/main_args.mli ocaml-3.12.0+functor/driver/main_args.mli
  1082. *** ocaml-3.12.0/driver/main_args.mli   2010-05-20 16:06:29.000000000 +0200
  1083. --- ocaml-3.12.0+functor/driver/main_args.mli   2011-06-06 14:33:18.195859009 +0200
  1084. ***************
  1085. *** 42,45 ****
  1086. --- 42,47 ----
  1087.       val _output_obj : unit -> unit
  1088.       val _pack : unit -> unit
  1089. +     val _pack_functor : string -> unit
  1090. +     val _functor : string -> unit
  1091.       val _pp : string -> unit
  1092.       val _principal : unit -> unit
  1093. ***************
  1094. *** 126,129 ****
  1095. --- 128,133 ----
  1096.     val _p : unit -> unit
  1097.     val _pack : unit -> unit
  1098. +   val _pack_functor : string -> unit
  1099. +   val _functor : string -> unit
  1100.     val _pp : string -> unit
  1101.     val _principal : unit -> unit
  1102. diff -C 2 -N -r -w ocaml-3.12.0/driver/main.ml ocaml-3.12.0+functor/driver/main.ml
  1103. *** ocaml-3.12.0/driver/main.ml 2010-05-20 16:06:29.000000000 +0200
  1104. --- ocaml-3.12.0+functor/driver/main.ml 2011-06-06 15:37:02.775859002 +0200
  1105. ***************
  1106. *** 48,52 ****
  1107.     else if Filename.check_suffix name ".cmi" && !make_package then
  1108.       objfiles := name :: !objfiles
  1109. !   else if Filename.check_suffix name ext_obj
  1110.          || Filename.check_suffix name ext_lib then
  1111.       ccobjs := name :: !ccobjs
  1112. --- 48,55 ----
  1113.     else if Filename.check_suffix name ".cmi" && !make_package then
  1114.       objfiles := name :: !objfiles
  1115. !   else if Filename.check_suffix name ".cmi" && !print_types then begin
  1116. !     Compile.init_path ();
  1117. !     Typemod.print_types ppf name
  1118. !   end else if Filename.check_suffix name ext_obj
  1119.          || Filename.check_suffix name ext_lib then
  1120.       ccobjs := name :: !ccobjs
  1121. ***************
  1122. *** 117,120 ****
  1123. --- 120,127 ----
  1124.     let _output_obj () = output_c_object := true; custom_runtime := true
  1125.     let _pack = set make_package
  1126. +   let _pack_functor s =
  1127. +     set make_package ();
  1128. +     pack_functor := Some s
  1129. +   let _functor s = functors := s :: !functors
  1130.     let _pp s = preprocessor := Some s
  1131.     let _principal = set principal
  1132. ***************
  1133. *** 154,157 ****
  1134. --- 161,167 ----
  1135.     | None -> Config.default_executable_name
  1136.  
  1137. + let module_name filename =
  1138. +   String.capitalize (Misc.chop_extensions (Filename.basename filename))
  1139. +
  1140.   let main () =
  1141.     try
  1142. ***************
  1143. *** 174,179 ****
  1144.       else if !make_package then begin
  1145.         Compile.init_path();
  1146.         Bytepackager.package_files (List.rev !objfiles)
  1147. !                                  (extract_output !output_name)
  1148.       end
  1149.       else if not !compile_only && !objfiles <> [] then begin
  1150. --- 184,195 ----
  1151.       else if !make_package then begin
  1152.         Compile.init_path();
  1153. +       let target = extract_output !output_name in
  1154. +       Env.add_functor_arguments (module_name target);
  1155. +       if Filename.check_suffix target ".cmi" then
  1156. +   Typemod.package_interfaces (List.rev !objfiles)
  1157. +           target !pack_functor
  1158. +       else
  1159.     Bytepackager.package_files (List.rev !objfiles)
  1160. !           target !pack_functor
  1161.       end
  1162.       else if not !compile_only && !objfiles <> [] then begin
  1163. ***************
  1164. *** 202,204 ****
  1165.       exit 2
  1166.  
  1167. ! let _ = main ()
  1168. --- 218,222 ----
  1169.       exit 2
  1170.  
  1171. ! let _ =
  1172. !   main ()
  1173. !
  1174. diff -C 2 -N -r -w ocaml-3.12.0/driver/optcompile.ml ocaml-3.12.0+functor/driver/optcompile.ml
  1175. *** ocaml-3.12.0/driver/optcompile.ml   2008-12-03 19:09:09.000000000 +0100
  1176. --- ocaml-3.12.0+functor/driver/optcompile.ml   2011-06-06 14:33:18.195859009 +0200
  1177. ***************
  1178. *** 40,46 ****
  1179.     Ident.reinit();
  1180.     try
  1181.       if !Clflags.nopervasives
  1182. !     then Env.initial
  1183. !     else Env.open_pers_signature "Pervasives" Env.initial
  1184.     with Not_found ->
  1185.       fatal_error "cannot open pervasives.cmi"
  1186. --- 40,47 ----
  1187.     Ident.reinit();
  1188.     try
  1189. +     let env = Env.initial in
  1190.       if !Clflags.nopervasives
  1191. !     then env
  1192. !     else Env.open_pers_signature "Pervasives" env
  1193.     with Not_found ->
  1194.       fatal_error "cannot open pervasives.cmi"
  1195. ***************
  1196. *** 81,84 ****
  1197. --- 82,86 ----
  1198.         Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
  1199.       if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
  1200. +     Env.add_functor_arguments modulename;
  1201.       let sg = Typemod.transl_signature (initial_env()) ast in
  1202.       if !Clflags.print_types then
  1203. ***************
  1204. *** 113,116 ****
  1205. --- 115,119 ----
  1206.     let inputfile = Pparse.preprocess sourcefile in
  1207.     let env = initial_env() in
  1208. +   Env.add_functor_arguments modulename;
  1209.     Compilenv.reset ?packname:!Clflags.for_package modulename;
  1210.     let cmxfile = outputprefix ^ ".cmx" in
  1211. ***************
  1212. *** 138,141 ****
  1213. --- 141,145 ----
  1214.       Stypes.dump (outputprefix ^ ".annot");
  1215.     with x ->
  1216. +     Printexc.print_backtrace stderr;
  1217.       remove_file objfile;
  1218.       remove_file cmxfile;
  1219. ***************
  1220. *** 146,147 ****
  1221. --- 150,153 ----
  1222.   let c_file name =
  1223.     if Ccomp.compile_file name <> 0 then exit 2
  1224. +
  1225. +
  1226. diff -C 2 -N -r -w ocaml-3.12.0/driver/optmain.ml ocaml-3.12.0+functor/driver/optmain.ml
  1227. *** ocaml-3.12.0/driver/optmain.ml  2010-05-20 16:06:29.000000000 +0200
  1228. --- ocaml-3.12.0+functor/driver/optmain.ml  2011-06-06 15:37:10.035859003 +0200
  1229. ***************
  1230. *** 45,48 ****
  1231. --- 45,52 ----
  1232.     else if Filename.check_suffix name ".cmi" && !make_package then
  1233.       objfiles := name :: !objfiles
  1234. +   else if Filename.check_suffix name ".cmi" && !print_types then begin
  1235. +     Optcompile.init_path ();
  1236. +     Typemod.print_types ppf name
  1237. +   end
  1238.     else if Filename.check_suffix name ext_obj
  1239.          || Filename.check_suffix name ext_lib then
  1240. ***************
  1241. *** 126,129 ****
  1242. --- 130,137 ----
  1243.     let _p = set gprofile
  1244.     let _pack = set make_package
  1245. +   let _pack_functor s =
  1246. +     set make_package ();
  1247. +     pack_functor := Some s
  1248. +   let _functor s = functors := s :: !functors
  1249.     let _pp s = preprocessor := Some s
  1250.     let _principal = set principal
  1251. ***************
  1252. *** 164,167 ****
  1253. --- 172,178 ----
  1254.   end);;
  1255.  
  1256. + let module_name filename =
  1257. +   String.capitalize (Misc.chop_extensions (Filename.basename filename))
  1258. +
  1259.   let main () =
  1260.     native_code := true;
  1261. ***************
  1262. *** 183,187 ****
  1263.         Optcompile.init_path();
  1264.         let target = extract_output !output_name in
  1265. !       Asmpackager.package_files ppf (List.rev !objfiles) target;
  1266.       end
  1267.       else if !shared then begin
  1268. --- 194,203 ----
  1269.         Optcompile.init_path();
  1270.         let target = extract_output !output_name in
  1271. !     Env.add_functor_arguments (module_name target);
  1272. !       if Filename.check_suffix target ".cmi" then
  1273. !   Typemod.package_interfaces (List.rev !objfiles)
  1274. !           target !pack_functor
  1275. !       else
  1276. !       Asmpackager.package_files ppf (List.rev !objfiles) target !pack_functor;
  1277.       end
  1278.       else if !shared then begin
  1279. ***************
  1280. *** 214,216 ****
  1281.       exit 2
  1282.  
  1283. ! let _ = main ()
  1284. --- 230,234 ----
  1285.       exit 2
  1286.  
  1287. !
  1288. ! let _ =
  1289. !   main ()
  1290. diff -C 2 -N -r -w ocaml-3.12.0/Makefile ocaml-3.12.0+functor/Makefile
  1291. *** ocaml-3.12.0/Makefile   2010-06-16 03:32:26.000000000 +0200
  1292. --- ocaml-3.12.0+functor/Makefile   2011-06-06 14:33:18.175859003 +0200
  1293. ***************
  1294. *** 20,25 ****
  1295.   CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
  1296.   CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
  1297. ! COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES)
  1298. ! LINKFLAGS=
  1299.  
  1300.   CAMLYACC=boot/ocamlyacc
  1301. --- 20,25 ----
  1302.   CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
  1303.   CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
  1304. ! COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES) -g
  1305. ! LINKFLAGS=-g
  1306.  
  1307.   CAMLYACC=boot/ocamlyacc
  1308. ***************
  1309. *** 49,53 ****
  1310.     typing/btype.cmo typing/oprint.cmo \
  1311.     typing/subst.cmo typing/predef.cmo \
  1312. !   typing/datarepr.cmo typing/env.cmo \
  1313.     typing/typedtree.cmo typing/ctype.cmo \
  1314.     typing/printtyp.cmo typing/includeclass.cmo \
  1315. --- 49,53 ----
  1316.     typing/btype.cmo typing/oprint.cmo \
  1317.     typing/subst.cmo typing/predef.cmo \
  1318. !   typing/datarepr.cmo typing/cmi_format.cmo typing/env.cmo \
  1319.     typing/typedtree.cmo typing/ctype.cmo \
  1320.     typing/printtyp.cmo typing/includeclass.cmo \
  1321. ***************
  1322. *** 546,550 ****
  1323.   tools/cvt_emit: tools/cvt_emit.mll
  1324.     cd tools; \
  1325. !   $(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit
  1326.  
  1327.   # The "expunge" utility
  1328. --- 546,550 ----
  1329.   tools/cvt_emit: tools/cvt_emit.mll
  1330.     cd tools; \
  1331. !   $(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../boot" cvt_emit
  1332.  
  1333.   # The "expunge" utility
  1334. diff -C 2 -N -r -w ocaml-3.12.0/ocamldoc/Makefile ocaml-3.12.0+functor/ocamldoc/Makefile
  1335. *** ocaml-3.12.0/ocamldoc/Makefile  2010-06-16 13:38:22.000000000 +0200
  1336. --- ocaml-3.12.0+functor/ocamldoc/Makefile  2011-06-06 14:33:18.195859009 +0200
  1337. ***************
  1338. *** 154,157 ****
  1339. --- 154,158 ----
  1340.     $(OCAMLSRCDIR)/typing/datarepr.cmo \
  1341.     $(OCAMLSRCDIR)/typing/subst.cmo \
  1342. +   $(OCAMLSRCDIR)/typing/cmi_format.cmo \
  1343.     $(OCAMLSRCDIR)/typing/env.cmo \
  1344.     $(OCAMLSRCDIR)/typing/ctype.cmo \
  1345. diff -C 2 -N -r -w ocaml-3.12.0/ocamldoc/Makefile.nt ocaml-3.12.0+functor/ocamldoc/Makefile.nt
  1346. *** ocaml-3.12.0/ocamldoc/Makefile.nt   2010-05-28 13:21:46.000000000 +0200
  1347. --- ocaml-3.12.0+functor/ocamldoc/Makefile.nt   2011-06-06 14:33:18.195859009 +0200
  1348. ***************
  1349. *** 149,152 ****
  1350. --- 149,153 ----
  1351.     $(OCAMLSRCDIR)/typing/datarepr.cmo \
  1352.     $(OCAMLSRCDIR)/typing/subst.cmo \
  1353. +   $(OCAMLSRCDIR)/typing/cmi_format.cmo \
  1354.     $(OCAMLSRCDIR)/typing/env.cmo \
  1355.     $(OCAMLSRCDIR)/typing/ctype.cmo \
  1356. diff -C 2 -N -r -w ocaml-3.12.0/otherlibs/dynlink/Makefile ocaml-3.12.0+functor/otherlibs/dynlink/Makefile
  1357. *** ocaml-3.12.0/otherlibs/dynlink/Makefile 2010-05-28 17:09:22.000000000 +0200
  1358. --- ocaml-3.12.0+functor/otherlibs/dynlink/Makefile 2011-06-06 14:33:18.195859009 +0200
  1359. ***************
  1360. *** 34,38 ****
  1361.     ../../typing/primitive.cmo ../../typing/types.cmo \
  1362.     ../../typing/btype.cmo ../../typing/subst.cmo ../../typing/predef.cmo \
  1363. !   ../../typing/datarepr.cmo ../../typing/env.cmo \
  1364.     ../../bytecomp/lambda.cmo ../../bytecomp/instruct.cmo \
  1365.     ../../bytecomp/cmo_format.cmi ../../bytecomp/opcodes.cmo \
  1366. --- 34,40 ----
  1367.     ../../typing/primitive.cmo ../../typing/types.cmo \
  1368.     ../../typing/btype.cmo ../../typing/subst.cmo ../../typing/predef.cmo \
  1369. !   ../../typing/datarepr.cmo \
  1370. !   ../../typing/cmi_format.cmo \
  1371. !   ../../typing/env.cmo \
  1372.     ../../bytecomp/lambda.cmo ../../bytecomp/instruct.cmo \
  1373.     ../../bytecomp/cmo_format.cmi ../../bytecomp/opcodes.cmo \
  1374. diff -C 2 -N -r -w ocaml-3.12.0/parsing/location.ml ocaml-3.12.0+functor/parsing/location.ml
  1375. *** ocaml-3.12.0/parsing/location.ml    2008-01-11 17:13:18.000000000 +0100
  1376. --- ocaml-3.12.0+functor/parsing/location.ml    2011-06-06 14:33:18.195859009 +0200
  1377. ***************
  1378. *** 206,210 ****
  1379.   let get_pos_info pos =
  1380.     let (filename, linenum, linebeg) =
  1381. !     if pos.pos_fname = "" && !input_name = "" then
  1382.         ("", -1, 0)
  1383.       else if pos.pos_fname = "" then
  1384. --- 206,210 ----
  1385.   let get_pos_info pos =
  1386.     let (filename, linenum, linebeg) =
  1387. !     if pos.pos_fname = "" && (!input_name = "" || !input_name = "_none_") then
  1388.         ("", -1, 0)
  1389.       else if pos.pos_fname = "" then
  1390. diff -C 2 -N -r -w ocaml-3.12.0/stdlib/camlinternalMod.ml ocaml-3.12.0+functor/stdlib/camlinternalMod.ml
  1391. *** ocaml-3.12.0/stdlib/camlinternalMod.ml  2008-01-11 17:13:18.000000000 +0100
  1392. --- ocaml-3.12.0+functor/stdlib/camlinternalMod.ml  2011-06-06 14:33:18.195859009 +0200
  1393. ***************
  1394. *** 67,68 ****
  1395. --- 67,76 ----
  1396.           update_mod comps.(i) (Obj.field o i) (Obj.field n i)
  1397.         done
  1398. +
  1399. + module StringMap = Map.Make(String)
  1400. +
  1401. + type functor_arg
  1402. + type functor_env = functor_arg StringMap.t
  1403. + let create_functor_env () = StringMap.empty
  1404. + let find_functor_arg = StringMap.find
  1405. + let add_functor_arg = StringMap.add
  1406. diff -C 2 -N -r -w ocaml-3.12.0/stdlib/camlinternalMod.mli ocaml-3.12.0+functor/stdlib/camlinternalMod.mli
  1407. *** ocaml-3.12.0/stdlib/camlinternalMod.mli 2004-08-12 14:57:00.000000000 +0200
  1408. --- ocaml-3.12.0+functor/stdlib/camlinternalMod.mli 2011-06-06 14:33:18.195859009 +0200
  1409. ***************
  1410. *** 22,23 ****
  1411. --- 22,29 ----
  1412.   val init_mod: string * int * int -> shape -> Obj.t
  1413.   val update_mod: shape -> Obj.t -> Obj.t -> unit
  1414. +
  1415. + type functor_env
  1416. + type functor_arg
  1417. + val create_functor_env : unit -> functor_env
  1418. + val find_functor_arg :  string -> functor_env -> functor_arg
  1419. + val add_functor_arg : string -> functor_arg -> functor_env -> functor_env
  1420. diff -C 2 -N -r -w ocaml-3.12.0/tools/Makefile.shared ocaml-3.12.0+functor/tools/Makefile.shared
  1421. *** ocaml-3.12.0/tools/Makefile.shared  2010-06-07 08:58:41.000000000 +0200
  1422. --- ocaml-3.12.0+functor/tools/Makefile.shared  2011-06-06 14:33:18.205858999 +0200
  1423. ***************
  1424. *** 234,238 ****
  1425.  
  1426.   OBJINFO=../utils/misc.cmo ../utils/config.cmo ../bytecomp/bytesections.cmo \
  1427. !         objinfo.cmo
  1428.  
  1429.   objinfo: objinfo_helper$(EXE) $(OBJINFO)
  1430. --- 234,238 ----
  1431.  
  1432.   OBJINFO=../utils/misc.cmo ../utils/config.cmo ../bytecomp/bytesections.cmo \
  1433. !         ../typing/cmi_format.cmo objinfo.cmo
  1434.  
  1435.   objinfo: objinfo_helper$(EXE) $(OBJINFO)
  1436. diff -C 2 -N -r -w ocaml-3.12.0/tools/objinfo.ml ocaml-3.12.0+functor/tools/objinfo.ml
  1437. *** ocaml-3.12.0/tools/objinfo.ml   2010-05-24 16:27:50.000000000 +0200
  1438. --- ocaml-3.12.0+functor/tools/objinfo.ml   2011-06-06 14:33:18.205858999 +0200
  1439. ***************
  1440. *** 24,27 ****
  1441. --- 24,28 ----
  1442.   open Cmo_format
  1443.   open Clambda
  1444. + open Cmi_format
  1445.  
  1446.   let input_stringlist ic len =
  1447. ***************
  1448. *** 45,52 ****
  1449. --- 46,65 ----
  1450.     printf "\t%s\n" name
  1451.  
  1452. + let print_functor_infos functor_args functor_parts =
  1453. +   if functor_args <> [] then begin
  1454. +     printf "Functor args:\n";
  1455. +     List.iter print_name_crc functor_args;
  1456. +     printf "Functors parts:\n";
  1457. +     List.iter (fun (id, deps) ->
  1458. +       printf "\t%s\n" ( id);
  1459. +       List.iter (fun (id, crc) -> printf "\t\t(%s:%s)\n" (id) (Digest.to_hex crc)) deps;
  1460. +     ) functor_parts
  1461. +   end
  1462. +
  1463.   let print_cmo_infos cu =
  1464.     printf "Unit name: %s\n" cu.cu_name;
  1465.     print_string "Interfaces imported:\n";
  1466.     List.iter print_name_crc cu.cu_imports;
  1467. +   print_functor_infos cu.cu_functor_args cu.cu_functor_parts;
  1468.     printf "Uses unsafe features: ";
  1469.     match cu.cu_primitives with
  1470. ***************
  1471. *** 98,105 ****
  1472.     List.iter print_cmo_infos lib.lib_units
  1473.  
  1474. ! let print_cmi_infos name sign comps crcs =
  1475. !   printf "Unit name: %s\n" name;
  1476.     printf "Interfaces imported:\n";
  1477. !   List.iter print_name_crc crcs
  1478.  
  1479.   let print_general_infos name crc defines cmi cmx =
  1480. --- 111,119 ----
  1481.     List.iter print_cmo_infos lib.lib_units
  1482.  
  1483. ! let print_cmi_infos cmi cmi_crc =
  1484. !   printf "Unit name: %s\n" cmi.cmi_name;
  1485.     printf "Interfaces imported:\n";
  1486. !   List.iter print_name_crc cmi.cmi_crcs;
  1487. !   print_functor_infos cmi.cmi_functor_args cmi.cmi_functor_parts
  1488.  
  1489.   let print_general_infos name crc defines cmi cmx =
  1490. ***************
  1491. *** 118,121 ****
  1492. --- 132,136 ----
  1493.     print_general_infos
  1494.       ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx;
  1495. +   print_functor_infos ui.ui_functor_args ui.ui_functor_parts;
  1496.     printf "Approximation:\n";
  1497.     Format.fprintf Format.std_formatter "  %a@." print_approx_infos ui.ui_approx;
  1498. ***************
  1499. *** 223,230 ****
  1500.       print_cma_infos toc
  1501.     end else if magic_number = cmi_magic_number then begin
  1502. !     let (name, sign, comps) = input_value ic in
  1503. !     let crcs = input_value ic in
  1504.       close_in ic;
  1505. !     print_cmi_infos name sign comps crcs
  1506.     end else if magic_number = cmx_magic_number then begin
  1507.       let ui = (input_value ic : unit_infos) in
  1508. --- 238,244 ----
  1509.       print_cma_infos toc
  1510.     end else if magic_number = cmi_magic_number then begin
  1511. !     let (cmi, cmi_crc) = Cmi_format.input_cmi_info ic in
  1512.       close_in ic;
  1513. !     print_cmi_infos cmi cmi_crc
  1514.     end else if magic_number = cmx_magic_number then begin
  1515.       let ui = (input_value ic : unit_infos) in
  1516. diff -C 2 -N -r -w ocaml-3.12.0/tools/ocamlcp.ml ocaml-3.12.0+functor/tools/ocamlcp.ml
  1517. *** ocaml-3.12.0/tools/ocamlcp.ml   2010-05-20 16:06:29.000000000 +0200
  1518. --- ocaml-3.12.0+functor/tools/ocamlcp.ml   2011-06-06 14:33:18.205858999 +0200
  1519. ***************
  1520. *** 71,74 ****
  1521. --- 71,76 ----
  1522.     let _output_obj = option "-output-obj"
  1523.     let _pack = option "-pack"
  1524. +   let _pack_functor = option_with_arg "-pack-functor"
  1525. +   let _functor = option_with_arg "-functor"
  1526.     let _pp s = incompatible "-pp"
  1527.     let _principal = option "-principal"
  1528. diff -C 2 -N -r -w ocaml-3.12.0/typing/cmi_format.ml ocaml-3.12.0+functor/typing/cmi_format.ml
  1529. *** ocaml-3.12.0/typing/cmi_format.ml   1970-01-01 01:00:00.000000000 +0100
  1530. --- ocaml-3.12.0+functor/typing/cmi_format.ml   2011-06-06 14:33:18.205858999 +0200
  1531. ***************
  1532. *** 0 ****
  1533. --- 1,24 ----
  1534. + type pers_flags = Rectypes
  1535. +
  1536. + type cmi_info = {
  1537. +     cmi_name : string;
  1538. +     cmi_sig : Types.signature_item list;
  1539. +     mutable cmi_crcs : (string * Digest.t) list;
  1540. +     cmi_flags : pers_flags list;
  1541. +     cmi_arg_id : Ident.t;
  1542. +     cmi_functor_args : (string * Digest.t) list;
  1543. +     cmi_functor_parts : (string * (string * Digest.t) list) list;
  1544. + }
  1545. +
  1546. + let input_cmi_info ic =
  1547. +   let cmi = (input_value ic : cmi_info) in
  1548. +   let cmi_crc = (input_value ic : Digest.t) in
  1549. +   cmi, cmi_crc
  1550. +
  1551. + let output_cmi_info oc cmi =
  1552. +   let s = Marshal.to_string cmi [] in
  1553. +   let crc = Digest.string s in
  1554. +   output_string oc s;
  1555. +   output_value oc crc;
  1556. +   crc
  1557. +
  1558. diff -C 2 -N -r -w ocaml-3.12.0/typing/cmi_format.mli ocaml-3.12.0+functor/typing/cmi_format.mli
  1559. *** ocaml-3.12.0/typing/cmi_format.mli  1970-01-01 01:00:00.000000000 +0100
  1560. --- ocaml-3.12.0+functor/typing/cmi_format.mli  2011-06-06 14:33:18.205858999 +0200
  1561. ***************
  1562. *** 0 ****
  1563. --- 1,21 ----
  1564. + type pers_flags = Rectypes
  1565. +
  1566. + type cmi_info = {
  1567. +     cmi_name : string;
  1568. +     cmi_sig : Types.signature_item list;
  1569. +     mutable cmi_crcs : (string * Digest.t) list;
  1570. +     cmi_flags : pers_flags list;
  1571. +     cmi_arg_id : Ident.t;
  1572. + (* For functors: this interface corresponds to a file that depends
  1573. +    on these arguments, with the corresponding digests.
  1574. + *)
  1575. +     cmi_functor_args : (string * Digest.t) list;
  1576. + (* For functors: this interface corresponds to a file that depends
  1577. +    on these units, with the corresponding argument dependencies.
  1578. +    The dependencies should be a suffix of the current dependencies.
  1579. + *)
  1580. +     cmi_functor_parts : (string * (string * Digest.t) list) list;
  1581. + }
  1582. +
  1583. + val input_cmi_info : in_channel -> cmi_info * Digest.t
  1584. + val output_cmi_info : out_channel -> cmi_info -> Digest.t
  1585. diff -C 2 -N -r -w ocaml-3.12.0/typing/ctype.ml ocaml-3.12.0+functor/typing/ctype.ml
  1586. *** ocaml-3.12.0/typing/ctype.ml    2010-06-24 10:43:39.000000000 +0200
  1587. --- ocaml-3.12.0+functor/typing/ctype.ml    2011-06-06 14:33:18.205858999 +0200
  1588. ***************
  1589. *** 3474,3475 ****
  1590. --- 3474,3576 ----
  1591.   let collapse_conj_params env params =
  1592.     List.iter (collapse_conj env []) params
  1593. +
  1594. + module PrintDebugType = struct
  1595. +
  1596. +   type context = {
  1597. +     table : (int, string) Hashtbl.t;
  1598. +   }
  1599. +
  1600. +   let rec type_expr c t =
  1601. +     try
  1602. +       Hashtbl.find c.table t.id
  1603. +     with Not_found ->
  1604. +       Hashtbl.add c.table t.id (Printf.sprintf "{ty.id = %d}" t.id);
  1605. +       let b = Buffer.create 100 in
  1606. +       Printf.bprintf b "{ desc = %s;\n" (type_desc c t.desc);
  1607. +       Printf.bprintf b "  level = %d;\n" t.level;
  1608. +       Printf.bprintf b "  id = %d }" t.id;
  1609. +       let s = Buffer.contents b in
  1610. +       Hashtbl.add c.table t.id s;
  1611. +       s
  1612. +
  1613. +   and type_desc c t =
  1614. +     match t with
  1615. +   Tvar -> "Tvar"
  1616. +       | Tarrow _ -> "Tarrow"
  1617. +       | Ttuple _ -> "Ttuple"
  1618. +       | Tconstr _ -> "Tconstr"
  1619. +       | Tobject _ -> "Tobject"
  1620. +       | Tfield _ -> "Tfield"
  1621. +       | Tnil -> "Tnil"
  1622. +       | Tlink _ -> "Tlink"
  1623. +       | Tsubst _ -> "Tsubst"
  1624. +       | Tvariant _ -> "Tvariant"
  1625. +       | Tunivar -> "Tunivar"
  1626. +       | Tpoly _ -> "Tpoly"
  1627. +       | Tpackage _ -> "Tpackage"
  1628. +
  1629. + (*
  1630. +       | Tarrow of label * type_expr * type_expr * commutable
  1631. +       | Ttuple of type_expr list
  1632. +       | Tconstr of Path.t * type_expr list * abbrev_memo ref
  1633. +       | Tobject of type_expr * (Path.t * type_expr list) option ref
  1634. +       | Tfield of string * field_kind * type_expr * type_expr
  1635. +       | Tnil
  1636. +       | Tlink of type_expr
  1637. +       | Tsubst of type_expr         (* for copying *)
  1638. +       | Tvariant of row_desc
  1639. +       | Tunivar
  1640. +       | Tpoly of type_expr * type_expr list
  1641. +       | Tpackage of Path.t * string list * type_expr list
  1642. + *)
  1643. +
  1644. + (*
  1645. + and row_desc =
  1646. +     { row_fields: (label * row_field) list;
  1647. +       row_more: type_expr;
  1648. +       row_bound: unit;
  1649. +       row_closed: bool;
  1650. +       row_fixed: bool;
  1651. +       row_name: (Path.t * type_expr list) option }
  1652. +
  1653. + and row_field =
  1654. +     Rpresent of type_expr option
  1655. +   | Reither of bool * type_expr list * bool * row_field option ref
  1656. +         (* 1st true denotes a constant constructor *)
  1657. +         (* 2nd true denotes a tag in a pattern matching, and
  1658. +            is erased later *)
  1659. +   | Rabsent
  1660. +
  1661. + and abbrev_memo =
  1662. +     Mnil
  1663. +   | Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
  1664. +   | Mlink of abbrev_memo ref
  1665. +
  1666. + and field_kind =
  1667. +     Fvar of field_kind option ref
  1668. +   | Fpresent
  1669. +   | Fabsent
  1670. +
  1671. + and commutable =
  1672. +     Cok
  1673. +   | Cunknown
  1674. +   | Clink of commutable ref
  1675. + *)
  1676. +
  1677. +   let type_expr t = type_expr { table = Hashtbl.create 13 } t
  1678. +
  1679. + end
  1680. +
  1681. + let _ =
  1682. +   Printexc.register_printer (fun e ->
  1683. +     match e with
  1684. +   Unify list ->
  1685. +     let b = Buffer.create 100 in
  1686. +     Printf.bprintf b "Ctype.Unify [\n";
  1687. +     List.iter (fun (t1, t2) ->
  1688. +       Printf.bprintf b "      (%s,\n" (PrintDebugType.type_expr t1);
  1689. +       Printf.bprintf b "       %s)\n" (PrintDebugType.type_expr t2);
  1690. +     ) list;
  1691. +     Printf.bprintf b "            ]\n";
  1692. +     Some (Buffer.contents b)
  1693. +       | _ -> None)
  1694. diff -C 2 -N -r -w ocaml-3.12.0/typing/env.ml ocaml-3.12.0+functor/typing/env.ml
  1695. *** ocaml-3.12.0/typing/env.ml  2010-04-30 03:56:21.000000000 +0200
  1696. --- ocaml-3.12.0+functor/typing/env.ml  2011-06-06 15:35:45.245858999 +0200
  1697. ***************
  1698. *** 22,25 ****
  1699. --- 22,26 ----
  1700.   open Types
  1701.  
  1702. + type intf_info = string * Digest.t
  1703.  
  1704.   type error =
  1705. ***************
  1706. *** 28,31 ****
  1707. --- 29,33 ----
  1708.     | Illegal_renaming of string * string
  1709.     | Inconsistent_import of string * string * string
  1710. +   | Inconsistent_arguments of string * intf_info list * intf_info list
  1711.     | Need_recursive_types of string * string
  1712.  
  1713. ***************
  1714. *** 135,141 ****
  1715.   let current_unit = ref ""
  1716.  
  1717.   (* Persistent structure descriptions *)
  1718.  
  1719. ! type pers_flags = Rectypes
  1720.  
  1721.   type pers_struct =
  1722. --- 137,153 ----
  1723.   let current_unit = ref ""
  1724.  
  1725. + let functor_args = ref ([] : (string * Digest.t) list)
  1726. + let functor_arg_crcs = (Hashtbl.create 17 : (string, Digest.t * string) Hashtbl.t)
  1727. + let functor_parts = ref ([] : (string * (string * Digest.t) list) list)
  1728. + let functor_parts_table = (Hashtbl.create 17 : (string, Ident.t) Hashtbl.t)
  1729. +
  1730.   (* Persistent structure descriptions *)
  1731.  
  1732. ! (* type pers_flags = Rectypes moved to Cmi_format *)
  1733. !
  1734. ! type ps_kind =
  1735. !     PersistentStructureDependency
  1736. !   | PersistentStructureArgument
  1737. !   | PersistentStructureUnit
  1738.  
  1739.   type pers_struct =
  1740. ***************
  1741. *** 145,152 ****
  1742.       ps_crcs: (string * Digest.t) list;
  1743.       ps_filename: string;
  1744. !     ps_flags: pers_flags list }
  1745.  
  1746. ! let persistent_structures =
  1747. !   (Hashtbl.create 17 : (string, pers_struct) Hashtbl.t)
  1748.  
  1749.   (* Consistency between persistent structures *)
  1750. --- 157,169 ----
  1751.       ps_crcs: (string * Digest.t) list;
  1752.       ps_filename: string;
  1753. !     ps_flags: Cmi_format.pers_flags list;
  1754. !     ps_id : Ident.t;
  1755. !     ps_kind : ps_kind;
  1756. !     ps_crc : Digest.t;
  1757. !     ps_functor_args : (string * Digest.t) list;
  1758. !     ps_functor_parts : (string * (string * Digest.t) list) list;
  1759. !  }
  1760.  
  1761. ! let persistent_structures = (Hashtbl.create 17 : (string, pers_struct) Hashtbl.t)
  1762.  
  1763.   (* Consistency between persistent structures *)
  1764. ***************
  1765. *** 162,168 ****
  1766.       raise(Error(Inconsistent_import(name, auth, source)))
  1767.  
  1768.   (* Reading persistent structures from .cmi files *)
  1769.  
  1770. ! let read_pers_struct modname filename =
  1771.     let ic = open_in_bin filename in
  1772.     try
  1773. --- 179,223 ----
  1774.       raise(Error(Inconsistent_import(name, auth, source)))
  1775.  
  1776. + let check_functor_args filename crcs =
  1777. +   if crcs <> [] then
  1778. +     let rec iter current_crcs =
  1779. +       match current_crcs with
  1780. +     [] ->
  1781. +       raise(Error(Inconsistent_arguments(filename, crcs, !functor_args)))
  1782. +   | _ :: tail ->
  1783. +     if current_crcs = crcs then () else
  1784. +       iter tail
  1785. +
  1786. +     in
  1787. +     iter !functor_args
  1788. +
  1789.   (* Reading persistent structures from .cmi files *)
  1790.  
  1791. ! open Cmi_format
  1792. !
  1793. ! (* TODO: check the case where two modules have inconsistent
  1794. !    assumptions on a module: one uses it as an argument, the other one as
  1795. !    a dependency. This should fail. *)
  1796. !
  1797. ! let add_functor_arg id =
  1798. !   Ident.make_functor_part id;
  1799. !   Ident.make_functor_arg id;
  1800. !   let name = Ident.name id in
  1801. !   functor_parts := (Ident.name id, []) :: !functor_parts;
  1802. !   if not (Hashtbl.mem functor_parts_table name) then
  1803. !     Hashtbl.add functor_parts_table name (Ident.create name)
  1804. !
  1805. ! let add_functor_part id deps =
  1806. !   Ident.make_functor_part id;
  1807. !   let name = Ident.name id in
  1808. !   functor_parts := (Ident.name id, deps) :: !functor_parts;
  1809. !   if not (Hashtbl.mem functor_parts_table name) then
  1810. !     Hashtbl.add functor_parts_table name (Ident.create name)
  1811. !
  1812. ! let get_functor_part name = Hashtbl.find functor_parts_table name
  1813. !
  1814. ! let get_functor_parts () = !functor_parts
  1815. !
  1816. ! let read_pers_struct modname filename ps_kind =
  1817.     let ic = open_in_bin filename in
  1818.     try
  1819. ***************
  1820. *** 173,193 ****
  1821.         raise(Error(Not_an_interface filename))
  1822.       end;
  1823. !     let (name, sign) = input_value ic in
  1824. !     let crcs = input_value ic in
  1825. !     let flags = input_value ic in
  1826.       close_in ic;
  1827.       let comps =
  1828.         !components_of_module' empty Subst.identity
  1829. !                              (Pident(Ident.create_persistent name))
  1830. !                              (Tmty_signature sign) in
  1831. !     let ps = { ps_name = name;
  1832. !                ps_sig = sign;
  1833.                  ps_comps = comps;
  1834. !                ps_crcs = crcs;
  1835.                  ps_filename = filename;
  1836. !                ps_flags = flags } in
  1837.       if ps.ps_name <> modname then
  1838.         raise(Error(Illegal_renaming(ps.ps_name, filename)));
  1839.       check_consistency filename ps.ps_crcs;
  1840.       List.iter
  1841.         (function Rectypes ->
  1842. --- 228,262 ----
  1843.         raise(Error(Not_an_interface filename))
  1844.       end;
  1845. !     let (cmi, crc) = Cmi_format.input_cmi_info ic in
  1846.       close_in ic;
  1847. +     let ps_id = Ident.create_persistent cmi.cmi_name in
  1848. +     begin
  1849. +       match ps_kind with
  1850. +   | PersistentStructureArgument -> add_functor_arg ps_id
  1851. +   | PersistentStructureDependency ->
  1852. +     if cmi.cmi_functor_args <> [] then add_functor_part ps_id cmi.cmi_functor_args
  1853. +   | PersistentStructureUnit -> ()
  1854. +     end;
  1855.       let comps =
  1856.         !components_of_module' empty Subst.identity
  1857. !         (Pident ps_id)
  1858. !         (Tmty_signature cmi.cmi_sig) in
  1859. !     let ps = { ps_name = cmi.cmi_name;
  1860. !                ps_sig = cmi.cmi_sig;
  1861.                  ps_comps = comps;
  1862. !                ps_crcs = (cmi.cmi_name, crc) :: cmi.cmi_crcs;
  1863. !          ps_crc = crc;
  1864.                  ps_filename = filename;
  1865. !                ps_flags = cmi.cmi_flags;
  1866. !          ps_kind = ps_kind;
  1867. !          ps_id = ps_id;
  1868. !          ps_functor_args = cmi.cmi_functor_args;
  1869. !          ps_functor_parts = cmi.cmi_functor_parts;
  1870. !        } in
  1871.       if ps.ps_name <> modname then
  1872.         raise(Error(Illegal_renaming(ps.ps_name, filename)));
  1873.       check_consistency filename ps.ps_crcs;
  1874. +     if ps_kind <> PersistentStructureUnit then
  1875. +       check_functor_args filename ps.ps_functor_args;
  1876.       List.iter
  1877.         (function Rectypes ->
  1878. ***************
  1879. *** 206,213 ****
  1880. --- 275,287 ----
  1881.     with Not_found ->
  1882.       read_pers_struct name (find_in_path_uncap !load_path (name ^ ".cmi"))
  1883. +       PersistentStructureDependency
  1884.  
  1885.   let reset_cache () =
  1886.     current_unit := "";
  1887.     Hashtbl.clear persistent_structures;
  1888. +   functor_args := [];
  1889. +   functor_parts := [];
  1890. +   Hashtbl.clear functor_parts_table;
  1891. +   Hashtbl.clear functor_arg_crcs;
  1892.     Consistbl.clear crc_units
  1893.  
  1894. ***************
  1895. *** 226,230 ****
  1896.           if Ident.persistent id
  1897.           then (find_pers_struct (Ident.name id)).ps_comps
  1898. !         else raise Not_found
  1899.         end
  1900.     | Pdot(p, s, pos) ->
  1901. --- 300,306 ----
  1902.           if Ident.persistent id
  1903.           then (find_pers_struct (Ident.name id)).ps_comps
  1904. !         else begin
  1905. !     raise Not_found
  1906. !   end
  1907.         end
  1908.     | Pdot(p, s, pos) ->
  1909. ***************
  1910. *** 312,316 ****
  1911.             let ps = find_pers_struct (Ident.name id) in
  1912.             Tmty_signature(ps.ps_sig)
  1913. !         else raise Not_found
  1914.         end
  1915.     | Pdot(p, s, pos) ->
  1916. --- 388,394 ----
  1917.             let ps = find_pers_struct (Ident.name id) in
  1918.             Tmty_signature(ps.ps_sig)
  1919. !         else begin
  1920. !     raise Not_found
  1921. !   end
  1922.         end
  1923.     | Pdot(p, s, pos) ->
  1924. ***************
  1925. *** 334,338 ****
  1926.           if s = !current_unit then raise Not_found;
  1927.           let ps = find_pers_struct s in
  1928. !         (Pident(Ident.create_persistent s), ps.ps_comps)
  1929.         end
  1930.     | Ldot(l, s) ->
  1931. --- 412,416 ----
  1932.           if s = !current_unit then raise Not_found;
  1933.           let ps = find_pers_struct s in
  1934. !         (Pident ps.ps_id, ps.ps_comps)
  1935.         end
  1936.     | Ldot(l, s) ->
  1937. ***************
  1938. *** 364,368 ****
  1939.           if s = !current_unit then raise Not_found;
  1940.           let ps = find_pers_struct s in
  1941. !         (Pident(Ident.create_persistent s), Tmty_signature ps.ps_sig)
  1942.         end
  1943.     | Ldot(l, s) ->
  1944. --- 442,446 ----
  1945.           if s = !current_unit then raise Not_found;
  1946.           let ps = find_pers_struct s in
  1947. !         (Pident ps.ps_id, Tmty_signature ps.ps_sig)
  1948.         end
  1949.     | Ldot(l, s) ->
  1950. ***************
  1951. *** 783,792 ****
  1952.   let open_pers_signature name env =
  1953.     let ps = find_pers_struct name in
  1954. !   open_signature (Pident(Ident.create_persistent name)) ps.ps_sig env
  1955.  
  1956.   (* Read a signature from a file *)
  1957.  
  1958.   let read_signature modname filename =
  1959. !   let ps = read_pers_struct modname filename in ps.ps_sig
  1960.  
  1961.   (* Return the CRC of the interface of the given compilation unit *)
  1962. --- 861,881 ----
  1963.   let open_pers_signature name env =
  1964.     let ps = find_pers_struct name in
  1965. !   open_signature (Pident ps.ps_id) ps.ps_sig env
  1966.  
  1967.   (* Read a signature from a file *)
  1968.  
  1969.   let read_signature modname filename =
  1970. !   let ps = read_pers_struct modname filename PersistentStructureDependency in
  1971. !   ps.ps_sig
  1972. !
  1973. ! let read_my_signature modname filename =
  1974. !   let ps = read_pers_struct modname filename PersistentStructureDependency in
  1975. !   if ps.ps_functor_args <> !functor_args then
  1976. !     raise (Error(Inconsistent_arguments (filename, ps.ps_functor_args, !functor_args)));
  1977. !   ps.ps_sig
  1978. !
  1979. ! let read_signature_and_args modname filename =
  1980. !   let ps = read_pers_struct modname filename PersistentStructureUnit in
  1981. !   (ps.ps_sig, ps.ps_functor_args, ps.ps_functor_parts)
  1982.  
  1983.   (* Return the CRC of the interface of the given compilation unit *)
  1984. ***************
  1985. *** 813,836 ****
  1986.     try
  1987.       output_string oc cmi_magic_number;
  1988. !     output_value oc (modname, sg);
  1989. !     flush oc;
  1990. !     let crc = Digest.file filename in
  1991. !     let crcs = (modname, crc) :: imports in
  1992. !     output_value oc crcs;
  1993. !     let flags = if !Clflags.recursive_types then [Rectypes] else [] in
  1994. !     output_value oc flags;
  1995.       close_out oc;
  1996.       (* Enter signature in persistent table so that imported_unit()
  1997.          will also return its crc *)
  1998.       let comps =
  1999.         components_of_module empty Subst.identity
  2000. !         (Pident(Ident.create_persistent modname)) (Tmty_signature sg) in
  2001.       let ps =
  2002.         { ps_name = modname;
  2003.           ps_sig = sg;
  2004.           ps_comps = comps;
  2005. !         ps_crcs = crcs;
  2006.           ps_filename = filename;
  2007. !         ps_flags = flags } in
  2008.       Hashtbl.add persistent_structures modname ps;
  2009.       Consistbl.set crc_units modname crc filename
  2010. --- 902,935 ----
  2011.     try
  2012.       output_string oc cmi_magic_number;
  2013. !     let cmi = {
  2014. !       cmi_name = modname;
  2015. !       cmi_sig = sg;
  2016. !       cmi_crcs = imports;
  2017. !       cmi_functor_args = !functor_args;
  2018. !       cmi_arg_id = Ident.create modname;
  2019. !       cmi_flags = (if !Clflags.recursive_types then [Rectypes] else []);
  2020. !       cmi_functor_parts = !functor_parts;
  2021. !     } in
  2022. !     let crc = output_cmi_info oc cmi in
  2023.       close_out oc;
  2024.       (* Enter signature in persistent table so that imported_unit()
  2025.          will also return its crc *)
  2026. +     let ps_pers_id = Ident.create_persistent modname in
  2027.       let comps =
  2028.         components_of_module empty Subst.identity
  2029. !         (Pident ps_pers_id) (Tmty_signature sg) in
  2030.       let ps =
  2031.         { ps_name = modname;
  2032.           ps_sig = sg;
  2033.           ps_comps = comps;
  2034. !         ps_crcs = (modname, crc) :: cmi.cmi_crcs;
  2035. !   ps_crc = crc;
  2036.           ps_filename = filename;
  2037. !         ps_flags = cmi.cmi_flags;
  2038. !   ps_id = ps_pers_id;
  2039. !   ps_kind = PersistentStructureDependency;
  2040. !   ps_functor_args = cmi.cmi_functor_args;
  2041. !   ps_functor_parts = cmi.cmi_functor_parts;
  2042. !       } in
  2043.       Hashtbl.add persistent_structures modname ps;
  2044.       Consistbl.set crc_units modname crc filename
  2045. ***************
  2046. *** 845,848 ****
  2047. --- 944,970 ----
  2048.   (* Make the initial environment *)
  2049.  
  2050. + (* TODO Add checks: identifiers loaded for functor arguments should not conflict
  2051. + with any local identifier. This is simply done in the case of persistent modules,
  2052. + as their identifier is marked persistent. This is harder:
  2053. + - for namespaces (check !!!)
  2054. + - for these local identifiers
  2055. + *)
  2056. +
  2057. + let add_functor_arguments modname =
  2058. +   if !Clflags.functors <> [] then begin
  2059. +     add_functor_part (Ident.create_persistent modname) [];
  2060. +     functor_args := [];
  2061. +     List.iter (fun filename ->
  2062. +       let filename = Filename.chop_suffix filename ".mli" (* could be .cmi *) in
  2063. +       let modname = String.capitalize  (Filename.basename filename) in
  2064. +       let filename = filename ^ ".cmi" in
  2065. +       let ps = read_pers_struct modname filename PersistentStructureArgument in
  2066. +       functor_args := (Ident.name ps.ps_id, ps.ps_crc) :: !functor_args;
  2067. +       Hashtbl.add functor_arg_crcs (Ident.name ps.ps_id) (ps.ps_crc, filename);
  2068. +     ) !Clflags.functors
  2069. +   end
  2070. +
  2071. + let get_functor_args () = !functor_args
  2072. +
  2073.   let initial = Predef.build_initial_env add_type add_exception empty
  2074.  
  2075. ***************
  2076. *** 867,870 ****
  2077. --- 989,1000 ----
  2078.                 make inconsistent assumptions@ over interface %s@]"
  2079.         source1 source2 name
  2080. +   | Inconsistent_arguments(filename, file_functor_args, current_functor_args) ->
  2081. +     fprintf ppf
  2082. +       "@[<hov>Inconsistent functor arguments with file %s@." filename;
  2083. +     fprintf ppf "File arguments:";
  2084. +     List.iter (fun (id,_) -> fprintf ppf "(%s)" id) file_functor_args;
  2085. +     fprintf ppf "@.Current arguments:";
  2086. +     List.iter (fun (id,_) -> fprintf ppf "(%s)" id) current_functor_args;
  2087. +     fprintf ppf "@]"
  2088.     | Need_recursive_types(import, export) ->
  2089.         fprintf ppf
  2090. diff -C 2 -N -r -w ocaml-3.12.0/typing/env.mli ocaml-3.12.0+functor/typing/env.mli
  2091. *** ocaml-3.12.0/typing/env.mli 2008-10-06 15:53:54.000000000 +0200
  2092. --- ocaml-3.12.0+functor/typing/env.mli 2011-06-06 14:33:18.205858999 +0200
  2093. ***************
  2094. *** 19,24 ****
  2095. --- 19,30 ----
  2096.   type t
  2097.  
  2098. + type intf_info = string * Digest.t
  2099. +
  2100.   val empty: t
  2101.   val initial: t
  2102. + val add_functor_arguments : string -> unit
  2103. + val get_functor_args : unit -> (string * Digest.t) list
  2104. + val get_functor_parts : unit -> (string  * (string * Digest.t) list) list
  2105. + val get_functor_part : string -> Ident.t
  2106.   val diff: t -> t -> Ident.t list
  2107.  
  2108. ***************
  2109. *** 91,94 ****
  2110. --- 97,103 ----
  2111.  
  2112.   val read_signature: string -> string -> signature
  2113. + val read_my_signature: string -> string -> signature
  2114. + val read_signature_and_args: string -> string ->
  2115. +   signature * (string * Digest.t) list * (string * (string * Digest.t) list) list
  2116.           (* Arguments: module name, file name. Results: signature. *)
  2117.   val save_signature: signature -> string -> string -> unit
  2118. ***************
  2119. *** 134,137 ****
  2120. --- 143,147 ----
  2121.     | Illegal_renaming of string * string
  2122.     | Inconsistent_import of string * string * string
  2123. +   | Inconsistent_arguments of string * intf_info list * intf_info list
  2124.     | Need_recursive_types of string * string
  2125.  
  2126. diff -C 2 -N -r -w ocaml-3.12.0/typing/ident.ml ocaml-3.12.0+functor/typing/ident.ml
  2127. *** ocaml-3.12.0/typing/ident.ml    2010-01-22 13:48:24.000000000 +0100
  2128. --- ocaml-3.12.0+functor/typing/ident.ml    2011-06-06 14:33:18.205858999 +0200
  2129. ***************
  2130. *** 19,22 ****
  2131. --- 19,24 ----
  2132.   let global_flag = 1
  2133.   let predef_exn_flag = 2
  2134. + let functor_part_flag = 4
  2135. + let functor_arg_flag = 8
  2136.  
  2137.   (* A stamp of 0 denotes a persistent identifier *)
  2138. ***************
  2139. *** 43,48 ****
  2140.   let stamp i = i.stamp
  2141.  
  2142. - let unique_name i = i.name ^ "_" ^ string_of_int i.stamp
  2143. -
  2144.   let unique_toplevel_name i = i.name ^ "/" ^ string_of_int i.stamp
  2145.  
  2146. --- 45,48 ----
  2147. ***************
  2148. *** 78,81 ****
  2149. --- 78,93 ----
  2150.     (i.flags land global_flag) <> 0
  2151.  
  2152. + let make_functor_part i =
  2153. +   i.flags <- i.flags lor functor_part_flag
  2154. +
  2155. + let is_functor_part i =
  2156. +   (i.flags land functor_part_flag) <> 0
  2157. +
  2158. + let make_functor_arg i =
  2159. +   i.flags <- i.flags lor functor_arg_flag
  2160. +
  2161. + let is_functor_arg i =
  2162. +   (i.flags land functor_arg_flag) <> 0
  2163. +
  2164.   let is_predef_exn i =
  2165.     (i.flags land predef_exn_flag) <> 0
  2166. ***************
  2167. *** 83,90 ****
  2168.   let print ppf i =
  2169.     match i.stamp with
  2170. !   | 0 -> fprintf ppf "%s!" i.name
  2171.     | -1 -> fprintf ppf "%s#" i.name
  2172.     | n -> fprintf ppf "%s/%i%s" i.name n (if global i then "g" else "")
  2173.  
  2174.   type 'a tbl =
  2175.       Empty
  2176. --- 95,108 ----
  2177.   let print ppf i =
  2178.     match i.stamp with
  2179. !   | 0 -> fprintf ppf "%s!%s" i.name (if is_functor_arg i then "@" else if is_functor_part i then "$" else "")
  2180.     | -1 -> fprintf ppf "%s#" i.name
  2181.     | n -> fprintf ppf "%s/%i%s" i.name n (if global i then "g" else "")
  2182.  
  2183. +
  2184. + let unique_name i = i.name ^ "_" ^ string_of_int i.stamp ^
  2185. +   (if is_functor_arg i then "a" else "") ^
  2186. +   (if is_functor_part i then "p" else "") ^
  2187. +   (if is_functor_arg i then "g" else "")
  2188. +
  2189.   type 'a tbl =
  2190.       Empty
  2191. diff -C 2 -N -r -w ocaml-3.12.0/typing/ident.mli ocaml-3.12.0+functor/typing/ident.mli
  2192. *** ocaml-3.12.0/typing/ident.mli   2010-01-22 13:48:24.000000000 +0100
  2193. --- ocaml-3.12.0+functor/typing/ident.mli   2011-06-06 14:33:18.205858999 +0200
  2194. ***************
  2195. *** 41,44 ****
  2196. --- 41,48 ----
  2197.   val make_global: t -> unit
  2198.   val global: t -> bool
  2199. + val make_functor_part: t -> unit
  2200. + val is_functor_part: t -> bool
  2201. + val make_functor_arg: t -> unit
  2202. + val is_functor_arg: t -> bool
  2203.   val is_predef_exn: t -> bool
  2204.  
  2205. diff -C 2 -N -r -w ocaml-3.12.0/typing/printtyp.ml ocaml-3.12.0+functor/typing/printtyp.ml
  2206. *** ocaml-3.12.0/typing/printtyp.ml 2010-04-30 09:11:27.000000000 +0200
  2207. --- ocaml-3.12.0+functor/typing/printtyp.ml 2011-06-06 14:33:18.205858999 +0200
  2208. ***************
  2209. *** 36,40 ****
  2210.   let unique_names = ref Ident.empty
  2211.  
  2212. ! let ident_name id =
  2213.     try Ident.find_same id !unique_names with Not_found -> Ident.name id
  2214.  
  2215. --- 36,40 ----
  2216.   let unique_names = ref Ident.empty
  2217.  
  2218. ! let ident_name id = (* Ident.unique_name id *)
  2219.     try Ident.find_same id !unique_names with Not_found -> Ident.name id
  2220.  
  2221. diff -C 2 -N -r -w ocaml-3.12.0/typing/typemod.ml ocaml-3.12.0+functor/typing/typemod.ml
  2222. *** ocaml-3.12.0/typing/typemod.ml  2010-06-07 10:24:02.000000000 +0200
  2223. --- ocaml-3.12.0+functor/typing/typemod.ml  2011-06-06 14:39:22.775859001 +0200
  2224. ***************
  2225. *** 40,43 ****
  2226. --- 40,47 ----
  2227.     | Not_allowed_in_functor_body
  2228.     | With_need_typeconstr
  2229. +   | Inconsistent_functor_arguments of string * string
  2230. +   | No_functor_argument
  2231. +   | Functor_argument_not_found of string
  2232. +   | File_not_found of string
  2233.  
  2234.   exception Error of Location.t * error
  2235. ***************
  2236. *** 996,999 ****
  2237. --- 1000,1015 ----
  2238.     end
  2239.  
  2240. + let module_name filename =
  2241. +   String.capitalize (Misc.chop_extensions (Filename.basename filename))
  2242. +
  2243. + let print_types ppf f =
  2244. +   let filename =
  2245. +     try find_in_path !Config.load_path f
  2246. +     with Not_found -> raise(Error(Location.none, File_not_found f))
  2247. +   in
  2248. +   let (sg,_,_) = Env.read_signature_and_args (module_name filename) filename in
  2249. +   fprintf ppf "%a@." Printtyp.signature sg
  2250. +
  2251. +
  2252.   (* "Packaging" of several compilation units into one unit
  2253.      having them as sub-modules.  *)
  2254. ***************
  2255. *** 1001,1013 ****
  2256.   let rec package_signatures subst = function
  2257.       [] -> []
  2258. !   | (name, sg) :: rem ->
  2259.         let sg' = Subst.signature subst sg in
  2260. !       let oldid = Ident.create_persistent name
  2261. !       and newid = Ident.create name in
  2262.         Tsig_module(newid, Tmty_signature sg', Trec_not) ::
  2263.         package_signatures (Subst.add_module oldid (Pident newid) subst) rem
  2264.  
  2265. ! let package_units objfiles cmifile modulename =
  2266.     (* Read the signatures of the units *)
  2267.     let units =
  2268.       List.map
  2269. --- 1017,1033 ----
  2270.   let rec package_signatures subst = function
  2271.       [] -> []
  2272. !   | (name, sg, parts) :: rem ->
  2273.         let sg' = Subst.signature subst sg in
  2274. !       let oldid = Ident.create_persistent name in
  2275. !       if parts <> [] then Ident.make_functor_part oldid;
  2276. !       let newid = Ident.create name in
  2277.         Tsig_module(newid, Tmty_signature sg', Trec_not) ::
  2278.         package_signatures (Subst.add_module oldid (Pident newid) subst) rem
  2279.  
  2280. ! let package_units objfiles cmifile modulename functor_id =
  2281.     (* Read the signatures of the units *)
  2282. +   let needed_impl = ref Tbl.empty in
  2283. +   let provided_impl = ref Tbl.empty in
  2284. +   let functor_args = ref None in
  2285.     let units =
  2286.       List.map
  2287. ***************
  2288. *** 1015,1030 ****
  2289.            let pref = chop_extensions f in
  2290.            let modname = String.capitalize(Filename.basename pref) in
  2291. !          let sg = Env.read_signature modname (pref ^ ".cmi") in
  2292. !          if Filename.check_suffix f ".cmi" &&
  2293. !             not(Mtype.no_code_needed_sig Env.initial sg)
  2294. !          then raise(Error(Location.none, Implementation_is_required f));
  2295. !          (modname, Env.read_signature modname (pref ^ ".cmi")))
  2296.         objfiles in
  2297.     (* Compute signature of packaged unit *)
  2298.     Ident.reinit();
  2299. !   let sg = package_signatures Subst.identity units in
  2300.     (* See if explicit interface is provided *)
  2301.     let mlifile =
  2302.       chop_extension_if_any cmifile ^ !Config.interface_suffix in
  2303.     if Sys.file_exists mlifile then begin
  2304.       if not (Sys.file_exists cmifile) then begin
  2305. --- 1035,1107 ----
  2306.            let pref = chop_extensions f in
  2307.            let modname = String.capitalize(Filename.basename pref) in
  2308. !          let (sg, f_args, f_parts) =
  2309. !      Env.read_signature_and_args modname (pref ^ ".cmi") in
  2310. !          if Filename.check_suffix f ".cmi" then begin
  2311. !      if not(Mtype.no_code_needed_sig Env.initial sg)
  2312. !            then needed_impl := Tbl.add modname f !needed_impl
  2313. !    end else
  2314. !      provided_impl := Tbl.remove modname !provided_impl;
  2315. !
  2316. !    begin match !functor_args with
  2317. !        None -> functor_args := Some (f, f_args)
  2318. !      | Some (f1, f_args1) ->
  2319. !        if f_args1 <> f_args then
  2320. !          raise (Error(Location.none,
  2321. !               Inconsistent_functor_arguments(f1, f)));
  2322. !    end;
  2323. ! (* TODO: fix the double read of the signature in the trunk *)
  2324. !          (modname, sg, f_parts))
  2325.         objfiles in
  2326. +   Tbl.iter (fun modname f ->
  2327. +     if not (Tbl.mem modname !provided_impl) then
  2328. +       raise(Error(Location.none, Implementation_is_required f));
  2329. +     ) !needed_impl;
  2330. +   let (functor_args, functor_info) =
  2331. +     match !functor_args, functor_id with
  2332. +   None, None -> ([], None)
  2333. +       | Some (_, fargs), None -> (fargs, None)
  2334. +       | (None | Some (_, [])), Some id ->
  2335. +   raise (Error (Location.none, No_functor_argument))
  2336. +       | Some (_, (name,_) :: fargs), Some id ->
  2337. +   let newarg = Ident.create name in
  2338. +   let arg = Ident.create_persistent name in
  2339. +   Ident.make_functor_arg arg;
  2340. +   Ident.make_functor_part arg;
  2341. +   (fargs, Some (id, arg, newarg))
  2342. +   in
  2343.     (* Compute signature of packaged unit *)
  2344.     Ident.reinit();
  2345. !   let subst = Subst.identity in
  2346. !   let (subst, functor_info) = match functor_info with
  2347. !       None -> (subst, None)
  2348. !     | Some (functor_id, functor_oldarg, functor_newarg) ->
  2349. !       let subst = Subst.add_module functor_oldarg (Pident functor_newarg) subst in
  2350. !       (subst, Some (functor_id, functor_newarg))
  2351. !   in
  2352. !   let sg = package_signatures subst units in
  2353. !   let sg = match functor_info with
  2354. !       None -> sg
  2355. !     | Some (functor_id, functor_arg_id) ->
  2356. !       let functor_arg_name = Ident.name functor_arg_id in
  2357. !       let functor_arg_file =
  2358. !         try
  2359. !           find_in_path_uncap !Config.load_path (functor_arg_name ^ ".cmi")
  2360. !         with Not_found ->
  2361. !     raise (Error(Location.none, Functor_argument_not_found functor_arg_name))
  2362. !       in
  2363. ! (* TODO: check consistency of arguments ? *)
  2364. !       let (functor_arg_sg, _, _) = Env.read_signature_and_args functor_arg_name functor_arg_file
  2365. !       in
  2366. !       [
  2367. !   Tsig_module(functor_id,
  2368. !           Tmty_functor(functor_arg_id,
  2369. !                Tmty_signature functor_arg_sg,
  2370. !                Tmty_signature sg), Trec_not)
  2371. !       ]
  2372. !   in
  2373.     (* See if explicit interface is provided *)
  2374.     let mlifile =
  2375.       chop_extension_if_any cmifile ^ !Config.interface_suffix in
  2376. +   let cc =
  2377.     if Sys.file_exists mlifile then begin
  2378.       if not (Sys.file_exists cmifile) then begin
  2379. ***************
  2380. *** 1035,1039 ****
  2381.     end else begin
  2382.       (* Determine imports *)
  2383. !     let unit_names = List.map fst units in
  2384.       let imports =
  2385.         List.filter
  2386. --- 1112,1116 ----
  2387.     end else begin
  2388.       (* Determine imports *)
  2389. !     let unit_names = List.map (fun (name, _, _) -> name) units in
  2390.       let imports =
  2391.         List.filter
  2392. ***************
  2393. *** 1044,1047 ****
  2394. --- 1121,1213 ----
  2395.       Tcoerce_none
  2396.     end
  2397. +   in
  2398. +   (cc, functor_info, functor_args)
  2399. +
  2400. + let package_interfaces objfiles targetfile functor_name =
  2401. +   let objfiles =
  2402. +     List.map
  2403. +       (fun f ->
  2404. +         try find_in_path !Config.load_path f
  2405. +         with Not_found -> raise(Error(Location.none, File_not_found f)))
  2406. +       objfiles in
  2407. +   let prefix = chop_extensions targetfile in
  2408. +   let targetcmi = prefix ^ ".cmi" in
  2409. +   let targetname = String.capitalize(Filename.basename prefix) in
  2410. +   let functor_id = match functor_name with
  2411. +       None -> None
  2412. +     | Some modname -> Some (Ident.create modname) in
  2413. +   try
  2414. +
  2415. +     (* Read the signatures of the units *)
  2416. +     let functor_args = ref None in
  2417. +     let units =
  2418. +       List.map
  2419. +   (fun f ->
  2420. +           let pref = chop_extensions f in
  2421. +           let modname = String.capitalize(Filename.basename pref) in
  2422. +           let (sg, f_args, f_parts) = Env.read_signature_and_args modname f in
  2423. +     begin match !functor_args with
  2424. +         None -> functor_args := Some (f, f_args)
  2425. +       | Some (f1, f_args1) ->
  2426. +         if f_args1 <> f_args then
  2427. +       raise (Error(Location.none,
  2428. +                Inconsistent_functor_arguments(f1, f)));
  2429. +     end;
  2430. +           (modname, sg, f_parts))
  2431. +   objfiles in
  2432. +   let (functor_args, functor_info) =
  2433. +     match !functor_args, functor_id with
  2434. +   None, None -> ([], None)
  2435. +       | Some (_, fargs), None -> (fargs, None)
  2436. +       | (None | Some (_, [])), Some id ->
  2437. +   raise (Error (Location.none, No_functor_argument))
  2438. +       | Some (_, (name,_) :: fargs), Some id ->
  2439. +   let newarg = Ident.create name in
  2440. +   let arg = Ident.create_persistent name in
  2441. +   Ident.make_functor_arg arg;
  2442. +   Ident.make_functor_part arg;
  2443. +   (fargs, Some (id, arg, newarg))
  2444. +   in
  2445. +   (* Compute signature of packaged unit *)
  2446. +   Ident.reinit();
  2447. +   let subst = Subst.identity in
  2448. +   let (subst, functor_info) = match functor_info with
  2449. +       None -> (subst, None)
  2450. +     | Some (functor_id, functor_oldarg, functor_newarg) ->
  2451. +       let subst = Subst.add_module functor_oldarg (Pident functor_newarg) subst in
  2452. +       (subst, Some (functor_id, functor_newarg))
  2453. +   in
  2454. +   let sg = package_signatures subst units in
  2455. +   let sg = match functor_info with
  2456. +       None -> sg
  2457. +     | Some (functor_id, functor_arg_id) ->
  2458. +       let functor_arg_name = Ident.name functor_arg_id in
  2459. +       let functor_arg_file =
  2460. +         try
  2461. +           find_in_path_uncap !Config.load_path (functor_arg_name ^ ".cmi")
  2462. +         with Not_found ->
  2463. +     raise (Error(Location.none, Functor_argument_not_found functor_arg_name))
  2464. +       in
  2465. +       let (functor_arg_sg, _, _) = Env.read_signature_and_args functor_arg_name functor_arg_file
  2466. +       in
  2467. +       [
  2468. +   Tsig_module(functor_id,
  2469. +           Tmty_functor(functor_arg_id,
  2470. +                Tmty_signature functor_arg_sg,
  2471. +                Tmty_signature sg), Trec_not)
  2472. +       ]
  2473. +   in
  2474. +
  2475. +     (* Determine imports *)
  2476. +   let unit_names = List.map (fun (name, _, _) -> name) units in
  2477. +   let imports =
  2478. +     List.filter
  2479. +       (fun (name, crc) -> not (List.mem name unit_names))
  2480. +       (Env.imported_units()) in
  2481. +     (* Write packaged signature *)
  2482. +   Env.save_signature_with_imports sg targetname targetcmi imports
  2483. +
  2484. +   with x ->
  2485. +     remove_file targetfile; raise x
  2486.  
  2487.   (* Error report *)
  2488. ***************
  2489. *** 1107,1108 ****
  2490. --- 1273,1283 ----
  2491.         fprintf ppf
  2492.           "Only type constructors with identical parameters can be substituted."
  2493. +   | Inconsistent_functor_arguments (f1, f2) ->
  2494. +       fprintf ppf
  2495. +         "Files %s and %s make inconsistent assumptions on their arguments" f1 f2
  2496. +   | No_functor_argument ->
  2497. +       fprintf ppf "Cannot build a functor with toplevel modules"
  2498. +   | Functor_argument_not_found s ->
  2499. +       fprintf ppf "Compiled interface for functor argument %s could not be found" s
  2500. +   | File_not_found file ->
  2501. +       fprintf ppf "File %s not found" file
  2502. diff -C 2 -N -r -w ocaml-3.12.0/typing/typemod.mli ocaml-3.12.0+functor/typing/typemod.mli
  2503. *** ocaml-3.12.0/typing/typemod.mli 2010-05-18 19:18:24.000000000 +0200
  2504. --- ocaml-3.12.0+functor/typing/typemod.mli 2011-06-06 14:39:39.595859002 +0200
  2505. ***************
  2506. *** 33,38 ****
  2507.   val simplify_signature: signature -> signature
  2508.  
  2509.   val package_units:
  2510. !         string list -> string -> string -> Typedtree.module_coercion
  2511.  
  2512.   type error =
  2513. --- 33,44 ----
  2514.   val simplify_signature: signature -> signature
  2515.  
  2516. + val package_interfaces:
  2517. +   (* objfiles *) string list -> (* target *) string -> (* pack_functor *) string option -> unit
  2518. +
  2519.   val package_units:
  2520. !   string list -> string -> string -> Ident.t option ->
  2521. !     Typedtree.module_coercion * (Ident.t * Ident.t) option * (string * Digest.t) list
  2522. !
  2523. ! val print_types : formatter -> string -> unit
  2524.  
  2525.   type error =
  2526. ***************
  2527. *** 52,55 ****
  2528. --- 58,65 ----
  2529.     | Not_allowed_in_functor_body
  2530.     | With_need_typeconstr
  2531. +   | Inconsistent_functor_arguments of string * string
  2532. +   | No_functor_argument
  2533. +   | Functor_argument_not_found of string
  2534. +   | File_not_found of string
  2535.  
  2536.   exception Error of Location.t * error
  2537. diff -C 2 -N -r -w ocaml-3.12.0/utils/clflags.ml ocaml-3.12.0+functor/utils/clflags.ml
  2538. *** ocaml-3.12.0/utils/clflags.ml   2009-12-09 10:17:12.000000000 +0100
  2539. --- ocaml-3.12.0+functor/utils/clflags.ml   2011-06-06 14:33:18.215859000 +0200
  2540. ***************
  2541. *** 93,94 ****
  2542. --- 93,98 ----
  2543.   let shared = ref false (* -shared *)
  2544.   let dlcode = ref true (* not -nodynlink *)
  2545. +
  2546. +
  2547. + let pack_functor = ref None (* module name of functor *)
  2548. + let functors = ref []       (* list of interface files, used as functor argument spec *)
  2549. diff -C 2 -N -r -w ocaml-3.12.0/utils/clflags.mli ocaml-3.12.0+functor/utils/clflags.mli
  2550. *** ocaml-3.12.0/utils/clflags.mli  2009-12-09 10:17:12.000000000 +0100
  2551. --- ocaml-3.12.0+functor/utils/clflags.mli  2011-06-06 14:33:18.215859000 +0200
  2552. ***************
  2553. *** 77,78 ****
  2554. --- 77,82 ----
  2555.   val shared : bool ref
  2556.   val dlcode : bool ref
  2557. +
  2558. + val pack_functor : string option ref (* module name of functor *)
  2559. + val functors : string list ref       (* list of interface files, used as functor argument spec *)
  2560. +
  2561. diff -C 2 -N -r -w ocaml-3.12.0/utils/config.mlp ocaml-3.12.0+functor/utils/config.mlp
  2562. *** ocaml-3.12.0/utils/config.mlp   2010-05-19 13:29:38.000000000 +0200
  2563. --- ocaml-3.12.0+functor/utils/config.mlp   2011-06-06 15:31:17.035859008 +0200
  2564. ***************
  2565. *** 51,62 ****
  2566.  
  2567.   let exec_magic_number = "Caml1999X008"
  2568. ! and cmi_magic_number = "Caml1999I012"
  2569. ! and cmo_magic_number = "Caml1999O007"
  2570. ! and cma_magic_number = "Caml1999A008"
  2571. ! and cmx_magic_number = "Caml1999Y011"
  2572. ! and cmxa_magic_number = "Caml1999Z010"
  2573.   and ast_impl_magic_number = "Caml1999M013"
  2574.   and ast_intf_magic_number = "Caml1999N012"
  2575. ! and cmxs_magic_number = "Caml2007D001"
  2576.  
  2577.   let load_path = ref ([] : string list)
  2578. --- 51,62 ----
  2579.  
  2580.   let exec_magic_number = "Caml1999X008"
  2581. ! and cmi_magic_number = "Caml1999I013"
  2582. ! and cmo_magic_number = "Caml1999O008"
  2583. ! and cma_magic_number = "Caml1999A009"
  2584. ! and cmx_magic_number = "Caml1999Y012"
  2585. ! and cmxa_magic_number = "Caml1999Z011"
  2586.   and ast_impl_magic_number = "Caml1999M013"
  2587.   and ast_intf_magic_number = "Caml1999N012"
  2588. ! and cmxs_magic_number = "Caml2007D002"
  2589.  
  2590.   let load_path = ref ([] : string list)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top