made a weird deck a long time ago about this kinda stuff

boot_js.ml

@@ -4,7 +4,8 @@ module NVG = Graphv_webgl
 
 let _ =
   Logs.set_reporter (Human.Logs_reporter.console_reporter ());
-  Logs.set_level (Some Debug)
+  Logs.set_level (Some Debug);
+  Logs.debug (fun m -> m "hello")
 
 module Log = (val Logs.src_log Logs.default : Logs.LOG)
 
@@ -26,8 +27,12 @@ let scale_canvas (canvas : Dom_html.canvasElement Js.t) =
   canvas##.style##.width := width;
   canvas##.style##.height := height
 
-let webgl_initialize canvas =
+let _ =
+  let canvas =
+    Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
+  in
   scale_canvas canvas;
+  let webgl_ctx =
     (* Graphv requires a stencil buffer to work properly *)
     let attrs = WebGL.defaultContextAttributes in
     attrs##.stencil := Js._true;
@@ -38,8 +43,7 @@ let webgl_initialize canvas =
         print_endline "Sorry your browser does not support WebGL";
         raise Exit
     | Some ctx -> ctx
-
+  in
-let graphv_initialize webgl_ctx =
   let open NVG in
   let vg =
     create
@@ -49,75 +53,57 @@ let graphv_initialize webgl_ctx =
   (* File in this case is actually the CSS font name *)
   Text.create vg ~name:"sans" ~file:"sans" |> ignore;
   webgl_ctx##clearColor 0.3 0.3 0.32 1.;
-  vg
 
