Re: [Caml-list] Heterogeneous dictionary

[Alain Frisch <alain@frisch.fr>]

On 04/04/2013 08:19 AM, Martin Jambon wrote:
> type 'a t = ('a, (unit -> unit)) Hashtbl.t
>
> let create n = Hashtbl.create n
>
> let access () =
>    let r = ref None in
>    let get tbl k =
>      try
>        (Hashtbl.find tbl k) ();
>        let result = !r in
>        r := None;
>        result
>      with Not_found -> None
>    in
>    let set tbl k v =
>      let v_opt = Some v in
>      Hashtbl.replace tbl k (fun () -> r := v_opt)
>    in
>    get, set

Careful, this is buggy!  If you apply the "get" on an existing value 
with the "wrong" type, it will set the slot corresponding to that wrong 
type, which can result in a fake "get" later on that type.

# let h = create 10;;
val h : '_a X.t = <abstr>
# let (get1, set1) = access ();;
val get1 : '_a X.t -> '_a -> '_b option = <fun>
val set1 : '_a X.t -> '_a -> '_b -> unit = <fun>
# let (get2, set2) = access ();;
val get2 : '_a X.t -> '_a -> '_b option = <fun>
val set2 : '_a X.t -> '_a -> '_b -> unit = <fun>
# set1 h "a" true;;
- : unit = ()
# set2 h "b" "X";;
- : unit = ()
# get1 h "b";;
- : bool option = None
(*  ====> the slot for get2/set2 has been filled! *)

# get2 h "a";;
- : string option = Some "X"

(* WRONG! *)


Here is an implementation of the same interface based on local 
exceptions.  It avoids the bug above and it is also more efficient and 
thread-safe:


type 'a t = ('a, exn) Hashtbl.t

let create n = Hashtbl.create n

let access (type t) () =
   let module M = struct exception E of t end in
   let r = ref None in
   let get tbl k =
     try
       match Hashtbl.find tbl k with
       | M.E x -> Some x
       | _ -> None
     with Not_found -> None
   in
   let set tbl k v =
     Hashtbl.replace tbl k (M.E v)
   in
   get, set

(If [get] is more frequent than [set], it is worth storing a "t option" 
in the exception directly.)

-- Alain