26 (*forget snd*) |
26 (*forget snd*) |
27 val --| : ('a -> 'b * 'c) * ('c -> 'd * 'e) -> 'a -> 'b * 'e |
27 val --| : ('a -> 'b * 'c) * ('c -> 'd * 'e) -> 'a -> 'b * 'e |
28 (*concatenation*) |
28 (*concatenation*) |
29 val ^^ : ('a -> string * 'b) * ('b -> string * 'c) -> 'a -> string * 'c |
29 val ^^ : ('a -> string * 'b) * ('b -> string * 'c) -> 'a -> string * 'c |
30 (*one element literal*) |
30 (*one element literal*) |
31 val $$ : ''a -> ''a list -> ''a * ''a list |
31 val $$ : string -> string list -> string * string list |
32 end; |
32 end; |
33 |
33 |
34 signature SCAN = |
34 signature SCAN = |
35 sig |
35 sig |
36 include BASIC_SCAN |
36 include BASIC_SCAN |
37 val fail: 'a -> 'b |
37 val fail: 'a -> 'b |
38 val fail_with: ('a -> string) -> 'a -> 'b |
38 val fail_with: ('a -> string) -> 'a -> 'b |
39 val succeed: 'a -> 'b -> 'a * 'b |
39 val succeed: 'a -> 'b -> 'a * 'b |
40 val some: ('a -> 'b option) -> 'a list -> 'b * 'a list |
40 val some: ('a -> 'b option) -> 'a list -> 'b * 'a list |
41 val one: ('a -> bool) -> 'a list -> 'a * 'a list |
41 val one: ('a -> bool) -> 'a list -> 'a * 'a list |
42 val this: ''a list -> ''a list -> ''a list * ''a list |
42 val this: string list -> string list -> string list * string list |
43 val this_string: string -> string list -> string * string list |
43 val this_string: string -> string list -> string * string list |
44 val any: ('a -> bool) -> 'a list -> 'a list * 'a list |
44 val any: ('a -> bool) -> 'a list -> 'a list * 'a list |
45 val any1: ('a -> bool) -> 'a list -> 'a list * 'a list |
45 val any1: ('a -> bool) -> 'a list -> 'a list * 'a list |
46 val optional: ('a -> 'b * 'a) -> 'b -> 'a -> 'b * 'a |
46 val optional: ('a -> 'b * 'a) -> 'b -> 'a -> 'b * 'a |
47 val option: ('a -> 'b * 'a) -> 'a -> 'b option * 'a |
47 val option: ('a -> 'b * 'a) -> 'a -> 'b option * 'a |
155 | one pred (x :: xs) = |
155 | one pred (x :: xs) = |
156 if pred x then (x, xs) else raise FAIL NONE; |
156 if pred x then (x, xs) else raise FAIL NONE; |
157 |
157 |
158 fun $$ _ [] = raise MORE NONE |
158 fun $$ _ [] = raise MORE NONE |
159 | $$ a (x :: xs) = |
159 | $$ a (x :: xs) = |
160 if a = x then (x, xs) else raise FAIL NONE; |
160 if (a: string) = x then (x, xs) else raise FAIL NONE; |
161 |
161 |
162 fun this ys xs = |
162 fun this ys xs = |
163 let |
163 let |
164 fun drop_prefix [] xs = xs |
164 fun drop_prefix [] xs = xs |
165 | drop_prefix (_ :: _) [] = raise MORE NONE |
165 | drop_prefix (_ :: _) [] = raise MORE NONE |
166 | drop_prefix (y :: ys) (x :: xs) = |
166 | drop_prefix (y :: ys) (x :: xs) = |
167 if y = x then drop_prefix ys xs else raise FAIL NONE; |
167 if (y: string) = x then drop_prefix ys xs else raise FAIL NONE; |
168 in (ys, drop_prefix ys xs) end; |
168 in (ys, drop_prefix ys xs) end; |
169 |
169 |
170 fun this_string s = this (explode s) >> K s; (*primitive string -- no symbols here!*) |
170 fun this_string s = this (explode s) >> K s; (*primitive string -- no symbols here!*) |
171 |
171 |
172 fun any _ [] = raise MORE NONE |
172 fun any _ [] = raise MORE NONE |