-let request_animation_frame () =
+  (*
-  let t, s = Lwt.wait () in
+    let render ev =
-  let (_ : Dom_html.animation_frame_request_id) =
-    Dom_html.window##requestAnimationFrame
-      (Js.wrap_callback (fun (time : float) -> Lwt.wakeup s time))
-  in
-  t
-
-let render_stream canvas webgl_ctx vg
-    (render : NVG.t -> ?time:float -> Gg.p2 -> Human.I.t -> unit) :
-    Human.I.t Lwt_stream.t -> unit Lwt.t =
-  Lwt_stream.iter_n (fun i ->
-      request_animation_frame () >>= fun time ->
     webgl_ctx##clear
       (webgl_ctx##._COLOR_BUFFER_BIT_
       lor webgl_ctx##._DEPTH_BUFFER_BIT_
       lor webgl_ctx##._STENCIL_BUFFER_BIT_);
     let device_ratio = Dom_html.window##.devicePixelRatio in
-      NVG.begin_frame vg ~width:canvas##.width ~height:canvas##.height
+    begin_frame vg ~width:canvas##.width ~height:canvas##.height
       ~device_ratio;
-      NVG.Transform.scale vg ~x:device_ratio ~y:device_ratio;
+    Transform.scale vg ~x:device_ratio ~y:device_ratio;
-      render vg ~time Gg.P2.o i;
+    ignore Human.Panel.Ui.(panel vg Gg.P2.o test ev);
-      NVG.end_frame vg;
+    (*
-      Lwt.return_unit)
+    Path.begin_ vg ;
-
+    Path.rect vg ~x:40. ~y:40. ~w:320. ~h:320. ;
-open Human
+    set_fill_color vg ~color:Color.(rgba ~r:154 ~g:203 ~b:255 ~a:200) ;
-
+    fill vg ;
-let _ =
+    Transform.translate vg ~x:200. ~y:200. ;
-  let canvas =
+    Transform.rotate vg ~angle:(time *. 0.0005) ;
-    Js.Unsafe.coerce (Dom_html.getElementById_exn "canvas")
+    Text.set_font_face vg ~name:"sans" ;
+    Text.set_size vg ~size:48. ;
+    Text.set_align vg ~align:Align.(center lor middle) ;
+    set_fill_color vg ~color:Color.white ;
+    Text.text vg ~x:0. ~y:0. "Hello World!" ; *)
+    NVG.end_frame vg
   in
-  let webgl_ctx = webgl_initialize canvas in
+  Dom_html.window##requestAnimationFrame
-  let vg = graphv_initialize webgl_ctx in
+    (Js.wrap_callback (fun _ -> render Human.Event.empty))
+  |> ignore;*)
   let open Js_of_ocaml_lwt.Lwt_js_events in
-  let open Nottui in
-  let gravity_pad = Gravity.make ~h:`Negative ~v:`Negative in
-  let gravity_crop = Gravity.make ~h:`Positive ~v:`Negative in
-  let body = Lwd.var (Lwd.pure Ui.empty) in
-  let wm = Widgets.window_manager (Lwd.join (Lwd.get body)) in
-  Nav.test_populate () >>= fun test_store ->
-  let ui = Widgets.(h_node_area (test_store, [ [] ])) in
-  let root =
-    Lwd.set body
-      (Lwd.map ~f:(Ui.resize ~pad:gravity_pad ~crop:gravity_crop) ui);
-    Widgets.window_manager_view wm
-  in
-
-  let events, push_event = Lwt_stream.create () in
-  let images =
-    Human.Nottui_lwt.render vg
-      ~size:(Gg.P2.v canvas##.width canvas##.height)
-      events root
-  in
   async (fun () ->
-      render_stream canvas webgl_ctx vg
+      buffered_loop (make_event Dom_html.Event.keydown)
-        (fun vg ?(time = 0.) p i ->
+        Dom_html.document (fun ev _ ->
-          let _ = time in
+          webgl_ctx##clear
-          Log.debug (fun m ->
+            (webgl_ctx##._COLOR_BUFFER_BIT_
-              m "Drawing image: p=%a n=%a" Gg.V2.pp p
+            lor webgl_ctx##._DEPTH_BUFFER_BIT_
-                (I.Draw.pp ~attr:A.dark)
+            lor webgl_ctx##._STENCIL_BUFFER_BIT_);
-                i);
+          let device_ratio = Dom_html.window##.devicePixelRatio in
-          let p' = I.Draw.node vg A.dark p i in
+          begin_frame vg ~width:canvas##.width ~height:canvas##.height
+            ~device_ratio;
+          Transform.scale vg ~x:device_ratio ~y:device_ratio;
+          Human.Panel.Ui.(
+            render_lwt vg Gg.P2.o
+              (Human.Event_js.evt_of_jskey `Press ev))
+          >>= fun p ->
           Logs.debug (fun m ->
-              m "Drawing finished: p'=%a" Gg.V2.pp p'))
+              m "Drawing finished at point: %a" Gg.V2.pp p);
-        images);
+          NVG.end_frame vg;
-  buffered_loop (make_event Dom_html.Event.keydown) Dom_html.document
+          Lwt.return_unit))
-    (fun ev _ ->
+
-      Dom.preventDefault ev;
+(* Dom_html.document##.onkeydown
-      Lwt.return
+   := Dom.handler (fun (evt : Dom_html.keyboardEvent Js.t) ->
-      @@ push_event (Some (`Keys [ Event_js.evt_of_jskey ev ])))
+          render (Human.Event_js.evt_of_jskey `Press evt) ;
+          Js._false ) *)

doc/console.drawio

@@ -0,0 +1 @@
+<mxfile host="Electron" modified="2023-03-13T23:21:20.375Z" agent="5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/20.8.16 Chrome/106.0.5249.199 Electron/21.3.5 Safari/537.36" etag="Z2Mfk2ZBbl7WkBZ1-Pcz" version="20.8.16" type="device"><diagram name="Page-1" id="LQ51MIGZ5u8MJkVY-xBH">7Vttc9o4EP41zPQ6k4xlY2M+BpJcP+RuOpOZa/PpRtgyqJUtzogA/fUn2TK2LBFIwC9tmkyItdabtc8+u1qLgTONt3+mcLn4i4aIDGwr3A6c24FtD32bfwrBLhfYo3EumKc4zEWgFDziH0gKLSld4xCtlIqMUsLwUhUGNElQwBQZTFO6UatFlKijLuEcaYLHABJd+gWHbJFLfdcq5Z8Qni+KkYEl78SwqCwFqwUM6aYicu4GzjSllOVX8XaKiFi7Yl3ydvcH7u4nlqKEndIA3aL7+bd/bD8ef/nu3D7cpA/0SvbyDMlaPjBBjAtSFIjVgoEoJPwvu2nhSClaQhsLJATgmn8gskKiGaGwaPfxuuznQ3IF/pCLwXbFCjO05fOfLFhMuADwyxVL6Xc0pYSmXJLQhNecRJiQmggSPE94MeArgLh88oxShrnubuSNGIehGGayWWCGHpcwEGNuOFC5LKXrJERicfjTTAicIfKZrjDD1NjnQ63Cvu8FTfEPmjBYTD/ihXsYYyIgP6XrFPOObOtvxJU/kevNO0Xbg4oEe3hws0I0Rizd8So71TQ2JR7dAnWLChYdKYPSBOb7nkqU8AsJlFeAxvY01AxsjwgtrpYwUdTr/bcWAM8W5WojZ3cjwEHTWCzZpKzDr+byPynaGDurXnHLz0FRFTrAGjljpHctkMj1xQeWY/AFyIcphrYuMHrozTzX00fnuLnB2WAwFhBMZqvlftDfoiZEZiXvxTlejbAzahZ6vjXzdc1e7UcvYCRJ8MAEahy42uCYwOQQVVW48UVyETelCwWgQpAERWJY/kQELld4lg1rnclGW5VlJDl5OjkNgYGcwLAxdhqb2KkGjV76oLr6znckL9D3QYV6nqpQTZ9GdTamTV2ZUqVV/anreJYJVVQsmBwiPwo0PPA7XuCjWdSkIuyho2jCcTRV2G26fV9bdhTyWFkWacoWdE4TSO5KaQ3gZZ0HSpdSHd8QYzsJe7hmVFUW2mL2VTS/dmXpqXLndit7zgq7opDwx/1aLTxlPYzcoly2y0pFw9cgI4oiOzAiQ3r/Ahlikd6CC77SfAYBeqmipDoG0zl6sUcz0FJEIMPP6vRMuJFNP9Msetkzha/g060BL5++bFPD3n4Sb4ej1wkcD0DL/tWg5baErLMYydWcg6WBojHXELni1+gash/ZXUWe/zTpMoBfcxl6NOYYXIbdmPfu1GcU10+K/zD7jFfF1fUgwUV+ODQhwbdnToaEkjeu3SpzgCO00bidn+pBnGZcyNBWAVvvIZ9XYz5E3yqIDFe+Z5ulhxMZqwwMIo0BwHI7MCUx8rzYRbrK02r1LUuKYTI/uLM4ldRqW8RjSO8wHHYsFSquHg57Bm7zmuI2YNiadEB2DRNX4wQEiqz+MQYadxlpAD1RLjLe7znWsG01/B/p9thqrAEcTUWM/ivTcO8hXwAclSAB0DUyalUjejTe0+ivlW3dydhoMmPwU5Ctvq/L3yC2ZcUzEIaRZdKUfK/UpBW7NVr1NSMeum0a8bBLI75E2u88G345gupDqubkLGDuD36xNKAh5dNTJ/MqnL0ZzP3DJ/BOxafbCD7B+EBc1FKSAejHJa7eSURqj45tEVp9gwW6SUc2E1z23zGB0amGfwBGLYWbI80+QXv22cet/Ug9AjDq+i2C+7O4+IbePPc/i1fkPvu9sSxmWbH0jy1m8fp0mARYoGNfPO6TL76sgb5l99pD/336xvJc/20O3F0VsvU3OU1vLLtJfLxXD1Jsyo6fOLE7dSF6aNjTWOQi6Ybje5QeIunks0vnIslMW3b9PYzVbr7B0aOc3wegX3PQoHaIqrET0LxYfv0r1375HTrn7n8=</diagram></mxfile>

doc/deck_example.ml

@@ -0,0 +1,17 @@
+let rec copy_blocks buffer r w =
+  match%lwt Lwt_io.read_into r buffer 0 (Bytes.length buffer) with
+  | 0 -> Lwt.return_unit
+  | bytes_read ->
+    let%lwt () = Lwt_io.write_from_exactly w buffer 0 bytes_read in
+    copy_blocks buffer r w
+
+let run () =
+  ((let%lwt server =
+      Lwt_io.establish_server (Lwt_unix.ADDR_INET (Unix.inet_addr_any, 8765))
+        (fun (r, w) ->
+           let buffer = Bytes.create (16 * 1024) in
+           copy_blocks buffer r w)
+    in
+    Lwt.return server) : Lwt_io.server Lwt.t) |> ignore
+
+let () =  Lwt_main.run   run ();

doc/factorial.drawio

@@ -0,0 +1 @@
+<mxfile host="Electron" modified="2023-03-14T02:21:12.395Z" agent="5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/20.8.16 Chrome/106.0.5249.199 Electron/21.3.5 Safari/537.36" etag="kySTQQLOUsgllAWFhiTX" version="20.8.16" type="device"><diagram name="Page-1" id="LQ51MIGZ5u8MJkVY-xBH">7Vtbb6M4FP41kdKRWmEIhDy2Tbv70F2NNNLO9GnlgEk8dXCWOE06v35tMOFik9AkXGY6rVrhg318Od+5+BgPrPvl7o8IrhZ/UR+RgWn4u4E1HZimMwH8vyC8JQRrMkkI8wj7CQlkhC/4B5JEQ1I32EfrQkVGKWF4VSR6NAyRxwo0GEV0W6wWUFLsdQXnSCF88SBRqV+xzxYJ1bWNjP4nwvNF2jMw5JslTCtLwnoBfbrNkayHgXUfUcqSp+XuHhGxdum6JO0eK97uBxahkNVpgKbocf79H9NdTr6+WNOn2+iJXksur5Bs5IQJYpwQIU+sFvQYjTAUbEL+F9dwCO/ubhbxp7l4Sik+fhWzZG9y6Zz/NlS+z54KLdYrGGqbzKD3Mo/oJvSvPUpoNLBuxURCzMRYKljC5Yo/hLP1Ki4bOMiPWojFYAskCOCG/0NkjWIw/RsQCpms++mmNO1heA2u0gHzxU3GXJwHJ8eTT6lmYVImQztBX7AlH/sUiImziL6g+2Rq05CGvOZdgAkpkSDB85AXCQoEh1cUMcyheSvJjIqpbheYoS8r6InutlwJOS1eOyQEz2d/R+AMkc90zZePinYeRwyKcgyfShWW2PfF6O8WfBl+0JDBdOQBLzzCJSZCne/pJsKckWn8jbb7mQumaFcJUrCHPjcZiC4Ri954lbSBVJZtpmv2SNIWOT1LaVCq93zPKdMA/iCV4B0KYTqKRhyFq1iU660cnUBqSKNlNVBJ2uaouhgS/YXXFjDG1gSprHOw3eMy6Sbt2rhA774zc2xH7Z3j5hbHnZUV8TepAZJS1kv8oN2SKNCKGTquMXM1+I0BLk1mRacl+7fe4iWBsUHT2aqcXTxoXcRLGR8AoBpHPgsCV2s8i7s1LmuOZPCiM08joDFPoDn7NNHZpxIYLu6AFI+RuqC9pzjuhcryO9+VHDDglRJ1nIJEHUWeWnE2Jk1VmFKkefkV1/EsHcqJWNhyiNzAU/DA3ziei2ZBk4IwR1ZBEpaliMLUiMJqShSusuzI5zsBWaQRW9A5DSF5yKglgGd1nqiIzGJxfEeMvUnYww2jRWGhHWbfRPMbW5aec2+mO8k5LrylhZBP91u+8BxzGNtpOWsXl9KG70FGEASmp0WG9P8pMsQinYILvtJ8BB46VFGaOgajOTrIUQ+0CBHI8GtxeDrcyKafaRy/7C2FW8CnXQJeMnzZpoS9/SBOh6PTCRwroGX+atCyW0LWWRbJVpyDoYCiMdcQ2OJX6xriH8kuR09+mnQZwC25DDUaszQuw2zMe3fqM9Ln54L/0PuMdwXW5SDBRq4/0iHBNWdWjITMbtzYecsBjpiNxvW8rgexmnEhI7MI2DKHZFyN+RB1qyByYln+riqVsY7BIPZ5AKx2A10aI8mkXYRVkogrb1kiDMN55c6irlEr7RGPIb3DcNgyilCx1XDY0dg2pynbBjRbkw6MXcOGq3EDBNIzi2MWaNJlpAHUYwCRI//IsYZpFsP/saqPrcYawFJElB1dfIR8ASgZSABUiYxblYgajfc0+mtlW1cbG01mDH4KY6vu63InN22p8gz4fmDoxCWPl5pU5bJtdVVNNtvU5FGXmnyJ3N95inw4jOpDvqZ2KjBxCr9YLlCT9+mpp3kXzk4Gc//wCZy6+LQbwSdwKoKjljINQP1q4vpjhKWT8bFtQqunWKCblGQzAWb//RIY19X7ChS1FHKOFfUE7alnL7f3xc8Axl2fJNg/i4dv6PS5/5m8NP/Z781lOsqcpn9qMZPXpw9KgAE69sWTPvniyyroKZvXHvrv+vvKc/23Pm63i5Atn+Y0va/sJu/xUT1Iuic7/tWJ2akLUUPDnsYiF8k2HN+j9BBJtb9fOhdJerNlls9ijHbTDZYa5fz+CPo9Hxu4xe/aO/4K2lLPNqtuoQ2TC13JdTB2tS+kd7ji1pobauULFcP4dtgwdz0s5lWnaZkkL5UNwc3JLORdtOEwfxvtZG4nk+LLb+12OVTu2l01O4B67K8aMB8f7xJfKarN3+kzdPblhJ0YL2Y3aBP3kl1Dth7+Bw==</diagram></mxfile>

dune

@@ -1,50 +1,20 @@
 (env
  (dev (flags (:standard -warn-error -A))
-  (js_of_ocaml (flags :standard)
+  (js_of_ocaml (flags --no-inline --pretty --source-map-inline --debug-info)
-   (build_runtime_flags :standard --no-inline --debug-info)
+   (build_runtime_flags --no-inline --pretty --source-map-inline --debug-info)
-   (compilation_mode whole_program)
+   (link_flags --source-map-inline))))
-   (link_flags :standard))))
-
-(library
- (name log_js)
-  (modes byte)
- (preprocess (pps js_of_ocaml-ppx))
- (flags (:standard -rectypes -linkall))
- (modules log_js)
- (libraries
-   logs))
-
-(library
- (name graphast)
- (modes byte)
- (kind ppx_rewriter)
- (modules graphast)
- (libraries
-   logs
-   ppxlib
-   fmt
-   lwt
-   ))
-
-(executable
- (name ppx_graph)
- (modes byte)
- (modules ppx_graph)
- (libraries
- graphast))
 
 (executable
  (name boot_js)
  (modes byte js)
  (preprocess (pps js_of_ocaml-ppx)) 
- (flags (:standard -rectypes -linkall))
+
  (modules boot_js human)
  (libraries
    fmt
+   logs
    graphv_webgl
    js_of_ocaml-lwt
-   js_of_ocaml-compiler
-   js_of_ocaml-toplevel
    digestif.ocaml
    checkseum.ocaml
    irmin.mem
@@ -53,131 +23,8 @@
    cohttp-lwt-jsoo
    mimic
    uri
+   zed
    gg
    lwd
-   log_js))
+))
 
-(rule
- (targets test_dynlink.cmo test_dynlink.cmi)
- (action
-  (run ocamlc -c %{dep:test_dynlink.ml})))
-
-(rule
- (targets test_dynlink.js)
- (action
-  (run %{bin:js_of_ocaml} --pretty --toplevel %{dep:test_dynlink.cmo})))
-
-(rule
- (targets embedded_fs.js)
- (action
-  (run %{bin:jsoo_fs}
-    ; lol hack?
-    -I .
-    -o %{targets}
-    %{dep:examples.ml}
-    %{dep:test_dynlink.js})))
-
-(rule
- (targets export.txt)
- (deps
-  (package js_of_ocaml-ppx)
-  (package js_of_ocaml)
-  (package js_of_ocaml-compiler)
-  (package js_of_ocaml-lwt)
-  (package js_of_ocaml-tyxml)
-  (package js_of_ocaml-toplevel))
- (action
-  (run
-    jsoo_listunits
-    -o %{targets}
-    stdlib
-    graphics
-    str
-    dynlink
-    dynlink
-    js_of_ocaml
-    js_of_ocaml-lwt
-    js_of_ocaml-tyxml
-    js_of_ocaml-toplevel
-    js_of_ocaml-compiler
-    js_of_ocaml-compiler.runtime
-    js_of_ocaml-lwt.graphics
-    js_of_ocaml-ppx.as-lib
-    js_of_ocaml.deriving
-    lwt
-    tyxml.functor
-    tyxml.functor:html_types.cmi
-    react
-    reactiveData
-    ppxlib)))
-
-(executables
- (names toplevel)
- (modules toplevel)
- (flags
-  (:standard -rectypes -linkall))
- (modes js)
- (js_of_ocaml
-  (flags
-   compile
-   --pretty
-   --Werror
-   --target-env browser
-   --export %{dep:export.txt}
-   --toplevel
-   --disable shortvar
-   +toplevel.js
-   +dynlink.js
-   %{dep:embedded_fs.js}))
- (preprocess
-  (pps js_of_ocaml-ppx ppxlib.metaquot))
- (libraries
-   fmt
-   js_of_ocaml-compiler
-   js_of_ocaml-tyxml
-   js_of_ocaml-toplevel
-   lwt
-   js_of_ocaml-lwt
-   ;; not used directly
-   graphics
-   js_of_ocaml.deriving
-   js_of_ocaml-lwt.graphics
-   js_of_ocaml-ppx.as-lib
-   compiler-libs
-   compiler-libs.common
-   compiler-libs.bytecomp
-   js_of_ocaml-compiler.runtime
-   ocp-indent.lib
-   react
-   reactiveData
-   str
-   log_js
-   ppxlib))
-
-; (rule
-;  (targets toplevel.js)
-;  (deps examples.ml)
-;  (action
-;   (run
-;    %{bin:js_of_ocaml}
-;    compile
-;    --pretty
-;    --Werror
-;    --target-env
-;    browser
-;    --extern-fs
-;    "--file=%{dep:examples.ml}"
-;    --export
-;    %{dep:export.txt}
-;    --toplevel
-;    --disable
-;    shortvar
-;    +toplevel.js
-;    +dynlink.js
-;    %{dep:toplevel.bc}
-;    -o
-;    %{targets})))
-
-(alias
-  (name default)
-  (deps toplevel.bc.js index.html toplevel.html))

graphast.ml

@@ -1,997 +0,0 @@
-(* graph typed abstract syntax tree:
-
-   couple options for hooking into compilation:
-   - modify ocaml source
-   - reimplement toplevel functions to allow extracting tast
-     * needs multiple implementaitons for byte and js
-     * only accepts toplevel phrases
-   - ppx
-     * only gets ast, would need to parse for tast (could use merlin or ocamlcommon?)
-   - merlin
-     * need to understand protocol and whether current lib interfaces give enough control
-*)
-
-open Ppxlib
-open Lwt
-module F = Fmt
-module Log = Logs
-
-module Printast = struct
-  include Ocaml_common.Printast
-  open Asttypes
-  open Format
-  open Lexing
-  open Location
-  open Parsetree
-
-  let fmt_position with_name f l =
-    let fname = if with_name then l.pos_fname else "" in
-    if l.pos_lnum = -1 then fprintf f "%s[%d]" fname l.pos_cnum
-    else
-      fprintf f "%s[%d,%d+%d]" fname l.pos_lnum l.pos_bol
-        (l.pos_cnum - l.pos_bol)
-
-  let fmt_location f loc =
-    if not !Ocaml_common.Clflags.locations then ()
-    else
-      let p_2nd_name =
-        loc.loc_start.pos_fname <> loc.loc_end.pos_fname
-      in
-      fprintf f "(%a..%a)" (fmt_position true) loc.loc_start
-        (fmt_position p_2nd_name)
-        loc.loc_end;
-      if loc.loc_ghost then fprintf f " ghost"
-
-  let rec fmt_longident_aux f x =
-    match x with
-    | Longident.Lident s -> fprintf f "%s" s
-    | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s
-    | Longident.Lapply (y, z) ->
-        fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
-
-  let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x
-
-  let fmt_longident_loc f (x : Longident.t loc) =
-    fprintf f "%a" fmt_longident_aux x.txt
-
-  let fmt_string_loc f (x : string loc) = fprintf f "\"%s\"@ " x.txt
-
-  let fmt_str_opt_loc f (x : string option loc) =
-    fprintf f "\"%s\"@ " (Option.value x.txt ~default:"_")
-
-  let fmt_char_option f = function
-    | None -> fprintf f ""
-    | Some c -> fprintf f "%c" c
-
-  let fmt_constant f x =
-    match x with
-    | Pconst_integer (i, m) -> fprintf f "%s%a" i fmt_char_option m
-    | Pconst_char c -> fprintf f "'%02x'" (Char.code c)
-    | Pconst_string (s, _strloc, None) -> fprintf f "%S" s
-    | Pconst_string (s, _strloc, Some delim) ->
-        fprintf f "%S(%S)" s delim
-    | Pconst_float (s, _) -> fprintf f "%s" s
-
-  let str_longident_loc = F.to_to_string fmt_longident_loc
-  let str_constant = F.to_to_string fmt_constant
-
-  let fmt_mutable_flag f x =
-    match x with
-    | Immutable -> fprintf f "Immutable"
-    | Mutable -> fprintf f "Mutable"
-
-  let fmt_virtual_flag f x =
-    match x with
-    | Virtual -> fprintf f "Virtual"
-    | Concrete -> fprintf f "Concrete"
-
-  let fmt_override_flag f x =
-    match x with
-    | Override -> fprintf f "Override"
-    | Fresh -> fprintf f "Fresh"
-
-  let fmt_closed_flag f x =
-    match x with
-    | Closed -> fprintf f "Closed"
-    | Open -> fprintf f "Open"
-
-  let fmt_rec_flag f x =
-    match x with
-    | Nonrecursive -> fprintf f ""
-    | Recursive -> fprintf f "Rec "
-
-  let fmt_direction_flag f x =
-    match x with Upto -> fprintf f "Up" | Downto -> fprintf f "Down"
-
-  let fmt_private_flag f x =
-    match x with
-    | Public -> fprintf f "Public"
-    | Private -> fprintf f "Private"
-
-  let line = F.pf
-
-  let list f ppf l =
-    F.pf ppf "%a" (F.brackets @@ F.list ~sep:F.semi f) l
-
-  let option f = F.option ~none:(fun ppf () -> F.pf ppf "None") f
-  let longident_loc ppf li = line ppf "%a@ " fmt_longident_loc li
-  let string ppf s = line ppf "\"%s\"@ " s
-  let string_loc ppf s = line ppf "%a@ " fmt_string_loc s
-  let str_opt_loc ppf s = line ppf "%a@ " fmt_str_opt_loc s
-
-  let arg_label ppf = function
-    | Nolabel -> fprintf ppf "" (* "Nolabel\n" *)
-    | Optional s -> fprintf ppf "?:%s@ " s
-    | Labelled s -> fprintf ppf "~:%s@ " s
-
-  let rec core_type ppf x =
-    attributes ppf x.ptyp_attributes;
-    match x.ptyp_desc with
-    | Ptyp_any -> line ppf "Ptyp_any@ "
-    | Ptyp_var s -> line ppf "Ptyp_var %s@ " s
-    | Ptyp_arrow (l, ct1, ct2) ->
-        line ppf "Ptyp_arrow@ ";
-        arg_label ppf l;
-        core_type ppf ct1;
-        core_type ppf ct2
-    | Ptyp_tuple l ->
-        line ppf "Ptyp_tuple@ ";
-        list core_type ppf l
-    | Ptyp_constr (li, l) ->
-        line ppf "Ptyp_constr %a@ " fmt_longident_loc li;
-        list core_type ppf l
-    | Ptyp_variant (l, closed, low) ->
-        line ppf "Ptyp_variant closed=%a@ " fmt_closed_flag closed;
-        list label_x_bool_x_core_type_list ppf l;
-        option (list string) ppf low
-    | Ptyp_object (l, c) ->
-        line ppf "Ptyp_object %a@ " fmt_closed_flag c;
-        List.iter
-          (fun field ->
-            match field.pof_desc with
-            | Otag (l, t) ->
-                line ppf "method %s@ " l.txt;
-                attributes ppf field.pof_attributes;
-                core_type ppf t
-            | Oinherit ct ->
-                line ppf "Oinherit@ ";
-                core_type ppf ct)
-          l
-    | Ptyp_class (li, l) ->
-        line ppf "Ptyp_class %a@ " fmt_longident_loc li;
-        list core_type ppf l
-    | Ptyp_alias (ct, s) ->
-        line ppf "Ptyp_alias \"%s\"@ " s;
-        core_type ppf ct
-    | Ptyp_poly (sl, ct) ->
-        line ppf "Ptyp_poly%a@ "
-          (fun ppf ->
-            List.iter (fun x ->
-                fprintf ppf " %a" Ocaml_common.Pprintast.tyvar x.txt))
-          sl;
-        core_type ppf ct
-    | Ptyp_package (s, l) ->
-        line ppf "Ptyp_package %a@ " fmt_longident_loc s;
-        list package_with ppf l
-    | Ptyp_extension (s, arg) ->
-        line ppf "Ptyp_extension \"%s\"@ " s.txt;
-        payload ppf arg
-
-  and package_with ppf (s, t) =
-    line ppf "with type %a@ " fmt_longident_loc s;
-    core_type ppf t
-
-  and pattern ppf x =
-    (* line i ppf "pattern %a@ " fmt_location x.ppat_loc; *)
-    attributes ppf x.ppat_attributes;
-    match x.ppat_desc with
-    | Ppat_any -> line ppf "Ppat_any@ "
-    | Ppat_var s -> line ppf "<var> %a@ " fmt_string_loc s
-    | Ppat_alias (p, s) ->
-        line ppf "Ppat_alias %a@ " fmt_string_loc s;
-        pattern ppf p
-    | Ppat_constant c -> line ppf "Ppat %a@ " fmt_constant c
-    | Ppat_interval (c1, c2) ->
-        line ppf "Ppat_interval %a..%a@ " fmt_constant c1 fmt_constant
-          c2
-    | Ppat_tuple l ->
-        line ppf "Ppat_tuple@ ";
-        list pattern ppf l
-    | Ppat_construct (li, po) ->
-        line ppf "Ppat_construct %a@ " fmt_longident_loc li;
-        option pattern ppf (Option.map snd po)
-    | Ppat_variant (l, po) ->
-        line ppf "Ppat_variant \"%s\"@ " l;
-        option pattern ppf po
-    | Ppat_record (l, c) ->
-        line ppf "Ppat_record %a@ " fmt_closed_flag c;
-        list longident_x_pattern ppf l
-    | Ppat_array l ->
-        line ppf "Ppat_array@ ";
-        list pattern ppf l
-    | Ppat_or (p1, p2) ->
-        line ppf "Ppat_or@ ";
-        pattern ppf p1;
-        pattern ppf p2
-    | Ppat_lazy p ->
-        line ppf "Ppat_lazy@ ";
-        pattern ppf p
-    | Ppat_constraint (p, ct) ->
-        line ppf "Ppat_constraint@ ";
-        pattern ppf p;
-        core_type ppf ct
-    | Ppat_type li ->
-        line ppf "Ppat_type@ ";
-        longident_loc ppf li
-    | Ppat_unpack s -> line ppf "Ppat_unpack %a@ " fmt_str_opt_loc s
-    | Ppat_exception p ->
-        line ppf "Ppat_exception@ ";
-        pattern ppf p
-    | Ppat_open (m, p) ->
-        line ppf "Ppat_open \"%a\"@ " fmt_longident_loc m;
-        pattern ppf p
-    | Ppat_extension (s, arg) ->
-        line ppf "Ppat_extension \"%s\"@ " s.txt;
-        payload ppf arg
-
-  and expression ppf x : unit =
-    (* line ppf "expression %a@ " fmt_location x.pexp_loc; *)
-    attributes ppf x.pexp_attributes;
-
-    match x.pexp_desc with
-    | Pexp_ident _li ->
-        (* line ppf "Pexp_ident %a@ " fmt_longident_loc li; *)
-        (* str_longident_loc li *)
-        ()
-    | Pexp_constant _c ->
-        (*line ppf "Pexp %a@ " fmt_constant c;*)
-        (* str_constant c *)
-        ()
-    | Pexp_let (rf, l, e) ->
-        line ppf "Pexp_let %a@ " fmt_rec_flag rf;
-        list value_binding ppf l;
-        expression ppf e
-    | Pexp_function _l ->
-        line ppf "Pexp_function@ " (* ; list case ppf l *)
-    | Pexp_fun (l, eo, p, e) ->
-        line ppf "Pexp_fun@ ";
-        arg_label ppf l;
-        F.option (fun ppf -> F.pf ppf "=%a" expression) ppf eo;
-        F.pf ppf "%a@ ->@ %a" pattern p expression e
-    | Pexp_apply (e, l) ->
-        line ppf "Pexp_apply@ ";
-        expression ppf e;
-        let name = Pprintast.string_of_expression x in
-        list (graph_node name) ppf l
-    | Pexp_match (e, l) ->
-        line ppf "Pexp_match@ ";
-        expression ppf e;
-        list case ppf l
-    | Pexp_try (e, l) ->
-        line ppf "Pexp_try@ ";
-        expression ppf e;
-        list case ppf l
-    | Pexp_tuple l ->
-        line ppf "Pexp_tuple@ ";
-        list expression ppf l
-    | Pexp_construct (li, eo) ->
-        line ppf "Pexp_construct %a@ " fmt_longident_loc li;
-        option expression ppf eo
-    | Pexp_variant (l, eo) ->
-        line ppf "Pexp_variant \"%s\"@ " l;
-        option expression ppf eo
-    | Pexp_record (l, eo) ->
-        line ppf "Pexp_record@ ";
-        list longident_x_expression ppf l;
-        option expression ppf eo
-    | Pexp_field (e, li) ->
-        line ppf "Pexp_field@ ";
-        expression ppf e;
-        longident_loc ppf li
-    | Pexp_setfield (e1, li, e2) ->
-        line ppf "Pexp_setfield@ ";
-        expression ppf e1;
-        longident_loc ppf li;
-        expression ppf e2
-    | Pexp_array l ->
-        line ppf "Pexp_array@ ";
-        list expression ppf l
-    | Pexp_ifthenelse (e1, e2, eo) ->
-        line ppf "Pexp_if@ ";
-        expression ppf e1;
-        line ppf "Pexp_then@ ";
-        expression ppf e2;
-        F.option
-          (fun ppf ->
-            line ppf "Pexp_else@ ";
-            expression ppf)
-          ppf eo
-    | Pexp_sequence (e1, e2) ->
-        line ppf "Pexp_sequence@ ";
-        expression ppf e1;
-        expression ppf e2
-    | Pexp_while (e1, e2) ->
-        line ppf "Pexp_while@ ";
-        expression ppf e1;
-        expression ppf e2
-    | Pexp_for (p, e1, e2, df, e3) ->
-        line ppf "Pexp_for %a@ " fmt_direction_flag df;
-        pattern ppf p;
-        expression ppf e1;
-        expression ppf e2;
-        expression ppf e3
-    | Pexp_constraint (e, ct) ->
-        line ppf "Pexp_constraint@ ";
-        expression ppf e;
-        core_type ppf ct
-    | Pexp_coerce (e, cto1, cto2) ->
-        line ppf "Pexp_coerce@ ";
-        expression ppf e;
-        option core_type ppf cto1;
-        core_type ppf cto2
-    | Pexp_send (e, s) ->
-        line ppf "Pexp_send \"%s\"@ " s.txt;
-        expression ppf e
-    | Pexp_new li -> line ppf "Pexp_new %a@ " fmt_longident_loc li
-    | Pexp_setinstvar (s, e) ->
-        line ppf "Pexp_setinstvar %a@ " fmt_string_loc s;
-        expression ppf e
-    | Pexp_override l ->
-        line ppf "Pexp_override@ ";
-        list string_x_expression ppf l
-    | Pexp_letmodule (s, me, e) ->
-        line ppf "Pexp_letmodule %a@ " fmt_str_opt_loc s;
-        module_expr ppf me;
-        expression ppf e
-    | Pexp_letexception (cd, e) ->
-        line ppf "Pexp_letexception@ ";
-        extension_constructor ppf cd;
-        expression ppf e
-    | Pexp_assert e ->
-        line ppf "Pexp_assert@ ";
-        expression ppf e
-    | Pexp_lazy e ->
-        line ppf "Pexp_lazy@ ";
-        expression ppf e
-    | Pexp_poly (e, cto) ->
-        line ppf "Pexp_poly@ ";
-        expression ppf e;
-        option core_type ppf cto
-    | Pexp_object s ->
-        line ppf "Pexp_object@ ";
-        class_structure ppf s
-    | Pexp_newtype (s, e) ->
-        line ppf "Pexp_newtype \"%s\"@ " s.txt;
-        expression ppf e
-    | Pexp_pack me ->
-        line ppf "Pexp_pack@ ";
-        module_expr ppf me
-    | Pexp_open (o, e) ->
-        line ppf "Pexp_open %a@ " fmt_override_flag o.popen_override;
-        module_expr ppf o.popen_expr;
-        expression ppf e
-    | Pexp_letop { let_; ands; body } ->
-        line ppf "Pexp_letop@ ";
-        binding_op ppf let_;
-        list binding_op ppf ands;
-        expression ppf body
-    | Pexp_extension (s, arg) ->
-        line ppf "Pexp_extension \"%s\"@ " s.txt;
-        payload ppf arg
-    | Pexp_unreachable -> line ppf "Pexp_unreachable"
-
-  and value_description ppf x =
-    line ppf "value_description %a %a@ " fmt_string_loc x.pval_name
-      fmt_location x.pval_loc;
-    attributes ppf x.pval_attributes;
-    core_type ppf x.pval_type;
-    list string ppf x.pval_prim
-
-  and type_parameter ppf (x, _variance) = core_type ppf x
-
-  and type_declaration ppf x =
-    line ppf "type_declaration %a %a@ " fmt_string_loc x.ptype_name
-      fmt_location x.ptype_loc;
-    attributes ppf x.ptype_attributes;
-
-    line ppf "ptype_params =@ ";
-    list type_parameter ppf x.ptype_params;
-    line ppf "ptype_cstrs =@ ";
-    list core_type_x_core_type_x_location ppf x.ptype_cstrs;
-    line ppf "ptype_kind =@ ";
-    type_kind ppf x.ptype_kind;
-    line ppf "ptype_private = %a@ " fmt_private_flag x.ptype_private;
-    line ppf "ptype_manifest =@ ";
-    option core_type ppf x.ptype_manifest
-
-  and attribute ppf k a =
-    line ppf "%s \"%s\"@ " k a.attr_name.txt;
-    payload ppf a.attr_payload
-
-  and attributes ppf l =
-    List.iter
-      (fun a ->
-        line ppf "attribute \"%s\"@ " a.attr_name.txt;
-        payload ppf a.attr_payload)
-      l
-
-  and payload ppf = function
-    | PStr x -> structure ppf x
-    | PSig x -> signature ppf x
-    | PTyp x -> core_type ppf x
-    | PPat (x, None) -> pattern ppf x
-    | PPat (x, Some g) ->
-        pattern ppf x;
-        line ppf "<when>@ ";
-        expression ppf g
-
-  and type_kind ppf x =
-    match x with
-    | Ptype_abstract -> line ppf "Ptype_abstract@ "
-    | Ptype_variant l ->
-        line ppf "Ptype_variant@ ";
-        list constructor_decl ppf l
-    | Ptype_record l ->
-        line ppf "Ptype_record@ ";
-        list label_decl ppf l
-    | Ptype_open -> line ppf "Ptype_open@ "
-
-  and type_extension ppf x =
-    line ppf "type_extension@ ";
-    attributes ppf x.ptyext_attributes;
-
-    line ppf "ptyext_path = %a@ " fmt_longident_loc x.ptyext_path;
-    line ppf "ptyext_params =@ ";
-    list type_parameter ppf x.ptyext_params;
-    line ppf "ptyext_constructors =@ ";
-    list extension_constructor ppf x.ptyext_constructors;
-    line ppf "ptyext_private = %a@ " fmt_private_flag x.ptyext_private
-
-  and type_exception ppf x =
-    line ppf "type_exception@ ";
-    attributes ppf x.ptyexn_attributes;
-    line ppf "ptyext_constructor =@ ";
-
-    extension_constructor ppf x.ptyexn_constructor
-
-  and extension_constructor ppf x =
-    line ppf "extension_constructor %a@ " fmt_location x.pext_loc;
-    attributes ppf x.pext_attributes;
-
-    line ppf "pext_name = \"%s\"@ " x.pext_name.txt;
-    line ppf "pext_kind =@ ";
-    extension_constructor_kind ppf x.pext_kind
-
-  and extension_constructor_kind ppf x =
-    match x with
-    | Pext_decl (_, a, r) ->
-        line ppf "Pext_decl@ ";
-        constructor_arguments ppf a;
-        option core_type ppf r
-    | Pext_rebind li ->
-        line ppf "Pext_rebind@ ";
-        line ppf "%a@ " fmt_longident_loc li
-
-  and class_type ppf x =
-    line ppf "class_type %a@ " fmt_location x.pcty_loc;
-    attributes ppf x.pcty_attributes;
-
-    match x.pcty_desc with
-    | Pcty_constr (li, l) ->
-        line ppf "Pcty_constr %a@ " fmt_longident_loc li;
-        list core_type ppf l
-    | Pcty_signature cs ->
-        line ppf "Pcty_signature@ ";
-        class_signature ppf cs
-    | Pcty_arrow (l, co, cl) ->
-        line ppf "Pcty_arrow@ ";
-        arg_label ppf l;
-        core_type ppf co;
-        class_type ppf cl
-    | Pcty_extension (s, arg) ->
-        line ppf "Pcty_extension \"%s\"@ " s.txt;
-        payload ppf arg
-    | Pcty_open (o, e) ->
-        line ppf "Pcty_open %a %a@ " fmt_override_flag
-          o.popen_override fmt_longident_loc o.popen_expr;
-        class_type ppf e
-
-  and class_signature ppf cs =
-    line ppf "class_signature@ ";
-    core_type ppf cs.pcsig_self;
-    list class_type_field ppf cs.pcsig_fields
-
-  and class_type_field ppf x =
-    line ppf "class_type_field %a@ " fmt_location x.pctf_loc;
-    attributes ppf x.pctf_attributes;
-    match x.pctf_desc with
-    | Pctf_inherit ct ->
-        line ppf "Pctf_inherit@ ";
-        class_type ppf ct
-    | Pctf_val (s, mf, vf, ct) ->
-        line ppf "Pctf_val \"%s\" %a %a@ " s.txt fmt_mutable_flag mf
-          fmt_virtual_flag vf;
-        core_type ppf ct
-    | Pctf_method (s, pf, vf, ct) ->
-        line ppf "Pctf_method \"%s\" %a %a@ " s.txt fmt_private_flag
-          pf fmt_virtual_flag vf;
-        core_type ppf ct
-    | Pctf_constraint (ct1, ct2) ->
-        line ppf "Pctf_constraint@ ";
-        core_type ppf ct1;
-        core_type ppf ct2
-    | Pctf_attribute a -> attribute ppf "Pctf_attribute" a
-    | Pctf_extension (s, arg) ->
-        line ppf "Pctf_extension \"%s\"@ " s.txt;
-        payload ppf arg
-
-  and class_description ppf x =
-    line ppf "class_description %a@ " fmt_location x.pci_loc;
-    attributes ppf x.pci_attributes;
-
-    line ppf "pci_virt = %a@ " fmt_virtual_flag x.pci_virt;
-    line ppf "pci_params =@ ";
-    list type_parameter ppf x.pci_params;
-    line ppf "pci_name = %a@ " fmt_string_loc x.pci_name;
-    line ppf "pci_expr =@ ";
-    class_type ppf x.pci_expr
-
-  and class_type_declaration ppf x =
-    line ppf "class_type_declaration %a@ " fmt_location x.pci_loc;
-    attributes ppf x.pci_attributes;
-    line ppf "pci_virt = %a@ " fmt_virtual_flag x.pci_virt;
-    line ppf "pci_params =@ ";
-    list type_parameter ppf x.pci_params;
-    line ppf "pci_name = %a@ " fmt_string_loc x.pci_name;
-    line ppf "pci_expr =@ ";
-    class_type ppf x.pci_expr
-
-  and class_expr ppf x =
-    line ppf "class_expr %a@ " fmt_location x.pcl_loc;
-    attributes ppf x.pcl_attributes;
-    match x.pcl_desc with
-    | Pcl_constr (li, l) ->
-        line ppf "Pcl_constr %a@ " fmt_longident_loc li;
-        list core_type ppf l
-    | Pcl_structure cs ->
-        line ppf "Pcl_structure@ ";
-        class_structure ppf cs
-    | Pcl_fun (l, eo, p, e) ->
-        line ppf "Pcl_fun@ ";
-        arg_label ppf l;
-        option expression ppf eo;
-        pattern ppf p;
-        class_expr ppf e
-    | Pcl_apply (ce, l) ->
-        line ppf "Pcl_apply@ ";
-        class_expr ppf ce;
-        list label_x_expression ppf l
-    | Pcl_let (rf, l, ce) ->
-        line ppf "Pcl_let %a@ " fmt_rec_flag rf;
-        list value_binding ppf l;
-        class_expr ppf ce
-    | Pcl_constraint (ce, ct) ->
-        line ppf "Pcl_constraint@ ";
-        class_expr ppf ce;
-        class_type ppf ct
-    | Pcl_extension (s, arg) ->
-        line ppf "Pcl_extension \"%s\"@ " s.txt;
-        payload ppf arg
-    | Pcl_open (o, e) ->
-        line ppf "Pcl_open %a %a@ " fmt_override_flag o.popen_override
-          fmt_longident_loc o.popen_expr;
-        class_expr ppf e
-
-  and class_structure ppf { pcstr_self = p; pcstr_fields = l } =
-    line ppf "class_structure@ ";
-    pattern ppf p;
-    list class_field ppf l
-
-  and class_field ppf x =
-    line ppf "class_field %a@ " fmt_location x.pcf_loc;
-    attributes ppf x.pcf_attributes;
-    match x.pcf_desc with
-    | Pcf_inherit (ovf, ce, so) ->
-        line ppf "Pcf_inherit %a@ " fmt_override_flag ovf;
-        class_expr ppf ce;
-        option string_loc ppf so
-    | Pcf_val (s, mf, k) ->
-        line ppf "Pcf_val %a@ " fmt_mutable_flag mf;
-        line ppf "%a@ " fmt_string_loc s;
-        class_field_kind ppf k
-    | Pcf_method (s, pf, k) ->
-        line ppf "Pcf_method %a@ " fmt_private_flag pf;
-        line ppf "%a@ " fmt_string_loc s;
-        class_field_kind ppf k
-    | Pcf_constraint (ct1, ct2) ->
-        line ppf "Pcf_constraint@ ";
-        core_type ppf ct1;
-        core_type ppf ct2
-    | Pcf_initializer e ->
-        line ppf "Pcf_initializer@ ";
-        expression ppf e
-    | Pcf_attribute a -> attribute ppf "Pcf_attribute" a
-    | Pcf_extension (s, arg) ->
-        line ppf "Pcf_extension \"%s\"@ " s.txt;
-        payload ppf arg
-
-  and class_field_kind ppf = function
-    | Cfk_concrete (o, e) ->
-        line ppf "Concrete %a@ " fmt_override_flag o;
-        expression ppf e
-    | Cfk_virtual t ->
-        line ppf "Virtual@ ";
-        core_type ppf t
-
-  and class_declaration ppf x =
-    line ppf "class_declaration %a@ " fmt_location x.pci_loc;
-    attributes ppf x.pci_attributes;
-    line ppf "pci_virt = %a@ " fmt_virtual_flag x.pci_virt;
-    line ppf "pci_params =@ ";
-    list type_parameter ppf x.pci_params;
-    line ppf "pci_name = %a@ " fmt_string_loc x.pci_name;
-    line ppf "pci_expr =@ ";
-    class_expr ppf x.pci_expr
-
-  and module_type ppf x =
-    line ppf "module_type %a@ " fmt_location x.pmty_loc;
-    attributes ppf x.pmty_attributes;
-
-    match x.pmty_desc with
-    | Pmty_ident li -> line ppf "Pmty_ident %a@ " fmt_longident_loc li
-    | Pmty_alias li -> line ppf "Pmty_alias %a@ " fmt_longident_loc li
-    | Pmty_signature s ->
-        line ppf "Pmty_signature@ ";
-        signature ppf s
-    | Pmty_functor (Unit, mt2) ->
-        line ppf "Pmty_functor ()@ ";
-        module_type ppf mt2
-    | Pmty_functor (Named (s, mt1), mt2) ->
-        line ppf "Pmty_functor %a@ " fmt_str_opt_loc s;
-        module_type ppf mt1;
-        module_type ppf mt2
-    | Pmty_with (mt, l) ->
-        line ppf "Pmty_with@ ";
-        module_type ppf mt;
-        list with_constraint ppf l
-    | Pmty_typeof m ->
-        line ppf "Pmty_typeof@ ";
-        module_expr ppf m
-    | Pmty_extension (s, arg) ->
-        line ppf "Pmod_extension \"%s\"@ " s.txt;
-        payload ppf arg
-
-  and signature ppf x = list signature_item ppf x
-
-  and signature_item ppf x =
-    line ppf "signature_item %a@ " fmt_location x.psig_loc;
-
-    match x.psig_desc with
-    | Psig_value vd ->
-        line ppf "Psig_value@ ";
-        value_description ppf vd
-    | Psig_type (rf, l) ->
-        line ppf "Psig_type %a@ " fmt_rec_flag rf;
-        list type_declaration ppf l
-    | Psig_typesubst l ->
-        line ppf "Psig_typesubst@ ";
-        list type_declaration ppf l
-    | Psig_typext te ->
-        line ppf "Psig_typext@ ";
-        type_extension ppf te
-    | Psig_exception te ->
-        line ppf "Psig_exception@ ";
-        type_exception ppf te
-    | Psig_module pmd ->
-        line ppf "Psig_module %a@ " fmt_str_opt_loc pmd.pmd_name;
-        attributes ppf pmd.pmd_attributes;
-        module_type ppf pmd.pmd_type
-    | Psig_modsubst pms ->
-        line ppf "Psig_modsubst %a = %a@ " fmt_string_loc pms.pms_name
-          fmt_longident_loc pms.pms_manifest;
-        attributes ppf pms.pms_attributes
-    | Psig_recmodule decls ->
-        line ppf "Psig_recmodule@ ";
-        list module_declaration ppf decls
-    | Psig_modtype x ->
-        line ppf "Psig_modtype %a@ " fmt_string_loc x.pmtd_name;
-        attributes ppf x.pmtd_attributes;
-        modtype_declaration ppf x.pmtd_type
-    | Psig_open od ->
-        line ppf "Psig_open %a %a@ " fmt_override_flag
-          od.popen_override fmt_longident_loc od.popen_expr;
-        attributes ppf od.popen_attributes
-    | Psig_include incl ->
-        line ppf "Psig_include@ ";
-        module_type ppf incl.pincl_mod;
-        attributes ppf incl.pincl_attributes
-    | Psig_class l ->
-        line ppf "Psig_class@ ";
-        list class_description ppf l
-    | Psig_class_type l ->
-        line ppf "Psig_class_type@ ";
-        list class_type_declaration ppf l
-    | Psig_extension ((s, arg), attrs) ->
-        line ppf "Psig_extension \"%s\"@ " s.txt;
-        attributes ppf attrs;
-        payload ppf arg
-    | Psig_attribute a -> attribute ppf "Psig_attribute" a
-    | _ ->
-        Log.err (fun m -> m "Printast signature_item not matched");
-        raise Not_found
-
-  and modtype_declaration ppf = function
-    | None -> line ppf "#abstract"
-    | Some mt -> module_type ppf mt
-
-  and with_constraint ppf x =
-    match x with
-    | Pwith_type (lid, td) ->
-        line ppf "Pwith_type %a@ " fmt_longident_loc lid;
-        type_declaration ppf td
-    | Pwith_typesubst (lid, td) ->
-        line ppf "Pwith_typesubst %a@ " fmt_longident_loc lid;
-        type_declaration ppf td
-    | Pwith_module (lid1, lid2) ->
-        line ppf "Pwith_module %a = %a@ " fmt_longident_loc lid1
-          fmt_longident_loc lid2
-    | Pwith_modsubst (lid1, lid2) ->
-        line ppf "Pwith_modsubst %a = %a@ " fmt_longident_loc lid1
-          fmt_longident_loc lid2
-    | _ ->
-        Log.err (fun m -> m "Printast with_constraint not matched");
-        raise Not_found
-
-  and module_expr ppf x =
-    line ppf "module_expr %a@ " fmt_location x.pmod_loc;
-    attributes ppf x.pmod_attributes;
-
-    match x.pmod_desc with
-    | Pmod_ident li -> line ppf "Pmod_ident %a@ " fmt_longident_loc li
-    | Pmod_structure s ->
-        line ppf "Pmod_structure@ ";
-        structure ppf s
-    | Pmod_functor (Unit, me) ->
-        line ppf "Pmod_functor ()@ ";
-        module_expr ppf me
-    | Pmod_functor (Named (s, mt), me) ->
-        line ppf "Pmod_functor %a@ " fmt_str_opt_loc s;
-        module_type ppf mt;
-        module_expr ppf me
-    | Pmod_apply (me1, me2) ->
-        line ppf "Pmod_apply@ ";
-        module_expr ppf me1;
-        module_expr ppf me2
-    | Pmod_constraint (me, mt) ->
-        line ppf "Pmod_constraint@ ";
-        module_expr ppf me;
-        module_type ppf mt
-    | Pmod_unpack e ->
-        line ppf "Pmod_unpack@ ";
-        expression ppf e
-    | Pmod_extension (s, arg) ->
-        line ppf "Pmod_extension \"%s\"@ " s.txt;
-        payload ppf arg
-
-  and structure ppf x =
-    line ppf "struct@ ";
-    list structure_item ppf x
-
-  and structure_item ppf x =
-    match x.pstr_desc with
-    | Pstr_eval (e, attrs) ->
-        line ppf "Pstr_eval ";
-        attributes ppf attrs;
-        expression ppf e
-    | Pstr_value (rf, l) ->
-        line ppf "%a" fmt_rec_flag rf;
-        list value_binding ppf l
-    | Pstr_primitive vd ->
-        line ppf "Pstr_primitive@ ";
-        value_description ppf vd
-    | Pstr_type (rf, l) ->
-        line ppf "Pstr_type %a@ " fmt_rec_flag rf;
-        list type_declaration ppf l
-    | Pstr_typext te ->
-        line ppf "Pstr_typext@ ";
-        type_extension ppf te
-    | Pstr_exception te ->
-        line ppf "Pstr_exception@ ";
-        type_exception ppf te
-    | Pstr_module x ->
-        line ppf "Pstr_module@ ";
-        module_binding ppf x
-    | Pstr_recmodule bindings ->
-        line ppf "Pstr_recmodule@ ";
-        list module_binding ppf bindings
-    | Pstr_modtype x ->
-        line ppf "Pstr_modtype %a@ " fmt_string_loc x.pmtd_name;
-        attributes ppf x.pmtd_attributes;
-        modtype_declaration ppf x.pmtd_type
-    | Pstr_open od ->
-        line ppf "Pstr_open %a@ " fmt_override_flag od.popen_override;
-        module_expr ppf od.popen_expr;
-        attributes ppf od.popen_attributes
-    | Pstr_class l ->
-        line ppf "Pstr_class@ ";
-        list class_declaration ppf l
-    | Pstr_class_type l ->
-        line ppf "Pstr_class_type@ ";
-        list class_type_declaration ppf l
-    | Pstr_include incl ->
-        line ppf "Pstr_include";
-        attributes ppf incl.pincl_attributes;
-        module_expr ppf incl.pincl_mod
-    | Pstr_extension ((s, arg), attrs) ->
-        line ppf "Pstr_extension \"%s\"@ " s.txt;
-        attributes ppf attrs;
-        payload ppf arg
-    | Pstr_attribute a -> attribute ppf "Pstr_attribute" a
-
-  and module_declaration ppf pmd =
-    str_opt_loc ppf pmd.pmd_name;
-    attributes ppf pmd.pmd_attributes;
-    module_type ppf pmd.pmd_type
-
-  and module_binding ppf x =
-    str_opt_loc ppf x.pmb_name;
-    attributes ppf x.pmb_attributes;
-    module_expr ppf x.pmb_expr
-
-  and core_type_x_core_type_x_location ppf (ct1, ct2, l) =
-    line ppf "<constraint> %a@ " fmt_location l;
-    core_type ppf ct1;
-    core_type ppf ct2
-
-  and constructor_decl ppf
-      { pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes; _ } =
-    line ppf "%a@ " fmt_location pcd_loc;
-    line ppf "%a@ " fmt_string_loc pcd_name;
-    attributes ppf pcd_attributes;
-    constructor_arguments ppf pcd_args;
-    option core_type ppf pcd_res
-
-  and constructor_arguments ppf = function
-    | Pcstr_tuple l -> list core_type ppf l
-    | Pcstr_record l -> list label_decl ppf l
-
-  and label_decl ppf
-      { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } =
-    line ppf "%a@ " fmt_location pld_loc;
-    attributes ppf pld_attributes;
-    line ppf "%a@ " fmt_mutable_flag pld_mutable;
-    line ppf "%a" fmt_string_loc pld_name;
-    core_type ppf pld_type
-
-  and longident_x_pattern ppf (li, p) =
-    line ppf "%a@ " fmt_longident_loc li;
-    pattern ppf p
-
-  and case ppf { pc_lhs; pc_guard; pc_rhs } =
-    line ppf "<case>@ ";
-    pattern ppf pc_lhs;
-    (match pc_guard with
-    | None -> ()
-    | Some g ->
-        line ppf "<when>@ ";
-        expression ppf g);
-    expression ppf pc_rhs
-
-  and value_binding ppf x =
-    line ppf "<def> ";
-    attributes ppf x.pvb_attributes;
-    pattern ppf x.pvb_pat;
-    expression ppf x.pvb_expr
-
-  and binding_op ppf x =
-    line ppf "<binding_op> %a %a" fmt_string_loc x.pbop_op
-      fmt_location x.pbop_loc;
-    pattern ppf x.pbop_pat;
-    expression ppf x.pbop_exp
-
-  and string_x_expression ppf (s, e) =
-    line ppf "<override> %a " fmt_string_loc s;
-    expression ppf e
-
-  and longident_x_expression ppf (li, e) =
-    line ppf "%a@ " fmt_longident_loc li;
-    expression ppf e
-
-  and label_x_expression ppf (l, e) =
-    fprintf ppf "<arg> ";
-    arg_label ppf l;
-    expression ppf e
-
-  and graph_node (name : string) ppf (l, e) =
-    F.pf ppf "\"%s\"" name;
-    label_x_expression ppf (l, e)
-
-  and label_x_bool_x_core_type_list ppf x =
-    match x.prf_desc with
-    | Rtag (l, b, ctl) ->
-        line ppf "Rtag \"%s\" %s@ " l.txt (string_of_bool b);
-        attributes ppf x.prf_attributes;
-        list core_type ppf ctl
-    | Rinherit ct ->
-        line ppf "Rinherit@ ";
-        core_type ppf ct
-
-  let rec toplevel_phrase ppf x =
-    match x with
-    | Ptop_def s ->
-        line ppf "Ptop_def\n";
-        structure ppf s
-    | Ptop_dir { pdir_name; pdir_arg; _ } -> (
-        line ppf "Ptop_dir \"%s\"\n" pdir_name.txt;
-        match pdir_arg with
-        | None -> ()
-        | Some da -> directive_argument ppf da)
-
-  and directive_argument ppf x =
-    match x.pdira_desc with
-    | Pdir_string s -> line ppf "Pdir_string \"%s\"\n" s
-    | Pdir_int (n, None) -> line ppf "Pdir_int %s\n" n
-    | Pdir_int (n, Some m) -> line ppf "Pdir_int %s%c\n" n m
-    | Pdir_ident li -> line ppf "Pdir_ident %a\n" fmt_longident li
-    | Pdir_bool b -> line ppf "Pdir_bool %s\n" (string_of_bool b)
-
-  let interface = signature
-  let implementation = structure
-  let top_phrase = toplevel_phrase
-end
-
-let log_info pp exp = Log.info (fun m -> m "ppx_graph:@ %a" pp exp)
-
-let graph_structure str =
-  let string_constants_of =
-    object
-      inherit [string list] Ast_traverse.fold as super
-
-      (* sig
-         val interface : Format.formatter -> signature_item list -> unit
-         val implementation : Format.formatter -> structure_item list -> unit
-         val top_phrase : Format.formatter -> toplevel_phrase -> unit
-         val expression : int -> Format.formatter -> expression -> unit
-         val structure : int -> Format.formatter -> Parsetree.structure -> unit
-         val payload : int -> Format.formatter -> payload -> unit
-          end *)
-
-      method! expression e acc =
-        let acc = super#expression e acc in
-        F.str "%a" Printast.expression e :: acc
-
-      (* match e.pexp_desc with
-         | Pexp_constant (Pconst_string (s, _, _)) -> s :: acc
-         | Pexp_let (_, vb, exp) ->
-             F.str "\"%a\" -> \"%a\""
-               (F.parens
-                  (F.list
-                     ~sep:(fun ppf () -> F.string ppf "->")
-                     (F.pair Pprintast.pattern ppPprintast.expression)))
-               (List.map (fun vb -> (vb.pvb_pat, vb.pvb_expr)) vb)
-               Pprintast.expression exp
-             :: acc
-           | _ -> acc *)
-
-      (* method! pattern p acc =
-         let acc = super#pattern p acc in
-         match p.ppat_desc with
-         | Ppat_constant (Pconst_string (s, _, _)) -> s :: acc
-         | _ -> acc *)
-    end
-  in
-  Log.debug (fun m ->
-      m "graph_structure:@[<hov> %a@]"
-        (F.list ~sep:(fun ppf () -> F.pf ppf "\n") F.string)
-        (List.rev (string_constants_of#structure str [])))
-
-let init () =
-  Driver.register_transformation
-    ~impl:(fun str ->
-      log_info Ocaml_common.Pprintast.structure str;
-      (* log_info Ocaml_common.Printast.implementation str; *)
-      Ocaml_common.Clflags.locations := false;
-      log_info Printast.implementation str;
-      Ocaml_common.Clflags.locations := true;
-      str)
-    "ppx_graph"

log_js.ml

@@ -1,56 +0,0 @@
-module Logs_reporter = struct
-  (* Console reporter *)
-
-  open Jsoo_runtime
-
-  let console : Logs.level -> string -> unit =
-   fun level s ->
-    let meth =
-      match level with
-      | Logs.Error -> "error"
-      | Logs.Warning -> "warn"
-      | Logs.Info -> "info"
-      | Logs.Debug -> "debug"
-      | Logs.App -> "log"
-    in
-    ignore
-      (Js.meth_call
-         (Js.pure_js_expr "console")
-         meth
-         [| Js.string s |])
-
-  let ppf, flush =
-    let b = Buffer.create 255 in
-    let flush () =
-      let s = Buffer.contents b in
-      Buffer.clear b;
-      s
-    in
-    (Format.formatter_of_buffer b, flush)
-
-  let hook =
-    ref (fun level s ->
-        ignore (Logs.level_to_string (Some level) ^ ": " ^ s))
-
-  let console_report _src level ~over k msgf =
-    let k _ =
-      let s = flush () in
-      console level s;
-      !hook level s;
-      over ();
-      k ()
-    in
-    msgf @@ fun ?header ?tags fmt ->
-    let _tags = tags in
-    match header with
-    | None -> Format.kfprintf k ppf ("@[" ^^ fmt ^^ "@]@.")
-    | Some h -> Format.kfprintf k ppf ("[%s] @[" ^^ fmt ^^ "@]@.") h
-
-  let console_reporter () = { Logs.report = console_report }
-end
-
-let _ =
-  Logs.set_reporter (Logs_reporter.console_reporter ());
-  Logs.set_level (Some Debug)
-
-module Log = Logs

notes.org

@@ -24,21 +24,3 @@
 * principles?
 an "anywhere" programming environment
 
-* 221211
-ok you got the scroll box mostly working so next:
-** fix the scroll jump bugs
-** setup better keybindings
-** fix cursor and active focus indicators
-
-
-
-* 221210 -
-** need to resolve the issue with the ui.t Resize type.
-this is an issue with the direction of the determination of the .height and .width fields of Ui.t
-
-currently you were planning to combine update_sensors and update_size
-
-in the original nottui.ml library, are Ui.t.w and Ui.t.h determined from the top down orbottom up?
-the bottom up, becahse they are chars
-
-

toplevel.html

@@ -1,230 +0,0 @@
-<?xml version="1.0" encoding="utf-8"?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
-          "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml">
-  <head>
-    <title>OCaml toplevel</title>
-    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
-    <link rel="stylesheet" href="//maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap.min.css" />
-    <link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap.min.css" />
-    <style>
-
-      code, kbd, pre, samp {
-      font-family: Menlo,Monaco,Consolas,monospace;
-      }
-      body,html {
-      height: 100%;
-      background-color:#eee;
-      }
-
-      #toplevel-container {
-      width: 50%;
-      background-color: black;
-      color: #ccc;
-      overflow: auto;
-      overflow-x: hidden;
-      height: 100%;
-      float:left;
-      padding:10px;
-      padding-top: 20px;
-      }
-
-      #toplevel-container pre#output {
-      padding: 0px;
-      }
-
-      #toplevel-container #output {
-      background-color:transparent;
-      color: #ccc;
-      border: none;
-      line-height:18px;
-      font-size: 12px;
-      margin-bottom: 0px;
-      }
-
-      #toplevel-container textarea {
-      width:90%;
-      line-height:18px;
-      font-size: 12px;
-      background-color: transparent;
-      color: #fff;
-      border: 0;
-      resize: none;
-      outline: none;
-      font-family: Menlo,Monaco,Consolas,monospace;
-      font-weight: bold;
-      float:left;
-      margin: 0px;
-      padding:0px;
-      }
-      #toplevel-container #sharp {
-      float: left;
-      line-height:18px;
-      font-size: 12px;
-      font-family: Menlo,Monaco,Consolas,monospace;
-      white-space: pre;
-      }
-      .sharp:before{
-      content:"# ";
-      line-height:18px;
-      font-size: 12px;
-      font-family: Menlo,Monaco,Consolas,monospace;
-      }
-      .caml{
-      color:rgb(110, 110, 201);
-      }
-      #toplevel-side{
-      position:relative;
-      width:45%;
-      height: 100%;
-      overflow: auto;
-      text-align:justify;
-      float:left;
-      margin-left:30px;
-      }
-      #toplevel-side ul{
-      padding: 0px;
-      list-style-type: none;
-      }
-
-      .stderr {
-      color: #d9534f;
-      }
-      .stdout {
-
-      }
-      .errorloc{
-      border-bottom-width: 3px;
-      border-bottom-style: solid;
-      border-bottom-color: red;
-      }
-      canvas {
-      border: 1px dashed black;
-      float: left;
-      margin: 7px;
-      }
-      #output canvas {
-      background-color: #464646;
-      float: none;
-      display: block;
-      border: 1px dashed while;
-      margin: 7px;
-      }
-      #output img {
-      display:block;
-      }
-      #toplevel-examples {
-      width: 270px;
-      float: left;
-      }
-      #toplevel-examples .list-group-item{
-      padding: 5px 15px;
-      }
-      #btn-share {
-      float:right;
-      margin-top:-20px;
-      background-color:rgb(92, 129, 184);
-      border-color: rgb(70, 75, 128);
-      padding: 1px 5px;
-      display:none;
-      }
-      .clear { clear:both; }
-
-      .sharp .id { color: #59B65C ; font-style: italic }
-      .sharp .kw0 { color: rgb(64, 75, 190); font-weight: bold ;}
-      .sharp .kw1 { color: rgb(150, 0, 108); font-weight: bold ;}
-      .sharp .kw2 { color: rgb(23, 100, 42); font-weight: bold ;}
-      .sharp .kw3 { color: #59B65C; font-weight: bold ;}
-      .sharp .kw4 { color: #59B65C; font-weight: bold ;}
-      .sharp .comment { color: green ; font-style: italic ; }
-      .sharp .string { color: #6B6B6B; font-weight: bold ; }
-      .sharp .text { }
-      .sharp .numeric { color: #729AAF; }
-      .sharp .directive { font-style: italic ; color : #EB00FF; } ;
-      .sharp .escape { color: #409290 ; }
-      .sharp .symbol0 { color: orange ; font-weight: bold ; }
-      .sharp .symbol1 { color: #993300 ; font-weight: bold ; }
-      .sharp .constant { color: rgb(0, 152, 255); }
-    </style>
-    <script type="text/javascript">
-
-      window.onhashchange = function() { window.location.reload() }
-      var hash = window.location.hash.replace(/^#/,"");
-      var fields = hash.split(/&/);
-      var prefix = "";
-      var version = "";
-      for(var f in fields){
-        var data = fields[f].split(/=/);
-        if(data[0] == "version"){
-          version = data[1].replace(/%20|%2B/g,"+");
-          break;
-        }
-      }
-      function load_script(url){
-        var fileref=document.createElement('script');
-        fileref.setAttribute("type","text/javascript");
-        fileref.setAttribute("src", prefix+(version==""?"":(version+"/"))+url);
-        document.getElementsByTagName("head")[0].appendChild(fileref);
-      }
-      load_script("_build/default/exported-unit.cmis.js");
-      load_script("_build/default/toplevel.bc.js");
-
-    </script>
-  </head>
-  <body>
-    <div id="toplevel-container">
-      <pre id="output"></pre>
-      <div>
-        <div id="sharp" class="sharp"></div>
-        <textarea id="userinput">Loading ...</textarea>
-        <button type="button" class="btn btn-default"
-                id="btn-share">Share</button>
-      </div>
-    </div>
-    <div id="toplevel-side">
-      <h3>Js_of_ocaml</h3>
-      <h4>A compiler from OCaml bytecode to Javascript.</h4>
-      <p>It makes OCaml programs that run on Web browsers. It is
-        easy to install as it works with an existing installation of OCaml,
-        with no need to recompile any library. It comes with bindings for a
-        large part of the browser APIs.</p>
-      <p>This web-based OCaml toplevel is compiled using Js_of_ocaml.</p>
-      <h4>Command</h4>
-      <table class="table table-striped table-condensed">
-        <tbody class>
-          <tr>
-            <td>Enter/Return</td>
-            <td>Submit code</td>
-          </tr>
-          <tr>
-            <td>Ctrl + Enter</td>
-            <td>Newline</td>
-          </tr>
-          <tr>
-            <td>Up / Down</td>
-            <td>Browse history</td>
-          </tr>
-          <tr>
-            <td>Ctrl + l</td>
-            <td>Clear display</td>
-          </tr>
-          <tr>
-            <td>Ctrl + k</td>
-            <td>Reset toplevel</td>
-          </tr>
-          <tr>
-            <td>Tab</td>
-            <td>Indent code</td>
-          </tr>
-
-        </tbody>
-      </table>
-      <h4>Try to execute samples</h4>
-      <div id="toplevel-examples" class="list-group"></div>
-      <canvas width=200 height=200 id="test-canvas"></canvas>
-      <h4 class="clear">See the generated javascript code</h4>
-      <pre id="last-js">
-      </pre>
-    </div>
-  </body>
-</html>

toplevel.ml

@@ -1,645 +0,0 @@
-(* Js_of_ocaml toplevel
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2011 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-open Js_of_ocaml
-open Js_of_ocaml_lwt
-open Js_of_ocaml_tyxml
-open Js_of_ocaml_toplevel
-open Lwt
-
-module Graphics_support = struct
-  let init elt = Graphics_js.open_canvas elt
-end
-
-module Log = Log_js.Log
-
-module Ppx_support = struct
-  let init () =
-    Ppx_graph.init ();
-    Ast_mapper.register "js_of_ocaml" (fun _ -> Ppx_js.mapper);
-    Ast_mapper.register "ppxlib" (fun _ ->
-        Log.info (fun m -> m "Ppxlib.mapper");
-        {
-          Ast_mapper.default_mapper with
-          structure =
-            (fun _ ->
-              Log.info (fun m -> m "Ppxlib.Driver.map_structure");
-              Ppxlib.Driver.map_structure);
-          signature =
-            (fun _ ->
-              Log.info (fun m -> m "Ppxlib.Driver.map_signature");
-              Ppxlib.Driver.map_signature);
-        })
-end
-
-module Colorize = struct
-  open Js_of_ocaml
-  open Js_of_ocaml_tyxml
-
-  let text ~a_class:cl s =
-    Tyxml_js.Html.(span ~a:[ a_class [ cl ] ] [ txt s ])
-
-  let ocaml = text
-
-  let highlight from_ to_ e =
-    match Js.Opt.to_option e##.textContent with
-    | None -> assert false
-    | Some x ->
-        let x = Js.to_string x in
-        let (`Pos from_) = from_ in
-        let to_ =
-          match to_ with `Pos n -> n | `Last -> String.length x - 1
-        in
-        e##.innerHTML := Js.string "";
-        let span kind s =
-          if s <> "" then
-            let span =
-              Tyxml_js.Html.(span ~a:[ a_class [ kind ] ] [ txt s ])
-            in
-            Dom.appendChild e (Tyxml_js.To_dom.of_element span)
-        in
-        span "normal" (String.sub x 0 from_);
-        span "errorloc" (String.sub x from_ (to_ - from_));
-        span "normal" (String.sub x to_ (String.length x - to_))
-end
-
-module Indent : sig
-  val textarea : Dom_html.textAreaElement Js.t -> unit
-end = struct
-  let _ = Approx_lexer.enable_extension "lwt"
-
-  let indent s in_lines =
-    let output =
-      {
-        IndentPrinter.debug = false;
-        config = IndentConfig.default;
-        in_lines;
-        indent_empty = true;
-        adaptive = true;
-        kind = IndentPrinter.Print (fun s acc -> acc ^ s);
-      }
-    in
-    let stream = Nstream.of_string s in
-    IndentPrinter.proceed output stream IndentBlock.empty ""
-
-  let textarea (textbox : Dom_html.textAreaElement Js.t) : unit =
-    let rec loop s acc (i, pos') =
-      try
-        let pos = String.index_from s pos' '\n' in
-        loop s ((i, (pos', pos)) :: acc) (succ i, succ pos)
-      with _ -> List.rev ((i, (pos', String.length s)) :: acc)
-    in
-    let rec find (l : (int * (int * int)) list) c =
-      match l with
-      | [] -> assert false
-      | (i, (lo, up)) :: _ when up >= c -> (c, i, lo, up)
-      | (_, (_lo, _up)) :: rem -> find rem c
-    in
-    let v = textbox##.value in
-    let pos =
-      let c1 = textbox##.selectionStart
-      and c2 = textbox##.selectionEnd in
-      if
-        Js.Opt.test (Js.Opt.return c1)
-        && Js.Opt.test (Js.Opt.return c2)
-      then
-        let l = loop (Js.to_string v) [] (0, 0) in
-        Some (find l c1, find l c2)
-      else None
-    in
-    let f =
-      match pos with
-      | None -> fun _ -> true
-      | Some ((_c1, line1, _lo1, _up1), (_c2, line2, _lo2, _up2)) ->
-          fun l -> l >= line1 + 1 && l <= line2 + 1
-    in
-    let v = indent (Js.to_string v) f in
-    textbox##.value := Js.string v;
-    match pos with
-    | Some ((c1, line1, _lo1, up1), (c2, line2, _lo2, up2)) ->
-        let l = loop v [] (0, 0) in
-        let lo1'', up1'' = List.assoc line1 l in
-        let lo2'', up2'' = List.assoc line2 l in
-        let n1 = max (c1 + up1'' - up1) lo1'' in
-        let n2 = max (c2 + up2'' - up2) lo2'' in
-        let () = (Obj.magic textbox)##setSelectionRange n1 n2 in
-        textbox##focus;
-        ()
-    | None -> ()
-end
-
-let compiler_name = "OCaml"
-let by_id s = Dom_html.getElementById s
-
-let by_id_coerce s f =
-  Js.Opt.get
-    (f (Dom_html.getElementById s))
-    (fun () -> raise Not_found)
-
-let do_by_id s f =
-  try f (Dom_html.getElementById s) with Not_found -> ()
-
-(* load file using a synchronous XMLHttpRequest *)
-let load_resource_aux filename url =
-  Js_of_ocaml_lwt.XmlHttpRequest.perform_raw
-    ~response_type:XmlHttpRequest.ArrayBuffer url
-  >|= fun frame ->
-  if frame.Js_of_ocaml_lwt.XmlHttpRequest.code = 200 then
-    Js.Opt.case frame.Js_of_ocaml_lwt.XmlHttpRequest.content
-      (fun () -> Printf.eprintf "Could not load %s\n" filename)
-      (fun b ->
-        Sys_js.update_file ~name:filename
-          ~content:(Typed_array.String.of_arrayBuffer b))
-  else ()
-
-let load_resource scheme ~prefix ~path:suffix =
-  let url = scheme ^ suffix in
-  let filename = Filename.concat prefix suffix in
-  Lwt.async (fun () -> load_resource_aux filename url);
-  Some ""
-
-let setup_pseudo_fs () =
-  Sys_js.mount ~path:"/dev/" (fun ~prefix:_ ~path:_ -> None);
-  Sys_js.mount ~path:"/http/" (load_resource "http://");
-  Sys_js.mount ~path:"/https/" (load_resource "https://");
-  Sys_js.mount ~path:"/ftp/" (load_resource "ftp://");
-  Sys_js.mount ~path:"/home/" (load_resource "filesys/")
-
-let exec' s =
-  let res : bool = JsooTop.use Format.std_formatter s in
-  if not res then Format.eprintf "error while evaluating %s@." s
-
-module Version = struct
-  type t = int list
-
-  let split_char ~sep p =
-    let len = String.length p in
-    let rec split beg cur =
-      if cur >= len then
-        if cur - beg > 0 then [ String.sub p beg (cur - beg) ] else []
-      else if sep p.[cur] then
-        String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
-      else split beg (cur + 1)
-    in
-    split 0 0
-
-  let split v =
-    match
-      split_char
-        ~sep:(function '+' | '-' | '~' -> true | _ -> false)
-        v
-    with
-    | [] -> assert false
-    | x :: _ ->
-        List.map int_of_string
-          (split_char ~sep:(function '.' -> true | _ -> false) x)
-
-  let current : t = split Sys.ocaml_version
-  let compint (a : int) b = compare a b
-
-  let rec compare v v' =
-    match (v, v') with
-    | [ x ], [ y ] -> compint x y
-    | [], [] -> 0
-    | [], y :: _ -> compint 0 y
-    | x :: _, [] -> compint x 0
-    | x :: xs, y :: ys -> (
-        match compint x y with 0 -> compare xs ys | n -> n)
-end
-
-let setup_toplevel () =
-  JsooTop.initialize ();
-  Sys.interactive := false;
-  if Version.compare Version.current [ 4; 07 ] >= 0 then
-    exec' "open Stdlib";
-  exec'
-    "module Lwt_main = struct\n\
-    \             let run t = match Lwt.state t with\n\
-    \               | Lwt.Return x -> x\n\
-    \               | Lwt.Fail e -> raise e\n\
-    \               | Lwt.Sleep -> failwith \"Lwt_main.run: thread \
-     didn't return\"\n\
-    \            end";
-  let header1 =
-    Printf.sprintf "        %s version %%s" compiler_name
-  in
-  let header2 =
-    Printf.sprintf "     Compiled with Js_of_ocaml version %s"
-      Sys_js.js_of_ocaml_version
-  in
-  exec'
-    (Printf.sprintf "Format.printf \"%s@.\" Sys.ocaml_version;;"
-       header1);
-  exec' (Printf.sprintf "Format.printf \"%s@.\";;" header2);
-  exec' "#enable \"pretty\";;";
-  exec' "#disable \"shortvar\";;";
-  Ppx_support.init ();
-  let[@alert "-deprecated"] new_directive n k =
-    Hashtbl.add Toploop.directive_table n k
-  in
-  new_directive "load_js"
-    (Toploop.Directive_string
-       (fun name -> Js.Unsafe.global##load_script_ name));
-  Sys.interactive := true;
-  ()
-
-let resize ~container ~textbox () =
-  Lwt.pause () >>= fun () ->
-  textbox##.style##.height := Js.string "auto";
-  textbox##.style##.height
-  := Js.string (Printf.sprintf "%dpx" (max 18 textbox##.scrollHeight));
-  container##.scrollTop := container##.scrollHeight;
-  Lwt.return ()
-
-let setup_printers () =
-  exec'
-    "let _print_error fmt e = Format.pp_print_string fmt \
-     (Js_of_ocaml.Js_error.to_string e)";
-  Topdirs.dir_install_printer Format.std_formatter
-    Longident.(Lident "_print_error");
-  exec'
-    "let _print_unit fmt (_ : 'a) : 'a = Format.pp_print_string fmt \
-     \"()\"";
-  Topdirs.dir_install_printer Format.std_formatter
-    Longident.(Lident "_print_unit")
-
-let setup_examples ~container ~textbox =
-  let r = Regexp.regexp "^\\(\\*+(.*)\\*+\\)$" in
-  let all = ref [] in
-  (try
-     let ic = open_in "/static/examples.ml" in
-     while true do
-       let line = input_line ic in
-       match Regexp.string_match r line 0 with
-       | Some res ->
-           let name =
-             match Regexp.matched_group res 1 with
-             | Some s -> s
-             | None -> assert false
-           in
-           all := `Title name :: !all
-       | None -> all := `Content line :: !all
-     done;
-     assert false
-   with _ -> ());
-  let example_container = by_id "toplevel-examples" in
-  let _ =
-    List.fold_left
-      (fun acc tok ->
-        match tok with
-        | `Content line -> line ^ "\n" ^ acc
-        | `Title name ->
-            let a =
-              Tyxml_js.Html.(
-                a
-                  ~a:
-                    [
-                      a_class [ "list-group-item" ];
-                      a_onclick (fun _ ->
-                          textbox##.value := (Js.string acc)##trim;
-                          Lwt.async (fun () ->
-                              resize ~container ~textbox ()
-                              >>= fun () ->
-                              textbox##focus;
-                              Lwt.return_unit);
-                          true);
-                    ]
-                  [ txt name ])
-            in
-            Dom.appendChild example_container (Tyxml_js.To_dom.of_a a);
-            "")
-      "" !all
-  in
-  ()
-
-(* we need to compute the hash form href to avoid different encoding behavior
-     across browser. see Url.get_fragment *)
-let parse_hash () =
-  let frag = Url.Current.get_fragment () in
-  Url.decode_arguments frag
-
-let rec iter_on_sharp ~f x =
-  Js.Opt.iter (Dom_html.CoerceTo.element x) (fun e ->
-      if Js.to_bool (e##.classList##contains (Js.string "sharp")) then
-        f e);
-  match Js.Opt.to_option x##.nextSibling with
-  | None -> ()
-  | Some n -> iter_on_sharp ~f n
-
-let setup_share_button ~output =
-  do_by_id "btn-share" (fun e ->
-      e##.style##.display := Js.string "block";
-      e##.onclick :=
-        Dom_html.handler (fun _ ->
-            (* get all ocaml code *)
-            let code = ref [] in
-            Js.Opt.iter output##.firstChild
-              (iter_on_sharp ~f:(fun e ->
-                   code :=
-                     Js.Opt.case e##.textContent
-                       (fun () -> "")
-                       Js.to_string
-                     :: !code));
-            let code_encoded = String.concat "" (List.rev !code) in
-            let url, is_file =
-              match Url.Current.get () with
-              | Some (Url.Http url) ->
-                  (Url.Http { url with Url.hu_fragment = "" }, false)
-              | Some (Url.Https url) ->
-                  (Url.Https { url with Url.hu_fragment = "" }, false)
-              | Some (Url.File url) ->
-                  (Url.File { url with Url.fu_fragment = "" }, true)
-              | _ -> assert false
-            in
-            let frag =
-              let frags = parse_hash () in
-              let frags =
-                List.remove_assoc "code" frags
-                @ [ ("code", code_encoded) ]
-              in
-              Url.encode_arguments frags
-            in
-            let uri = Url.string_of_url url ^ "#" ^ frag in
-            let append_url str =
-              let dom =
-                Tyxml_js.Html.(
-                  p
-                    [
-                      txt "Share this url : ";
-                      a ~a:[ a_href str ] [ txt str ];
-                    ])
-              in
-              Dom.appendChild output (Tyxml_js.To_dom.of_element dom)
-            in
-            Lwt.async (fun () ->
-                Lwt.catch
-                  (fun () ->
-                    if is_file then
-                      failwith "Cannot shorten url with file scheme"
-                    else
-                      let uri =
-                        Printf.sprintf
-                          "http://is.gd/create.php?format=json&url=%s"
-                          (Url.urlencode uri)
-                      in
-                      Lwt.bind (Js_of_ocaml_lwt.Jsonp.call uri)
-                        (fun o ->
-                          let str = Js.to_string o##.shorturl in
-                          append_url str;
-                          Lwt.return_unit))
-                  (fun exn ->
-                    Format.eprintf
-                      "Could not generate short url. reason: %s@."
-                      (Printexc.to_string exn);
-                    append_url uri;
-                    Lwt.return_unit));
-            Js._false))
-
-let setup_js_preview () =
-  let ph = by_id "last-js" in
-  let runcode : string -> 'a = Js.Unsafe.global##.toplevelEval in
-  Js.Unsafe.global##.toplevelEval := fun bc ->
-  ph##.innerHTML := Js.string bc;
-  runcode bc
-
-let current_position = ref 0
-
-let highlight_location loc =
-  let x = ref 0 in
-  let output = by_id "output" in
-  let first =
-    Js.Opt.get
-      (output##.childNodes##item !current_position)
-      (fun _ -> assert false)
-  in
-  iter_on_sharp first ~f:(fun e ->
-      incr x;
-      let _file1, line1, col1 =
-        Location.get_pos_info loc.Location.loc_start
-      in
-      let _file2, line2, col2 =
-        Location.get_pos_info loc.Location.loc_end
-      in
-      if !x >= line1 && !x <= line2 then
-        let from_ = if !x = line1 then `Pos col1 else `Pos 0 in
-        let to_ = if !x = line2 then `Pos col2 else `Last in
-        Colorize.highlight from_ to_ e)
-
-let append colorize output cl s =
-  Dom.appendChild output
-    (Tyxml_js.To_dom.of_element (colorize ~a_class:cl s))
-
-module History = struct
-  let data = ref [| "" |]
-  let idx = ref 0
-
-  let get_storage () =
-    match Js.Optdef.to_option Dom_html.window##.localStorage with
-    | exception _ -> raise Not_found
-    | None -> raise Not_found
-    | Some t -> t
-
-  let setup () =
-    try
-      let s = get_storage () in
-      match Js.Opt.to_option (s##getItem (Js.string "history")) with
-      | None -> raise Not_found
-      | Some s ->
-          let a = Json.unsafe_input s in
-          data := a;
-          idx := Array.length a - 1
-    with _ -> ()
-
-  let push text =
-    let l = Array.length !data in
-    let n = Array.make (l + 1) "" in
-    !data.(l - 1) <- text;
-    Array.blit !data 0 n 0 l;
-    data := n;
-    idx := l;
-    try
-      let s = get_storage () in
-      let str = Json.output !data in
-      s##setItem (Js.string "history") str
-    with Not_found -> ()
-
-  let current text = !data.(!idx) <- text
-
-  let previous textbox =
-    if !idx > 0 then (
-      decr idx;
-      textbox##.value := Js.string !data.(!idx))
-
-  let next textbox =
-    if !idx < Array.length !data - 1 then (
-      incr idx;
-      textbox##.value := Js.string !data.(!idx))
-end
-
-let run _ =
-  let container = by_id "toplevel-container" in
-  let output = by_id "output" in
-  let textbox : 'a Js.t =
-    by_id_coerce "userinput" Dom_html.CoerceTo.textarea
-  in
-  let sharp_chan = open_out "/dev/null0" in
-  let sharp_ppf = Format.formatter_of_out_channel sharp_chan in
-  let caml_chan = open_out "/dev/null1" in
-  let caml_ppf = Format.formatter_of_out_channel caml_chan in
-  let execute () =
-    let content = Js.to_string textbox##.value##trim in
-    let content' =
-      let len = String.length content in
-      if
-        try
-          content <> ""
-          && content.[len - 1] <> ';'
-          && content.[len - 2] <> ';'
-        with _ -> true
-      then content ^ ";;"
-      else content
-    in
-    current_position := output##.childNodes##.length;
-    textbox##.value := Js.string "";
-    History.push content;
-    JsooTop.execute true ~pp_code:sharp_ppf ~highlight_location
-      caml_ppf content';
-    resize ~container ~textbox () >>= fun () ->
-    container##.scrollTop := container##.scrollHeight;
-    textbox##focus;
-    Lwt.return_unit
-  in
-  let history_down _e =
-    let txt = Js.to_string textbox##.value in
-    let pos = textbox##.selectionStart in
-    try
-      if String.length txt = pos then raise Not_found;
-      let _ = String.index_from txt pos '\n' in
-      Js._true
-    with Not_found ->
-      History.current txt;
-      History.next textbox;
-      Js._false
-  in
-  let history_up _e =
-    let txt = Js.to_string textbox##.value in
-    let pos = textbox##.selectionStart - 1 in
-    try
-      if pos < 0 then raise Not_found;
-      let _ = String.rindex_from txt pos '\n' in
-      Js._true
-    with Not_found ->
-      History.current txt;
-      History.previous textbox;
-      Js._false
-  in
-  let meta e =
-    let b = Js.to_bool in
-    b e##.ctrlKey || b e##.altKey || b e##.metaKey
-  in
-  let shift e = Js.to_bool e##.shiftKey in
-  (* setup handlers *)
-  textbox##.onkeyup :=
-    Dom_html.handler (fun _ ->
-        Lwt.async (resize ~container ~textbox);
-        Js._true);
-  textbox##.onchange :=
-    Dom_html.handler (fun _ ->
-        Lwt.async (resize ~container ~textbox);
-        Js._true);
-  textbox##.onkeydown :=
-    Dom_html.handler (fun e ->
-        match e##.keyCode with
-        | 13 when not (meta e || shift e) ->
-            Lwt.async execute;
-            Js._false
-        | 13 ->
-            Lwt.async (resize ~container ~textbox);
-            Js._true
-        | 09 ->
-            Indent.textarea textbox;
-            Js._false
-        | 76 when meta e ->
-            output##.innerHTML := Js.string "";
-            Js._true
-        | 75 when meta e ->
-            setup_toplevel ();
-            Js._false
-        | 38 -> history_up e
-        | 40 -> history_down e
-        | _ -> Js._true);
-  (Lwt.async_exception_hook :=
-     fun exc ->
-       Format.eprintf "exc during Lwt.async: %s@."
-         (Printexc.to_string exc);
-       match exc with
-       | Js_error.Exn e ->
-           let e = Js_error.to_error e in
-           Firebug.console##log e##.stack
-       | _ -> ());
-  Lwt.async (fun () ->
-      resize ~container ~textbox () >>= fun () ->
-      textbox##focus;
-      Lwt.return_unit);
-  Graphics_support.init
-    (by_id_coerce "test-canvas" Dom_html.CoerceTo.canvas);
-  Sys_js.set_channel_flusher caml_chan
-    (append Colorize.ocaml output "caml");
-  Sys_js.set_channel_flusher sharp_chan
-    (append Colorize.ocaml output "sharp");
-  Sys_js.set_channel_flusher stdout
-    (append Colorize.text output "stdout");
-  Sys_js.set_channel_flusher stderr
-    (append Colorize.text output "stderr");
-  let readline () =
-    Js.Opt.case
-      (Dom_html.window##prompt
-         (Js.string "The toplevel expects inputs:")
-         (Js.string ""))
-      (fun () -> "")
-      (fun s -> Js.to_string s ^ "\n")
-  in
-  Sys_js.set_channel_filler stdin readline;
-  setup_share_button ~output;
-  Ppx_graph.setup_graph ~container ~textbox;
-  setup_examples ~container ~textbox;
-  setup_pseudo_fs ();
-  setup_toplevel ();
-  setup_js_preview ();
-  setup_printers ();
-  History.setup ();
-  textbox##.value := Js.string "";
-  (* Run initial code if any *)
-  try
-    let code = List.assoc "code" (parse_hash ()) in
-    textbox##.value := Js.string code;
-    Lwt.async execute
-  with
-  | Not_found -> ()
-  | exc ->
-      Firebug.console##log_3 (Js.string "exception")
-        (Js.string (Printexc.to_string exc))
-        exc
-
-let _ =
-  Dom_html.window##.onload
-  := Dom_html.handler (fun _ ->
-         run ();
-         Js._false)

unicom.org

@@ -1,37 +0,0 @@
-UNICOM
-
-unifying tools for thought and commmunication
-
-At the top level is a kind of "trace" that connects all the tools together
-and records the exact use of all the tools in a session. Traces are the only
-kind of document in the system, and are basically written by a user when
-they interact with the system. Users can store, retrieve, view, and modify
-traces as a way of controlling system state, retrieving history, and sharing
-information?
-
-
-tools for thought:
-- todo lists
-- personal journal
-- calendar
-- calculator/spreadsheet
-- health, fitness, finance data tracking, analysis
-- Integrated Development Environment [for development/configuration of all these tools]
-
-
-tools for communication:
-- collaborative documents
-  video / .txt file
-- content discovery,display,labeling?
-  twitter / netflix / books
-- direct messages
-  sms / email
-- group messages
-  private (chat) / private (irc,twitter)
-- audio/music production
-  sound driver / DAW
-- cad
-  KiCad / OpenSCAD
-
-
-