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

cleanup and fixes

Browse Source
This commit is contained in:
cqc
2021-07-20 14:30:47 -05:00
parent 59cff7602c
commit 5ad950a8ea
2 changed files with 29 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

0
.gitmodules vendored
View File

56
bin/main.ml
View File

@ -4,34 +4,16 @@ module F = Fmt
module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
(* Store.set_exn t ~info:(info "Adding a new entry") log_file logs) *)
module Topmain = struct
open Ocaml_common
open Ocaml_toplevel
module Compenv = Ocaml_common.Compenv
let preload_objects = ref []
let prepare ppf =
Toploop.set_paths ();
try
let res =
let objects =
List.rev (!preload_objects @ !Compenv.first_objfiles)
in
List.for_all (Topdirs.load_file ppf) objects
in
Toploop.run_hooks Toploop.Startup;
res
with x ->
try Location.report_exception ppf x; false
with x ->
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
false
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]). *)
(* 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) =
@ -42,27 +24,44 @@ module Topmain = struct
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;
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@.";
ignore(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
(*done*)
let preload_objects = ref ["komm.cma"]
let init ppf =
F.epr "Topmain.init: \n";
Compenv.readenv ppf Before_args;
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
if not (prepare ppf) then raise Exit;
Toploop.set_paths ();
Load_path.add_dir "/home/cqc/.opam/default/lib/toplevel";
Load_path.add_dir "/home/cqc/p/pinephone/komm/komm/_build/default/lib/";
(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: ppf 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 "Uncaught exception: %s\n" (Printexc.to_string x));
Compmisc.init_path ();
Clflags.debug := true;
Location.formatter_for_warnings := ppf;
@ -80,8 +79,6 @@ module Topmain = struct
Location.input_phrase_buffer := Some phrase_buffer;
Sys.catch_break true;
Toploop.run_hooks Toploop.After_setup;
(*Toploop.load_ocamlinit ppf;*)
(*while true do*)
eval lb
end
@ -183,7 +180,7 @@ module Display = struct
let video_initialized = lazy (Sdl.init Sdl.Init.video)
let make_frame ?(title="komm") ~w ~h =
let make_frame ?(title="komm") ~w ~h () =
Lazy.force video_initialized >>= fun () ->
Sdl.create_window ~w ~h title
Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*))
@ -282,7 +279,6 @@ let font_sans_bold = lazy (load_font "fonts/Roboto-Bold.ttf")
let font_sans_light = lazy (load_font "fonts/Roboto-Light.ttf")
let font_emoji = lazy (load_font "fonts/NotoEmoji-Regular.ttf")
let str_of_pnt p = Printf.sprintf "(x:%0.1f y:%0.1f)" (P2.x p) (P2.y p)
let str_of_box b = Printf.sprintf "(ox:%0.1f oy:%0.1f ex%0.1f ey%0.1f)" (Box2.ox b) (Box2.oy b) (Box2.maxx b) (Box2.maxy b)
let draw_label text b =
@ -515,7 +511,9 @@ let draw_top (t:top) height (s:Display.state) =
Display.handle_keyevents s.events
(function
| `Key_up {char='\r'; mods=[Ctrl]; _} ->
Buffer.clear t.res; eval (Format.formatter_of_buffer t.res) (str_of_textedit t.te);
Buffer.clear t.res;
eval (Format.formatter_of_buffer t.res)
((str_of_textedit t.te) ^ ";;"); (*HACK to prevent getting stuck in parser*)
ignore (Lwt_main.run (Store.tree t.storeview.s >>= (fun tree ->
Store.Tree.add tree t.path (str_of_textedit t.te))));
ignore (Lwt_main.run (Store.set_exn t.storeview.s ~info:(Irmin_unix.info "executed")
@ -548,4 +546,4 @@ let draw_komm (s:Display.state) =
] {s with box = !state.box (*(Box2.v P2.o (Size2.v (float mouse_x) (float mouse_y)))*)};
(!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node))
let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900) draw_komm) ()
let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) ()