tuned;
authorwenzelm
Mon, 10 May 2004 19:26:25 +0200
changeset 14728 df34201f1a15
parent 14727 ab06e87e5c83
child 14729 0e987111a17e
tuned;
src/Pure/General/symbol.ML
src/Pure/General/xml.ML
--- a/src/Pure/General/symbol.ML	Mon May 10 19:26:11 2004 +0200
+++ b/src/Pure/General/symbol.ML	Mon May 10 19:26:25 2004 +0200
@@ -35,7 +35,7 @@
   val is_blank: symbol -> bool
   val is_quasi_letter: symbol -> bool
   val is_letdig: symbol -> bool
-  val beginning: symbol list -> string
+  val beginning: int -> symbol list -> string
   val scanner: string -> (string list -> 'a * string list) -> symbol list -> 'a
   val scan_id: string list -> string * string list
   val scan: string list -> symbol * string list
@@ -300,16 +300,16 @@
 
 (* scanning through symbols *)
 
-fun beginning raw_ss =
+fun beginning n raw_ss =
   let
     val (all_ss, _) = Library.take_suffix is_blank raw_ss;
-    val dots = if length all_ss > 10 then " ..." else "";
-    val (ss, _) = Library.take_suffix is_blank (Library.take (10, all_ss));
+    val dots = if length all_ss > n then " ..." else "";
+    val (ss, _) = Library.take_suffix is_blank (Library.take (n, all_ss));
   in implode (map (fn s => if is_blank s then space else s) ss) ^ dots end;
 
 fun scanner msg scan chs =
   let
-    fun err_msg cs = msg ^ ": " ^ beginning cs;
+    fun err_msg cs = msg ^ ": " ^ beginning 10 cs;
     val fin_scan = Scan.error (Scan.finite stopper (!! (fn (cs, _) => err_msg cs) scan));
   in
     (case fin_scan chs of
@@ -327,18 +327,17 @@
 val scan_encoded_newline =
   $$ "\r" -- $$ "\n" >> K "\n" ||
   $$ "\r" >> K "\n" ||
-  Scan.optional ($$ "\\") "" -- $$ "\\"  -- $$ "<"  -- $$ "^" -- $$ "n"
-    -- $$ "e" -- $$ "w" -- $$ "l" -- $$ "i" -- $$ "n" -- $$ "e" -- $$ ">" >> K "\n";
+  Scan.optional ($$ "\\") "" -- Scan.list (explode "\\<^newline>") >> K "\n";
 
 fun raw_body c = ord space <= ord c andalso ord c <= ord "~" andalso c <> ">";
-val scan_raw = $$ "r" ^^ $$ "a" ^^ $$ "w" ^^ $$ ":" ^^ (Scan.any raw_body >> implode);
+val scan_raw = Scan.list (explode "raw:") -- Scan.any raw_body >> (implode o op @);
 
 in
 
 val scan =
   scan_encoded_newline ||
   ($$ "\\" --| Scan.optional ($$ "\\") "") ^^ $$ "<" ^^
-    !! (fn (cs, _) => "Malformed symbolic character specification: \\" ^ "<" ^ beginning cs)
+    !! (fn (cs, _) => "Malformed symbolic character specification: \\" ^ "<" ^ beginning 10 cs)
        (($$ "^" ^^ (scan_raw || scan_id) || scan_id) ^^ $$ ">") ||
   Scan.one not_eof;
 
--- a/src/Pure/General/xml.ML	Mon May 10 19:26:11 2004 +0200
+++ b/src/Pure/General/xml.ML	Mon May 10 19:26:25 2004 +0200
@@ -1,12 +1,9 @@
 (*  Title:      Pure/General/xml.ML
     ID:         $Id$
-    Author:     Markus Wenzel, LMU Muenchen
-                Stefan Berghofer, TU Muenchen
+    Author:     David Aspinall, Stefan Berghofer and Markus Wenzel
     License:    GPL (GNU GENERAL PUBLIC LICENSE)
 
 Basic support for XML input and output.
-
-FIXME da: missing input raises FAIL (scan.ML), should give error message.
 *)
 
 signature XML =
@@ -51,13 +48,14 @@
 
 fun cdata s = cdata_open ^ s ^ cdata_close;
 
+
 (* elements *)
 
 datatype tree =
     Elem of string * (string * string) list * tree list
   | Text of string;
 
-fun attribute (a, x) = a ^ " = \"" ^ (text x) ^ "\"";
+fun attribute (a, x) = a ^ " = \"" ^ text x ^ "\"";
 
 fun element name atts cs =
   let val elem = space_implode " " (name :: map attribute atts) in
@@ -67,41 +65,41 @@
 
 fun string_of_tree (Elem (name, atts, ts)) =
       element name atts (map string_of_tree ts)
-  | string_of_tree (Text s) = s
-  
+  | string_of_tree (Text s) = s;
+
 val header = "<?xml version=\"1.0\"?>\n";
 
 
 (* parser *)
 
-fun err s (xs, _) = "XML parsing error: " ^ s ^ "\nfound:\n" ^
-  implode (take (100, xs));
+fun err s (xs, _) =
+  "XML parsing error: " ^ s ^ "\nfound: " ^ quote (Symbol.beginning 100 xs);
 
-val scan_whspc = Scan.repeat ($$ " " || $$ "\n" || $$ "\t");
+val scan_whspc = Scan.any Symbol.is_blank;
 
-val literal = Scan.literal o Scan.make_lexicon o single o explode;
+fun scan_string s = Scan.list (Symbol.explode s) >> K s;
 
 val scan_special = $$ "&" ^^ Symbol.scan_id ^^ $$ ";" >> decode;
 
 val parse_chars = Scan.repeat1 (Scan.unless (scan_whspc -- $$ "<")
   (scan_special || Scan.one Symbol.not_eof)) >> implode;
 
-val parse_cdata = literal "<![CDATA[" |--
-  (Scan.repeat (Scan.unless (literal "]]>") (Scan.one Symbol.not_eof)) >>
-    implode) --| literal "]]>";
+val parse_cdata = scan_string "<![CDATA[" |--
+  (Scan.repeat (Scan.unless (scan_string "]]>") (Scan.one Symbol.not_eof)) >>
+    implode) --| scan_string "]]>";
 
 val parse_att =
   Symbol.scan_id --| scan_whspc --| $$ "=" --| scan_whspc --| $$ "\"" --
   (Scan.repeat (Scan.unless ($$ "\"")
     (scan_special || Scan.one Symbol.not_eof)) >> implode) --| $$ "\"";
 
-val parse_comment = literal "<!--" --
-  Scan.repeat (Scan.unless (literal "-->") (Scan.one Symbol.not_eof)) --
-  literal "-->";
+val parse_comment = scan_string "<!--" --
+  Scan.repeat (Scan.unless (scan_string "-->") (Scan.one Symbol.not_eof)) --
+  scan_string "-->";
 
-val parse_pi = literal "<?" |--
-  Scan.repeat (Scan.unless (literal "?>") (Scan.one Symbol.not_eof)) --|
-  literal "?>";
+val parse_pi = scan_string "<?" |--
+  Scan.repeat (Scan.unless (scan_string "?>") (Scan.one Symbol.not_eof)) --|
+  scan_string "?>";
 
 fun parse_content xs =
   ((Scan.optional (scan_whspc |-- parse_chars >> (single o Text)) [] --
@@ -117,14 +115,14 @@
   ($$ "<" |-- Symbol.scan_id --
     Scan.repeat (scan_whspc |-- parse_att) --| scan_whspc :-- (fn (s, _) =>
       !! (err "Expected > or />")
-        (   literal "/>" >> K []
+        (scan_string "/>" >> K []
          || $$ ">" |-- parse_content --|
             !! (err ("Expected </" ^ s ^ ">"))
-              (literal ("</" ^ s) --| scan_whspc --| $$ ">"))) >>
+              (scan_string ("</" ^ s) --| scan_whspc --| $$ ">"))) >>
     (fn ((s, atts), ts) => Elem (s, atts, ts))) xs;
 
 val parse_document =
-  Scan.option (literal "<!DOCTYPE" -- scan_whspc |--
+  Scan.option (scan_string "<!DOCTYPE" -- scan_whspc |--
     (Scan.repeat (Scan.unless ($$ ">")
       (Scan.one Symbol.not_eof)) >> implode) --| $$ ">" --| scan_whspc) --
   parse_elem;
@@ -132,8 +130,7 @@
 fun tree_of_string s =
   (case Scan.finite Symbol.stopper (Scan.error (!! (err "Malformed element")
       (scan_whspc |-- parse_elem --| scan_whspc))) (Symbol.explode s) of
-     (x, []) => x
-   | (_, ys) => error ("XML parsing error: Unprocessed input\n" ^
-       implode (take (100, ys))));
+    (x, []) => x
+  | (_, ys) => error ("XML parsing error: Unprocessed input\n" ^ Symbol.beginning 100 ys));
 
 end;