Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 127 lines (94 sloc) 2.934 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (**
19 Management of imperative scope
20 @author Vincent Benayoun
21 *)
22
23
24 module type IMPERATIVE_SCOPE =
25 sig
26 (**
27 The mutable type of the instance
28 *)
29 type 'a t
30
31 type elt
32
33 (** create a new structure given a size for blocks *)
34 val create : int -> 'a t
35
36 (** reset the structure to its initial state *)
37 val reset : 'a t -> unit
38
39 (** push a new block *)
40 val push : 'a t -> unit
41
42 (** pop the top block *)
43 val pop : 'a t -> unit
44
45 (** fold the top block *)
46 val fold : (elt -> 'a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc
47
48 (** bind the elt to 'a in the top block *)
49 val bind : 'a t -> elt -> 'a -> unit
50
51 (** unbind the elt from the top block *)
52 val unbind : 'a t -> elt -> unit
53
54 (** find the first binded data to the elt (top down) *)
55 val find_opt : 'a t -> elt -> 'a option
56
57 end
58
59 module type ARG =
60 sig
61 type elt
62 type 'a block
63
64 val create : int -> 'a block
65 val fold : (elt -> 'a -> 'acc -> 'acc) -> 'a block -> 'acc -> 'acc
66 val bind : 'a block -> elt -> 'a -> unit
67 val unbind : 'a block -> elt -> unit
68 val find_opt: 'a block -> elt -> 'a option
69 end
70
71
72 module Make(Arg : ARG) : IMPERATIVE_SCOPE with type elt = Arg.elt =
73 struct
74
75 type 'a t = 'a Arg.block list ref
76 type elt = Arg.elt
77
78 let block_size = ref 0
79
80 let new_stack() = [Arg.create !block_size]
81
82 let create n = block_size := n; ref (new_stack())
83 let reset s = s := new_stack()
84 let push s = s := (Arg.create !block_size)::!s
85 let pop s =
86 match !s with
87 | [_] -> s := new_stack()
88 | _ -> s := List.tl !s
89 let fold f s = Arg.fold f (List.hd !s)
90 let bind s e v = Arg.bind (List.hd !s) e v
91 let unbind s e = Arg.unbind (List.hd !s) e
92
93 let rec find_opt s e =
94 let rec aux l =
95 match l with
96 | [] -> None
97 | hd::tl ->
98 let found = Arg.find_opt hd e in
99 match found with
100 | Some _ -> found
101 | None -> aux tl
102 in
103 aux !s
104 end
105
106
107 module Default (Arg : sig type elt end) = Make(
108 struct
109 type elt = Arg.elt
110 type 'a block = (elt, 'a) Hashtbl.t
111
112 let create n = Hashtbl.create n
113
114 let fold f = Hashtbl.fold f
115
116 let bind b e v = Hashtbl.add b e v
117 let unbind b e = Hashtbl.remove b e
118
119 let find_opt b e =
120 try
121 Some (Hashtbl.find b e)
122 with
123 | Not_found -> None
124
125 end
126 )
Something went wrong with that request. Please try again.