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
|
(*pp camlp4o *)
(* arch-tag: BNF parser utilities
Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
open Stream;;
let insens = false;;
type repatt = C of char | R of char * char;;
(* Transforms the character to the lowercase format if case-insensitivty is
used. *)
let cx isinsens c =
if isinsens then Char.lowercase c else c;;
let optparse func args =
Strutil.string_of_charlist (Streamutil.optparse func [] args);;
let optparse_1 funchead args =
Strutil.string_of_charlist (Streamutil.optparse_1 funchead funchead [] args);;
let test_char_patt ?(i=insens) patt c =
let c = cx i c in
match patt with
C x -> c = (cx i x)
| R (x, y) -> (cx i x) <= c && c <= (cx i y);;
let rec test_range ?(i=insens) pattlist c = match pattlist with
[] -> false
| x :: xs -> if test_char_patt ~i:i x c then true else test_range ~i:i xs c;;
let range ?(i=insens) pattlist stream =
match Stream.peek stream with
None -> raise Stream.Failure
| Some c -> (if test_range ~i:i pattlist c then (Stream.junk stream; c)
else raise Stream.Failure);;
let range_n ?(i=insens) pattlist stream =
match Stream.peek stream with
None -> raise Stream.Failure
| Some c -> (
if not (test_range ~i:i pattlist c) then (Stream.junk stream; c)
else raise Stream.Failure);;
(*
let s_or test1 test2 istream =
try begin
let cstream = new BNFSupport.lazyStream istream in
let retval = test1 cstream in
cstream#consume_stream;
retval
end with Stream.Failure | Stream.Error _ -> begin
let cstream = new BNFSupport.lazyStream istream in
let retval = test2 cstream in
cstream#consume_stream;
retval;
end;
;;
*)
let chr = Char.chr;;
let s_and predlist istream =
if predlist = [] then raise (Stream.Error "Predicate list empty in s_and")
else begin
let procitem item =
let cs = new BNFsupport.lazyStream istream in
(cs, item cs#to_stream) in
let processed = List.map procitem predlist in
(fst (List.hd processed))#consume_stream;
List.map snd processed;
end;;
let mstring ?(i=insens) s istream =
let comparisonstream = Stream.of_string s in
let cs = new BNFsupport.lazyStream istream in
let rec p checkdata instream =
match checkdata with
[] -> []
| x :: xs -> begin
let y = Stream.next instream in
if not ((cx i y) = (cx i x)) then raise Stream.Failure else
x :: (p xs instream)
end
in
let res = p (Streamutil.to_list comparisonstream) cs#to_stream in
cs#consume_stream;
Strutil.string_of_charlist res;;
let eof = Stream.empty;;
|
