diff --git a/src/camlp4/uTop_camlp4.ml b/src/camlp4/uTop_camlp4.ml index 1c72ca1..c2743e4 100644 --- a/src/camlp4/uTop_camlp4.ml +++ b/src/camlp4/uTop_camlp4.ml @@ -69,29 +69,36 @@ let parse_camlp4 syntax str eos_is_error = let loc, msg = get_camlp4_error_message exn in UTop.Error ([loc], msg) -let parse_toplevel_phrase str eos_is_error = +let parse_toplevel_phrase_camlp4 str eos_is_error = match parse_camlp4 Syntax.top_phrase str eos_is_error with | UTop.Value None -> - raise UTop.Need_more + 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.Value (AstFilters.fold_topphrase_filters (fun t filter -> filter t) ast) | UTop.Error (locs, msg) -> UTop.Error (locs, msg) -let compose f g x = f (g x) +let parse_toplevel_phrase str eos_is_error = + match parse_toplevel_phrase_camlp4 str eos_is_error with + | UTop.Value ast -> + convert_camlp4_toplevel_phrase ast + | UTop.Error (locs, msg) -> + UTop.Error (locs, msg) 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)) + let rec loop phrases = function + | [] -> UTop.Value (List.rev phrases) + | (ast::more_asts) -> + match convert_camlp4_toplevel_phrase + (AstFilters.fold_topphrase_filters (fun t filter -> filter t) ast) + with + | UTop.Value y -> loop (y::phrases) more_asts + | UTop.Error (_,_) as e -> e + in loop [] asts | UTop.Error (locs, msg) -> UTop.Error (locs, msg) diff --git a/src/camlp4/uTop_camlp4.mli b/src/camlp4/uTop_camlp4.mli index 8eeef03..4b257ef 100644 --- a/src/camlp4/uTop_camlp4.mli +++ b/src/camlp4/uTop_camlp4.mli @@ -10,6 +10,10 @@ 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 275d38e..0ad44f0 100644 --- a/src/lib/uTop.ml +++ b/src/lib/uTop.ml @@ -240,9 +240,11 @@ let parse_default parse 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_default Parse.toplevel_phrase) +let parse_toplevel_phrase_default = parse_default Parse.toplevel_phrase +let parse_toplevel_phrase = ref parse_toplevel_phrase_default -let parse_use_file = ref (parse_default Parse.use_file) +let parse_use_file_default = parse_default Parse.use_file +let parse_use_file = ref parse_use_file_default (* +-----------------------------------------------------------------+ | Safety checking | diff --git a/src/lib/uTop.mli b/src/lib/uTop.mli index f388328..59b79a3 100644 --- a/src/lib/uTop.mli +++ b/src/lib/uTop.mli @@ -211,6 +211,10 @@ exception Need_more (*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_use_file_default : string -> bool -> Parsetree.toplevel_phrase list result + (** The default parser for toplevel regions. It uses the standard + ocaml parser. *) + 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. @@ -228,6 +232,10 @@ 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 + (** The default parser for toplevel phrases. It uses the standard + ocaml parser. *) + val parse_default : (Lexing.lexbuf -> 'a) -> string -> bool -> 'a result (** The default parser. It uses the standard ocaml parser. *) diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 14cc197..30016cb 100644 --- a/src/lib/uTop_main.ml +++ b/src/lib/uTop_main.ml @@ -744,7 +744,7 @@ module Emacs(M : sig end) = struct in loop true - let process_checked_phrase phrase = begin + let process_checked_phrase phrase = (* Rewrite toplevel expressions. *) let phrase = rewrite phrase in try @@ -763,7 +763,6 @@ module Emacs(M : sig end) = struct in List.iter (send "stderr") (split_at ~trim:true '\n' msg); false - end let process_input add_to_history eos_is_error = let input = read_data () in @@ -790,7 +789,7 @@ module Emacs(M : sig end) = struct let process_input_multi () = let input = read_data () in let result, warnings = parse_input_multi input in - let typecheck = function phrase -> + let typecheck phrase = match UTop.check_phrase phrase with | None -> None | Some (locs, msg) -> Some (convert_locs input locs, msg) (* FIXME *) @@ -815,7 +814,6 @@ module Emacs(M : sig end) = struct () in loop phrases - (* FIXME: send "end" ""? *) | UTop.Error (locs, msg) -> send_error locs msg (Some warnings)