v0.18~preview.129.42+498

bonsai.opam

@@ -13,9 +13,9 @@ depends: [
   "ocaml" {>= "5.1.0"}
   "abstract_algebra"
   "async_rpc_kernel"
+  "bonsai_concrete"
   "core"
   "core_kernel"
-  "incr_dom"
   "incr_map"
   "incremental"
   "ppx_here"
@@ -26,7 +26,7 @@ depends: [
   "virtual_dom"
   "dune"             {>= "3.11.0"}
   "ocaml-embed-file"
-  "ppxlib"           {>= "0.28.0"}
+  "ppxlib"           {>= "0.33.0"}
 ]
 available: arch != "arm32" & arch != "x86_32"
 synopsis: "A library for building dynamic webapps, using Js_of_ocaml"

extra/bonsai_extra.ml

@@ -38,8 +38,7 @@ let with_self_effect
     ~f:(fun model inject graph ->
       let current_model =
         let get_model = Bonsai.peek model graph in
-        let%arr inject = inject
-        and get_model = get_model in
+        let%arr inject and get_model in
         let%bind.Effect () = inject () in
         let%map.Effect model = get_model in
         match model with
@@ -95,9 +94,7 @@ let state_machine1_dynamic_model
       (Bonsai.both input model_creator)
       graph
   in
-  let%arr model = model
-  and inject = inject
-  and model_creator = model_creator in
+  let%arr model and inject and model_creator in
   model_creator model, inject
 ;;
 
@@ -141,7 +138,7 @@ let exactly_once effect graph =
   else (
     Bonsai.Edge.lifecycle
       ~on_activate:
-        (let%map set_has_run = set_has_run
+        (let%map set_has_run
          and event = effect in
          Effect.Many [ set_has_run true; event ])
       graph;
@@ -155,8 +152,7 @@ let exactly_once_with_value ?sexp_of_model ?equal effect graph =
     | None ->
       Bonsai.Edge.lifecycle
         ~on_activate:
-          (let%map set_value = set_value
-           and effect = effect in
+          (let%map set_value and effect in
            let%bind.Effect r = effect in
            set_value (Some r))
         graph;
@@ -174,7 +170,7 @@ let value_with_override ?sexp_of_model ?equal value graph =
     | None -> value
   in
   let setter =
-    let%arr set_state = set_state in
+    let%arr set_state in
     fun v -> set_state (Some v)
   in
   Bonsai.both value setter
@@ -232,7 +228,7 @@ let pipe (type a) (module A : Bonsai_proc.Model with type t = a) graph =
              (Effect.Private.Callback.respond_to r hd);
            { model with queued_actions }))
   in
-  let%arr inject = inject in
+  let%arr inject in
   let request =
     Effect.Private.make ~request:() ~evaluator:(fun r ->
       Effect.Expert.handle (inject (Add_receiver r)))
@@ -263,7 +259,7 @@ module Id_gen (T : Int_intf.S) () = struct
         graph
     in
     let fetch =
-      let%arr fetch = fetch in
+      let%arr fetch in
       fetch ()
     in
     fetch, model
@@ -306,8 +302,7 @@ let mirror'
   end
   in
   let callback =
-    let%map store_set = store_set
-    and interactive_set = interactive_set in
+    let%map store_set and interactive_set in
     fun old_pair { M2.store = store_value; interactive = interactive_value } ->
       let stability =
         if Option.equal equal store_value interactive_value then `Stable else `Unstable
@@ -412,7 +407,7 @@ let with_last_modified_time
 
 let is_stable ~equal input ~time_to_stable graph =
   let sign =
-    let%arr time_to_stable = time_to_stable in
+    let%arr time_to_stable in
     Time_ns.Span.sign time_to_stable
   in
   match%sub sign with
@@ -429,8 +424,7 @@ let is_stable ~equal input ~time_to_stable graph =
   | Pos ->
     let%sub _, last_modified_time = with_last_modified_time ~equal input graph in
     let next_stable_time =
-      let%arr last_modified_time = last_modified_time
-      and time_to_stable = time_to_stable in
+      let%arr last_modified_time and time_to_stable in
       Time_ns.add last_modified_time time_to_stable
     in
     let at_next_stable_time = Bonsai.Clock.at next_stable_time graph in
@@ -494,8 +488,8 @@ let value_stability (type a) ?sexp_of_model ~equal:input_equal input ~time_to_st
   match%sub most_recent_stable_and_true with
   | Some most_recent_stable_and_true ->
     let%arr most_recent_stable, must_be_true = most_recent_stable_and_true
-    and is_stable = is_stable
-    and input = input in
+    and is_stable
+    and input in
     (match must_be_true with
      | true -> ()
      | false ->
@@ -504,7 +498,7 @@ let value_stability (type a) ?sexp_of_model ~equal:input_equal input ~time_to_st
     then Stability.Stable input
     else Unstable { previously_stable = Some most_recent_stable; unstable_value = input }
   | None ->
-    let%arr input = input in
+    let%arr input in
     Stability.Unstable { previously_stable = None; unstable_value = input }
 ;;
 
@@ -550,8 +544,7 @@ module One_at_a_time = struct
           | Release -> Idle, true)
     in
     let effect =
-      let%arr inject_status = inject_status
-      and f = f in
+      let%arr inject_status and f in
       let open Effect.Let_syntax in
       fun query ->
         match%bind inject_status Acquire with

extra/dune

@@ -1,6 +1,6 @@
 (library
  (name bonsai_extra)
- (libraries bonsai core virtual_dom.ui_effect incr_dom.ui_incr)
+ (libraries bonsai core virtual_dom.ui_effect bonsai_concrete.ui_incr)
  (public_name bonsai.extra)
  (preprocess
   (pps ppx_bonsai ppx_jane ppx_pattern_bind)))

perf_shared/dune

@@ -2,6 +2,6 @@
  (name bonsai_perf_shared)
  (public_name bonsai.perf_shared)
  (libraries bonsai bonsai_driver core incr_map virtual_dom.ui_effect
-   incr_dom.ui_incr)
+   bonsai_concrete.ui_incr)
  (preprocess
   (pps ppx_jane)))

ppx_bonsai/src/expander/ppx_bonsai_expander.ml

@@ -172,7 +172,7 @@ let sub (location_behavior : Location_behavior.t) : (module Ext) =
             ~destruct
             ~loc
             ~modul
-            ~locality
+            ~return_value_in_exclave:locality.return_value_in_exclave
             ~lhs:case.pc_lhs
             ~body:case.pc_rhs
         in
@@ -238,7 +238,7 @@ let arr (location_behavior : Location_behavior.t) : (module Ext) =
             match acc with
             | true -> true
             | false ->
-              (match pattern.ppat_desc with
+              (match Ppxlib_jane.Shim.Pattern_desc.of_parsetree pattern.ppat_desc with
                (* let (_ as a) = x in ... *)
                | Ppat_alias (_, _) -> false
                | Ppat_any
@@ -251,10 +251,11 @@ let arr (location_behavior : Location_behavior.t) : (module Ext) =
                | Ppat_constant _
                | Ppat_interval (_, _)
                | Ppat_var _ | Ppat_tuple _
+               | Ppat_unboxed_tuple (_, _)
                | Ppat_construct (_, _)
                | Ppat_array _
                | Ppat_or (_, _)
-               | Ppat_constraint (_, _)
+               | Ppat_constraint (_, _, _)
                | Ppat_type _ | Ppat_lazy _ | Ppat_extension _
                | Ppat_open (_, _)
                | Ppat_exception _
@@ -446,7 +447,13 @@ let arr (location_behavior : Location_behavior.t) : (module Ext) =
             args
             ~init:(maybe_wrap_exclave ~loc ~locality body)
             ~f:(fun pat inner ->
-              maybe_destruct ~destruct ~modul ~locality:`global ~loc ~lhs:pat ~body:inner)
+              maybe_destruct
+                ~destruct
+                ~modul
+                ~return_value_in_exclave:false
+                ~loc
+                ~lhs:pat
+                ~body:inner)
         in
         let build_application unlabelled_exps ~f_exp ~op_name =
           let args =
@@ -505,11 +512,10 @@ let arr (location_behavior : Location_behavior.t) : (module Ext) =
         expression
     ;;
 
-    let expand_match ~loc ~modul ~locality expr cases =
+    let expand_match ~loc ~modul ~(locality : Locality.t) expr cases =
       (match locality with
-       | `global -> ()
-       | `local ->
-         Location.raise_errorf ~loc "ppx_bonsai supports neither [bindl] nor [mapl]");
+       | { allocate_function_on_stack = false; return_value_in_exclave = false } -> ()
+       | _ -> Location.raise_errorf ~loc "ppx_bonsai supports neither [bindl] nor [mapl]");
       bind_apply
         ~prevent_tail_call
         ~loc

ppx_bonsai/src/ppx_bonsai.ml

@@ -3,7 +3,7 @@ open Ppx_let_expander
 open Ppx_bonsai_expander
 module Test_extension = Test_extension
 
-let locality = `global
+let locality = Locality.global
 
 let location_behavior : Location_behavior.t ref =
   ref Location_behavior.Location_of_callsite