From 5ad950a8ea054ab2837897464b1ce7919655f86d Mon Sep 17 00:00:00 2001 From: cqc Date: Tue, 20 Jul 2021 14:30:47 -0500 Subject: [PATCH] cleanup and fixes --- .gitmodules | 0 bin/main.ml | 60 ++++++++++++++++++++++++++--------------------------- 2 files changed, 29 insertions(+), 31 deletions(-) delete mode 100644 .gitmodules diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index e69de29..0000000 diff --git a/bin/main.ml b/bin/main.ml index 75c8a8e..f173b78 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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; - Location.reset(); + 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) ()