delorted!
This commit is contained in:
100
bin/main.ml
100
bin/main.ml
@ -8,18 +8,8 @@ module Topmain = struct
|
|||||||
open Ocaml_common
|
open Ocaml_common
|
||||||
open Ocaml_toplevel
|
open Ocaml_toplevel
|
||||||
module Compenv = Ocaml_common.Compenv
|
module Compenv = Ocaml_common.Compenv
|
||||||
let preload_objects = ref []
|
|
||||||
let first_nonexpanded_pos = ref 0 (* Position of the first non expanded argument *)
|
|
||||||
let current = ref (!Arg.current)
|
|
||||||
let argv = ref Sys.argv
|
|
||||||
let is_expanded pos = pos < !first_nonexpanded_pos (* Test whether the option is part of a responsefile *)
|
|
||||||
let expand_position pos len =
|
|
||||||
if pos < !first_nonexpanded_pos then
|
|
||||||
first_nonexpanded_pos := !first_nonexpanded_pos + len (* Shift the position *)
|
|
||||||
else
|
|
||||||
(* New last position *)
|
|
||||||
first_nonexpanded_pos := pos + len + 2
|
|
||||||
|
|
||||||
|
let preload_objects = ref []
|
||||||
let prepare ppf =
|
let prepare ppf =
|
||||||
Toploop.set_paths ();
|
Toploop.set_paths ();
|
||||||
try
|
try
|
||||||
@ -37,70 +27,8 @@ module Topmain = struct
|
|||||||
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
|
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
|
||||||
false
|
false
|
||||||
|
|
||||||
(* If [name] is "", then the "file" is stdin treated as a script file. *)
|
let read_interactive_input = ref (fun _ _ -> 0)
|
||||||
let file_argument name =
|
let refill_lexbuf buffer len = !read_interactive_input buffer len
|
||||||
let ppf = Format.err_formatter in
|
|
||||||
if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
|
|
||||||
then preload_objects := name :: !preload_objects
|
|
||||||
else if is_expanded !current then begin
|
|
||||||
(* Script files are not allowed in expand options because otherwise the
|
|
||||||
check in override arguments may fail since the new argv can be larger
|
|
||||||
than the original argv.
|
|
||||||
*)
|
|
||||||
Printf.eprintf "For implementation reasons, the toplevel does not support\
|
|
||||||
\ having script files (here %S) inside expanded arguments passed through the\
|
|
||||||
\ -args{,0} command-line option.\n" name;
|
|
||||||
raise Exit
|
|
||||||
end else begin
|
|
||||||
let newargs = Array.sub !argv !current
|
|
||||||
(Array.length !argv - !current)
|
|
||||||
in
|
|
||||||
Compenv.readenv ppf Before_link;
|
|
||||||
Compmisc.read_clflags_from_env ();
|
|
||||||
if prepare ppf && Toploop.run_script ppf name newargs
|
|
||||||
then raise Exit
|
|
||||||
else raise Not_found
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
let wrap_expand f s =
|
|
||||||
let start = !current in
|
|
||||||
let arr = f s in
|
|
||||||
expand_position start (Array.length arr);
|
|
||||||
arr
|
|
||||||
|
|
||||||
module Options = Main_args.Make_bytetop_options (struct
|
|
||||||
include Main_args.Default.Topmain
|
|
||||||
let _stdin () = file_argument ""
|
|
||||||
let _args = wrap_expand Arg.read_arg
|
|
||||||
let _args0 = wrap_expand Arg.read_arg0
|
|
||||||
let anonymous s = file_argument s
|
|
||||||
end);;
|
|
||||||
|
|
||||||
let () =
|
|
||||||
let extra_paths =
|
|
||||||
match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
|
|
||||||
| exception Not_found -> []
|
|
||||||
| s -> Misc.split_path_contents s
|
|
||||||
in
|
|
||||||
Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
|
|
||||||
|
|
||||||
let first_line = ref true
|
|
||||||
let read_interactive_input = ref (fun _ _ -> (0, false))
|
|
||||||
let refill_lexbuf buffer _ =
|
|
||||||
let prompt =
|
|
||||||
if !Clflags.noprompt then ""
|
|
||||||
else if !first_line then "# "
|
|
||||||
else if !Clflags.nopromptcont then ""
|
|
||||||
else if Lexer.in_comment () then "* "
|
|
||||||
else " "
|
|
||||||
in
|
|
||||||
first_line := false;
|
|
||||||
let (len, eof) = !read_interactive_input prompt buffer in
|
|
||||||
(* F.epr "refill_lexbuf: %s %b \n" (Bytes.sub_string buffer 0 len) eof ; *)
|
|
||||||
if eof then Location.echo_eof ();
|
|
||||||
len
|
|
||||||
|
|
||||||
exception PPerror
|
exception PPerror
|
||||||
(* Phase buffer that stores the last toplevel phrase (see
|
(* Phase buffer that stores the last toplevel phrase (see
|
||||||
[Location.input_phrase_buffer]). *)
|
[Location.input_phrase_buffer]). *)
|
||||||
@ -108,38 +36,20 @@ module Topmain = struct
|
|||||||
type evalenv = Format.formatter -> string -> unit
|
type evalenv = Format.formatter -> string -> unit
|
||||||
let eval lb ppf (text:string) =
|
let eval lb ppf (text:string) =
|
||||||
F.epr "Topmain.eval: \n";
|
F.epr "Topmain.eval: \n";
|
||||||
read_interactive_input := (
|
read_interactive_input := (fun buffer _ ->
|
||||||
fun prompt buffer ->
|
|
||||||
F.epr "Topmain.eval: read_interactive_input \n";
|
|
||||||
F.text ppf prompt; F.flush ppf ();
|
|
||||||
let i = ref 0 in
|
|
||||||
try
|
|
||||||
(*if !i >= len then raise Exit; *)
|
|
||||||
Bytes.blit_string text 0 buffer 0 (String.length text);
|
Bytes.blit_string text 0 buffer 0 (String.length text);
|
||||||
Buffer.add_string phrase_buffer text; (* Also populate the phrase buffer as new characters are added. *)
|
Buffer.add_string phrase_buffer text; (* Also populate the phrase buffer as new characters are added. *)
|
||||||
i := (String.length text);
|
String.length text);
|
||||||
(*if c = '\n' then raise Exit;*)
|
|
||||||
(!i, true)
|
|
||||||
with
|
|
||||||
| End_of_file ->
|
|
||||||
(!i, true)
|
|
||||||
| Exit ->
|
|
||||||
(!i, false));
|
|
||||||
let snap = Btype.snapshot () in
|
let snap = Btype.snapshot () in
|
||||||
try
|
try
|
||||||
Buffer.reset phrase_buffer; (* Reset the phrase buffer, then flush the lexing buffer. *)
|
Buffer.reset phrase_buffer; (* Reset the phrase buffer, then flush the lexing buffer. *)
|
||||||
Lexing.flush_input lb;
|
Lexing.flush_input lb;
|
||||||
F.epr "eval: 1. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
|
|
||||||
Location.reset();
|
Location.reset();
|
||||||
Warnings.reset_fatal ();
|
Warnings.reset_fatal ();
|
||||||
first_line := true;
|
|
||||||
let phr = try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror in
|
let phr = try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror in
|
||||||
F.epr "eval: 2. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
|
|
||||||
let phr = Toploop.preprocess_phrase ppf phr in
|
let phr = Toploop.preprocess_phrase ppf phr in
|
||||||
Env.reset_cache_toplevel ();
|
Env.reset_cache_toplevel ();
|
||||||
F.epr "eval: 3. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
|
|
||||||
ignore(Toploop.execute_phrase true ppf phr);
|
ignore(Toploop.execute_phrase true ppf phr);
|
||||||
F.epr "eval: 4. phrase_buffer=%s\n" (Buffer.contents phrase_buffer)
|
|
||||||
with
|
with
|
||||||
| End_of_file -> F.epr "Topmain.eval End_of_file exception\n"; Btype.backtrack snap
|
| End_of_file -> F.epr "Topmain.eval End_of_file exception\n"; Btype.backtrack snap
|
||||||
| Sys.Break -> F.epr "Topmain.eval Sys.Break exception\n"; F.pf ppf "Interrupted.@."; Btype.backtrack snap
|
| Sys.Break -> F.epr "Topmain.eval Sys.Break exception\n"; F.pf ppf "Interrupted.@."; Btype.backtrack snap
|
||||||
|
|||||||
Reference in New Issue
Block a user