From bef8cb8fed5952ad491a1c74f8748b7efbd56b99 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Wed, 3 Apr 2013 17:53:02 +0200 Subject: [PATCH] Add function `parse_use_file`. --- src/camlp4/uTop_camlp4.ml | 33 ++++++++++++++++++++++++--------- src/camlp4/uTop_camlp4.mli | 4 ---- src/lib/uTop.ml | 8 +++++--- src/lib/uTop.mli | 5 ++++- src/lib/uTop_main.ml | 8 ++++---- 5 files changed, 37 insertions(+), 21 deletions(-) diff --git a/src/camlp4/uTop_camlp4.ml b/src/camlp4/uTop_camlp4.ml index 80be75f..1c72ca1 100644 --- a/src/camlp4/uTop_camlp4.ml +++ b/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 "")) diff --git a/src/camlp4/uTop_camlp4.mli b/src/camlp4/uTop_camlp4.mli index d0a195c..8eeef03 100644 --- a/src/camlp4/uTop_camlp4.mli +++ b/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 diff --git a/src/lib/uTop.ml b/src/lib/uTop.ml index d780f5c..275d38e 100644 --- a/src/lib/uTop.ml +++ b/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 | diff --git a/src/lib/uTop.mli b/src/lib/uTop.mli index ed8c9e3..f388328 100644 --- a/src/lib/uTop.mli +++ b/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 diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 43e3902..eceaba3 100644 --- a/src/lib/uTop_main.ml +++ b/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" "";