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
|
(***********************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
(* \VV/ *************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
(* Mapping under pairs *)
let on_fst f (a,b) = (f a,b)
let on_snd f (a,b) = (a,f b)
let map_pair f (a,b) = (f a,f b)
(* Mapping under pairs *)
let on_pi1 f (a,b,c) = (f a,b,c)
let on_pi2 f (a,b,c) = (a,f b,c)
let on_pi3 f (a,b,c) = (a,b,f c)
(* Projections from triplets *)
let pi1 (a,_,_) = a
let pi2 (_,a,_) = a
let pi3 (_,_,a) = a
(* Characters *)
let is_letter c = (c >= 'a' && c <= 'z') or (c >= 'A' && c <= 'Z')
let is_digit c = (c >= '0' && c <= '9')
let is_ident_tail c =
is_letter c or is_digit c || c = '\'' or c = '_'
let is_blank = function
| ' ' | '\r' | '\t' | '\n' -> true
| _ -> false
module Empty =
struct
type t
let abort (x : t) = assert false
end
(* Strings *)
module String : CString.ExtS = CString
let subst_command_placeholder s t =
let buff = Buffer.create (String.length s + String.length t) in
let i = ref 0 in
while (!i < String.length s) do
if s.[!i] = '%' & !i+1 < String.length s & s.[!i+1] = 's'
then (Buffer.add_string buff t;incr i)
else Buffer.add_char buff s.[!i];
incr i
done;
Buffer.contents buff
(* Lists *)
module List : CList.ExtS = CList
let (@) = CList.append
(* Arrays *)
module Array : CArray.ExtS = CArray
(* Maps *)
module Map = CMap
(* Matrices *)
let matrix_transpose mat =
List.fold_right (List.map2 (fun p c -> p::c)) mat
(if mat = [] then [] else List.map (fun _ -> []) (List.hd mat))
(* Functions *)
let identity x = x
let compose f g x = f (g x)
let const x _ = x
let iterate f =
let rec iterate_f n x =
if n <= 0 then x else iterate_f (pred n) (f x)
in
iterate_f
let repeat n f x =
let rec loop i = if i <> 0 then (f x; loop (i - 1)) in loop n
let iterate_for a b f x =
let rec iterate i v = if i > b then v else iterate (succ i) (f i v) in
iterate a x
let app_opt f x =
match f with
| Some f -> f x
| None -> x
(* Stream *)
let stream_nth n st =
try List.nth (Stream.npeek (n+1) st) n
with Failure _ -> raise Stream.Failure
let stream_njunk n st =
repeat n Stream.junk st
(* Delayed computations *)
type 'a delayed = unit -> 'a
let delayed_force f = f ()
(* Misc *)
type ('a,'b) union = Inl of 'a | Inr of 'b
(*s interruption *)
let interrupt = ref false
let check_for_interrupt () =
if !interrupt then begin interrupt := false; raise Sys.Break end
|
