src/hcons.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                     Kim Nguyen, LRI UMR8623                         *)
   6 (*                   Université Paris-Sud & CNRS                       *)
   7 (*                                                                     *)
   8 (*  Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
   9 (*  Recherche Scientifique. All rights reserved.  This file is         *)
  10 (*  distributed under the terms of the GNU Lesser General Public       *)
  11 (*  License, with the special exception on linking described in file   *)
  12 (*  ../LICENSE.                                                        *)
  13 (*                                                                     *)
  14 (***********************************************************************)
  15
  16 include Hcons_sig
  17
  18 module type TableBuilder =
  19   functor
  20     (H : Common_sig.HashedType) ->
  21       Common_sig.HashSet with type data = H.t
  22
  23 module Builder (TB : TableBuilder) (H : Common_sig.HashedType) =
  24 struct
  25   type data = H.t
  26   type t = { id   : Uid.t;
  27              hash : int;
  28              node : data }
  29   let uid_make = ref (Uid.make_maker())
  30   let node t = t.node
  31   let uid t = t.id
  32   let hash t = t.hash
  33   let equal t1 t2 = t1 == t2
  34   module HN =
  35   struct
  36     type _t = t
  37     type t = _t
  38     let hash = hash
  39     let equal x y = x == y || H.equal x.node y.node
  40   end
  41   module T = TB(HN)
  42
  43   let pool = T.create 101
  44   let init () =
  45     T.clear pool;
  46     uid_make := Uid.make_maker ()
  47   let dummy x = { id = Uid.dummy; hash = H.hash x; node = x }
  48
  49   let make x =
  50     let cell = dummy x in
  51     try
  52       T.find pool cell
  53     with
  54     | Not_found ->
  55       let cell = { cell with id = !uid_make(); } in
  56       T.add pool cell;
  57       cell
  58 end
  59
  60 module Make = Builder (Misc.HashSet)
  61 module Weak = Builder (Weak.Make)
  62
  63 module PosInt =
  64 struct
  65   type data = int
  66   type t = int
  67   let make v =
  68     if v < 0 then raise (Invalid_argument "Hcons.PosInt.make")
  69     else v
  70
  71   let node v = v
  72
  73   let hash v = v
  74
  75   let uid v = Uid.of_int v
  76   let dummy _ = ~-1
  77   let equal x y = x == y
  78
  79   let init () = ()
  80 end