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
module Base = struct
let pow2 k =
let rec h k = if k = 0 then 1 else 2 * h (k-1) in
if k >= 0 then h k else invalid_arg "Ext.Base.pow2"
let neg f x = not (f x)
let swap (x,y) = (y,x)
let clone (type t) (x : t) : t =
let buf = Marshal.(to_bytes x [No_sharing; Closures]) in
Marshal.from_bytes buf 0
end
module Format = struct
let pp_spc fmt () = Format.fprintf fmt "@ "
let pp_cut fmt () = Format.fprintf fmt "@,"
let to_string pp x = Format.asprintf "%a" pp x
end
module List = struct
let cart_prod l1 l2 =
List.map (fun x1 -> List.map (fun x2 -> x1,x2) l2) l1 |> List.flatten
let replace_assoc k v l = (k,v) :: List.remove_assoc k l
let add_list_assoc k v l =
let rec h = function
[] -> [k,[v]]
| (k',vs)::l -> if k=k' then (k,v::vs) :: l else (k',vs) :: h l in
h l
let scatter f l =
let add k v l =
let v' = List.assoc k l in
(k,v::v') :: List.remove_assoc k l in
List.fold_left
(fun acc x ->
let k = f x in
if List.mem_assoc k acc then add k x acc else (k,[x])::acc)
[]
l
let iter_fst f l =
ignore (List.fold_left (fun z x -> f z x; false) true l)
let fold_leftr f l acc = List.fold_left f acc l
let pp_v pp fmt l =
let open Stdlib.Format in
match l with
| [] -> fprintf fmt "[]"
| [x] -> fprintf fmt "@[<h>[%a]@]" pp x
| _ -> fprintf fmt "@[<v>[%a]@]" (pp_print_list ~pp_sep:Format.pp_cut pp) l
let pp_h ?(sep="") pp fmt l = Stdlib.Format.pp_print_list ~pp_sep:(fun fmt () -> Stdlib.Format.fprintf fmt "%s" sep) pp fmt l
let pp_opt ~lr ~sep pp fmt l =
match l with
| [] -> ()
| _ -> Stdlib.Format.fprintf fmt "%s%a%s" (fst lr) (pp_h ~sep pp) l (snd lr)
let pp_assoc (pp_k,pp_v) fmt l =
let open Stdlib.Format in
let pp_elem fmt (k,v) = fprintf fmt "%a->%a" pp_k k pp_v v in
fprintf fmt "[%a]" (pp_h ~sep:"," pp_elem) l
end
module Option = struct
let pp ?(none="?") pp fmt v =
let open Stdlib.Format in
match v with
| None -> pp_print_string fmt none
| Some v' -> fprintf fmt "%a" pp v'
end
module File = struct
let check_dir path =
if not (Sys.is_directory path) then raise (Sys_error ("file " ^ " is not a directory"))
let open_file fname =
let oc = open_out fname in
oc, Stdlib.Format.formatter_of_out_channel oc
let close_file (oc,ocf) =
Stdlib.Format.fprintf ocf "@.";
close_out oc
let copy_with_subst defns ic oc =
let rec subst mdefs s = match mdefs with
[] -> s
| (v,v')::ds -> subst ds (Str.global_replace (Str.regexp_string v) v' s) in
try
while true do
let line = input_line ic in
Printf.fprintf oc "%s\n" (subst defns line)
done
with End_of_file ->
()
end