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

that was quite the breakup

Browse Source
This commit is contained in:
cqc
2021-08-05 23:23:09 -05:00
parent 99c9d92ecc
commit 548bc0da64
5 changed files with 2468 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
bin/dune
View File

@ -3,12 +3,28 @@
(modes byte)
(modules main)
(link_flags (-linkall))
(libraries topinf
tsdl
tgls.tgles2
wall
zed
irmin-unix
ocaml-compiler-libs.common
ocaml-compiler-libs.bytecomp
ocaml-compiler-libs.toplevel
findlib))
(library
(name topinf)
(modes byte)
(modules topinf)
(libraries tsdl
tgls.tgles2
wall
zed
irmin-unix
compiler-libs.toplevel
findlib_top
ocaml-compiler-libs.common
ocaml-compiler-libs.toplevel))
ocaml-compiler-libs.bytecomp
ocaml-compiler-libs.toplevel
findlib))

6
bin/init.ml Normal file
View File

@ -0,0 +1,6 @@
#directory "";;
let x = 1.0;;
assert (x = 1.0)

116
bin/main.ml
View File

@ -1,118 +1,9 @@
[@@@ocaml.warning "-6-9-26-27"]
[@@@ocaml.warning "-6-9-26-27-32-34"]
open Lwt.Infix
module F = Fmt
module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String)
module Topmain = struct
open Ocaml_common
open Ocaml_toplevel
module Compenv = Ocaml_common.Compenv
let read_interactive_input = ref (fun _ _ -> 0)
exception PPerror
(* Phase buffer that stores the last toplevel phrase (see [Location.input_phrase_buffer]). *)
let phrase_buffer = Buffer.create 1024
type evalenv = Format.formatter -> string -> unit
let eval lb ppf (text : string) =
F.epr "Topmain.eval: \n";
(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
F.epr "Topmain.eval: 1 reset@.";
Buffer.reset phrase_buffer;
(* Reset the phrase buffer, then flush the lexing buffer. *)
Lexing.flush_input lb;
(* calls read_interactive_input to fill buffer again *)
Location.reset ();
Warnings.reset_fatal ();
F.epr "Topmain.eval: 2 Toploop.parse_toplevel_phrase@.";
let phr =
try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror
in
F.epr "Topmain.eval: 3 Toploop.preprocess_phrase@.";
let phr = Toploop.preprocess_phrase ppf phr in
F.epr "Topmain.eval: 4 Env.reset_cache_toplevel@.";
Env.reset_cache_toplevel ();
F.epr "Topmain.eval: 5 Toploop.execute_phrase=%b@."
(Toploop.execute_phrase true ppf phr);
F.epr "Topmain.eval: 6 handle exceptions@."
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
| PPerror ->
F.epr "Topmain.eval PPerror exception\n";
()
| x ->
F.epr "Topmain.eval unknown exception\n";
Location.report_exception ppf x;
Btype.backtrack snap
let preload_objects = ref [ (*"komm.cma"*) ]
let init ppf =
F.epr "Topmain.init: \n";
Clflags.include_dirs :=
List.rev_append [ Sys.getcwd () ] !Clflags.include_dirs;
(* Topdirs.dir_directory ((Sys.getcwd ()) ^ "/topfind");*)
let extra_paths =
match Sys.getenv "OCAML_TOPLEVEL_PATH" with
| exception Not_found -> []
| s -> Misc.split_path_contents s
in
Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs;
Compenv.readenv ppf Before_args;
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
Toploop.set_paths ();
(try
F.epr "Load_path.get_paths: @.";
List.iter (fun s -> F.epr "\t%s\n" s) (Load_path.get_paths ());
let res =
List.for_all
(fun name ->
F.epr "Topdirs.load_file: name=%s@." name;
Topdirs.load_file ppf name)
(List.rev !preload_objects @ !Compenv.first_objfiles)
in
Toploop.run_hooks Toploop.Startup;
if not res then raise Exit
with Exit as x ->
Format.fprintf ppf "Topmain.init: Uncaught exception: %s\n"
(Printexc.to_string x));
Compmisc.init_path ();
Clflags.debug := true;
Location.formatter_for_warnings := ppf;
if not !Clflags.noversion then
F.pf ppf "OCaml version %s@.@." Config.version;
(try Toploop.initialize_toplevel_env ()
with (Env.Error _ | Typetexp.Error _) as exn ->
Location.report_exception ppf exn;
raise Exit);
let lb = Lexing.from_function (fun b l -> !read_interactive_input b l) in
Location.init lb "//toplevel//";
Location.input_name := "//toplevel//";
Location.input_lexbuf := Some lb;
Location.input_phrase_buffer := Some phrase_buffer;
Sys.catch_break true;
Toploop.run_hooks Toploop.After_setup;
eval lb
end
module Display = struct
open Tgles2
open Tsdl
@ -659,7 +550,7 @@ let draw_storeview (r : storeview) height (s : Display.state) =
type top = {
te : textedit;
res : Format.symbolic_output_buffer;
mutable eval : Topmain.evalenv option;
mutable eval : Topinf.evalenv option;
path : string list;
storeview : storeview;
}
@ -708,7 +599,7 @@ let draw_top (t : top) height (s : Display.state) =
match t.eval with
| None ->
let e =
Topmain.init (Format.formatter_of_symbolic_output_buffer t.res)
Topinf.init (Format.formatter_of_symbolic_output_buffer t.res)
in
t.eval <- Some e;
e
@ -720,6 +611,7 @@ let draw_top (t : top) height (s : Display.state) =
F.epr "draw_top: previous t.res=@.";
format_symbolic_output_buffer F.stderr
(Format.flush_symbolic_output_buffer t.res);
Topinf.print_toplevel_value_bindings ();
(* HACK overwriting stdout formatter because fucking ocaml/toplevel/topdirs.ml hardcodes it *)
Format.pp_set_formatter_out_functions Format.std_formatter
(out_funs_of_sob t.res);

2427
bin/topinf.ml Normal file
View File

File diff suppressed because it is too large Load Diff

12
bin/topinf.mli Normal file
View File

@ -0,0 +1,12 @@
(* Accessors for the table of toplevel value bindings. These functions
must appear as first and second exported functions in this module.
(See module Translmod.) *)
val getvalue : string -> Obj.t
val setvalue : string -> Obj.t -> unit
val print_toplevel_value_bindings : unit -> unit
type evalenv = Format.formatter -> string -> unit
val init : Format.formatter -> evalenv