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 (*
  17   Time-stamp: <Last modified on 2013-03-18 00:16:08 CET by Kim Nguyen>
  18 *)
  19
  20 include Hcons_sig
  21
  22 module type TableBuilder =
  23   functor
  24     (H : Common_sig.HashedType) ->
  25       Common_sig.HashSet with type data = H.t
  26
  27 module Builder (TB : TableBuilder) (H : Common_sig.HashedType) =
  28 struct
  29   type data = H.t
  30   type t = { id   : Uid.t;
  31              hash : int;
  32              node : data }
  33   let uid_make = ref (Uid.make_maker())
  34   let node t = t.node
  35   let uid t = t.id
  36   let hash t = t.hash
  37   let equal t1 t2 = t1 == t2
  38   module HN =
  39   struct
  40     type _t = t
  41     type t = _t
  42     let hash = hash
  43     let equal x y = x == y || H.equal x.node y.node
  44   end
  45   module T = TB(HN)
  46
  47   let pool = T.create 101
  48   let init () =
  49     T.clear pool;
  50     uid_make := Uid.make_maker ()
  51   let dummy x = { id = Uid.dummy; hash = H.hash x; node = x }
  52
  53   let make x =
  54     let cell = dummy x in
  55     try
  56       T.find pool cell
  57     with
  58     | Not_found ->
  59       let cell = { cell with id = !uid_make(); } in
  60       T.add pool cell;
  61       cell
  62 end
  63
  64 module Make = Builder (Misc.HashSet)
  65 module Weak = Builder (Weak.Make)
  66
  67 module PosInt =
  68 struct
  69   type data = int
  70   type t = int
  71   let make v =
  72     if v < 0 then raise (Invalid_argument "Hcons.PosInt.make")
  73     else v
  74
  75   let node v = v
  76
  77   let hash v = v
  78
  79   let uid v = Uid.of_int v
  80   let dummy _ = ~-1
  81   let equal x y = x == y
  82
  83   let init () = ()
  84 end