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-01-30 19:08:47 CET by Kim Nguyen>
  18 *)
  19
  20 include Sigs.HCONS
  21
  22 module type TableBuilder =
  23   functor
  24     (H : Sigs.AUX.HashedType) ->
  25       Sigs.AUX.HashSet with type data = H.t
  26
  27 module Builder (TB : TableBuilder) (H : Sigs.AUX.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
  52   let make x =
  53     let cell = { id = Uid.dummy; hash = H.hash x; node = x } in
  54     try
  55       T.find pool cell
  56     with
  57     | Not_found ->
  58       let cell = { cell with id = !uid_make(); } in
  59       T.add pool cell;
  60       cell
  61 end
  62
  63 module Make = Builder (Utils.HashSet)
  64 module Weak = Builder (Weak.Make)
  65
  66 module PosInt =
  67 struct
  68   type data = int
  69   type t = int
  70   let make v =
  71     if v < 0 then raise (Invalid_argument "Hcons.PosInt.make")
  72     else v
  73
  74   let node v = v
  75
  76   let hash v = v
  77
  78   let uid v = Uid.of_int v
  79
  80   let equal x y = x == y
  81
  82   let init () = ()
  83 end