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
|
(***********************************************************************)
(* 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') || (c >= 'A' && c <= 'Z')
let is_digit c = (c >= '0' && c <= '9')
let is_ident_tail c =
is_letter c || is_digit c || c = '\'' || 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
(* Stacks *)
module Stack = CStack
(* Matrices *)
let matrix_transpose mat =
List.fold_right (List.map2 (fun p c -> p::c)) mat
(if List.is_empty 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 =
let rec iterate_f f n x =
if n <= 0 then x else iterate_f 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 = ('a, 'b) CSig.union = Inl of 'a | Inr of 'b
type 'a until = 'a CSig.until = Stop of 'a | Cont of 'a
(*s interruption *)
let interrupt = ref false
let check_for_interrupt () =
if !interrupt then begin interrupt := false; raise Sys.Break end
|
