From 793a50281653cda08562c6653ad5c62d2b47882d Mon Sep 17 00:00:00 2001 From: cqc Date: Thu, 15 Jul 2021 20:59:51 -0500 Subject: [PATCH] delorted! --- bin/main.ml | 104 ++++------------------------------------------------ 1 file changed, 7 insertions(+), 97 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 6cfc2df..ce120ce 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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