Source file cache.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
(**
  * cache.ml
  *
  * a module for KaSim
  * Jérôme Feret, projet Abstraction, INRIA Paris-Rocquencourt
  * Jean Krivine, Université Paris-Diderot, CNRS
  *
  * KaSim
  * Jean Krivine, Université Paris-Diderot, CNRS
  *
  * Creation: 27/03/2012
  * Last modification: 27/03/2012
  * *
  *
  * It uses imperative styles to ensure compatibility with other modules
  *
  * Copyright 2011,2012  Institut National de Recherche en Informatique et
  * en Automatique.  All rights reserved.  This file is distributed
  * under the terms of the GNU Library General Public License *)

module type Cache = sig
  module O : SetMap.OrderedType

  type t

  val last : t -> O.t option
  val create : int option -> t
  val add : O.t -> t -> t
  val fold : (O.t -> 'a -> 'a) -> t -> 'a -> 'a
  val iter : (O.t -> unit) -> t -> unit
end

module Cache =
functor
  (OO : SetMap.OrderedType)
  ->
  (
    struct
      module O = OO
      module SM = SetMap.Make (O)
      module S = SM.Set

      type finite_cache = {
        size: int;
        offset: int;
        cache: O.t option array;
        bag: S.t;
        last: O.t option;
      }

      let create_finite n =
        {
          size = n;
          offset = 0;
          cache = Array.make n None;
          bag = S.empty;
          last = None;
        }

      let next t =
        let offset = t.offset in
        if offset = t.size - 1 then
          { t with offset = 0 }
        else
          { t with offset = offset + 1 }

      let add_finite key t =
        let t = { t with last = Some key } in
        if S.mem key t.bag then
          t
        else (
          let t = { t with bag = S.add key t.bag } in
          let t = next t in
          let overwritten_value = t.cache.(t.offset) in
          let t =
            match overwritten_value with
            | None -> t
            | Some overwritten_value ->
              { t with bag = S.remove overwritten_value t.bag }
          in
          let _ = t.cache.(t.offset) <- Some key in
          t
        )

      let last_finite t = t.last

      type infinite_cache = { inf_bag: S.t; last: O.t option }
      type t = Finite of finite_cache | Infinite of infinite_cache

      let create_infinite = { inf_bag = S.empty; last = None }

      let add_infinite key t =
        { inf_bag = S.add key t.inf_bag; last = Some key }

      let create size =
        match size with
        | None -> Infinite create_infinite
        | Some a -> Finite (create_finite a)

      let last t =
        match t with
        | Finite t -> last_finite t
        | Infinite t -> t.last

      let add key t =
        match t with
        | Finite t -> Finite (add_finite key t)
        | Infinite t -> Infinite (add_infinite key t)

      let fold f t a =
        match t with
        | Finite t -> S.fold f t.bag a
        | Infinite t -> S.fold f t.inf_bag a

      let iter f t =
        match t with
        | Finite t -> S.iter f t.bag
        | Infinite t -> S.iter f t.inf_bag
    end :
      Cache with type O.t = OO.t)