9 infix 3 >>; |
9 infix 3 >>; |
10 infixr 0 ||; |
10 infixr 0 ||; |
11 |
11 |
12 signature BASIC_SCAN = |
12 signature BASIC_SCAN = |
13 sig |
13 sig |
|
14 type message = unit -> string |
14 (*error msg handler*) |
15 (*error msg handler*) |
15 val !! : ('a * string option -> string) -> ('a -> 'b) -> 'a -> 'b |
16 val !! : ('a * message option -> message) -> ('a -> 'b) -> 'a -> 'b |
16 (*apply function*) |
17 (*apply function*) |
17 val >> : ('a -> 'b * 'c) * ('b -> 'd) -> 'a -> 'd * 'c |
18 val >> : ('a -> 'b * 'c) * ('b -> 'd) -> 'a -> 'd * 'c |
18 (*alternative*) |
19 (*alternative*) |
19 val || : ('a -> 'b) * ('a -> 'b) -> 'a -> 'b |
20 val || : ('a -> 'b) * ('a -> 'b) -> 'a -> 'b |
20 (*sequential pairing*) |
21 (*sequential pairing*) |
39 include BASIC_SCAN |
40 include BASIC_SCAN |
40 val prompt: string -> ('a -> 'b) -> 'a -> 'b |
41 val prompt: string -> ('a -> 'b) -> 'a -> 'b |
41 val error: ('a -> 'b) -> 'a -> 'b |
42 val error: ('a -> 'b) -> 'a -> 'b |
42 val catch: ('a -> 'b) -> 'a -> 'b (*exception Fail*) |
43 val catch: ('a -> 'b) -> 'a -> 'b (*exception Fail*) |
43 val fail: 'a -> 'b |
44 val fail: 'a -> 'b |
44 val fail_with: ('a -> string) -> 'a -> 'b |
45 val fail_with: ('a -> message) -> 'a -> 'b |
45 val succeed: 'a -> 'b -> 'a * 'b |
46 val succeed: 'a -> 'b -> 'a * 'b |
46 val some: ('a -> 'b option) -> 'a list -> 'b * 'a list |
47 val some: ('a -> 'b option) -> 'a list -> 'b * 'a list |
47 val one: ('a -> bool) -> 'a list -> 'a * 'a list |
48 val one: ('a -> bool) -> 'a list -> 'a * 'a list |
48 val this: string list -> string list -> string list * string list |
49 val this: string list -> string list -> string list * string list |
49 val this_string: string -> string list -> string * string list |
50 val this_string: string -> string list -> string * string list |
91 |
92 |
92 (** scanners **) |
93 (** scanners **) |
93 |
94 |
94 (* exceptions *) |
95 (* exceptions *) |
95 |
96 |
|
97 type message = unit -> string; |
|
98 |
96 exception MORE of string option; (*need more input (prompt)*) |
99 exception MORE of string option; (*need more input (prompt)*) |
97 exception FAIL of string option; (*try alternatives (reason of failure)*) |
100 exception FAIL of message option; (*try alternatives (reason of failure)*) |
98 exception ABORT of string; (*dead end*) |
101 exception ABORT of message; (*dead end*) |
99 |
102 |
100 fun !! err scan xs = scan xs handle FAIL msg => raise ABORT (err (xs, msg)); |
103 fun !! err scan xs = scan xs handle FAIL msg => raise ABORT (err (xs, msg)); |
101 fun permissive scan xs = scan xs handle MORE _ => raise FAIL NONE | ABORT _ => raise FAIL NONE; |
104 fun permissive scan xs = scan xs handle MORE _ => raise FAIL NONE | ABORT _ => raise FAIL NONE; |
102 fun strict scan xs = scan xs handle MORE _ => raise FAIL NONE; |
105 fun strict scan xs = scan xs handle MORE _ => raise FAIL NONE; |
103 fun prompt str scan xs = scan xs handle MORE NONE => raise MORE (SOME str); |
106 fun prompt str scan xs = scan xs handle MORE NONE => raise MORE (SOME str); |
104 fun error scan xs = scan xs handle ABORT msg => Library.error msg; |
107 fun error scan xs = scan xs handle ABORT msg => Library.error (msg ()); |
105 |
108 |
106 fun catch scan xs = scan xs |
109 fun catch scan xs = scan xs |
107 handle ABORT msg => raise Fail msg |
110 handle ABORT msg => raise Fail (msg ()) |
108 | FAIL msg => raise Fail (the_default "Syntax error" msg); |
111 | FAIL msg => raise Fail (case msg of NONE => "Syntax error" | SOME m => m ()); |
109 |
112 |
110 |
113 |
111 (* scanner combinators *) |
114 (* scanner combinators *) |
112 |
115 |
113 fun (scan >> f) xs = scan xs |>> f; |
116 fun (scan >> f) xs = scan xs |>> f; |
234 |
237 |
235 (* finite scans *) |
238 (* finite scans *) |
236 |
239 |
237 fun finite' (Stopper (mk_stopper, is_stopper)) scan (state, input) = |
240 fun finite' (Stopper (mk_stopper, is_stopper)) scan (state, input) = |
238 let |
241 let |
239 fun lost () = raise ABORT "Bad scanner: lost stopper of finite scan!"; |
242 fun lost () = raise ABORT (fn () => "Bad scanner: lost stopper of finite scan!"); |
240 |
243 |
241 fun stop [] = lost () |
244 fun stop [] = lost () |
242 | stop lst = |
245 | stop lst = |
243 let val (xs, x) = split_last lst |
246 let val (xs, x) = split_last lst |
244 in if is_stopper x then ((), xs) else lost () end; |
247 in if is_stopper x then ((), xs) else lost () end; |
245 in |
248 in |
246 if exists is_stopper input then |
249 if exists is_stopper input then |
247 raise ABORT "Stopper may not occur in input of finite scan!" |
250 raise ABORT (fn () => "Stopper may not occur in input of finite scan!") |
248 else (strict scan --| lift stop) (state, input @ [mk_stopper input]) |
251 else (strict scan --| lift stop) (state, input @ [mk_stopper input]) |
249 end; |
252 end; |
250 |
253 |
251 fun finite stopper scan = unlift (finite' stopper (lift scan)); |
254 fun finite stopper scan = unlift (finite' stopper (lift scan)); |
252 |
255 |