console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

delorted!

Browse Source
This commit is contained in:
cqc
2021-07-15 20:59:51 -05:00
parent 88f734b7d9
commit 793a502816
1 changed files with 7 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
bin/main.ml
View File

@ -8,18 +8,8 @@ module Topmain = struct
open Ocaml_common
open Ocaml_toplevel
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 =
Toploop.set_paths ();
try
@ -37,70 +27,8 @@ module Topmain = struct
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
false
(* If [name] is "", then the "file" is stdin treated as a script file. *)
let file_argument name =
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
let read_interactive_input = ref (fun _ _ -> 0)
let refill_lexbuf buffer len = !read_interactive_input buffer len
exception PPerror
(* Phase buffer that stores the last toplevel phrase (see
[Location.input_phrase_buffer]). *)
@ -108,38 +36,20 @@ module Topmain = struct
type evalenv = Format.formatter -> string -> unit
let eval lb ppf (text:string) =
F.epr "Topmain.eval: \n";
read_interactive_input := (
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);
Buffer.add_string phrase_buffer text; (* Also populate the phrase buffer as new characters are added. *)
i := (String.length text);
(*if c = '\n' then raise Exit;*)
(!i, true)
with
| End_of_file ->
(!i, true)
| Exit ->
(!i, false));
read_interactive_input := (fun buffer _ ->
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. *)
String.length text);
let snap = Btype.snapshot () in
try
Buffer.reset phrase_buffer; (* Reset the phrase buffer, then flush the lexing buffer. *)
Lexing.flush_input lb;
F.epr "eval: 1. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
Location.reset();
Warnings.reset_fatal ();
first_line := true;
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
Env.reset_cache_toplevel ();
F.epr "eval: 3. phrase_buffer=%s\n" (Buffer.contents phrase_buffer);
ignore(Toploop.execute_phrase true ppf phr);
F.epr "eval: 4. phrase_buffer=%s\n" (Buffer.contents phrase_buffer)
with
| 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