Add function `parse_use_file`.

src/camlp4/uTop_camlp4.ml

@@ -45,7 +45,7 @@ let convert_camlp4_toplevel_phrase ast =
     let loc, msg = get_camlp4_error_message exn in
     UTop.Error ([loc], msg)
 
-let parse_toplevel_phrase_camlp4 str eos_is_error =
+let parse_camlp4 syntax str eos_is_error =
   (* Execute delayed actions now. *)
   Register.iter_and_take_callbacks (fun (_, f) -> f ());
   let eof = ref false in
@@ -61,12 +61,7 @@ let parse_toplevel_phrase_camlp4 str eos_is_error =
             Some str.[i])
     in
     let token_stream = Gram.filter (Gram.lex (Loc.mk UTop.input_name) char_stream) in
-    match Gram.parse_tokens_after_filter Syntax.top_phrase token_stream with
-      | Some ast ->
-          let ast = AstFilters.fold_topphrase_filters (fun t filter -> filter t) ast in
-          UTop.Value ast
-      | None ->
-          raise UTop.Need_more
+    UTop.Value (Gram.parse_tokens_after_filter syntax token_stream)
   with exn ->
     if !eof && not eos_is_error then
       raise UTop.Need_more
@@ -75,14 +70,34 @@ let parse_toplevel_phrase_camlp4 str eos_is_error =
       UTop.Error ([loc], msg)
 
 let parse_toplevel_phrase str eos_is_error =
-  match parse_toplevel_phrase_camlp4 str eos_is_error with
-    | UTop.Value ast ->
+  match parse_camlp4 Syntax.top_phrase str eos_is_error with
+    | UTop.Value None ->
+      raise UTop.Need_more
+    | UTop.Value (Some ast) ->
+        let ast = AstFilters.fold_topphrase_filters (fun t filter -> filter t) ast in
         convert_camlp4_toplevel_phrase ast
     | UTop.Error (locs, msg) ->
         UTop.Error (locs, msg)
 
+let compose f g x = f (g x)
+
+let parse_use_file str eos_is_error =
+  match parse_camlp4 Syntax.use_file str eos_is_error with
+    | UTop.Value ([], _) ->
+      raise UTop.Need_more
+    | UTop.Value (asts, _) ->
+      let astvals = List.map (compose convert_camlp4_toplevel_phrase (AstFilters.fold_topphrase_filters (fun t filter -> filter t))) asts in
+      (match List.filter (fun x -> match x with (UTop.Value y) -> false | _ -> true) astvals with
+      | [] ->
+        UTop.Value (List.map (fun (UTop.Value y) -> y) astvals)
+      | ((UTop.Error (locs,msg)::xs)) ->
+        UTop.Error (locs,msg))
+    | UTop.Error (locs, msg) ->
+        UTop.Error (locs, msg)
+
 let () =
   UTop.parse_toplevel_phrase := parse_toplevel_phrase;
+  UTop.parse_use_file := parse_use_file;
   (* Force camlp4 to display its welcome message. *)
   try
     ignore (!Toploop.parse_toplevel_phrase (Lexing.from_string ""))

src/camlp4/uTop_camlp4.mli

@@ -10,10 +10,6 @@
 val parse_toplevel_phrase : string -> bool -> Parsetree.toplevel_phrase UTop.result
   (** Toplevel phrase parser for utop using camlp4. *)
 
