/
base.ml
144 lines (121 loc) · 2.7 KB
/
base.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
external (@@) : ('a -> 'b) -> 'a -> 'b = "%apply"
external (+>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
let ($) f g x = f (g x)
let (!$) = Lazy.force
external id : 'a -> 'a = "%identity"
let uncurry f a b = f (a,b)
let curry f (a,b) = f a b
let flip f a b = f b a
let const a _ = a
let sure f =
function
Some x ->
Some (f x)
| None ->
None
let option f x = try Some (f x) with Not_found -> None
let maybe f x = try `Val (f x) with e -> `Error e
let tee f x = try ignore @@ f x; x with _ -> x
type ('a,'b) either = Left of 'a | Right of 'b
let failwithf fmt = Printf.kprintf (fun s () -> failwith s) fmt
let assoc x xs = (option @@ List.assoc x) xs
let string_of_list xs =
Printf.sprintf "[%s]"
@@ String.concat ";" xs
let rec unfold f init =
match f init with
Some (a, b) -> a :: unfold f b
| None -> []
let rec range a b =
if a >= b then
[]
else
a::range (a+1) b
let rec interperse delim =
function
[] -> []
| [x] -> [x]
| x::xs -> x::delim::interperse delim xs
let map_accum_left f init xs =
let f (accum,ys) x =
let accum',y =
f accum x in
(accum',y::ys) in
let accum,ys =
List.fold_left f (init,[]) xs in
accum,List.rev ys
let rec map_accum_right f init =
function
[] ->
init,[]
| x::xs ->
let (accum,ys) =
map_accum_right f init xs in
let (accum,y) =
f accum x in
accum,y::ys
let rec filter_map f =
function
x::xs ->
begin match f x with
Some y -> y::filter_map f xs
| None -> filter_map f xs
end
| [] ->
[]
let rec group_by f =
function
[] ->
[]
| x1::x2::xs when f x1 x2 ->
begin match group_by f @@ x2::xs with
y::ys ->
(x1::y)::ys
| _ ->
failwith "must not happen"
end
| x::xs ->
[x]::group_by f xs
let index x xs =
let rec loop i = function
[] ->
raise Not_found
| y::ys ->
if x = y then
i
else
loop (i+1) ys in
loop 0 xs
let string_of_char =
String.make 1
let hex =
Printf.sprintf "0x%x"
let open_out_with path f =
let ch =
open_out_bin path in
maybe f ch
+> tee (fun _ -> close_out ch)
+> function
`Val v -> v
| `Error e -> raise e
let open_in_with path f =
let ch =
open_in_bin path in
maybe f ch
+> tee (fun _ -> close_in ch)
+> function
`Val v -> v
| `Error e -> raise e
let undefined = Obj.magic 42
let undef = undefined
let rec format_list (sep : (unit, Format.formatter, unit) format) f ppf = function
| [] -> ()
| [x] -> f ppf x
| x::xs ->
Format.fprintf ppf "@[%a@]%t%a"
f x
(fun ppf -> Format.fprintf ppf sep)
(format_list sep f) xs
let format_ocaml_list f ppf xs =
Format.fprintf ppf "[ @[%a@] ]"
(format_list ";@ " f) xs