# HG changeset patch
# User wenzelm
# Date 1184015558 -7200
# Node ID c7cbab93f1d95661c0751560c93c02f897ed1c19
# Parent  67c748e5ae54501079b6943cbce437031ac7595c
tuned signature;
nested source: error msg passed to recover;

diff -r 67c748e5ae54 -r c7cbab93f1d9 src/Pure/General/scan.ML
--- a/src/Pure/General/scan.ML	Mon Jul 09 23:12:37 2007 +0200
+++ b/src/Pure/General/scan.ML	Mon Jul 09 23:12:38 2007 +0200
@@ -60,21 +60,18 @@
   val trace': ('a * 'b list -> 'c * ('d * 'e list)) -> 'a * 'b list ->
     ('c * 'b list) * ('d * 'e list)
   val trace: ('a list -> 'b * 'c list) -> 'a list -> ('b * 'a list) * 'c list
-  val try: ('a -> 'b) -> 'a -> 'b
-  val force: ('a -> 'b) -> 'a -> 'b
   val prompt: string -> ('a -> 'b) -> 'a -> 'b
   val finite': 'a * ('a -> bool) -> ('b * 'a list -> 'c * ('d * 'a list))
     -> 'b * 'a list -> 'c * ('d * 'a list)
   val finite: 'a * ('a -> bool) -> ('a list -> 'b * 'a list) -> 'a list -> 'b * 'a list
   val read: 'a * ('a -> bool) -> ('a list -> 'b * 'a list) -> 'a list -> 'b option
-  val catch: ('a -> 'b) -> 'a -> 'b
   val error: ('a -> 'b) -> 'a -> 'b
   val source': string -> (string -> 'a -> 'b list * 'a) -> ('b list * 'a -> 'c) ->
     'b * ('b -> bool) -> ('d * 'b list -> 'e list * ('d * 'b list)) ->
-    ('d * 'b list -> 'e list * ('d * 'b list)) option -> 'd * 'a -> 'e list * ('d * 'c)
+    (string -> 'd * 'b list -> 'e list * ('d * 'b list)) option -> 'd * 'a -> 'e list * ('d * 'c)
   val source: string -> (string -> 'a -> 'b list * 'a) -> ('b list * 'a -> 'c) ->
     'b * ('b -> bool) -> ('b list -> 'd list * 'b list) ->
-    ('b list -> 'd list * 'b list) option -> 'a -> 'd list * 'c
+    (string -> 'b list -> 'd list * 'b list) option -> 'a -> 'd list * 'c
   val single: ('a -> 'b * 'a) -> 'a -> 'b list * 'a
   val bulk: ('a -> 'b * 'a) -> 'a -> 'b list * 'a
   type lexicon
@@ -213,8 +210,8 @@
 (* exception handling *)
 
 fun !! err scan xs = scan xs handle FAIL msg => raise ABORT (err (xs, msg));
-fun try scan xs = scan xs handle MORE _ => raise FAIL NONE | ABORT _ => raise FAIL NONE;
-fun force scan xs = scan xs handle MORE _ => raise FAIL NONE;
+fun permissive scan xs = scan xs handle MORE _ => raise FAIL NONE | ABORT _ => raise FAIL NONE;
+fun strict scan xs = scan xs handle MORE _ => raise FAIL NONE;
 fun prompt str scan xs = scan xs handle MORE NONE => raise MORE (SOME str);
 fun catch scan xs = scan xs handle ABORT msg => raise FAIL (SOME msg);
 fun error scan xs = scan xs handle ABORT msg => Library.error msg;
@@ -233,7 +230,7 @@
   in
     if exists is_stopper input then
       raise ABORT "Stopper may not occur in input of finite scan!"
-    else (force scan --| lift stop) (state, input @ [stopper])
+    else (strict scan --| lift stop) (state, input @ [stopper])
   end;
 
 fun finite stopper scan = unlift (finite' stopper (lift scan));
@@ -258,20 +255,21 @@
 
     fun drain_loop recover inp =
       drain_with (catch scanner) inp handle FAIL msg =>
-        (Output.error_msg (the_default "Syntax error." msg); drain_with recover inp);
+        (drain_with (recover (the_default "Syntax error." msg)) inp);
 
     val ((ys, (state', xs')), src') =
       (case (get def_prmpt src, opt_recover) of
         (([], s), _) => (([], (state, [])), s)
       | ((xs, s), NONE) => drain_with (error scanner) ((state, xs), s)
-      | ((xs, s), SOME r) => drain_loop (unless (lift (one (#2 stopper))) r) ((state, xs), s));
+      | ((xs, s), SOME r) => drain_loop (unless (lift (one (#2 stopper))) o r) ((state, xs), s));
   in (ys, (state', unget (xs', src'))) end;
 
 fun source def_prmpt get unget stopper scan opt_recover =
-  unlift (source' def_prmpt get unget stopper (lift scan) (Option.map lift opt_recover));
+  unlift (source' def_prmpt get unget stopper (lift scan)
+    (Option.map (fn r => lift o r) opt_recover));
 
 fun single scan = scan >> (fn x => [x]);
-fun bulk scan = scan -- repeat (try scan) >> (op ::);
+fun bulk scan = scan -- repeat (permissive scan) >> (op ::);