-val parse_toplevel_phrase_camlp4 : string -> bool -> Camlp4.PreCast.Ast.str_item UTop.result
-  (** Camlp4 toplevel phrase parser. Same as {!parse_toplevel_phrase}
-      but the result is not converted to an OCaml ast. *)
-
 val convert_camlp4_toplevel_phrase : Camlp4.PreCast.Ast.str_item -> Parsetree.toplevel_phrase UTop.result
   (** Converts a camlp4 toplevel phrase into a standard OCaml toplevel
       phrase. Note that a camlp4 ast may not be convertible to an

src/lib/uTop.ml

@@ -209,12 +209,12 @@ let mkloc loc =
   (loc.Location.loc_start.Lexing.pos_cnum,
    loc.Location.loc_end.Lexing.pos_cnum)
 
-let parse_toplevel_phrase_default str eos_is_error =
+let parse_default parse str eos_is_error =
   let eof = ref false in
   let lexbuf = lexbuf_of_string eof str in
   try
     (* Try to parse the phrase. *)
-    let phrase = Parse.toplevel_phrase lexbuf in
+    let phrase = parse lexbuf in
     Value phrase
   with
     | _ when !eof && not eos_is_error ->
@@ -240,7 +240,9 @@ let parse_toplevel_phrase_default str eos_is_error =
     | exn ->
         Error ([], "Unknown parsing error (please report it to the utop project): " ^ Printexc.to_string exn)
 
-let parse_toplevel_phrase = ref parse_toplevel_phrase_default
+let parse_toplevel_phrase = ref (parse_default Parse.toplevel_phrase)
+
+let parse_use_file = ref (parse_default Parse.use_file)
 
 (* +-----------------------------------------------------------------+
    | Safety checking                                                 |

src/lib/uTop.mli

@@ -208,6 +208,9 @@ type 'a result =
 exception Need_more
   (** Exception raised by a parser when it need more data. *)
 
+(*val parse_use_file : (string -> bool -> ((Camlp4.PreCast.Syntax.Ast.str_item list * Camlp4.PreCast.Syntax.Loc.t option) Camlp4.PreCast.Syntax.Gram.Entry.t) result) ref*)
+val parse_use_file : (string -> bool -> Parsetree.toplevel_phrase list result) ref
+
 val parse_toplevel_phrase : (string -> bool -> Parsetree.toplevel_phrase result) ref
   (** [parse_toplevel_phrase] is the function used to parse a phrase
       typed in the toplevel.
@@ -225,7 +228,7 @@ val parse_toplevel_phrase : (string -> bool -> Parsetree.toplevel_phrase result)
       Except for {!Need_more}, the function must not raise any
       exception. *)
 
-val parse_toplevel_phrase_default : string -> bool -> Parsetree.toplevel_phrase result
+val parse_default : (Lexing.lexbuf -> 'a) -> string -> bool -> 'a result
   (** The default parser. It uses the standard ocaml parser. *)
 
 val input_name : string

src/lib/uTop_main.ml

@@ -72,12 +72,12 @@ let convert_locs str locs = List.map (fun (a, b) -> (index_of_offset str a, inde
    | The read-line class                                             |
    +-----------------------------------------------------------------+ *)
 
-let parse_and_check input eos_is_error =
+let parse_and_check parse input eos_is_error =
   let buf = Buffer.create 32 in
   let result =
     UTop.collect_formatters buf [Format.err_formatter]
       (fun () ->
-         match !UTop.parse_toplevel_phrase input eos_is_error with
+         match parse input eos_is_error with
            | UTop.Error (locs, msg) ->
                UTop.Error (convert_locs input locs, "Error: " ^ msg ^ "\n")
            | UTop.Value phrase ->
@@ -113,7 +113,7 @@ class read_phrase ~term = object(self)
         (* Toploop does that: *)
         Location.reset ();
         try
-          let result = parse_and_check input false in
+          let result = parse_and_check !UTop.parse_toplevel_phrase input false in
           return_value <- Some result;
           LTerm_history.add UTop.history input;
           return result
@@ -733,7 +733,7 @@ module Emacs(M : sig end) = struct
 
   let process_input add_to_history eos_is_error =
     let input = read_data () in
-    let result, warnings = parse_and_check input eos_is_error in
+    let result, warnings = parse_and_check !UTop.parse_toplevel_phrase input eos_is_error in
     match result with
       | UTop.Value phrase -> begin
           send "accept" "";