From bda692b6daeda7c5e7aa70a3dd3a41059261392b Mon Sep 17 00:00:00 2001
From: Wojciech Meyer <wojciech.meyer@gmail.com>
Date: Nov 18 2012 16:16:50 +0000
Subject: PR#5825: Add a primitive to use source file wrapped in the coresponding module.


Patch by Grégoire Henry!

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

---

diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index a7d90d9..a679f8c 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -164,8 +164,10 @@ let load_file = load_file false
 (* Load commands from a file *)
 
 let dir_use ppf name = ignore(Toploop.use_file ppf name)
+let dir_mod_use ppf name = ignore(Toploop.mod_use_file ppf name)
 
 let _ = Hashtbl.add directive_table "use" (Directive_string (dir_use std_out))
+let _ = Hashtbl.add directive_table "mod_use" (Directive_string (dir_mod_use std_out))
 
 (* Install, remove a printer *)
 
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 899ff30..8f834fd 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -102,6 +102,23 @@ let print_error = Location.print_error
 let print_warning = Location.print_warning
 let input_name = Location.input_name
 
+let parse_mod_use_file name lb =
+  let modname =
+    String.capitalize (Filename.chop_extension (Filename.basename name))
+  in
+  let items =
+    List.concat
+      (List.map
+         (function Ptop_def s -> s | Ptop_dir _ -> [])
+         (!parse_use_file lb))
+  in
+  [ Ptop_def
+      [ { pstr_desc =
+            Pstr_module ( Location.mknoloc modname ,
+                          { pmod_desc = Pmod_structure items;
+                            pmod_loc = Location.none } );
+          pstr_loc = Location.none } ] ]
+
 (* Hooks for initialization *)
 
 let toplevel_startup_hook = ref (fun () -> ())
@@ -284,7 +301,7 @@ let protect r newval body =
 
 let use_print_results = ref true
 
-let use_file ppf name =
+let use_file ppf wrap_mod name =
   try
     let (filename, ic, must_close) =
       if name = "" then
@@ -307,7 +324,10 @@ let use_file ppf name =
               if !Clflags.dump_parsetree then Printast.top_phrase ppf ph;
               if !Clflags.dump_source then Pprintast.top_phrase ppf ph;
               if not (execute_phrase !use_print_results ppf ph) then raise Exit)
-            (!parse_use_file lb);
+            (if wrap_mod then
+               parse_mod_use_file name lb
+             else
+               !parse_use_file lb);
           true
         with
         | Exit -> false
@@ -317,6 +337,9 @@ let use_file ppf name =
     success
   with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
 
+let mod_use_file ppf name = use_file ppf true name
+let use_file ppf name = use_file ppf false name
+
 let use_silently ppf name =
   protect use_print_results false (fun () -> use_file ppf name)
 
diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
index 1b51969..da607de 100644
--- a/toplevel/toploop.mli
+++ b/toplevel/toploop.mli
@@ -55,9 +55,11 @@ val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
            should be printed. Uncaught exceptions are always printed. *)
 val use_file : formatter -> string -> bool
 val use_silently : formatter -> string -> bool
+val mod_use_file : formatter -> string -> bool
         (* Read and execute commands from a file.
            [use_file] prints the types and values of the results.
-           [use_silently] does not print them. *)
+           [use_silently] does not print them.
+           [mod_use_file] wrap the file contents into a module. *)
 val eval_path: Path.t -> Obj.t
         (* Return the toplevel object referred to by the given path *)