anil.recoil.org
My working unpac repository
1(**************************************************************************)
2(* *)
3(* OCaml *)
4(* *)
5(* Francois Pottier, projet Cristal, INRIA Rocquencourt *)
6(* Jeremie Dimino, Jane Street Europe *)
7(* *)
8(* Copyright 2002 Institut National de Recherche en Informatique et *)
9(* en Automatique. *)
10(* *)
11(* All rights reserved. This file is distributed under the terms of *)
12(* the GNU Lesser General Public License version 2.1, with the *)
13(* special exception on linking described in the file LICENSE. *)
14(* *)
15(**************************************************************************)
16
17exception Empty
18
19type 'a cell =
20 | Nil
21 | Cons of { content: 'a; mutable next: 'a cell }
22
23type 'a t = {
24 mutable length: int;
25 mutable first: 'a cell;
26 mutable last: 'a cell
27}
28
29let create () = {
30 length = 0;
31 first = Nil;
32 last = Nil
33}
34
35let clear q =
36 q.length <- 0;
37 q.first <- Nil;
38 q.last <- Nil
39
40let add x q =
41 let cell = Cons {
42 content = x;
43 next = Nil
44 } in
45 match q.last with
46 | Nil ->
47 q.length <- 1;
48 q.first <- cell;
49 q.last <- cell
50 | Cons last ->
51 q.length <- q.length + 1;
52 last.next <- cell;
53 q.last <- cell
54
55let push =
56 add
57
58let peek q =
59 match q.first with
60 | Nil -> raise Empty
61 | Cons { content } -> content
62
63let peek_opt q =
64 match q.first with
65 | Nil -> None
66 | Cons { content } -> Some content
67
68let top =
69 peek
70
71let take q =
72 match q.first with
73 | Nil -> raise Empty
74 | Cons { content; next = Nil } ->
75 clear q;
76 content
77 | Cons { content; next } ->
78 q.length <- q.length - 1;
79 q.first <- next;
80 content
81
82let take_opt q =
83 match q.first with
84 | Nil -> None
85 | Cons { content; next = Nil } ->
86 clear q;
87 Some content
88 | Cons { content; next } ->
89 q.length <- q.length - 1;
90 q.first <- next;
91 Some content
92
93let pop =
94 take
95
96let drop q =
97 match q.first with
98 | Nil -> raise Empty
99 | Cons { content = _; next = Nil } ->
100 clear q
101 | Cons { content = _; next } ->
102 q.length <- q.length - 1;
103 q.first <- next
104
105let copy =
106 let rec copy q_res prev cell =
107 match cell with
108 | Nil -> q_res.last <- prev; q_res
109 | Cons { content; next } ->
110 let res = Cons { content; next = Nil } in
111 begin match prev with
112 | Nil -> q_res.first <- res
113 | Cons p -> p.next <- res
114 end;
115 copy q_res res next
116 in
117 fun q -> copy { length = q.length; first = Nil; last = Nil } Nil q.first
118
119let is_empty q =
120 q.length = 0
121
122let length q =
123 q.length
124
125let iter =
126 let rec iter f cell =
127 match cell with
128 | Nil -> ()
129 | Cons { content; next } ->
130 f content;
131 iter f next
132 in
133 fun f q -> iter f q.first
134
135let fold =
136 let rec fold f accu cell =
137 match cell with
138 | Nil -> accu
139 | Cons { content; next } ->
140 let accu = f accu content in
141 fold f accu next
142 in
143 fun f accu q -> fold f accu q.first
144
145let transfer q1 q2 =
146 if q1.length > 0 then
147 match q2.last with
148 | Nil ->
149 q2.length <- q1.length;
150 q2.first <- q1.first;
151 q2.last <- q1.last;
152 clear q1
153 | Cons last ->
154 q2.length <- q2.length + q1.length;
155 last.next <- q1.first;
156 q2.last <- q1.last;
157 clear q1
158
159(** {1 Iterators} *)
160
161let to_seq q =
162 let rec aux c () = match c with
163 | Nil -> Seq.Nil
164 | Cons { content=x; next; } -> Seq.Cons (x, aux next)
165 in
166 aux q.first
167
168let add_seq q i = Seq.iter (fun x -> push x q) i
169
170let of_seq g =
171 let q = create() in
172 add_seq q g;
173 q