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