Re: [Caml-list] Heterogeneous dictionary

[Martin Jambon <martin.jambon@ens-lyon.org>]

On 04/04/2013 12:32 AM, Alain Frisch wrote:
> 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! *)

Oops. Here is my corrected version:

let access () =
   let r = ref None in
   let get tbl k =
     r := None; (* reset state in case last operation was not a get *)
     try
       (Hashtbl.find tbl k) ();
       let result = !r in
       r := None; (* clean up here in order avoid memory leak *)
       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


> 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.)

Nice.