blob: 8dfe8759930ec93ae63e8ddbb3278c6e42d42bca (
plain)
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Extensible buffers *)
type t =
{mutable buffer : string;
mutable position : int;
mutable length : int;
initial_buffer : string}
let create n =
let n = if n < 1 then 1 else n in
let n = if n > Sys.max_string_length then Sys.max_string_length else n in
let s = String.create n in
{buffer = s; position = 0; length = n; initial_buffer = s}
let contents b = String.sub b.buffer 0 b.position
let sub b ofs len =
if ofs < 0 || len < 0 || ofs > b.position - len
then invalid_arg "Buffer.sub"
else begin
let r = String.create len in
String.blit b.buffer ofs r 0 len;
r
end
;;
let nth b ofs =
if ofs < 0 || ofs >= b.position then
invalid_arg "Buffer.nth"
else String.get b.buffer ofs
;;
let length b = b.position
let clear b = b.position <- 0
let reset b =
b.position <- 0; b.buffer <- b.initial_buffer;
b.length <- String.length b.buffer
let resize b more =
let len = b.length in
let new_len = ref len in
while b.position + more > !new_len do new_len := 2 * !new_len done;
if !new_len > Sys.max_string_length then begin
if b.position + more <= Sys.max_string_length
then new_len := Sys.max_string_length
else failwith "Buffer.add: cannot grow buffer"
end;
let new_buffer = String.create !new_len in
String.blit b.buffer 0 new_buffer 0 b.position;
b.buffer <- new_buffer;
b.length <- !new_len
let add_char b c =
let pos = b.position in
if pos >= b.length then resize b 1;
b.buffer.[pos] <- c;
b.position <- pos + 1
let add_substring b s offset len =
if offset < 0 || len < 0 || offset > String.length s - len
then invalid_arg "Buffer.add_substring";
let new_position = b.position + len in
if new_position > b.length then resize b len;
String.blit s offset b.buffer b.position len;
b.position <- new_position
let add_string b s =
let len = String.length s in
let new_position = b.position + len in
if new_position > b.length then resize b len;
String.blit s 0 b.buffer b.position len;
b.position <- new_position
let add_buffer b bs =
add_substring b bs.buffer 0 bs.position
let add_channel b ic len =
if b.position + len > b.length then resize b len;
really_input ic b.buffer b.position len;
b.position <- b.position + len
let output_buffer oc b =
output oc b.buffer 0 b.position
let closing = function
| '(' -> ')'
| '{' -> '}'
| _ -> assert false;;
(* opening and closing: open and close characters, typically ( and )
k: balance of opening and closing chars
s: the string where we are searching
start: the index where we start the search. *)
let advance_to_closing opening closing k s start =
let rec advance k i lim =
if i >= lim then raise Not_found else
if s.[i] = opening then advance (k + 1) (i + 1) lim else
if s.[i] = closing then
if k = 0 then i else advance (k - 1) (i + 1) lim
else advance k (i + 1) lim in
advance k start (String.length s);;
let advance_to_non_alpha s start =
let rec advance i lim =
if i >= lim then lim else
match s.[i] with
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' |
'é'|'à'|'á'|'è'|'ù'|'â'|'ê'|
'î'|'ô'|'û'|'ë'|'ï'|'ü'|'ç'|
'É'|'À'|'Á'|'È'|'Ù'|'Â'|'Ê'|
'Î'|'Ô'|'Û'|'Ë'|'Ï'|'Ü'|'Ç' ->
advance (i + 1) lim
| _ -> i in
advance start (String.length s);;
(* We are just at the beginning of an ident in s, starting at start. *)
let find_ident s start lim =
if start >= lim then raise Not_found else
match s.[start] with
(* Parenthesized ident ? *)
| '(' | '{' as c ->
let new_start = start + 1 in
let stop = advance_to_closing c (closing c) 0 s new_start in
String.sub s new_start (stop - start - 1), stop + 1
(* Regular ident *)
| _ ->
let stop = advance_to_non_alpha s (start + 1) in
String.sub s start (stop - start), stop;;
(* Substitute $ident, $(ident), or ${ident} in s,
according to the function mapping f. *)
let add_substitute b f s =
let lim = String.length s in
let rec subst previous i =
if i < lim then begin
match s.[i] with
| '$' as current when previous = '\\' ->
add_char b current;
subst ' ' (i + 1)
| '$' ->
let j = i + 1 in
let ident, next_i = find_ident s j lim in
add_string b (f ident);
subst ' ' next_i
| current when previous == '\\' ->
add_char b '\\';
add_char b current;
subst ' ' (i + 1)
| '\\' as current ->
subst current (i + 1)
| current ->
add_char b current;
subst current (i + 1)
end else
if previous = '\\' then add_char b previous in
subst ' ' 0;;
|
