Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
module type CELL = sig
type 'a cell
type 'a exp
val return : 'a -> 'a exp
val (>>=) : 'a exp -> ('a -> 'b exp) -> 'b exp
val cell : 'a exp -> 'a cell exp
val get : 'a cell -> 'a exp
val set : 'a cell -> 'a exp -> unit
val run : 'a exp -> 'a
end
module Cell : CELL = struct
type 'a cell = {
mutable code : 'a exp;
mutable value : 'a option;
mutable reads : ecell list;
mutable observers : ecell list;
id : int
}
and 'a exp = unit -> ('a * ecell list)
and ecell = Pack : 'a cell -> ecell
let id (Pack c) = c.id
let rec union xs ys =
match xs with
| [] -> []
| x :: xs' ->
if List.exists (fun y -> id x = id y) ys then
union xs' ys
else
x :: (union xs' ys)
let return v () = (v, [])
let (>>=) cmd f () =
let (a, cs) = cmd () in
let (b, ds) = f a () in
(b, union cs ds)
let r = ref 0
let new_id () = incr r; !r
let cell exp () =
let n = new_id() in
let cell = {
code = exp;
value = None;
reads = [];
observers = [];
id = n;
} in
(cell, [])
let get c () =
match c.value with
| Some v -> (v, [Pack c])
| None ->
let (v, ds) = c.code () in
c.value <- Some v;
c.reads <- ds;
List.iter (fun (Pack d) -> d.observers <- (Pack c) :: d.observers) ds;
(v, [Pack c])
let remove_observer o (Pack c) =
c.observers <- List.filter (fun o' -> id o != id o') c.observers
let rec invalidate (Pack c) =
let os = c.observers in
let rs = c.reads in
c.observers <- [];
c.value <- None;
c.reads <- [];
List.iter (remove_observer (Pack c)) rs;
List.iter invalidate os
let set c exp =
c.code <- exp;
invalidate (Pack c)
let run cmd = fst (cmd ())
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.