Commits

Yit Phang Khoo  committed d266688

Remove naive and object variants of lazy self-adjusting computation as well as lazy variant of eager self-adjusting computation.

  • Participants
  • Parent commits b72e106

Comments (0)

Files changed (6)

File Source/Adapton.mlpack

 Adapton/All
 Adapton/Default
-Adapton/EagerSALazy
 Adapton/EagerSATotalOrder
 Adapton/Exceptions
 Adapton/LazySABidi
-Adapton/LazySABidiObject
-Adapton/LazySANaive
-Adapton/LazySAObject
 Adapton/LazySparseArray
 Adapton/MemoN
 Adapton/NonSAEager

File Source/Adapton/All.ml

 (** List of all names and modules for self-adjusting values. *)
 let sa_list = [
     ( "LazySABidi", (module LazySABidi : Signatures.SAType) );
-    ( "LazySABidiObject", (module LazySABidiObject : Signatures.SAType) );
-    ( "LazySANaive", (module LazySANaive : Signatures.SAType) );
-    ( "LazySAObject", (module LazySAObject : Signatures.SAType) );
-    ( "EagerSALazy", (module EagerSALazy : Signatures.SAType) );
     ( "EagerSATotalOrder", (module EagerSATotalOrder : Signatures.SAType) );
     ( "NonSAEager", (module NonSAEager : Signatures.SAType) );
     ( "NonSALazy", (module NonSALazy : Signatures.SAType) );

File Source/Adapton/EagerSALazy.ml

-(** Eager variant of self-adjusting values by eagerly forcing {!Adapton.LazySABidi} thunks as they are created.
-
-    Note that change propagation does not occur during {!Adapton.LazySABidi.refresh} (unlike
-    {!Adapton.EagerSATotalOrder}), but during {!Adapton.LazySABidi.force} (like {!Adapton.LazySABidi}), at which
-    point, not only will the given self-adjusting value be updated, but all self-adjusting values reachable from the
-    the given self-adjusting values will be updated (unlike {!Adapton.LazySABidi}).
-*)
-
-(** Types and operations common to eager self-adjusting values containing any type. *)
-module T = struct
-    (** Abstract type identifying this module for self-adjusting values. *)
-    type sa
-
-    (** Eager self-adjusting values containing ['a]. *)
-    type 'a thunk = 'a LazySABidi.thunk
-
-    (** This module implements self-adjusting values. *)
-    let is_self_adjusting = true
-
-    (** This module implements eager values. *)
-    let is_lazy = false
-
-    (** Compute the hash value of a self-adjusting value. *)
-    let hash = LazySABidi.hash
-
-    (** Compute whether two self-adjusting values are equal. *)
-    let equal = LazySABidi.equal
-
-    (** Recompute self-adjusting values if necessary (this is a no-op as in {!Adapton.LazySABidi}). *)
-    let refresh = LazySABidi.refresh (* should be a no-op, but just in case *)
-
-    (** Return the value contained by a self-adjusting value, (re-)computing it if necessary. *)
-    let force = LazySABidi.force
-end
-include T
-
-(** Functor to make constructors and updaters for lazy self-adjusting values of a specific type. *)
-module Make (R : Signatures.EqualsType)
-        : Signatures.SAType.S with type sa = sa and type 'a thunk = 'a thunk and type data = R.t and type t = R.t thunk = struct
-    include T
-
-    module LazySABidiR = LazySABidi.Make (R)
-
-    (** Value contained by eager self-adjusting values for a specific type. *)
-    type data = R.t
-
-    (** Eager self-adjusting values for a specific type. *)
-    type t = R.t thunk
-
-    (**/**) (* helper functions *)
-    let make_eager f x =
-        let m = f x in
-        ignore (force m);
-        m
-    (**/**)
-
-    (** Create an eager self-adjusting value from a constant value. *)
-    let const = LazySABidiR.const
-
-    (** Update an eager self-adjusting value with a constant value. *)
-    let update_const = LazySABidiR.update_const
-
-    (** Create an eager self-adjusting value from a thunk. *)
-    let thunk = make_eager LazySABidiR.thunk
-
-    (** Update an eager self-adjusting value with a thunk. *)
-    let update_thunk = LazySABidiR.update_thunk
-
-    (* create memoizing constructors and updaters *)
-    include MemoN.Make (struct
-        type data = R.t
-        type t = R.t thunk
-
-        (** Create memoizing constructor and updater for an eager self-adjusting value. *)
-        let memo (type a) (module A : Hashtbl.SeededHashedType with type t = a) f =
-            let f memo x = f (make_eager memo) x in
-            let memo, update_memo = LazySABidiR.memo (module A) f in
-            ( make_eager memo, update_memo )
-    end)
-end

File Source/Adapton/LazySABidiObject.ml

-(** Bidirectional variant of lazy self-adjusting values based on {!LazySAObject}. *)
-
-(** Types and operations common to lazy self-adjusting values containing any type. *)
-module T = struct
-    (** Abstract type identifying this module for self-adjusting values. *)
-    type sa
-
-    (**/**) (* auxiliary types *)
-    module rec TT : sig
-        type 'a state =
-            | MemoValue of 'a * receipt * dependency list * (unit -> 'a) * unmemo (* 6 words *)
-            | Value of 'a * receipt * dependency list * (unit -> 'a) (* 5 words *)
-            | MemoThunk of (unit -> 'a) * unmemo (* 3 words *)
-            | Thunk of (unit -> 'a) (* 2 words *)
-            | Const of 'a * receipt (* 3 words *)
-        and unmemo = unit -> unit
-        and receipt = (bool -> unit) -> unit
-        and dependent = < dependents : Dependents.t >
-        and dependency = { (* 3 words (dependent is 'a thunk) *)
-            mutable dirty : bool;
-            mutable receipt : receipt;
-            dependent : dependent;
-        }
-    end = TT
-    and Dependents : WeakSet.S with type data = TT.dependency = WeakSet.Make (struct
-        type t = TT.dependency
-        let hash d = Hashtbl.hash d.TT.dependent
-        let equal d d' = d.TT.dependent == d'.TT.dependent
-    end)
-    include TT
-    (**/**)
-
-
-    (** This module implements self-adjusting values. *)
-    let is_self_adjusting = true
-
-    (** This module implements lazy values. *)
-    let is_lazy = true
-
-
-    (**/**) (* change-propagation state *)
-    let lazy_stack = ref []
-    (**/**)
-
-
-    (** Lazy self-adjusting values containing ['a]. *)
-    class virtual ['a] thunk equal init = object (self) (* (2 + 2) + 6 = 10 words (not including closure of unmemo and receipt) *)
-        val mutable thunk : 'a state = init (* 'a state: 6 words *)
-        val dependents : Dependents.t = Dependents.create 0
-
-        method dependents = dependents
-
-        method private dirty =
-            begin match thunk with
-                | MemoValue ( _, _, _, _, unmemo ) | MemoThunk ( _, unmemo ) -> unmemo ()
-                | Value _ | Thunk _ | Const _ -> ()
-            end;
-            let rec dirty = function
-                | d::ds ->
-                    dirty begin Dependents.fold begin fun d ds ->
-                        if d.dirty then
-                            ds
-                        else begin
-                            d.dirty <- true;
-                            d.dependent#dependents::ds
-                        end
-                    end d ds end
-                | [] ->
-                    ()
-            in
-            dirty [ dependents ]
-
-        method update_const x =
-            self#dirty;
-            thunk <- Const ( x, self#make_receipt x )
-
-        method update_thunk f =
-            self#dirty;
-            thunk <- Thunk f
-
-        method update_memo_thunk f unmemo =
-            self#dirty;
-            thunk <- MemoThunk ( f, unmemo )
-
-        method force =
-            let value, receipt = match thunk with
-                | MemoValue _ | Value _ ->
-                    (* compute the value if necessary *)
-                    self#repair (fun _ -> ());
-                    begin match thunk with
-                        | MemoValue ( value, receipt, _, _, _ ) | Value ( value, receipt, _, _ ) ->
-                            ( value, receipt )
-                        | MemoThunk _ | Thunk _ | Const _ ->
-                            failwith "repair did not compute result"
-                    end;
-                | MemoThunk ( f, _ ) | Thunk f ->
-                    self#evaluate f
-                | Const ( value, receipt ) ->
-                    ( value, receipt )
-            in
-            (* add dependency to caller *)
-            begin match !lazy_stack with
-                | ( dependent, dependencies )::_ ->
-                    let dependency = Dependents.merge dependents { dirty=false; receipt; dependent } in
-                    (* an existing dependency may be reused *)
-                    dependency.dirty <- false;
-                    dependency.receipt <- receipt;
-                    dependencies := dependency::!dependencies
-                | _ ->
-                    ()
-            end;
-            value
-
-        method private make_receipt x k = self#repair begin fun () -> k begin match thunk with
-            | MemoValue ( x', _, _, _, _ ) | Value ( x', _, _, _ ) | Const ( x', _ )  -> equal x x'
-            | MemoThunk _ | Thunk _ -> false
-        end end
-
-        method private evaluate f =
-            (* add self to call stack and evaluate *)
-            let dependencies = ref [] in
-            lazy_stack := ( ( self :> dependent ), dependencies )::!lazy_stack;
-            let value = try
-                f ()
-            with exn ->
-                lazy_stack := List.tl !lazy_stack;
-                raise exn
-            in
-            lazy_stack := List.tl !lazy_stack;
-            let dependencies = List.rev !dependencies in
-            let receipt = self#make_receipt value in
-            begin match thunk with
-                | MemoValue ( _ , _, _, _, unmemo ) | MemoThunk ( _, unmemo ) ->
-                    thunk <- MemoValue ( value, receipt, dependencies, f, unmemo )
-                | Value _ | Thunk _ ->
-                    thunk <- Value ( value, receipt, dependencies, f )
-                | Const _ ->
-                    failwith "evaluating Const"
-            end;
-            ( value, receipt )
-
-        (* receipt/repair performs a truncated inorder traversal of the dependency graph *)
-        method private repair k = match thunk with
-            | MemoValue ( _ , _, dependencies, f, _ ) | Value ( _ , _, dependencies, f ) ->
-                let rec repair = function
-                    | d::ds ->
-                        if d.dirty then begin
-                            d.dirty <- false;
-                            d.receipt (fun c -> if c then repair ds else (ignore (self#evaluate f); k ()))
-                        end else
-                            repair ds
-                    | [] ->
-                        k ()
-                in
-                repair dependencies
-            | MemoThunk ( f, _ ) | Thunk f ->
-                ignore (self#evaluate f); k ()
-            | Const _ ->
-                k ()
-    end
-
-
-    (** Compute the hash value of a self-adjusting value. *)
-    let hash = Hashtbl.seeded_hash
-
-    (** Compute whether two self-adjusting values are equal. *)
-    let equal = (==)
-
-    (** Recompute self-adjusting values if necessary (unused by this module; a no-op). *)
-    let refresh () = ()
-
-    (** Return the value contained by a self-adjusting value, (re-)computing it if necessary. *)
-    let force m = m#force
-end
-include T
-
-
-(** Functor to make a constructor, a mutator, and a memoizing constructor for lazy self-adjusting values of a specific type. *)
-module Make (R : Signatures.EqualsType)
-        : Signatures.SAType.S with type sa = sa and type 'a thunk = 'a thunk and type data = R.t and type t = R.t thunk = struct
-    include T
-
-    (** Value contained by lazy self-adjusting values for a specific type. *)
-    type data = R.t
-
-    (** Lazy self-adjusting values for a specific type. *)
-    class t init = object (self)
-        inherit [R.t] thunk R.equal init
-    end
-
-    (** Create a lazy self-adjusting value from a constant value that does not depend on other lazy self-adjusting values. *)
-    let const =
-        let uninit = Thunk (fun () -> failwith "uninit") in
-        fun x ->
-            object (self)
-                (* initial instance fields cannot refer to self, so temporarily place a dummy thunk and replace it in the initializer *)
-                inherit t uninit
-                initializer
-                    thunk <- Const ( x, self#make_receipt x )
-            end
-
-    (** Update a lazy self-adjusting value with a constant value that does not depend on other lazy self-adjusting values. *)
-    let update_const m x = m#update_const x
-
-    (** Create a lazy self-adjusting value from a thunk that may depend on other lazy self-adjusting values. *)
-    let thunk f = new t (Thunk f)
-
-    (** Update a lazy self-adjusting value with a thunk that may depend on other lazy self-adjusting values. *)
-    let update_thunk m f = m#update_thunk f
-
-    (** Local exception to signal memoization hit. *)
-    exception MemoHit of t
-
-    (* create memoizing constructors *)
-    include MemoN.Make (struct
-        type data = R.t
-        type t = R.t thunk
-
-        (** Create a memoizing constructor and updater for a lazy self-adjusting value. *)
-        let memo =
-            fun (type a) (module A : Hashtbl.SeededHashedType with type t = a) f ->
-                let module Memotable = Weak.Make (struct
-                    type t = A.t * R.t thunk
-                    let seed = Random.bits ()
-                    let hash ( a, _ ) = A.hash seed a
-                    let equal ( a, _ ) ( a', _ ) = A.equal a a'
-                end) in
-                let memotable = Memotable.create 0 in
-
-                let rec memo x = try
-                    let f () = f memo x in
-                    object (self)
-                        inherit t (Thunk f)
-                        initializer
-                            let binding = ( x, self ) in
-                            let _, other as binding' = Memotable.merge memotable binding in
-                            if binding' == binding then
-                                let unmemo () = Memotable.remove memotable binding in
-                                thunk <- MemoThunk ( f, unmemo )
-                            else
-                                raise (MemoHit other)
-                    end
-                with MemoHit other ->
-                    other
-                in
-
-                let update_memo m x =
-                    let f () = f memo x in
-                    let binding = ( x, m ) in
-                    let _, other as binding' = Memotable.merge memotable binding in
-                    if binding' == binding then begin
-                        let unmemo () = Memotable.remove memotable binding in
-                        m#update_memo_thunk f unmemo
-                    end else if m != other then
-                        m#update_thunk f
-                in
-                ( memo, update_memo )
-    end)
-end

File Source/Adapton/LazySANaive.ml

-(** Naive variant of lazy self-adjusting values. *)
-
-(** Types and operations common to lazy self-adjusting values containing any type. *)
-module T = struct
-    (** Abstract type identifying this module for self-adjusting values. *)
-    type sa
-
-    (** Lazy self-adjusting values containing ['a]. *)
-    type 'a thunk = { (* 2 + 7 = 9 words (not including closures of receipt, repair, evaluate, and unmemo) *)
-        id : int;
-        mutable thunk : 'a thunk';
-    }
-    (**/**) (* auxiliary types *)
-    and 'a thunk' =
-        | MemoValue of repair * 'a * receipt * receipt list * 'a evaluate * unmemo (* 7 words *)
-        | Value of repair * 'a * receipt * receipt list * 'a evaluate (* 6 words *)
-        | MemoThunk of 'a evaluate * unmemo (* 3  words *)
-        | Thunk of 'a evaluate (* 2 words *)
-        | Const of 'a * receipt (* 3 words *)
-    and unmemo = unit -> unit
-    and 'a evaluate = unit -> 'a * receipt
-    and receipt = visited -> (visited -> bool -> unit) -> unit
-    and repair = visited -> (visited -> unit) -> unit
-    and visited = (int, unit) Hashtbl.t
-    (**/**)
-
-
-    (** This module implements self-adjusting values. *)
-    let is_self_adjusting = true
-
-    (** This module implements lazy values. *)
-    let is_lazy = true
-
-
-    (**/**) (* change-propagation state *)
-    let lazy_id_counter = ref 0
-    let lazy_stack = ref []
-    (**/**)
-
-
-    (** Compute the hash value of a self-adjusting value. *)
-    let hash seed m = Hashtbl.seeded_hash seed m.id
-
-    (** Compute whether two self-adjusting values are equal. *)
-    let equal = (==)
-
-    (** Recompute self-adjusting values if necessary (unused by this module; a no-op). *)
-    let refresh () = ()
-
-    (** Return the value contained by a self-adjusting value, (re-)computing it if necessary. *)
-    let force m =
-        let value, receipt = match m.thunk with
-            | MemoValue ( repair, _, _, _, _, _ ) | Value ( repair, _, _, _, _ ) ->
-                (* compute the value if necessary *)
-                repair (Hashtbl.create 0) (fun _ -> ());
-                begin match m.thunk with
-                    | MemoValue ( _, value, receipt, _, _, _ ) | Value ( _, value, receipt, _, _ ) ->
-                        ( value, receipt )
-                    | MemoThunk _ | Thunk _ | Const _ ->
-                        failwith "repair did not compute result"
-                end
-            | MemoThunk ( evaluate, _ ) | Thunk evaluate ->
-                evaluate ()
-            | Const ( value, receipt ) ->
-                ( value, receipt )
-        in
-        (* add receipt to caller *)
-        begin match !lazy_stack with
-            | h::_ ->
-                h := receipt::!h
-            | _ ->
-                ()
-        end;
-        value
-end
-include T
-
-
-(** Functor to make constructors and updaters for lazy self-adjusting values of a specific type. *)
-module Make (R : Signatures.EqualsType)
-        : Signatures.SAType.S with type sa = sa and type 'a thunk = 'a thunk and type data = R.t and type t = R.t thunk = struct
-    include T
-
-    (** Value contained by lazy self-adjusting values for a specific type. *)
-    type data = R.t
-
-    (** Lazy self-adjusting values for a specific type. *)
-    type t = R.t thunk
-
-    (**/**) (* helper function to call unmemo on a thunk *)
-    let unmemo m = match m.thunk with
-        | MemoValue ( _, _, _, _, _, unmemo ) | MemoThunk ( _, unmemo ) -> unmemo ()
-        | Value _  | Thunk _ | Const _ -> ()
-    (**/**)
-
-    (**/**) (* helper function to make a const receipt *)
-    let make_const_receipt m x s k = match m.thunk with
-        | MemoValue ( repair, _, _, _, _, _ ) | Value ( repair, _, _, _, _ ) ->
-            repair s begin fun s -> k s begin match m.thunk with
-                | MemoValue ( _, value, _, _, _, _ ) | Value ( _, value, _, _, _ ) | Const ( value, _ ) -> R.equal value x
-                | MemoThunk _ | Thunk _ -> false
-            end end
-        | MemoThunk _ | Thunk _ ->
-            k s false
-        | Const ( value, _ ) ->
-            k s (R.equal value x)
-    (**/**)
-
-    (** Create a lazy self-adjusting value from a constant value that does not depend on other lazy self-adjusting values. *)
-    let const x =
-        let rec receipt s k = make_const_receipt m x s k
-        and m = { id=(!lazy_id_counter); thunk=Const ( x, receipt ) } in
-        incr lazy_id_counter;
-        m
-
-    (** Update a lazy self-adjusting value with a constant value that does not depend on other lazy self-adjusting values. *)
-    let update_const m x =
-        unmemo m;
-        let receipt s k = make_const_receipt m x s k in
-        m.thunk <- Const ( x, receipt )
-
-    (**/**) (* helper function to evaluate a thunk *)
-    let evaluate_actual m f =
-        (* add self to call stack and evaluate *)
-        let dependencies = ref [] in
-        lazy_stack := dependencies::!lazy_stack;
-        let value = try
-            f ()
-        with exn ->
-            lazy_stack := List.tl !lazy_stack;
-            raise exn
-        in
-        lazy_stack := List.tl !lazy_stack;
-        let dependencies = List.rev !dependencies in
-
-        (* repair/receipt performs a truncated inorder traversal of the dependency graph *)
-        let repair s k =
-            if Hashtbl.mem s m.id then
-                k s
-            else begin
-                Hashtbl.add s m.id ();
-                match m.thunk with
-                    | MemoValue ( _, _, _, dependencies, evaluate, _ ) | Value ( _, _, _, dependencies, evaluate ) ->
-                        let rec repair s = function
-                            | d::ds -> d s (fun s c -> if c then repair s ds else (ignore (evaluate ()); k s))
-                            | [] -> k s
-                        in
-                        repair s dependencies
-                    | MemoThunk ( evaluate, _ ) | Thunk evaluate ->
-                        ignore (evaluate ()); k s
-                    | Const _ ->
-                        k s
-            end
-        in
-
-        let receipt s k = repair s begin fun s -> k s begin match m.thunk with
-            | MemoValue ( _, value', _, _, _, _ ) | Value ( _, value', _, _, _ ) | Const ( value', _ ) -> R.equal value' value
-            | MemoThunk _ | Thunk _ -> false
-        end end in
-
-        ( repair, value, receipt, dependencies )
-    (**/**)
-
-    (**/**) (** helper function to make a function to evaluate a thunk *)
-    let make_evaluate m f =
-        let rec evaluate () =
-            let repair, value, receipt, dependencies = evaluate_actual m f in
-            m.thunk <- Value ( repair, value, receipt, dependencies, evaluate );
-            ( value, receipt )
-        in
-        evaluate
-    (**/**)
-
-    (** Create a lazy self-adjusting value from a thunk that may depend on other lazy self-adjusting values. *)
-    let thunk f =
-        let rec evaluate () = make_evaluate m f ()
-        and m = { id=(!lazy_id_counter); thunk=Thunk evaluate } in
-        incr lazy_id_counter;
-        m
-
-    (** Update a lazy self-adjusting value with a thunk that may depend on other lazy self-adjusting values. *)
-    let update_thunk m f =
-        unmemo m;
-        let evaluate () = make_evaluate m f () in
-        m.thunk <- Thunk evaluate
-
-    (* create memoizing constructors and updaters *)
-    include MemoN.Make (struct
-        type data = R.t
-        type t = R.t thunk
-
-        (** Create memoizing constructor and updater for a lazy self-adjusting value. *)
-        let memo (type a) (module A : Hashtbl.SeededHashedType with type t = a) f =
-            let module Memotable = Weak.Make (struct
-                type t = A.t * R.t thunk
-                let seed = Random.bits ()
-                let hash ( a, _ ) = A.hash seed a
-                let equal ( a, _ ) ( a', _ ) = A.equal a a'
-            end) in
-            let memotable = Memotable.create 0 in
-
-            (**/**) (* helper function to make a function to evaluate a thunk with memoization *)
-            let rec make_memo_evaluate m x unmemo =
-                let rec evaluate () =
-                    let repair, value, receipt, dependencies = evaluate_actual m (fun () -> f memo x) in
-                    m.thunk <- MemoValue ( repair, value, receipt, dependencies, evaluate, unmemo );
-                    ( value, receipt )
-                in
-                evaluate
-            (**/**)
-
-            (* memoizing constructor *)
-            and memo x =
-                (* create a strong reference to binding and hide it in the closure unmemo stored in m *)
-                let rec binding = ( x, m )
-                and unmemo () = Memotable.remove memotable binding
-                and evaluate () = make_memo_evaluate m x unmemo ()
-                and m = { id=(!lazy_id_counter); thunk=MemoThunk ( evaluate, unmemo ) } in
-                incr lazy_id_counter;
-                snd (Memotable.merge memotable binding)
-            in
-
-            (* memoizing updater *)
-            let update_memo m x =
-                unmemo m;
-                (* create a strong reference to binding and hide it in the closure unmemo stored in m *)
-                let rec binding = ( x, m )
-                and unmemo () = Memotable.remove memotable binding in
-                let evaluate () = make_memo_evaluate m x unmemo () in
-                if Memotable.merge memotable binding == binding then
-                    m.thunk <- MemoThunk ( evaluate, unmemo )
-                else
-                    let evaluate = make_evaluate m (fun () -> f memo x) in
-                    m.thunk <- Thunk evaluate;
-            in
-
-            ( memo, update_memo )
-    end)
-end

File Source/Adapton/LazySAObject.ml

-(** Naive variant of lazy self-adjusting values using an object representation. *)
-
-(** Types and operations common to lazy self-adjusting values containing any type. *)
-module T = struct
-    (** Abstract type identifying this module for self-adjusting values. *)
-    type sa
-
-    (**/**) (* auxiliary types *)
-    type 'a state =
-        | MemoValue of 'a * receipt * receipt list * (unit -> 'a) * unmemo (* 6 words *)
-        | Value of 'a * receipt * receipt list * (unit -> 'a) (* 5 words *)
-        | MemoThunk of (unit -> 'a) * unmemo (* 3 words *)
-        | Thunk of (unit -> 'a) (* 2 words *)
-        | Const of 'a * receipt (* 3 words *)
-    and unmemo = unit -> unit
-    and receipt = visited -> (visited -> bool -> unit) -> unit
-    and visited = (int, unit) Hashtbl.t
-    (**/**)
-
-
-    (** This module implements self-adjusting values. *)
-    let is_self_adjusting = true
-
-    (** This module implements lazy values. *)
-    let is_lazy = true
-
-
-    (**/**) (* change-propagation state *)
-    let lazy_stack = ref []
-    (**/**)
-
-
-    (** Lazy self-adjusting values containing ['a]. *)
-    class virtual ['a] thunk equal init = object (self) (* (2 + 1) + 6 = 9 words (not including closure of unmemo and receipt) *)
-        val mutable thunk : 'a state = init (* 'a state: 6 words *)
-
-        method private unmemo = match thunk with
-            | MemoValue ( _, _, _, _, unmemo ) | MemoThunk ( _, unmemo ) -> unmemo ()
-            | Value _ | Thunk _ | Const _ -> ()
-
-        method update_const x =
-            self#unmemo;
-            thunk <- Const ( x, self#make_receipt x )
-
-        method update_thunk f =
-            self#unmemo;
-            thunk <- Thunk f
-
-        method update_memo_thunk f unmemo =
-            self#unmemo;
-            thunk <- MemoThunk ( f, unmemo )
-
-        method force =
-            let value, receipt = match thunk with
-                | MemoValue _ | Value _ ->
-                    (* compute the value if necessary *)
-                    self#repair (Hashtbl.create 0) (fun _ -> ());
-                    begin match thunk with
-                        | MemoValue ( value, receipt, _, _, _ ) | Value ( value, receipt, _, _ ) ->
-                            ( value, receipt )
-                        | MemoThunk _ | Thunk _ | Const _ ->
-                            failwith "repair did not compute result"
-                    end;
-                | MemoThunk ( f, _ ) | Thunk f ->
-                    self#evaluate f
-                | Const ( value, receipt ) ->
-                    ( value, receipt )
-            in
-            (* add receipt to caller *)
-            begin match !lazy_stack with
-                | h::_ ->
-                    h := receipt::!h
-                | _ ->
-                    ()
-            end;
-            value
-
-        method private make_receipt x s k = self#repair s begin fun s -> k s begin match thunk with
-            | MemoValue ( x', _, _, _, _ ) | Value ( x', _, _, _ ) | Const ( x', _ )  -> equal x x'
-            | MemoThunk _ | Thunk _ -> false
-        end end
-
-        method private evaluate f =
-            (* add self to call stack and evaluate *)
-            let dependencies = ref [] in
-            lazy_stack := dependencies::!lazy_stack;
-            let value = try
-                f ()
-            with exn ->
-                lazy_stack := List.tl !lazy_stack;
-                raise exn
-            in
-            lazy_stack := List.tl !lazy_stack;
-            let dependencies = List.rev !dependencies in
-            let receipt = self#make_receipt value in
-            begin match thunk with
-                | MemoValue ( _ , _, _, _, unmemo ) | MemoThunk ( _, unmemo ) ->
-                    thunk <- MemoValue ( value, receipt, dependencies, f, unmemo )
-                | Value _ | Thunk _ ->
-                    thunk <- Value ( value, receipt, dependencies, f )
-                | Const _ ->
-                    failwith "evaluating Const"
-            end;
-            ( value, receipt )
-
-        (* receipt/repair performs a truncated inorder traversal of the dependency graph *)
-        method private repair s k = match thunk with
-            | MemoValue ( _ , _, dependencies, f, _ ) | Value ( _ , _, dependencies, f ) ->
-                let id = Oo.id self in
-                if Hashtbl.mem s id then
-                    k s
-                else begin
-                    Hashtbl.add s id ();
-                    let rec repair s = function
-                        | d::ds -> d s (fun s c -> if c then repair s ds else (ignore (self#evaluate f); k s))
-                        | [] -> k s
-                    in
-                    repair s dependencies
-                end
-            | MemoThunk ( f, _ ) | Thunk f ->
-                Hashtbl.add s (Oo.id self) ();
-                ignore (self#evaluate f);
-                k s
-            | Const _ ->
-                k s
-    end
-
-
-    (** Compute the hash value of a self-adjusting value. *)
-    let hash = Hashtbl.seeded_hash
-
-    (** Compute whether two self-adjusting values are equal. *)
-    let equal = (==)
-
-    (** Recompute self-adjusting values if necessary (unused by this module; a no-op). *)
-    let refresh () = ()
-
-    (** Return the value contained by a self-adjusting value, (re-)computing it if necessary. *)
-    let force m = m#force
-end
-include T
-
-
-(** Functor to make a constructor, a mutator, and a memoizing constructor for lazy self-adjusting values of a specific type. *)
-module Make (R : Signatures.EqualsType)
-        : Signatures.SAType.S with type sa = sa and type 'a thunk = 'a thunk and type data = R.t and type t = R.t thunk = struct
-    include T
-
-    (** Value contained by lazy self-adjusting values for a specific type. *)
-    type data = R.t
-
-    (** Lazy self-adjusting values for a specific type. *)
-    class t init = object (self)
-        inherit [R.t] thunk R.equal init
-    end
-
-    (** Create a lazy self-adjusting value from a constant value that does not depend on other lazy self-adjusting values. *)
-    let const =
-        let uninit = Thunk (fun () -> failwith "uninit") in
-        fun x ->
-            object (self)
-                (* initial instance fields cannot refer to self, so temporarily place a dummy thunk and replace it in the initializer *)
-                inherit t uninit
-                initializer
-                    thunk <- Const ( x, self#make_receipt x )
-            end
-
-    (** Update a lazy self-adjusting value with a constant value that does not depend on other lazy self-adjusting values. *)
-    let update_const m x = m#update_const x
-
-    (** Create a lazy self-adjusting value from a thunk that may depend on other lazy self-adjusting values. *)
-    let thunk f = new t (Thunk f)
-
-    (** Update a lazy self-adjusting value with a thunk that may depend on other lazy self-adjusting values. *)
-    let update_thunk m f = m#update_thunk f
-
-    (** Local exception to signal memoization hit. *)
-    exception MemoHit of t
-
-    (* create memoizing constructors *)
-    include MemoN.Make (struct
-        type data = R.t
-        type t = R.t thunk
-
-        (** Create a memoizing constructor and updater for a lazy self-adjusting value. *)
-        let memo =
-            fun (type a) (module A : Hashtbl.SeededHashedType with type t = a) f ->
-                let module Memotable = Weak.Make (struct
-                    type t = A.t * R.t thunk
-                    let seed = Random.bits ()
-                    let hash ( a, _ ) = A.hash seed a
-                    let equal ( a, _ ) ( a', _ ) = A.equal a a'
-                end) in
-                let memotable = Memotable.create 0 in
-
-                let rec memo x = try
-                    let f () = f memo x in
-                    object (self)
-                        inherit t (Thunk f)
-                        initializer
-                            let binding = ( x, self ) in
-                            let _, other as binding' = Memotable.merge memotable binding in
-                            if binding' == binding then
-                                let unmemo () = Memotable.remove memotable binding in
-                                thunk <- MemoThunk ( f, unmemo )
-                            else
-                                raise (MemoHit other)
-                    end
-                with MemoHit other ->
-                    other
-                in
-
-                let update_memo m x =
-                    let f () = f memo x in
-                    let binding = ( x, m ) in
-                    let _, other as binding' = Memotable.merge memotable binding in
-                    if binding' == binding then begin
-                        let unmemo () = Memotable.remove memotable binding in
-                        m#update_memo_thunk f unmemo
-                    end else if m != other then
-                        m#update_thunk f
-                in
-                ( memo, update_memo )
-    end)
-end