module type PROPERTY_LIST =
sig
    type t

    val create : unit -> t
    val new_property : unit -> (t -> 'a -> unit) * (t -> 'a option)
end

module MappedList : PROPERTY_LIST =
struct
    type t = (int, unit -> unit) Hashtbl.t

    let create () = Hashtbl.create 13

    let new_id : unit -> int =
    let id = ref 0 in
        fun () -> incr id; !id

    let new_property () =
        let id = new_id () in

        (* This ref is used to communicate information *)
        (* between set and get *)
        let v = ref None in

        let set t x =
            (* stash the update hook *)
            Hashtbl.replace t id (fun () -> v := Some x) in

        let get t =
            try
            (* call the update hook if it exist *)
            (Hashtbl.find t id) ();

            (* Then read the result if the above succeeded *)
            match !v with
                Some x as s ->
                    (* prevent the value cached in v from *)
                    (* existing longer than needed *)
                    (* without this, calling set could leave *)
                    v := None;
                    s
                | None -> None
                with Not_found -> None
        in
            (set, get)
end