type void = | module Fun = struct let id x = x let curry f x y = f (x, y) let uncurry f (x, y) = f x y let rec repeat n f x = if n = 0 then () else ( f x ; repeat (n - 1) f x) end module Int = struct let log2 n = if n <= 0 then failwith "log2" ; let rec loop acc n = if n = 1 then acc else loop (acc + 1) (n lsr 1) in loop 0 n let is_power_of_two n = if n < 0 then failwith "is_power_of_two" ; n <> 0 && n land (n - 1) = 0 end module String = struct let implode cs = let buf = Buffer.create 80 in List.iter (Buffer.add_char buf) cs ; Buffer.contents buf let explode s = let cs = ref [] in for i = String.length s - 1 downto 0 do cs := s.[i] :: !cs done ; !cs let split s c = let len = String.length s in let rec loop i = if i > len then [] else let j = try String.index_from s i c with Not_found -> len in String.sub s i (j - i) :: loop (j + 1) in loop 0 let breakup s n = let rec loop i = let len = min n (String.length s - i) in if len = 0 then [] else String.sub s i len :: loop (i + len) in loop 0 let rec find_from_opt f s i = if i = String.length s then None else if f s.[i] then Some i else find_from_opt f s (i + 1) end module List = struct let rec make n x = make' n x [] and make' n x xs = if n = 0 then xs else make' (n - 1) x (x :: xs) let rec table n f = table' n f [] and table' n f xs = if n = 0 then xs else table' (n - 1) f (f (n - 1) :: xs) let rec take n xs = match (n, xs) with | 0, _ -> [] | n, x :: xs' when n > 0 -> x :: take (n - 1) xs' | _ -> failwith "take" let rec drop n xs = match (n, xs) with | 0, _ -> xs | n, _ :: xs' when n > 0 -> drop (n - 1) xs' | _ -> failwith "drop" let rec last = function | [x] -> x | _ :: xs -> last xs | [] -> failwith "last" let rec split_last = function | [x] -> ([], x) | x :: xs -> let ys, y = split_last xs in (x :: ys, y) | [] -> failwith "split_last" let rec index_where p xs = index_where' p xs 0 and index_where' p xs i = match xs with | [] -> None | x :: _ when p x -> Some i | _ :: xs' -> index_where' p xs' (i + 1) let index_of x = index_where (( = ) x) let rec map_filter f = function | [] -> [] | x :: xs -> ( match f x with | None -> map_filter f xs | Some y -> y :: map_filter f xs) let rec concat_map f = function [] -> [] | x :: xs -> f x @ concat_map f xs let rec concat_map_s f l = let open Lwt.Syntax in match l with | [] -> Lwt.return [] | x :: xs -> let* x' = f x in let+ xs' = concat_map_s f xs in x' @ xs' let rec pairwise f = function | [] -> [] | x1 :: x2 :: xs -> f x1 x2 :: pairwise f xs | _ -> failwith "pairwise" end module List32 = struct let rec make n x = make' n x [] and make' n x xs = if n = 0l then xs else make' (Int32.sub n 1l) x (x :: xs) let rec length xs = length' xs 0l and length' xs n = match xs with | [] -> n | _ :: xs' when n < Int32.max_int -> length' xs' (Int32.add n 1l) | _ -> failwith "length" let rec nth xs n = match (n, xs) with | 0l, x :: _ -> x | n, _ :: xs' when n > 0l -> nth xs' (Int32.sub n 1l) | _ -> failwith "nth" let rec take n xs = match (n, xs) with | 0l, _ -> [] | n, x :: xs' when n > 0l -> x :: take (Int32.sub n 1l) xs' | _ -> failwith "take" let rec drop n xs = match (n, xs) with | 0l, _ -> xs | n, _ :: xs' when n > 0l -> drop (Int32.sub n 1l) xs' | _ -> failwith "drop" let rec mapi f xs = mapi' f 0l xs and mapi' f i = function | [] -> [] | x :: xs -> f i x :: mapi' f (Int32.add i 1l) xs let mapi_s f xs = let rec mapi_s' f i = let open Lwt.Syntax in function | [] -> Lwt.return [] | x :: xs -> let* v = f i x in let+ xs' = mapi_s' f (Int32.succ i) xs in v :: xs' in mapi_s' f 0l xs end module Array32 = struct let make n x = if n < 0l || Int64.of_int32 n > Int64.of_int max_int then raise (Invalid_argument "Array32.make") ; Array.make (Int32.to_int n) x let length a = Int32.of_int (Array.length a) let index_of_int32 i = if i < 0l || Int64.of_int32 i > Int64.of_int max_int then -1 else Int32.to_int i let get a i = Array.get a (index_of_int32 i) let set a i x = Array.set a (index_of_int32 i) x let blit a1 i1 a2 i2 n = Array.blit a1 (index_of_int32 i1) a2 (index_of_int32 i2) (index_of_int32 n) end module Bigarray = struct open Bigarray module Array1_64 = struct let create kind layout n = if n < 0L || n > Int64.of_int max_int then raise (Invalid_argument "Bigarray.Array1_64.create") ; Array1.create kind layout (Int64.to_int n) let dim a = Int64.of_int (Array1.dim a) let index_of_int64 i = if i < 0L || i > Int64.of_int max_int then -1 else Int64.to_int i let get a i = Array1.get a (index_of_int64 i) let set a i x = Array1.set a (index_of_int64 i) x let sub a i n = Array1.sub a (index_of_int64 i) (index_of_int64 n) end end module Option = struct let get o x = match o with Some y -> y | None -> x let force o = match o with Some y -> y | None -> raise (Invalid_argument "Option.force") let map f = function Some x -> Some (f x) | None -> None let app f = function Some x -> f x | None -> () end