cleanup and fixes

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
+  (* Phase buffer that stores the last toplevel phrase (see [Location.input_phrase_buffer]). *)
-   [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();
+      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) ()