lib/ax.ml

@@ -6,7 +6,6 @@ module Dyn = Dyn
 module Src = Src
 module Behavior = Behavior
 module Event = Event
-module Env = Env
 module Tree = Tree
 module Comp = Comp
 
@@ -23,7 +22,7 @@ module State = struct
   and sink =
     { tree : Tree.t
     ; render : Src.values -> Comp.t
-    ; env : Env.t
+    ; env : Comp.env
     ; del : to_del list }
 
   and to_add =
@@ -129,7 +128,7 @@ module State = struct
     (ctx.to_add, ctx.to_del, tree)
 
   let mount t comp : Tree.t * t =
-    let (to_add, _to_del, tree) = inst t Env.empty comp in
+    let (to_add, _to_del, tree) = inst t Comp.empty_env comp in
     let () = Tree.refresh_path [] tree in
     let t = add t to_add in
     (tree, t)

lib/comp.ml

@@ -27,6 +27,18 @@ let fold_var ~init ~f var comp =
 
 (*****)
 
+type env =
+  { event_handlers : Event.handler list
+  ; vars : Behavior.vars }
+
+let empty_env =
+  { event_handlers = []
+  ; vars = Var_id.empty_map }
+
+let bind_event_handlers t tree =
+  List.iter t.event_handlers
+    ~f:(Tree.set_event_handler tree)
+
 module type CONTEXT = sig
   type t
   type deleter
@@ -40,7 +52,7 @@ module type CONTEXT = sig
 
   val create_sink
     :  t
-    -> env:Env.t
+    -> env:env
     -> tree:Tree.t
     -> render:(Src.values -> component)
     -> del:deleter
@@ -60,19 +72,17 @@ end
 
 module type INST = sig
   type ctx
-  type deleter
-  val inst : ctx -> Env.t -> component -> Tree.t
+  val inst : ctx -> env -> component -> Tree.t
 end
 
 module Make_inst(Ctx : CONTEXT)
-  : INST with type ctx := Ctx.t
-          and type deleter := Ctx.deleter =
+  : INST with type ctx := Ctx.t =
 struct
   let rec inst ctx env = function
     | Tree(tag, comps) ->
        let tree = Tree.create tag in
        let () = Tree.set_children tree (List.map comps ~f:(inst ctx env)) in
-       let () = Env.bind_event_handlers env tree in
+       let () = bind_event_handlers env tree in
        tree
 
     | Dynamic(behav) ->
@@ -86,11 +96,14 @@ struct
 
     | Fold(init, f, make_comp) ->
        let src = Ctx.create_source ctx ~init in
-       let env = Env.with_event_handler env
-                   ~f:(fun evt -> Src.single_effect src (f evt)) in
-       inst ctx env (make_comp src)
-
-    | Bind(var, src, comp) ->
-       inst ctx (Env.with_var env var src) comp
+       let eh evt = Src.single_effect src (f evt) in
+       inst ctx { env with
+                  event_handlers = eh :: env.event_handlers }
+         (make_comp src)
+
+    | Bind(var_id, src_id, comp) ->
+       inst ctx { env with
+                  vars = Map.set env.vars ~key:var_id ~data:src_id }
+         comp
 
 end

lib/env.ml

@@ -1,22 +0,0 @@
-open Base
-open Unique_id.Ids
-
-type t =
-  { event_handlers : Event.handler list
-  ; vars : Behavior.vars }
-
-let empty =
-  { event_handlers = []
-  ; vars = Var_id.empty_map }
-
-let with_event_handler t ~f =
-  { t with
-    event_handlers = f :: t.event_handlers }
-
-let with_var t var_id src =
-  { t with
-    vars = Map.set t.vars ~key:var_id ~data:src }
-
-let bind_event_handlers t tree =
-  List.iter t.event_handlers
-    ~f:(Tree.add_event_handler tree)

lib/event.ml

@@ -7,3 +7,6 @@ let to_string = function
 
 let equal : t -> t -> bool =
   (=)
+
+let no_op_handler : handler =
+  fun _ -> Src.empty_effect

lib/src.ml

@@ -8,5 +8,8 @@ type effect = (value -> value) Src_id.map
 let empty_values : values =
   Src_id.empty_map
 
+let empty_effect : effect =
+  Src_id.empty_map
+
 let single_effect src f : effect =
   Map.singleton (module Src_id) src f

lib/tree.ml

@@ -9,7 +9,7 @@ type t =
   { mutable tag : tag
   ; mutable children : t list
   ; mutable path : int list Lazy.t
-  ; mutable event_handlers : Event.handler list }
+  ; mutable event_handler : Event.handler }
 
 let uninit_path =
   lazy (failwith "path not set")
@@ -18,7 +18,7 @@ let create tag =
   { tag
   ; children = []
   ; path = uninit_path
-  ; event_handlers = [] }
+  ; event_handler = Event.no_op_handler }
 
 let rec to_string {tag;children;_} = match tag with
   | Rect(w,h) -> Printf.sprintf "Rect(%d,%d)" w h
@@ -33,7 +33,7 @@ let rec equal a b =
 let path t = Lazy.force t.path
 let set_tag t tag = t.tag <- tag
 let set_children t ts = t.children <- ts
-let add_event_handler t eh = t.event_handlers <- eh::t.event_handlers
+let set_event_handler t eh = t.event_handler <- eh
 
 let rec refresh_path rev_pfx t =
   let () = t.path <- lazy (List.rev rev_pfx) in

test/test.ml

@@ -250,7 +250,6 @@ test_list [
             ~f:(fun (Click(x,y)) i -> i * x + y)
             (dyn_b ~f:(fun x -> Comp.rect x (x * 3)))
         in
-        let eh = List.hd_exn tree.event_handlers in
         [
           t "tree" (module Tree)
             (Tree.rect 4 12)
@@ -259,12 +258,10 @@ test_list [
             (Map.of_alist_exn (module Src_id)
                [ s1,10 ; s2,20 ; s3,30 ; s_new,4 ])
             (Map.map state.src_vals ~f:to_int_exn);
-          t "num_event_handlers" (module Int)
-            1 (List.length tree.event_handlers);
           t "handler_effect" (module Map_(Src_id)(Int))
             (Map.of_alist_exn (module Src_id)
                [ s_new, 8899 ])
-            (Map.map (eh (Click(100, 99)))
+            (Map.map (tree.event_handler (Click(100, 99)))
                ~f:(fun f -> to_int_exn (f (int#to_dyn 88))));
         ]
       );
@@ -282,8 +279,7 @@ test_list [
             (Tree.rect 27 36)
             tree;
         ] @
-        let eh = List.hd_exn tree.event_handlers in
-        let (updates, _) = State.update state (eh (Click(0,0))) in
+        let (updates, _) = State.update state (tree.event_handler (Click(0,0))) in
         [
           t "updated_tree" (module Option_(Tree))
             (Some(Tree.rect 30 40))