1
(**************************************************************************)
3
(* This file is part of Frama-C. *)
5
(* Copyright (C) 2007-2008 *)
6
(* CEA (Commissariat � l'�nergie Atomique) *)
8
(* you can redistribute it and/or modify it under the terms of the GNU *)
9
(* Lesser General Public License as published by the Free Software *)
10
(* Foundation, version 2.1. *)
12
(* It is distributed in the hope that it will be useful, *)
13
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
14
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
15
(* GNU Lesser General Public License for more details. *)
17
(* See the GNU Lesser General Public License version 2.1 *)
18
(* for more details (enclosed in the file licenses/LGPLv2.1). *)
20
(**************************************************************************)
22
(* $Id: computation.ml,v 1.15 2008/11/18 12:13:41 uid568 Exp $ *)
24
module type HASHTBL = sig
25
include Datatype.HASHTBL
26
val clear: 'a t -> unit
27
val find: 'a t -> key -> 'a
28
val remove: 'a t -> key -> unit
29
val mem: 'a t -> key -> bool
32
module type HASHTBL_OUTPUT = sig
33
include Project.Computation.OUTPUT
36
val replace: key -> data -> unit
37
val add: key -> data -> unit
38
val clear: unit -> unit
39
val length: unit -> int
40
val iter: (key -> data -> unit) -> unit
41
val fold: (key -> data -> 'a -> 'a) -> 'a -> 'a
42
val memo: ?change:(data -> data) -> (key -> data) -> key -> data
43
(** @plugin development guide *)
45
val find_all: key -> data list
46
val unsafe_find: key -> data
48
val remove: key -> unit
52
(H:HASHTBL)(Data:Project.Datatype.S)(Info:Signature.NAME_SIZE_DPDS) =
58
let create () = H.create Info.size
60
let state = ref (create ())
62
include Project.Computation.Register
63
(Datatype.Make_Hashtbl(H)(Data))
69
let set x = state := x
73
let clear () = H.clear !state
74
let length () = H.length !state
75
let replace key v = H.replace !state key v
76
let add key v = H.add !state key v
77
let find key = H.find !state key
78
let find_all key = H.find_all !state key
79
let unsafe_find key = try find key with Not_found -> assert false
80
let mem key = H.mem !state key
81
let remove key = H.remove !state key
82
let iter f = H.iter f !state
83
let fold f acc = H.fold f !state acc
85
let memo ?change f key =
89
~dft:old (fun f -> let v = f old in replace key v; v) change
97
module Hashtbl(Key:Hashtbl.HashedType) = Make_Hashtbl(Hashtbl.Make(Key))
99
module type REF_INPUT = sig
100
include Project.Datatype.S
101
val default: unit -> t
104
module type REF_OUTPUT = sig
105
include Project.Computation.OUTPUT
107
val set: data -> unit
108
val get: unit -> data
109
val clear: unit -> unit
112
module Ref(Data:REF_INPUT)(Info:Signature.NAME_DPDS) = struct
116
let create () = ref (Data.default ())
117
let state = ref (create ())
119
include Project.Computation.Register
124
let clear tbl = tbl := Data.default ()
126
let set x = state := x
130
let set v = !state := v
131
let get () = !(!state)
132
let clear () = !state := Data.default ()
136
module type OPTION_REF_OUTPUT = sig
138
val memo: ?change:(data -> data) -> (unit -> data) -> data
139
val map: (data -> data) -> data option
140
val may: (data -> unit) -> unit
144
(Data:Project.Datatype.S)(Info:Signature.NAME_DPDS) = struct
148
let create () = ref None
149
let state = ref (create ())
151
include Project.Computation.Register
152
(Datatype.OptionRef(Data))
154
type t = data option ref
156
let clear tbl = tbl := None
158
let set x = state := x
162
let set v = !state := Some v
163
let get () = match !(!state) with None -> raise Not_found | Some v -> v
164
let clear () = !state := None
170
~dft:old (fun f -> let v = f old in set v; v) change
176
let map f = Extlib.opt_map f !(!state)
177
let may f = Extlib.may f !(!state)
181
module type SET = sig
185
val singleton: elt -> t
186
val is_empty: t -> bool
187
val add: elt -> t -> t
188
val mem: elt -> t -> bool
189
val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
190
val iter: (elt -> unit) -> t -> unit
193
module type SET_REF_OUTPUT = sig
194
include Project.Computation.OUTPUT
198
val is_empty: unit -> bool
199
val fold: (elt -> 'a -> 'a) -> 'a -> 'a
200
val iter: (elt -> unit) -> unit
205
(Data:Project.Datatype.S with type t = Set.elt)
206
(Info:Signature.NAME_DPDS) =
210
include Datatype.Make_Set(Set)(Data)
211
let default () = Set.empty
215
let apply f = f (get ())
216
let is_empty () = apply Set.is_empty
217
let add x = set (apply (Set.add x))
218
let mem x = apply (Set.mem x)
219
let fold f = apply (Set.fold f)
220
let iter f = apply (Set.iter f)
223
module SetRef(Data:Project.Datatype.S) = Make_SetRef(Set.Make(Data))(Data)
227
module type QUEUE = sig
230
val iter: (elt -> unit) -> unit
231
val is_empty: unit -> bool
234
module Queue(Data:Project.Datatype.S)(Info:Signature.NAME_DPDS) = struct
238
let state = ref (Queue.create ())
240
include Project.Computation.Register
241
(Datatype.Queue(Data))
244
let create = Queue.create
245
let clear = Queue.clear
247
let set x = state := x
251
let add x = Queue.add x !state
252
let iter f = Queue.iter f !state
253
let is_empty () = Queue.is_empty !state
257
(** {3 Project itself} *)
259
module Project(Info:Signature.NAME_DPDS) =
261
(struct include Datatype.Project let default () = Project.dummy end)
264
(** {3 Apply Once} *)
266
let apply_once name dep f =
269
(struct include Datatype.Bool let default () = true end)
270
(struct let dependencies = dep let name = name end)
273
if First.get () then begin
275
try f () with exn -> First.set true; raise exn
281
compile-command: "LC_ALL=C make -C ../.. -j"
added
removed
src/project/computation.ml
