From 3912fa46cbf4b35eefb25cf4e73baa2872b27aa0 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Tue, 20 Aug 2024 17:05:00 -0400 Subject: [PATCH 01/18] Mark warnings as errors in release and warnings in dev - Just set it in all the dune files for now --- src/haz3lcore/dune | 4 ++++ src/haz3lschool/dune | 4 ++++ src/haz3lweb/dune | 4 ++++ src/pretty/dune | 4 ++++ src/util/dune | 2 ++ 5 files changed, 18 insertions(+) diff --git a/src/haz3lcore/dune b/src/haz3lcore/dune index 77e2ca3fe1..4958c24a03 100644 --- a/src/haz3lcore/dune +++ b/src/haz3lcore/dune @@ -14,8 +14,12 @@ (env (dev + (flags + (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release + (flags + (:standard -warn-error +A)) (js_of_ocaml (flags :standard)))) diff --git a/src/haz3lschool/dune b/src/haz3lschool/dune index a9f7575c78..7523b3b8a5 100644 --- a/src/haz3lschool/dune +++ b/src/haz3lschool/dune @@ -16,8 +16,12 @@ (env (dev + (flags + (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release + (flags + (:standard -warn-error +A)) (js_of_ocaml (flags :standard)))) diff --git a/src/haz3lweb/dune b/src/haz3lweb/dune index 8d25155dc5..6bd33aca80 100644 --- a/src/haz3lweb/dune +++ b/src/haz3lweb/dune @@ -78,8 +78,12 @@ (env (dev + (flags + (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release + (flags + (:standard -warn-error +A)) (js_of_ocaml (flags (:standard))))) diff --git a/src/pretty/dune b/src/pretty/dune index 868d03defc..6c6b5ac562 100644 --- a/src/pretty/dune +++ b/src/pretty/dune @@ -8,8 +8,12 @@ (env (dev + (flags + (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release + (flags + (:standard -warn-error +A)) (js_of_ocaml (flags :standard)))) diff --git a/src/util/dune b/src/util/dune index 889c95bd2c..8efc41a81c 100644 --- a/src/util/dune +++ b/src/util/dune @@ -12,8 +12,10 @@ (env (dev + (flags :standard -warn-error -A) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release + (flags :standard -warn-error +A) (js_of_ocaml (flags :standard)))) From abb64a3112f67f15a8372e7d02e72cbd47eb58b4 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Tue, 20 Aug 2024 17:16:59 -0400 Subject: [PATCH 02/18] Ignore warning 58 no-cmx-file --- src/haz3lcore/dune | 2 +- src/haz3lschool/dune | 2 +- src/haz3lweb/dune | 2 +- src/pretty/dune | 2 +- src/util/dune | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/haz3lcore/dune b/src/haz3lcore/dune index 4958c24a03..41cb346136 100644 --- a/src/haz3lcore/dune +++ b/src/haz3lcore/dune @@ -20,6 +20,6 @@ (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release (flags - (:standard -warn-error +A)) + (:standard -warn-error +A-58)) (js_of_ocaml (flags :standard)))) diff --git a/src/haz3lschool/dune b/src/haz3lschool/dune index 7523b3b8a5..12b063be39 100644 --- a/src/haz3lschool/dune +++ b/src/haz3lschool/dune @@ -22,6 +22,6 @@ (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release (flags - (:standard -warn-error +A)) + (:standard -warn-error +A-58)) (js_of_ocaml (flags :standard)))) diff --git a/src/haz3lweb/dune b/src/haz3lweb/dune index 6bd33aca80..121bcd65de 100644 --- a/src/haz3lweb/dune +++ b/src/haz3lweb/dune @@ -84,6 +84,6 @@ (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release (flags - (:standard -warn-error +A)) + (:standard -warn-error +A-58)) (js_of_ocaml (flags (:standard))))) diff --git a/src/pretty/dune b/src/pretty/dune index 6c6b5ac562..ad6e9ea4fd 100644 --- a/src/pretty/dune +++ b/src/pretty/dune @@ -14,6 +14,6 @@ (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release (flags - (:standard -warn-error +A)) + (:standard -warn-error +A-58)) (js_of_ocaml (flags :standard)))) diff --git a/src/util/dune b/src/util/dune index 8efc41a81c..a97c31face 100644 --- a/src/util/dune +++ b/src/util/dune @@ -16,6 +16,6 @@ (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release - (flags :standard -warn-error +A) + (flags :standard -warn-error +A-58) (js_of_ocaml (flags :standard)))) From 245ab137250a047081f8a11b658e9c2eecf631d1 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Tue, 20 Aug 2024 21:00:53 -0400 Subject: [PATCH 03/18] Move flags to dune-workspace --- dune-workspace | 9 +++++++++ src/haz3lcore/dune | 4 ---- src/haz3lschool/dune | 4 ---- src/haz3lweb/dune | 4 ---- src/pretty/dune | 4 ---- 5 files changed, 9 insertions(+), 16 deletions(-) create mode 100644 dune-workspace diff --git a/dune-workspace b/dune-workspace new file mode 100644 index 0000000000..480ccb1514 --- /dev/null +++ b/dune-workspace @@ -0,0 +1,9 @@ +(lang dune 3.16) + +(env + (dev + (flags + (:standard -warn-error -A))) + (release + (flags + (:standard -warn-error +A-58)))) diff --git a/src/haz3lcore/dune b/src/haz3lcore/dune index 41cb346136..77e2ca3fe1 100644 --- a/src/haz3lcore/dune +++ b/src/haz3lcore/dune @@ -14,12 +14,8 @@ (env (dev - (flags - (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release - (flags - (:standard -warn-error +A-58)) (js_of_ocaml (flags :standard)))) diff --git a/src/haz3lschool/dune b/src/haz3lschool/dune index 12b063be39..a9f7575c78 100644 --- a/src/haz3lschool/dune +++ b/src/haz3lschool/dune @@ -16,12 +16,8 @@ (env (dev - (flags - (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release - (flags - (:standard -warn-error +A-58)) (js_of_ocaml (flags :standard)))) diff --git a/src/haz3lweb/dune b/src/haz3lweb/dune index 121bcd65de..8d25155dc5 100644 --- a/src/haz3lweb/dune +++ b/src/haz3lweb/dune @@ -78,12 +78,8 @@ (env (dev - (flags - (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release - (flags - (:standard -warn-error +A-58)) (js_of_ocaml (flags (:standard))))) diff --git a/src/pretty/dune b/src/pretty/dune index ad6e9ea4fd..868d03defc 100644 --- a/src/pretty/dune +++ b/src/pretty/dune @@ -8,12 +8,8 @@ (env (dev - (flags - (:standard -warn-error -A)) (js_of_ocaml (flags :standard --debuginfo --noinline --dynlink --linkall --sourcemap))) (release - (flags - (:standard -warn-error +A-58)) (js_of_ocaml (flags :standard)))) From 9171acb8acb2b6e044ddd2ef24c5f25dfd103f87 Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Thu, 19 Sep 2024 16:44:28 -0400 Subject: [PATCH 04/18] Experiment with switching to Bonsai --- src/haz3lweb/Main.re | 141 +++++++++++++++++++++++------------------- src/haz3lweb/Model.re | 3 +- src/haz3lweb/dune | 9 ++- src/util/dune | 2 +- 4 files changed, 88 insertions(+), 67 deletions(-) diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index cf0269bf45..ed72a99a5a 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -1,6 +1,5 @@ open Util; open Js_of_ocaml; -open Incr_dom; open Haz3lweb; let scroll_to_caret = ref(true); @@ -36,7 +35,7 @@ let restart_caret_animation = () => | _ => () }; -let apply = (model, action, state, ~schedule_action): Model.t => { +let apply = (model, action, ~schedule_action): Model.t => { restart_caret_animation(); if (UpdateAction.is_edit(action)) { last_edit_action := JsUtil.timestamp(); @@ -48,7 +47,7 @@ let apply = (model, action, state, ~schedule_action): Model.t => { last_edit_action := JsUtil.timestamp(); switch ( try({ - let new_model = Update.apply(model, action, state, ~schedule_action); + let new_model = Update.apply(model, action, (), ~schedule_action); Log.update(action); new_model; }) { @@ -70,74 +69,92 @@ let apply = (model, action, state, ~schedule_action): Model.t => { }; }; +let on_startup = + ( + ~inject: UpdateAction.t => Ui_effect.t(unit), + ~schedule_event: Ui_effect.t(unit) => unit, + m: Model.t, + ) + : Model.t => { + let schedule_action = action => schedule_event(inject(action)); + let _ = + observe_font_specimen("font-specimen", fm => + schedule_action(Haz3lweb.Update.SetMeta(FontMetrics(fm))) + ); + NinjaKeys.initialize(NinjaKeys.options(schedule_action)); + JsUtil.focus_clipboard_shim(); + /* initialize state. */ + /* Initial evaluation on a worker */ + Update.schedule_evaluation(~schedule_action, m); + Os.is_mac := + Dom_html.window##.navigator##.platform##toUpperCase##indexOf( + Js.string("MAC"), + ) + >= 0; + m; +}; + module App = { module Model = Model; module Action = Update; module State = State; + // let create = + // ( + // model: Incr.t(Haz3lweb.Model.t), + // ~old_model as _: Incr.t(Haz3lweb.Model.t), + // ~inject, + // ) => { + // open Incr.Let_syntax; + // let%map model = model; + // /* Note: mapping over the old_model here may + // trigger an additional redraw */ + // Component.create( + // ~apply_action=apply(model), + // model, + // Haz3lweb.Page.view(~inject, model), + // ~on_display=(_, ~schedule_action) => { + // if (edit_action_applied^ + // && JsUtil.timestamp() + // -. last_edit_action^ > 1000.0) { + // /* If an edit action has been applied, but no other edit action + // has been applied for 1 second, save the model. */ + // edit_action_applied := false; + // print_endline("Saving..."); + // schedule_action(Update.Save); + // }; + // if (scroll_to_caret.contents) { + // scroll_to_caret := false; + // JsUtil.scroll_cursor_into_view_if_needed(); + // }; + // }, + // ); + // }; + // }; +}; - let on_startup = (~schedule_action, m: Model.t) => { - let _ = - observe_font_specimen("font-specimen", fm => - schedule_action(Haz3lweb.Update.SetMeta(FontMetrics(fm))) - ); - - NinjaKeys.initialize(NinjaKeys.options(schedule_action)); - JsUtil.focus_clipboard_shim(); - - /* initialize state. */ - let state = State.init(); - - /* Initial evaluation on a worker */ - Update.schedule_evaluation(~schedule_action, m); +let app = + Bonsai.state_machine0( + (module Model), + (module Update), + ~apply_action= + (~inject, ~schedule_event) => + apply(~schedule_action=x => schedule_event(inject(x))), + ~default_model=Model.load(Model.blank), + ~reset=on_startup, + ); - Os.is_mac := - Dom_html.window##.navigator##.platform##toUpperCase##indexOf( - Js.string("MAC"), - ) - >= 0; - Async_kernel.Deferred.return(state); - }; +open Bonsai.Let_syntax; - let create = - ( - model: Incr.t(Haz3lweb.Model.t), - ~old_model as _: Incr.t(Haz3lweb.Model.t), - ~inject, - ) => { - open Incr.Let_syntax; - let%map model = model; - /* Note: mapping over the old_model here may - trigger an additional redraw */ - Component.create( - ~apply_action=apply(model), - model, - Haz3lweb.Page.view(~inject, model), - ~on_display=(_, ~schedule_action) => { - if (edit_action_applied^ - && JsUtil.timestamp() - -. last_edit_action^ > 1000.0) { - /* If an edit action has been applied, but no other edit action - has been applied for 1 second, save the model. */ - edit_action_applied := false; - print_endline("Saving..."); - schedule_action(Update.Save); - }; - if (scroll_to_caret.contents) { - scroll_to_caret := false; - JsUtil.scroll_cursor_into_view_if_needed(); - }; - }, - ); - }; +let view = { + let%sub app = app; + let%arr (model, inject) = app; + Haz3lweb.Page.view(~inject, model); + // Bonsai.Computation.map(app, ~f=((model, inject)) => + // Haz3lweb.Page.view(~inject, model) + // ); }; switch (JsUtil.Fragment.get_current()) { | Some("debug") => DebugMode.go() -| _ => - Incr_dom.Start_app.start( - (module App), - ~debug=false, - ~bind_to_element_with_id="container", - ~initial_model=Model.load(Model.blank), - ) +| _ => Bonsai_web.Start.start(view, ~bind_to_element_with_id="container") }; diff --git a/src/haz3lweb/Model.re b/src/haz3lweb/Model.re index 839c07a0c8..e4939b3af0 100644 --- a/src/haz3lweb/Model.re +++ b/src/haz3lweb/Model.re @@ -33,6 +33,7 @@ let ui_state_init = { mousedown: false, }; +[@deriving sexp] type t = { editors: Editors.t, settings: Settings.t, @@ -41,7 +42,7 @@ type t = { ui_state, }; -let cutoff = (===); +let equal = (===); let mk = (editors, results) => { editors, diff --git a/src/haz3lweb/dune b/src/haz3lweb/dune index 8d25155dc5..d3e42ec636 100644 --- a/src/haz3lweb/dune +++ b/src/haz3lweb/dune @@ -9,7 +9,8 @@ (name workerServer) (modules WorkerServer) (libraries - incr_dom + bonsai + bonsai.web virtual_dom.input_widgets util ppx_yojson_conv.expander @@ -38,7 +39,8 @@ ezjs_idb workerServer str - incr_dom + bonsai + bonsai.web virtual_dom.input_widgets util ppx_yojson_conv.expander @@ -66,7 +68,8 @@ js_of_ocaml-ppx ppx_let ppx_sexp_conv - ppx_deriving.show))) + ppx_deriving.show + bonsai.ppx_bonsai))) (executable (name worker) diff --git a/src/util/dune b/src/util/dune index 889c95bd2c..743b3009d9 100644 --- a/src/util/dune +++ b/src/util/dune @@ -1,6 +1,6 @@ (library (name util) - (libraries re base ptmap incr_dom virtual_dom yojson) + (libraries re base ptmap bonsai bonsai.web virtual_dom yojson) (js_of_ocaml) (preprocess (pps From 2e2aa4c7c6200852bad1bb7f070810d2340e1ff2 Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Thu, 26 Sep 2024 09:41:51 -0400 Subject: [PATCH 05/18] on_startup first attempt --- src/haz3lweb/Main.re | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index ed72a99a5a..0bfbd505ae 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -70,13 +70,8 @@ let apply = (model, action, ~schedule_action): Model.t => { }; let on_startup = - ( - ~inject: UpdateAction.t => Ui_effect.t(unit), - ~schedule_event: Ui_effect.t(unit) => unit, - m: Model.t, - ) - : Model.t => { - let schedule_action = action => schedule_event(inject(action)); + (~inject: UpdateAction.t => Ui_effect.t(unit), m: Model.t) + : Ui_effect.t(unit) => { let _ = observe_font_specimen("font-specimen", fm => schedule_action(Haz3lweb.Update.SetMeta(FontMetrics(fm))) @@ -91,7 +86,7 @@ let on_startup = Js.string("MAC"), ) >= 0; - m; + Ui_effect.Ignore; }; module App = { @@ -140,18 +135,26 @@ let app = (~inject, ~schedule_event) => apply(~schedule_action=x => schedule_event(inject(x))), ~default_model=Model.load(Model.blank), - ~reset=on_startup, ); open Bonsai.Let_syntax; let view = { + let startup_completed = Bonsai.toggle'(~default_model=false); + let%sub startup_completed = startup_completed; let%sub app = app; + let%sub after_display = { + switch%sub (startup_completed) { + | {state: false, set_state, _} => + let%arr (model, inject) = app + and set_state = set_state; + Bonsai.Effect.Many([on_startup(~inject, model), set_state(true)]); + | {state: true, _} => Bonsai.Computation.return(Ui_effect.Ignore) + }; + }; + let%sub () = Bonsai.Edge.lifecycle(~after_display, ()); let%arr (model, inject) = app; Haz3lweb.Page.view(~inject, model); - // Bonsai.Computation.map(app, ~f=((model, inject)) => - // Haz3lweb.Page.view(~inject, model) - // ); }; switch (JsUtil.Fragment.get_current()) { From 644009954b82e5b1be5d8a19e3fff6112a755d8f Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Fri, 27 Sep 2024 11:58:15 -0400 Subject: [PATCH 06/18] Make on_startup an action --- src/haz3lweb/Keyboard.re | 2 +- src/haz3lweb/Log.re | 3 ++- src/haz3lweb/Main.re | 41 ++---------------------------------- src/haz3lweb/Update.re | 38 +++++++++++++++++++++++++++++++++ src/haz3lweb/UpdateAction.re | 10 ++++++--- 5 files changed, 50 insertions(+), 44 deletions(-) diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index f0501a66a4..7e4e655f26 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -227,7 +227,7 @@ let shortcuts = (sys: Key.sys): list(shortcut) => ] @ (if (ExerciseSettings.show_instructor) {instructor_shortcuts} else {[]}); -let handle_key_event = (k: Key.t): option(Update.t) => { +let handle_key_event = (k: Key.t): option(UpdateAction.t) => { let now = (a: Action.t): option(UpdateAction.t) => Some(PerformAction(a)); switch (k) { diff --git a/src/haz3lweb/Log.re b/src/haz3lweb/Log.re index 4d98345dab..7c87a640f6 100644 --- a/src/haz3lweb/Log.re +++ b/src/haz3lweb/Log.re @@ -12,7 +12,8 @@ let is_action_logged: UpdateAction.t => bool = | FinishImportAll(_) | FinishImportScratchpad(_) | Benchmark(_) - | DebugConsole(_) => false + | DebugConsole(_) + | Startup => false | Reset | TAB | Set(_) diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index 0bfbd505ae..653a709923 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -6,23 +6,6 @@ let scroll_to_caret = ref(true); let edit_action_applied = ref(true); let last_edit_action = ref(JsUtil.timestamp()); -let observe_font_specimen = (id, update) => - ResizeObserver.observe( - ~node=JsUtil.get_elem_by_id(id), - ~f= - (entries, _) => { - let specimen = Js.to_array(entries)[0]; - let rect = specimen##.contentRect; - update( - Haz3lweb.FontMetrics.{ - row_height: rect##.bottom -. rect##.top, - col_width: rect##.right -. rect##.left, - }, - ); - }, - (), - ); - let restart_caret_animation = () => // necessary to trigger reflow // @@ -69,26 +52,6 @@ let apply = (model, action, ~schedule_action): Model.t => { }; }; -let on_startup = - (~inject: UpdateAction.t => Ui_effect.t(unit), m: Model.t) - : Ui_effect.t(unit) => { - let _ = - observe_font_specimen("font-specimen", fm => - schedule_action(Haz3lweb.Update.SetMeta(FontMetrics(fm))) - ); - NinjaKeys.initialize(NinjaKeys.options(schedule_action)); - JsUtil.focus_clipboard_shim(); - /* initialize state. */ - /* Initial evaluation on a worker */ - Update.schedule_evaluation(~schedule_action, m); - Os.is_mac := - Dom_html.window##.navigator##.platform##toUpperCase##indexOf( - Js.string("MAC"), - ) - >= 0; - Ui_effect.Ignore; -}; - module App = { module Model = Model; module Action = Update; @@ -146,9 +109,9 @@ let view = { let%sub after_display = { switch%sub (startup_completed) { | {state: false, set_state, _} => - let%arr (model, inject) = app + let%arr (_model, inject) = app and set_state = set_state; - Bonsai.Effect.Many([on_startup(~inject, model), set_state(true)]); + Bonsai.Effect.Many([set_state(true), inject(Update.Startup)]); | {state: true, _} => Bonsai.Computation.return(Ui_effect.Ignore) }; }; diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index de814c4561..26324a9c2e 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -1,8 +1,26 @@ open Util; +open Js_of_ocaml; open Haz3lcore; include UpdateAction; // to prevent circularity +let observe_font_specimen = (id, update) => + ResizeObserver.observe( + ~node=JsUtil.get_elem_by_id(id), + ~f= + (entries, _) => { + let specimen = Js.to_array(entries)[0]; + let rect = specimen##.contentRect; + update( + FontMetrics.{ + row_height: rect##.bottom -. rect##.top, + col_width: rect##.right -. rect##.left, + }, + ); + }, + (), + ); + let update_settings = (a: settings_action, {settings, _} as model: Model.t): Model.t => switch (a) { @@ -213,6 +231,25 @@ let schedule_evaluation = (~schedule_action, model: Model.t): unit => }; }; +let on_startup = + (~schedule_action: UpdateAction.t => unit, m: Model.t): Model.t => { + let _ = + observe_font_specimen("font-specimen", fm => + schedule_action(UpdateAction.SetMeta(FontMetrics(fm))) + ); + NinjaKeys.initialize(NinjaKeys.options(schedule_action)); + JsUtil.focus_clipboard_shim(); + /* initialize state. */ + /* Initial evaluation on a worker */ + schedule_evaluation(~schedule_action, m); + Os.is_mac := + Dom_html.window##.navigator##.platform##toUpperCase##indexOf( + Js.string("MAC"), + ) + >= 0; + m; +}; + let update_cached_data = (~schedule_action, update, m: Model.t): Model.t => { let update_dynamics = reevaluate_post_update(update); /* If we switch editors, or change settings which require statics @@ -373,6 +410,7 @@ let apply = }; let m: Result.t(Model.t) = switch (update) { + | Startup => Ok(on_startup(~schedule_action, model)) | Reset => Ok(Model.reset(model)) | Set(Evaluation(_) as s_action) => Ok(update_settings(s_action, model)) | Set(s_action) => diff --git a/src/haz3lweb/UpdateAction.re b/src/haz3lweb/UpdateAction.re index b67861090f..cd2f145f3e 100644 --- a/src/haz3lweb/UpdateAction.re +++ b/src/haz3lweb/UpdateAction.re @@ -57,6 +57,7 @@ type export_action = [@deriving (show({with_path: false}), sexp, yojson)] type t = /* meta */ + | Startup | Reset | Set(settings_action) | SetMeta(set_meta) @@ -144,7 +145,8 @@ let is_edit: t => bool = | DebugConsole(_) | InitImportAll(_) | InitImportScratchpad(_) - | Benchmark(_) => false; + | Benchmark(_) + | Startup => false; let reevaluate_post_update: t => bool = fun @@ -197,7 +199,8 @@ let reevaluate_post_update: t => bool = | SwitchDocumentationSlide(_) | Reset | Undo - | Redo => true; + | Redo + | Startup => true; let should_scroll_to_caret = fun @@ -235,7 +238,8 @@ let should_scroll_to_caret = | Reset | Undo | Redo - | TAB => true + | TAB + | Startup => true | PerformAction(a) => switch (a) { | Move(_) From 31b690abc08302b9b6c74d0bce7114d180391ac1 Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Fri, 27 Sep 2024 15:10:07 -0400 Subject: [PATCH 07/18] Finish converting to Bonsai --- src/haz3lweb/Main.re | 81 ++++++++++++++-------------------- src/haz3lweb/view/DebugMode.re | 31 +------------ 2 files changed, 36 insertions(+), 76 deletions(-) diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index 653a709923..f884404d17 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -1,6 +1,7 @@ open Util; open Js_of_ocaml; open Haz3lweb; +open Bonsai.Let_syntax; let scroll_to_caret = ref(true); let edit_action_applied = ref(true); @@ -52,44 +53,6 @@ let apply = (model, action, ~schedule_action): Model.t => { }; }; -module App = { - module Model = Model; - module Action = Update; - module State = State; - // let create = - // ( - // model: Incr.t(Haz3lweb.Model.t), - // ~old_model as _: Incr.t(Haz3lweb.Model.t), - // ~inject, - // ) => { - // open Incr.Let_syntax; - // let%map model = model; - // /* Note: mapping over the old_model here may - // trigger an additional redraw */ - // Component.create( - // ~apply_action=apply(model), - // model, - // Haz3lweb.Page.view(~inject, model), - // ~on_display=(_, ~schedule_action) => { - // if (edit_action_applied^ - // && JsUtil.timestamp() - // -. last_edit_action^ > 1000.0) { - // /* If an edit action has been applied, but no other edit action - // has been applied for 1 second, save the model. */ - // edit_action_applied := false; - // print_endline("Saving..."); - // schedule_action(Update.Save); - // }; - // if (scroll_to_caret.contents) { - // scroll_to_caret := false; - // JsUtil.scroll_cursor_into_view_if_needed(); - // }; - // }, - // ); - // }; - // }; -}; - let app = Bonsai.state_machine0( (module Model), @@ -100,22 +63,46 @@ let app = ~default_model=Model.load(Model.blank), ); -open Bonsai.Let_syntax; - -let view = { - let startup_completed = Bonsai.toggle'(~default_model=false); - let%sub startup_completed = startup_completed; - let%sub app = app; +let on_startup = effect => { + let%sub startup_completed = Bonsai.toggle'(~default_model=false); let%sub after_display = { switch%sub (startup_completed) { | {state: false, set_state, _} => - let%arr (_model, inject) = app + let%arr effect = effect and set_state = set_state; - Bonsai.Effect.Many([set_state(true), inject(Update.Startup)]); + Bonsai.Effect.Many([set_state(true), effect]); | {state: true, _} => Bonsai.Computation.return(Ui_effect.Ignore) }; }; - let%sub () = Bonsai.Edge.lifecycle(~after_display, ()); + Bonsai.Edge.lifecycle(~after_display, ()); +}; + +let view = { + let%sub app = app; + let%sub () = { + on_startup( + Bonsai.Value.map(~f=((_model, inject)) => inject(Startup), app), + ); + }; + let%sub after_display = { + let%arr (_model, inject) = app; + if (scroll_to_caret.contents) { + scroll_to_caret := false; + JsUtil.scroll_cursor_into_view_if_needed(); + }; + if (edit_action_applied^ + && JsUtil.timestamp() + -. last_edit_action^ > 1000.0) { + /* If an edit action has been applied, but no other edit action + has been applied for 1 second, save the model. */ + edit_action_applied := false; + print_endline("Saving..."); + inject(Update.Save); + } else { + Ui_effect.Ignore; + }; + }; + let%sub () = Bonsai.Edge.after_display(after_display); let%arr (model, inject) = app; Haz3lweb.Page.view(~inject, model); }; diff --git a/src/haz3lweb/view/DebugMode.re b/src/haz3lweb/view/DebugMode.re index 543e7cc757..39cba26eb8 100644 --- a/src/haz3lweb/view/DebugMode.re +++ b/src/haz3lweb/view/DebugMode.re @@ -48,35 +48,8 @@ let view = { ); }; -module App = { - module Model = { - type t = unit; - let cutoff = (_, _) => false; - }; - module Action = { - type t = unit; - let sexp_of_t = _ => Sexplib.Sexp.unit; - }; - module State = { - type t = unit; - }; - let on_startup = (~schedule_action as _, _) => - Async_kernel.Deferred.return(); - let create = (_, ~old_model as _, ~inject as _) => - Incr_dom.Incr.return() - |> Incr_dom.Incr.map(~f=_ => - Incr_dom.Component.create( - ~apply_action=(_, _, ~schedule_action as _) => (), - (), - view, - ) - ); -}; - let go = () => - Incr_dom.Start_app.start( - (module App), - ~debug=false, + Bonsai_web.Start.start( + Bonsai.Computation.return(view), ~bind_to_element_with_id="container", - ~initial_model=(), ); From 7a2d9a7017488bbfe0e15732096f6ae854590750 Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Fri, 27 Sep 2024 15:10:24 -0400 Subject: [PATCH 08/18] Update dune-project --- dune-project | 1 - 1 file changed, 1 deletion(-) diff --git a/dune-project b/dune-project index 335194ae48..fbc79765cc 100644 --- a/dune-project +++ b/dune-project @@ -29,7 +29,6 @@ reason ppx_yojson_conv_lib ppx_yojson_conv - incr_dom (omd (>= 2.0.0~alpha4)) ezjs_idb virtual_dom From ccc6dc16b67bbb8c56d88b19f33e4f1b0fa80c46 Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Fri, 27 Sep 2024 15:17:45 -0400 Subject: [PATCH 09/18] Update dependencies --- dune-project | 2 +- hazel.opam | 3 +-- hazel.opam.locked | 58 ++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 57 insertions(+), 6 deletions(-) diff --git a/dune-project b/dune-project index fbc79765cc..dd2aafe478 100644 --- a/dune-project +++ b/dune-project @@ -31,7 +31,7 @@ ppx_yojson_conv (omd (>= 2.0.0~alpha4)) ezjs_idb - virtual_dom + bonsai ppx_deriving ptmap uuidm diff --git a/hazel.opam b/hazel.opam index 36a81b933a..03973e9189 100644 --- a/hazel.opam +++ b/hazel.opam @@ -14,10 +14,9 @@ depends: [ "reason" "ppx_yojson_conv_lib" "ppx_yojson_conv" - "incr_dom" "omd" {>= "2.0.0~alpha4"} "ezjs_idb" - "virtual_dom" + "bonsai" "ppx_deriving" "ptmap" "uuidm" diff --git a/hazel.opam.locked b/hazel.opam.locked index 31fd8b2c15..04c2cb9507 100644 --- a/hazel.opam.locked +++ b/hazel.opam.locked @@ -1,7 +1,7 @@ opam-version: "2.0" name: "hazel" -version: "~dev" +version: "dev" synopsis: "Hazel, a live functional programming environment with typed holes" maintainer: "Hazel Development Team" authors: "Hazel Development Team" @@ -13,9 +13,17 @@ depends: [ "alcotest" {= "1.8.0" & with-test} "angstrom" {= "0.16.0"} "astring" {= "0.8.5"} + "async" {= "v0.16.0"} + "async_durable" {= "v0.16.0"} + "async_extra" {= "v0.16.0"} "async_js" {= "v0.16.0"} "async_kernel" {= "v0.16.0"} "async_rpc_kernel" {= "v0.16.0"} + "async_rpc_websocket" {= "v0.16.0"} + "async_ssl" {= "v0.16.1"} + "async_unix" {= "v0.16.0"} + "async_websocket" {= "v0.16.0"} + "babel" {= "v0.16.0"} "base" {= "v0.16.3"} "base-bigarray" {= "base"} "base-bytes" {= "base"} @@ -26,53 +34,81 @@ depends: [ "base64" {= "3.5.1"} "base_bigstring" {= "v0.16.0"} "base_quickcheck" {= "v0.16.0"} + "bigarray-compat" {= "1.1.0"} "bignum" {= "v0.16.0"} "bigstringaf" {= "0.9.1"} "bin_prot" {= "v0.16.0"} + "bonsai" {= "v0.16.0"} "camlp-streams" {= "5.0.1"} "chrome-trace" {= "3.16.0"} "cmdliner" {= "1.3.0"} + "cohttp" {= "5.3.1"} + "cohttp-async" {= "5.3.0"} + "cohttp_async_websocket" {= "v0.16.0"} + "conduit" {= "7.0.0"} + "conduit-async" {= "7.0.0"} "conf-bash" {= "1"} "conf-gmp" {= "4"} + "conf-gmp-powm-sec" {= "3"} + "conf-libffi" {= "2.0.0"} + "conf-libssl" {= "4"} + "conf-pkg-config" {= "3"} + "conf-zlib" {= "1"} "core" {= "v0.16.2"} + "core_bench" {= "v0.16.0"} "core_kernel" {= "v0.16.0"} + "core_unix" {= "v0.16.0"} "cppo" {= "1.6.9"} "crunch" {= "3.3.1" & with-doc} + "cryptokit" {= "1.16.1"} "csexp" {= "1.5.2"} + "ctypes" {= "0.23.0"} + "ctypes-foreign" {= "0.23.0"} "diffable" {= "v0.16.0"} + "domain-name" {= "0.4.0"} "dune" {= "3.16.0"} "dune-build-info" {= "3.16.0"} "dune-configurator" {= "3.16.0"} "dune-rpc" {= "3.16.0"} "dyn" {= "3.16.0"} "either" {= "1.0.0"} + "expect_test_helpers_core" {= "v0.16.0"} "ezjs_idb" {= "0.1.1"} "ezjs_min" {= "0.3.0"} "fiber" {= "3.7.0"} "fieldslib" {= "v0.16.0"} "fix" {= "20230505"} - "fmt" {= "0.9.0" & with-test} + "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} + "fuzzy_match" {= "v0.16.0"} "gen" {= "1.1"} "gen_js_api" {= "1.1.2"} "incr_dom" {= "v0.16.0"} "incr_map" {= "v0.16.0"} "incr_select" {= "v0.16.0"} "incremental" {= "v0.16.1"} + "indentation_buffer" {= "v0.16.0"} "int_repr" {= "v0.16.0"} + "integers" {= "0.7.0"} + "ipaddr" {= "5.6.0"} + "ipaddr-sexp" {= "5.6.0"} "jane-street-headers" {= "v0.16.0"} "janestreet_lru_cache" {= "v0.16.1"} "js_of_ocaml" {= "5.8.2"} "js_of_ocaml-compiler" {= "5.8.2"} "js_of_ocaml-ppx" {= "5.8.2"} "js_of_ocaml_patches" {= "v0.16.0"} + "jsonm" {= "1.0.2"} "jsonrpc" {= "1.19.0"} "jst-config" {= "v0.16.0"} "junit" {= "2.0.2" & with-test} "junit_alcotest" {= "2.0.2" & with-test} "lambdasoup" {= "1.0.0"} + "logs" {= "0.7.0"} "lsp" {= "1.19.0"} "lwt" {= "5.7.0"} + "macaddr" {= "5.6.0"} + "magic-mime" {= "1.3.1"} "markup" {= "1.0.3"} "menhir" {= "20231231"} "menhirCST" {= "20231231"} @@ -85,11 +121,13 @@ depends: [ "ocaml-base-compiler" {= "5.2.0"} "ocaml-compiler-libs" {= "v0.17.0"} "ocaml-config" {= "3"} + "ocaml-embed-file" {= "v0.16.0"} "ocaml-index" {= "1.0"} "ocaml-lsp-server" {= "1.19.0"} "ocaml-options-vanilla" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} "ocaml-version" {= "3.6.7"} + "ocaml_intrinsics" {= "v0.16.1"} "ocamlbuild" {= "0.14.3"} "ocamlc-loc" {= "3.16.0"} "ocamlfind" {= "1.9.6"} @@ -104,7 +142,11 @@ depends: [ "ojs" {= "1.1.2"} "omd" {= "2.0.0~alpha4"} "ordering" {= "3.16.0"} + "ordinal_abbreviation" {= "v0.16.0"} "parsexp" {= "v0.16.0"} + "patdiff" {= "v0.16.1"} + "patience_diff" {= "v0.16.0"} + "polling_state_rpc" {= "v0.16.0"} "pp" {= "1.2.0"} "ppx_assert" {= "v0.16.0"} "ppx_base" {= "v0.16.0"} @@ -112,6 +154,7 @@ depends: [ "ppx_bin_prot" {= "v0.16.0"} "ppx_cold" {= "v0.16.0"} "ppx_compare" {= "v0.16.0"} + "ppx_css" {= "v0.16.0"} "ppx_custom_printf" {= "v0.16.0"} "ppx_derivers" {= "1.2.1"} "ppx_deriving" {= "6.0.2"} @@ -141,19 +184,24 @@ depends: [ "ppx_stable_witness" {= "v0.16.0"} "ppx_string" {= "v0.16.0"} "ppx_tydi" {= "v0.16.0"} + "ppx_typed_fields" {= "v0.16.0"} "ppx_typerep_conv" {= "v0.16.0"} "ppx_variants_conv" {= "v0.16.0"} "ppx_yojson_conv" {= "v0.16.0"} "ppx_yojson_conv_lib" {= "v0.16.0"} - "ppxlib" {= "0.32.1"} + "ppxlib" {= "0.33.0"} + "profunctor" {= "v0.16.0"} "protocol_version_header" {= "v0.16.0"} "ptime" {= "1.1.0" & with-test} "ptmap" {= "2.0.5"} "re" {= "1.11.0"} "reason" {= "3.12.0"} + "record_builder" {= "v0.16.0"} "result" {= "1.5"} "sedlex" {= "3.2"} "seq" {= "base"} + "sexp_grammar" {= "v0.16.0"} + "sexp_pretty" {= "v0.16.0"} "sexplib" {= "v0.16.0"} "sexplib0" {= "v0.16.0"} "spawn" {= "v0.15.1"} @@ -164,7 +212,11 @@ depends: [ "stored_reversed" {= "v0.16.0"} "streamable" {= "v0.16.1"} "stringext" {= "1.6.0"} + "textutils" {= "v0.16.0"} + "textutils_kernel" {= "v0.16.0"} + "tilde_f" {= "v0.16.0"} "time_now" {= "v0.16.0"} + "timezone" {= "v0.16.0"} "topkg" {= "1.0.7"} "typerep" {= "v0.16.0"} "tyxml" {= "4.6.0"} From 320611eb3da65a2ea8840e0f56297394659ad63d Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Fri, 27 Sep 2024 15:22:14 -0400 Subject: [PATCH 10/18] Tidy up --- src/haz3lweb/Main.re | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index f884404d17..0fe76fe63c 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -63,6 +63,8 @@ let app = ~default_model=Model.load(Model.blank), ); +/* This subcomponent is used to run an effect once when the app starts up, + After the first draw */ let on_startup = effect => { let%sub startup_completed = Bonsai.toggle'(~default_model=false); let%sub after_display = { @@ -74,7 +76,7 @@ let on_startup = effect => { | {state: true, _} => Bonsai.Computation.return(Ui_effect.Ignore) }; }; - Bonsai.Edge.lifecycle(~after_display, ()); + Bonsai.Edge.after_display(after_display); }; let view = { From 76d1b0a60ea5979c13f71f7e1dc6b0f0a8f4e16f Mon Sep 17 00:00:00 2001 From: Matt Keenan Date: Fri, 27 Sep 2024 15:28:41 -0400 Subject: [PATCH 11/18] Remove state from apply --- src/haz3lweb/Main.re | 2 +- src/haz3lweb/Update.re | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index 0fe76fe63c..af8058b770 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -31,7 +31,7 @@ let apply = (model, action, ~schedule_action): Model.t => { last_edit_action := JsUtil.timestamp(); switch ( try({ - let new_model = Update.apply(model, action, (), ~schedule_action); + let new_model = Update.apply(model, action, ~schedule_action); Log.update(action); new_model; }) { diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 26324a9c2e..1aacb159f3 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -397,9 +397,7 @@ let ui_state_update = }; }; -let apply = - (model: Model.t, update: t, _state: State.t, ~schedule_action) - : Result.t(Model.t) => { +let apply = (model: Model.t, update: t, ~schedule_action): Result.t(Model.t) => { let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => { switch ( Editors.perform_action(~settings=model.settings.core, model.editors, a) From 503e2356ce6d5c3d0824d2939403029960cb6840 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Sat, 28 Sep 2024 15:56:49 -0400 Subject: [PATCH 12/18] Update dependencies and minimize changes post bonsai --- dune-project | 2 +- hazel.opam | 2 +- hazel.opam.locked | 52 +++++++++++++++++++++++------------------------ 3 files changed, 27 insertions(+), 29 deletions(-) diff --git a/dune-project b/dune-project index dd2aafe478..1194593485 100644 --- a/dune-project +++ b/dune-project @@ -34,7 +34,7 @@ bonsai ppx_deriving ptmap - uuidm + (uuidm (= 0.9.8)) ; 0.9.9 has breaking deprecated changes unionFind ocamlformat (junit_alcotest :with-test) diff --git a/hazel.opam b/hazel.opam index 03973e9189..e78b188325 100644 --- a/hazel.opam +++ b/hazel.opam @@ -19,7 +19,7 @@ depends: [ "bonsai" "ppx_deriving" "ptmap" - "uuidm" + "uuidm" {= "0.9.8"} "unionFind" "ocamlformat" "junit_alcotest" {with-test} diff --git a/hazel.opam.locked b/hazel.opam.locked index 04c2cb9507..b2cfce2cea 100644 --- a/hazel.opam.locked +++ b/hazel.opam.locked @@ -11,7 +11,7 @@ bug-reports: "https://github.com/hazelgrove/hazel/issues" depends: [ "abstract_algebra" {= "v0.16.0"} "alcotest" {= "1.8.0" & with-test} - "angstrom" {= "0.16.0"} + "angstrom" {= "0.16.1"} "astring" {= "0.8.5"} "async" {= "v0.16.0"} "async_durable" {= "v0.16.0"} @@ -36,7 +36,7 @@ depends: [ "base_quickcheck" {= "v0.16.0"} "bigarray-compat" {= "1.1.0"} "bignum" {= "v0.16.0"} - "bigstringaf" {= "0.9.1"} + "bigstringaf" {= "0.10.0"} "bin_prot" {= "v0.16.0"} "bonsai" {= "v0.16.0"} "camlp-streams" {= "5.0.1"} @@ -45,8 +45,8 @@ depends: [ "cohttp" {= "5.3.1"} "cohttp-async" {= "5.3.0"} "cohttp_async_websocket" {= "v0.16.0"} - "conduit" {= "7.0.0"} - "conduit-async" {= "7.0.0"} + "conduit" {= "7.1.0"} + "conduit-async" {= "7.1.0"} "conf-bash" {= "1"} "conf-gmp" {= "4"} "conf-gmp-powm-sec" {= "3"} @@ -58,7 +58,7 @@ depends: [ "core_bench" {= "v0.16.0"} "core_kernel" {= "v0.16.0"} "core_unix" {= "v0.16.0"} - "cppo" {= "1.6.9"} + "cppo" {= "1.7.0"} "crunch" {= "3.3.1" & with-doc} "cryptokit" {= "1.16.1"} "csexp" {= "1.5.2"} @@ -82,7 +82,7 @@ depends: [ "fpath" {= "0.7.3"} "fuzzy_match" {= "v0.16.0"} "gen" {= "1.1"} - "gen_js_api" {= "1.1.2"} + "gen_js_api" {= "1.1.3"} "incr_dom" {= "v0.16.0"} "incr_map" {= "v0.16.0"} "incr_select" {= "v0.16.0"} @@ -103,43 +103,41 @@ depends: [ "jst-config" {= "v0.16.0"} "junit" {= "2.0.2" & with-test} "junit_alcotest" {= "2.0.2" & with-test} - "lambdasoup" {= "1.0.0"} + "lambdasoup" {= "1.1.1"} "logs" {= "0.7.0"} "lsp" {= "1.19.0"} - "lwt" {= "5.7.0"} "macaddr" {= "5.6.0"} "magic-mime" {= "1.3.1"} "markup" {= "1.0.3"} - "menhir" {= "20231231"} - "menhirCST" {= "20231231"} - "menhirLib" {= "20231231"} - "menhirSdk" {= "20231231"} + "menhir" {= "20240715"} + "menhirCST" {= "20240715"} + "menhirLib" {= "20240715"} + "menhirSdk" {= "20240715"} "merlin-extend" {= "0.6.1"} - "merlin-lib" {= "5.1-502"} - "num" {= "1.5"} + "merlin-lib" {= "5.2.1-502"} + "num" {= "1.5-1"} "ocaml" {= "5.2.0"} "ocaml-base-compiler" {= "5.2.0"} "ocaml-compiler-libs" {= "v0.17.0"} "ocaml-config" {= "3"} "ocaml-embed-file" {= "v0.16.0"} - "ocaml-index" {= "1.0"} + "ocaml-index" {= "1.1"} "ocaml-lsp-server" {= "1.19.0"} "ocaml-options-vanilla" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} - "ocaml-version" {= "3.6.7"} + "ocaml-version" {= "3.6.9"} "ocaml_intrinsics" {= "v0.16.1"} - "ocamlbuild" {= "0.14.3"} + "ocamlbuild" {= "0.15.0"} "ocamlc-loc" {= "3.16.0"} "ocamlfind" {= "1.9.6"} "ocamlformat" {= "0.26.2"} "ocamlformat-lib" {= "0.26.2"} "ocamlformat-rpc-lib" {= "0.26.2"} "ocp-indent" {= "1.8.1"} - "ocplib-endian" {= "1.2"} "octavius" {= "1.2.2"} - "odoc" {= "2.4.2" & with-doc} - "odoc-parser" {= "2.4.2" & with-doc} - "ojs" {= "1.1.2"} + "odoc" {= "2.4.3" & with-doc} + "odoc-parser" {= "2.4.3" & with-doc} + "ojs" {= "1.1.3"} "omd" {= "2.0.0~alpha4"} "ordering" {= "3.16.0"} "ordinal_abbreviation" {= "v0.16.0"} @@ -192,9 +190,9 @@ depends: [ "ppxlib" {= "0.33.0"} "profunctor" {= "v0.16.0"} "protocol_version_header" {= "v0.16.0"} - "ptime" {= "1.1.0" & with-test} + "ptime" {= "1.2.0" & with-test} "ptmap" {= "2.0.5"} - "re" {= "1.11.0"} + "re" {= "1.12.0"} "reason" {= "3.12.0"} "record_builder" {= "v0.16.0"} "result" {= "1.5"} @@ -224,16 +222,16 @@ depends: [ "unionFind" {= "20220122"} "uri" {= "4.4.0"} "uri-sexp" {= "4.4.0"} - "uucp" {= "15.1.0"} + "uucp" {= "16.0.0"} "uuidm" {= "0.9.8"} - "uunf" {= "15.1.0"} - "uuseg" {= "15.1.0"} + "uunf" {= "16.0.0"} + "uuseg" {= "16.0.0"} "uutf" {= "1.0.3"} "variantslib" {= "v0.16.0"} "virtual_dom" {= "v0.16.0"} "xdg" {= "3.16.0"} "yojson" {= "2.2.2"} - "zarith" {= "1.13"} + "zarith" {= "1.14"} "zarith_stubs_js" {= "v0.16.1"} ] build: [ From 202a0db565d62850ec27602475100801dde304b7 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Mon, 30 Sep 2024 15:33:02 -0400 Subject: [PATCH 13/18] Add some additional tests to be useful for the labeled tuples branch - Test_Statics for determining the type of the given expression - Test_Elaboration adds a unapplied function --- src/haz3lcore/lang/term/IdTagged.re | 5 + test/Test_Elaboration.re | 23 +++-- test/Test_Statics.re | 140 ++++++++++++++++++++++++++++ test/haz3ltest.re | 5 +- 4 files changed, 160 insertions(+), 13 deletions(-) create mode 100644 test/Test_Statics.re diff --git a/src/haz3lcore/lang/term/IdTagged.re b/src/haz3lcore/lang/term/IdTagged.re index 084a252de4..3812b0e83f 100644 --- a/src/haz3lcore/lang/term/IdTagged.re +++ b/src/haz3lcore/lang/term/IdTagged.re @@ -14,6 +14,11 @@ type t('a) = { term: 'a, }; +// To be used if you want to remove the id from the debug output +// let pp: ((Format.formatter, 'a) => unit, Format.formatter, t('a)) => unit = +// (fmt_a, formatter, ta) => { +// fmt_a(formatter, ta.term); +// }; let fresh = term => { {ids: [Id.mk()], copied: false, term}; }; diff --git a/test/Test_Elaboration.re b/test/Test_Elaboration.re index 1c5a7c7271..2bd2c5ef1a 100644 --- a/test/Test_Elaboration.re +++ b/test/Test_Elaboration.re @@ -74,20 +74,18 @@ let consistent_if = () => dhexp_of_uexp(u6), ); -let u7: Exp.t = - Ap( - Forward, - Fun( - Var("x") |> Pat.fresh, - BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) - |> Exp.fresh, - None, - None, - ) - |> Exp.fresh, - Var("y") |> Exp.fresh, +// x => 4 + 5 +let f = + Fun( + Var("x") |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) |> Exp.fresh, + None, + None, ) |> Exp.fresh; +let unapplied_function = () => alco_check("A function", f, dhexp_of_uexp(f)); + +let u7: Exp.t = Ap(Forward, f, Var("y") |> Exp.fresh) |> Exp.fresh; let ap_fun = () => alco_check("Application of a function", u7, dhexp_of_uexp(u7)); @@ -186,6 +184,7 @@ let elaboration_tests = [ test_case("Let expression", `Quick, let_exp), test_case("Inconsistent binary operation", `Quick, bin_op), test_case("Consistent if statement", `Quick, consistent_if), + test_case("An unapplied function", `Quick, unapplied_function), test_case("Application of function on free variable", `Quick, ap_fun), test_case("Inconsistent case statement", `Quick, inconsistent_case), test_case("Let expression for a function", `Quick, let_fun), diff --git a/test/Test_Statics.re b/test/Test_Statics.re new file mode 100644 index 0000000000..6b0189cf72 --- /dev/null +++ b/test/Test_Statics.re @@ -0,0 +1,140 @@ +open Alcotest; +open Haz3lcore; + +let testable_typ = testable(Fmt.using(Typ.show, Fmt.string), Typ.fast_equal); +module FreshId = { + let arrow = (a, b) => Arrow(a, b) |> Typ.fresh; + let unknown = a => Unknown(a) |> Typ.fresh; + let int = Typ.fresh(Int); + let float = Typ.fresh(Float); + let prod = a => Prod(a) |> Typ.fresh; + let string = Typ.fresh(String); +}; +let ids = List.init(12, _ => Id.mk()); +let id_at = x => x |> List.nth(ids); +let statics = Statics.mk(CoreSettings.on, Builtins.ctx_init); +let alco_check = Alcotest.option(testable_typ) |> Alcotest.check; + +// Get the type from the statics +let type_of = f => { + let s = statics(f); + switch (Id.Map.find(IdTagged.rep_id(f), s)) { + | InfoExp({ty, _}) => Some(ty) + | _ => None + }; +}; + +let unapplied_function = () => + alco_check( + "Unknown param", + Some(FreshId.(arrow(unknown(Internal), int))), + type_of( + Fun( + Var("x") |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + ); + +let tests = [ + test_case("Function with unknown param", `Quick, () => + alco_check( + "x => 4 + 5", + Some(FreshId.(arrow(unknown(Internal), int))), + type_of( + Fun( + Var("x") |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + ) + ), + test_case("Function with known param", `Quick, () => + alco_check( + "x : Int => 4 + 5", + Some(FreshId.(arrow(int, int))), + type_of( + Fun( + Pat.Cast( + Var("x") |> Pat.fresh, + FreshId.int, + FreshId.unknown(Internal), + ) + |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + ) + ), + test_case("bifunction", `Quick, () => + alco_check( + "x : Int, y: Int => x + y", + Some(FreshId.(arrow(prod([int, int]), int))), + type_of( + Fun( + Pat.Tuple([ + Pat.Cast( + Var("x") |> Pat.fresh, + FreshId.int, + FreshId.unknown(Internal), + ) + |> Pat.fresh, + Pat.Cast( + Var("y") |> Pat.fresh, + FreshId.int, + FreshId.unknown(Internal), + ) + |> Pat.fresh, + ]) + |> Pat.fresh, + BinOp(Int(Plus), Var("x") |> Exp.fresh, Var("y") |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + ) + ), + test_case("function application", `Quick, () => + alco_check( + "float_of_int(1)", + Some(FreshId.(float)), + type_of( + Ap(Forward, Var("float_of_int") |> Exp.fresh, Int(1) |> Exp.fresh) + |> Exp.fresh, + ), + ) + ), + test_case("function deferral", `Quick, () => + alco_check( + "string_sub(\"hello\", 1, _)", + Some(FreshId.(string)), + type_of( + Ap( + Forward, + Var("string_sub") |> Exp.fresh, + Tuple([ + String("hello") |> Exp.fresh, + Int(1) |> Exp.fresh, + Deferral(InAp) |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + ), + ) + ), +]; diff --git a/test/haz3ltest.re b/test/haz3ltest.re index e405fba7b8..10db05e656 100644 --- a/test/haz3ltest.re +++ b/test/haz3ltest.re @@ -4,6 +4,9 @@ let (suite, _) = run_and_report( ~and_exit=false, "Dynamics", - [("Elaboration", Test_Elaboration.elaboration_tests)], + [ + ("Elaboration", Test_Elaboration.elaboration_tests), + ("Statics", Test_Statics.tests), + ], ); Junit.to_file(Junit.make([suite]), "junit_tests.xml"); From 0b2782eed183a793ee904409f4439fc012c47f58 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Mon, 30 Sep 2024 16:50:27 -0400 Subject: [PATCH 14/18] Remove unnecessary qualifiers --- test/Test_Statics.re | 172 ++++++++++++++++++++----------------------- 1 file changed, 80 insertions(+), 92 deletions(-) diff --git a/test/Test_Statics.re b/test/Test_Statics.re index 6b0189cf72..b8fe0b184e 100644 --- a/test/Test_Statics.re +++ b/test/Test_Statics.re @@ -40,101 +40,89 @@ let unapplied_function = () => ), ); -let tests = [ - test_case("Function with unknown param", `Quick, () => - alco_check( - "x => 4 + 5", - Some(FreshId.(arrow(unknown(Internal), int))), - type_of( - Fun( - Var("x") |> Pat.fresh, - BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) - |> Exp.fresh, - None, - None, - ) - |> Exp.fresh, - ), - ) - ), - test_case("Function with known param", `Quick, () => - alco_check( - "x : Int => 4 + 5", - Some(FreshId.(arrow(int, int))), - type_of( - Fun( - Pat.Cast( +let tests = + FreshId.[ + test_case("Function with unknown param", `Quick, () => + alco_check( + "x => 4 + 5", + Some(arrow(unknown(Internal), int)), + type_of( + Fun( Var("x") |> Pat.fresh, - FreshId.int, - FreshId.unknown(Internal), + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, ) - |> Pat.fresh, - BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) |> Exp.fresh, - None, - None, - ) - |> Exp.fresh, - ), - ) - ), - test_case("bifunction", `Quick, () => - alco_check( - "x : Int, y: Int => x + y", - Some(FreshId.(arrow(prod([int, int]), int))), - type_of( - Fun( - Pat.Tuple([ - Pat.Cast( - Var("x") |> Pat.fresh, - FreshId.int, - FreshId.unknown(Internal), - ) - |> Pat.fresh, - Pat.Cast( - Var("y") |> Pat.fresh, - FreshId.int, - FreshId.unknown(Internal), - ) + ), + ) + ), + test_case("Function with known param", `Quick, () => + alco_check( + "x : Int => 4 + 5", + Some(arrow(int, int)), + type_of( + Fun( + Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + ) + ), + test_case("bifunction", `Quick, () => + alco_check( + "x : Int, y: Int => x + y", + Some(arrow(prod([int, int]), int)), + type_of( + Fun( + Tuple([ + Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) + |> Pat.fresh, + Cast(Var("y") |> Pat.fresh, int, unknown(Internal)) + |> Pat.fresh, + ]) |> Pat.fresh, - ]) - |> Pat.fresh, - BinOp(Int(Plus), Var("x") |> Exp.fresh, Var("y") |> Exp.fresh) + BinOp(Int(Plus), Var("x") |> Exp.fresh, Var("y") |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) |> Exp.fresh, - None, - None, - ) - |> Exp.fresh, - ), - ) - ), - test_case("function application", `Quick, () => - alco_check( - "float_of_int(1)", - Some(FreshId.(float)), - type_of( - Ap(Forward, Var("float_of_int") |> Exp.fresh, Int(1) |> Exp.fresh) - |> Exp.fresh, - ), - ) - ), - test_case("function deferral", `Quick, () => - alco_check( - "string_sub(\"hello\", 1, _)", - Some(FreshId.(string)), - type_of( - Ap( - Forward, - Var("string_sub") |> Exp.fresh, - Tuple([ - String("hello") |> Exp.fresh, - Int(1) |> Exp.fresh, - Deferral(InAp) |> Exp.fresh, - ]) + ), + ) + ), + test_case("function application", `Quick, () => + alco_check( + "float_of_int(1)", + Some(float), + type_of( + Ap(Forward, Var("float_of_int") |> Exp.fresh, Int(1) |> Exp.fresh) |> Exp.fresh, - ) - |> Exp.fresh, - ), - ) - ), -]; + ), + ) + ), + test_case("function deferral", `Quick, () => + alco_check( + "string_sub(\"hello\", 1, _)", + Some(string), + type_of( + Ap( + Forward, + Var("string_sub") |> Exp.fresh, + Tuple([ + String("hello") |> Exp.fresh, + Int(1) |> Exp.fresh, + Deferral(InAp) |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + ), + ) + ), + ]; From 8fbfe3bb80758f256b54a5fce45dd95cb49a3d9e Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Tue, 1 Oct 2024 11:10:51 -0400 Subject: [PATCH 15/18] Fix function deferral test --- test/Test_Statics.re | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/test/Test_Statics.re b/test/Test_Statics.re index b8fe0b184e..71fdafc8ba 100644 --- a/test/Test_Statics.re +++ b/test/Test_Statics.re @@ -109,17 +109,15 @@ let tests = test_case("function deferral", `Quick, () => alco_check( "string_sub(\"hello\", 1, _)", - Some(string), + Some(arrow(int, string)), type_of( - Ap( - Forward, + DeferredAp( Var("string_sub") |> Exp.fresh, - Tuple([ + [ String("hello") |> Exp.fresh, Int(1) |> Exp.fresh, Deferral(InAp) |> Exp.fresh, - ]) - |> Exp.fresh, + ], ) |> Exp.fresh, ), From 854edc88864ca3cb03c128dda8b5bc553dcd2731 Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Tue, 1 Oct 2024 11:44:15 -0400 Subject: [PATCH 16/18] Add deferral elaboration test --- test/Test_Elaboration.re | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/test/Test_Elaboration.re b/test/Test_Elaboration.re index 2bd2c5ef1a..2516f25227 100644 --- a/test/Test_Elaboration.re +++ b/test/Test_Elaboration.re @@ -177,6 +177,33 @@ let let_fun = () => dhexp_of_uexp(u9), ); +let deferral = () => + alco_check( + "string_sub(\"hello\", 1, _)", + dhexp_of_uexp( + DeferredAp( + Var("string_sub") |> Exp.fresh, + [ + String("hello") |> Exp.fresh, + Int(1) |> Exp.fresh, + Deferral(InAp) |> Exp.fresh, + ], + ) + |> Exp.fresh, + ), + dhexp_of_uexp( + DeferredAp( + Var("string_sub") |> Exp.fresh, + [ + String("hello") |> Exp.fresh, + Int(1) |> Exp.fresh, + Deferral(InAp) |> Exp.fresh, + ], + ) + |> Exp.fresh, + ), + ); + let elaboration_tests = [ test_case("Single integer", `Quick, single_integer), test_case("Empty hole", `Quick, empty_hole), @@ -188,4 +215,9 @@ let elaboration_tests = [ test_case("Application of function on free variable", `Quick, ap_fun), test_case("Inconsistent case statement", `Quick, inconsistent_case), test_case("Let expression for a function", `Quick, let_fun), + test_case( + "Function application with a deferred argument", + `Quick, + deferral, + ), ]; From 76ed41d82dc1fb426db80942fc72551ff6bcd28c Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Tue, 1 Oct 2024 11:44:54 -0400 Subject: [PATCH 17/18] Add evaluation tests --- test/Test_Evaluator.re | 44 ++++++++++++++++++++++++++++++++++++++++++ test/haz3ltest.re | 1 + 2 files changed, 45 insertions(+) create mode 100644 test/Test_Evaluator.re diff --git a/test/Test_Evaluator.re b/test/Test_Evaluator.re new file mode 100644 index 0000000000..fc159425b2 --- /dev/null +++ b/test/Test_Evaluator.re @@ -0,0 +1,44 @@ +open Alcotest; +open Haz3lcore; +let dhexp_typ = testable(Fmt.using(Exp.show, Fmt.string), DHExp.fast_equal); + +let ids = List.init(12, _ => Id.mk()); +let id_at = x => x |> List.nth(ids); +let statics = Statics.mk(CoreSettings.on, Builtins.ctx_init); + +// Get the type from the statics +let type_of = f => { + let s = statics(f); + switch (Id.Map.find(IdTagged.rep_id(f), s)) { + | InfoExp({ty, _}) => Some(ty) + | _ => None + }; +}; + +let int_evaluation = + Evaluator.evaluate(Builtins.env_init, {d: Exp.Int(8) |> Exp.fresh}); + +let evaluation_test = (msg, expected, unevaluated) => + check( + dhexp_typ, + msg, + expected, + Evaluator.Result.unbox( + snd(Evaluator.evaluate(Builtins.env_init, {d: unevaluated})), + ), + ); + +let test_int = () => + evaluation_test("8", Int(8) |> Exp.fresh, Int(8) |> Exp.fresh); + +let test_sum = () => + evaluation_test( + "4 + 5", + Int(9) |> Exp.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) |> Exp.fresh, + ); + +let tests = [ + test_case("Integer literal", `Quick, test_int), + test_case("Integer sum", `Quick, test_sum), +]; diff --git a/test/haz3ltest.re b/test/haz3ltest.re index 10db05e656..3e13ae44b7 100644 --- a/test/haz3ltest.re +++ b/test/haz3ltest.re @@ -7,6 +7,7 @@ let (suite, _) = [ ("Elaboration", Test_Elaboration.elaboration_tests), ("Statics", Test_Statics.tests), + ("Evaluator", Test_Evaluator.tests), ], ); Junit.to_file(Junit.make([suite]), "junit_tests.xml"); From 33cd14f2cfbbf6c07377c3d1ce1396552e7b591e Mon Sep 17 00:00:00 2001 From: Alexander Bandukwala <7h3kk1d@gmail.com> Date: Wed, 2 Oct 2024 14:44:48 -0400 Subject: [PATCH 18/18] Remove unnecessary print statement --- src/haz3lweb/Editors.re | 1 - 1 file changed, 1 deletion(-) diff --git a/src/haz3lweb/Editors.re b/src/haz3lweb/Editors.re index 7b5512fc10..f8fa4e0b06 100644 --- a/src/haz3lweb/Editors.re +++ b/src/haz3lweb/Editors.re @@ -56,7 +56,6 @@ let perform_action = CoreSettings.on | _ => settings }; - print_endline("action: " ++ Action.show(a)); switch (Perform.go(~settings, a, get_editor(editors))) { | Error(err) => Error(FailedToPerform(err)) | Ok(ed) => Ok(put_editor(ed, editors))