Re: [Caml-list] Making a polymorphic type non-polymorphic to comply with original signature

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

Hugo Ferreira wrote:
> Hello,
> 
> I have the following definition:
> 
> module rec H :
>   sig
>       type 'a node =
>           | Node of 'a node J.t
>           | Leaf of 'a
> 
>      type 'a t = 'a node
>      val equal : 'a t -> 'a t -> bool
>     val hash : 'a t -> int
>   end =
> struct
>     type 'a node =
>         | Node of 'a node J.t
>         | Leaf of 'a
> 
>     type 'a t = 'a node
>     let equa = (==)
>     let hash = Hashtbl.hash
> end
> 
> and J : Hashtbl.S with type 'a key = 'a H.node = Hashtbl.Make( H )
> ;;
> 
> The data type 'a node is polymorphic. It is also a key used by the
> hash-table. Note that H now does not comply with Hashtbl.HashedType
> (because Hashtbl.HashedType is not polymorphic). By adding the
> constraint "with type" also does not help.
> 
> Is it possible to make H comply with Hashtbl.HashedType i.e: make
> J.Key = 'a H.node ?


I just posted an implementation of polymorphic hash tables with physical
comparison, using the Obj module:

  http://martin.jambon.free.fr/phys.html

It is the following code:

(***** phys.mli *****)

type ('a, 'b) t

val add : ('a, 'b) t -> 'a -> 'b -> unit
val clear : ('a, 'b) t -> unit
val copy : ('a, 'b) t -> ('a, 'b) t
val create : int -> ('a, 'b) t
val find : ('a, 'b) t -> 'a -> 'b
val find_all : ('a, 'b) t -> 'a -> 'b list
val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit
val length : ('a, 'b) t -> int
val mem : ('a, 'b) t -> 'a -> bool
val remove : ('a, 'b) t -> 'a -> unit
val replace : ('a, 'b) t -> 'a -> 'b -> unit



(***** phys.ml *****)

(*
  This implementation uses the Obj module which allows to transgress
  the type system. It is not regular OCaml.
*)

module Magic_key =
struct
  type t = Obj.t
  let equal = ( == )
  let hash = Hashtbl.hash
end

module Magic_table = Hashtbl.Make (Magic_key)


type ('a, 'b) t = 'b Magic_table.t

let add tbl k v = Magic_table.add tbl (Obj.repr k) v
let clear tbl = Magic_table.clear tbl
let copy tbl = Magic_table.copy tbl
let create n = Magic_table.create n
let find tbl k = Magic_table.find tbl (Obj.repr k)
let find_all tbl k = Magic_table.find_all tbl (Obj.repr k)
let fold f tbl accu = Magic_table.fold (Obj.magic f) (Obj.magic tbl) accu
let iter f tbl = Magic_table.iter (Obj.magic f) (Obj.magic tbl)
let length tbl = Magic_table.length tbl
let mem tbl k = Magic_table.mem tbl (Obj.repr k)
let remove tbl k = Magic_table.remove tbl (Obj.repr k)
let replace tbl k v = Magic_table.replace tbl (Obj.repr k) v


(*****************)



Martin

-- 
http://mjambon.com/