1
(* minimal set up since we do not have core available *)
8
module Flat_int_map = Flat_map.Flat_int_map
9
module Flat_string_map = Flat_map.Flat_string_map
11
module Sexp = Sexplib.Sexp
13
module Sexpable = struct
23
type ('a, 'b) t with sexp
27
type ('a, 'b, 'c) t with sexp
31
module Binable = Bin_prot.Binable
33
let phys_equal = Pervasives.(==)
34
external ident : 'a -> 'a = "%identity"
37
type 'a t = 'a array with sexp, bin_io, typerep
41
let is_empty t = length t = 0
43
let rec list_length accu = function
45
| _ :: tl -> list_length (succ accu) tl
47
let of_list_map ~f xs =
51
let a = create (list_length 1 tl) (f hd) in
52
let rec fill a i = function
54
| hd::tl -> unsafe_set a i (f hd); fill a (i+1) tl in
57
(* It can be written in a more simple (but less efficient) way with [fold_right] *)
58
let to_list_map ~f arr =
59
let rec aux_to_list_map arr f acc index =
62
let elt = f (unsafe_get arr index) in
63
aux_to_list_map arr f (elt::acc) (pred index)
65
aux_to_list_map arr f [] (pred (length arr))
67
let map_stable ~f:map array =
68
let rec aux map array size index =
69
if index >= size then array else
70
let elt = array.(index) in
72
if phys_equal elt felt then aux map array size (succ index) else begin
73
let new_array = copy array in
74
new_array.(index) <- felt;
75
for i = succ index to pred size do
76
new_array.(i) <- map array.(i)
81
let size = Array.length array in
86
let iter2_exn ~f a b =
87
if length a <> length b then invalid_arg "Array.iter2_exn";
88
let f i a = f a b.(i) in
92
let length = length t in
94
if i >= length then None
98
| (Some _) as some -> some
99
| None -> loop (succ i)
104
let length = length t in
106
if i >= length then false
109
f elt || loop (succ i)
114
let length = length t in
116
if i >= length then true
119
f elt && loop (succ i)
126
type 'a t with sexp, bin_io, typerep
127
val get : 'a t -> int -> 'a
128
val length : _ t -> int
129
val init : int -> f:(int -> 'a) -> 'a t
130
val empty : unit -> 'a t
131
val make1 : 'a -> 'a t
132
val make2 : 'a -> 'a -> 'a t
133
val make3 : 'a -> 'a -> 'a -> 'a t
134
val make4 : 'a -> 'a -> 'a -> 'a -> 'a t
135
val make5 : 'a -> 'a -> 'a -> 'a -> 'a -> 'a t
136
val iter : f:('a -> unit) -> 'a t -> unit
137
val map : f:('a -> 'b) -> 'a t -> 'b t
138
val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t
139
val sort : cmp:('a -> 'a -> int) -> 'a t -> 'a t
140
val for_all : f:('a -> bool) -> 'a t -> bool
141
val exists : f:('a -> bool) -> 'a t -> bool
142
val of_array : f:(int -> 'a -> 'b) -> 'a array -> 'b t
143
val to_array : f:(int -> 'a -> 'b) -> 'a t -> 'b array
144
val map_stable : f:('a -> 'a) -> 'a t -> 'a t
145
val to_list : 'a t -> 'a list
146
val of_list : 'a list -> 'a t
147
val iter2_exn : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit
148
val is_empty : _ t -> bool
149
val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
150
val of_list_map : f:('a -> 'b) -> 'a list -> 'b t
151
val to_list_map : f:('a -> 'b) -> 'a t -> 'b list
156
let make2 a b = [|a ; b|]
157
let make3 a b c = [|a ; b ; c|]
158
let make4 a b c d = [|a ; b ; c ; d|]
159
let make5 a b c d e = [|a ; b ; c ; d ; e|]
161
let a = Array.copy a in
168
module Hashable = struct
169
module type Key = sig
171
val compare : t -> t -> int
178
val create : unit -> 'a t
179
val set : 'a t -> key:key -> data:'a -> unit
180
val find : 'a t -> key -> 'a option
181
val length : 'a t -> int
182
val iter : 'a t -> f:(key -> 'a -> unit) -> unit
183
val to_array : 'a t -> f:(key -> 'a -> 'b) -> 'b array
184
val to_init : (int -> f:(int -> 'b) -> 'c) -> 'a t -> f:(key -> 'a -> 'b) -> 'c
186
module Hash_set : sig
188
val create : unit -> t
189
val mem : t -> key -> bool
190
val add : t -> key -> unit
195
val mem : 'a t -> key -> bool
196
val add : 'a t -> key:key -> data:'a -> 'a t
197
val find : 'a t -> key -> 'a option
198
val to_alist : 'a t -> (key * 'a) list
201
module Make(Key:Key) : S with type key := Key.t = struct
202
module T = Hashtbl.Make(struct include Key let equal a b = compare a b = 0 end)
203
module Table = struct
205
let create () = create 128
206
let set a ~key ~data = replace a key data
207
let find a key = try Some (find a key) with Not_found -> None
208
let iter table ~f = iter f table
209
let to_array table ~f =
210
let length = length table in
211
let result = ref None in
214
| Some (array, index) -> incr index; array.(!index) <- f key a
216
let data = f key a in
217
let array = Array.make length data in
218
result := Some (array, ref 0)
223
| Some (array, index) -> assert (!index = pred length); array
224
let to_init init table ~f =
225
let array = to_array table ~f in
226
init (Array.length array) ~f:(fun i -> array.(i))
228
module Hash_set = struct
230
let create () = T.create 128
232
let add t b = T.replace t b ()
235
include Map.Make(Key)
236
let add map ~key ~data = add key data map
237
let find map key = try Some (find key map) with Not_found -> None
238
let mem map key = mem key map
239
let to_alist = bindings
246
type t = int with sexp, bin_io
247
let hash (a:int) = Hashtbl.hash a
248
let compare (a:int) b = Pervasives.compare a b
249
let equal a b = compare a b = 0
252
include Hashable.Make(T)
258
let is_empty = function
261
let rev_filter ~f list =
262
let rec aux acc = function
265
let acc = if f hd then hd :: acc else acc in
269
let nth list pos = try Some (nth list pos) with _ -> None
270
let filter_map ~f list =
271
let rec aux acc = function
275
| Some hd -> aux (hd::acc) tl
281
module Option = struct
282
type 'a t = 'a option with sexp, bin_io
287
let is_some = function Some _ -> true | None -> false
288
let is_none = function None -> true | Some _ -> false
289
let iter ~f = function
291
| Some value -> f value
292
let map ~f = function
294
| Some a -> Some (f a)
295
let map_stable ~f t =
299
if phys_equal arg arg' then t else Some arg'
303
module String = struct
305
type t = string with sexp, bin_io
306
include (StringLabels : (module type of StringLabels with type t := t))
307
let hash (a:string) = Hashtbl.hash a
308
let equal a b = String.compare a b = 0
311
include Hashable.Make(T)
313
let len = length str in
314
let rec loop acc last_pos pos =
316
sub str ~pos:0 ~len:last_pos :: acc
318
if str.[pos] = on then
319
let pos1 = pos + 1 in
320
let sub_str = sub str ~pos:pos1 ~len:(last_pos - pos1) in
321
loop (sub_str :: acc) pos (pos - 1)
322
else loop acc last_pos (pos - 1)
324
loop [] len (len - 1)
added
removed
extended/lib/pre_core.ml
