X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/dea4d05507e59ab779ed4bb209e05971d87e260c..bf090e021a5c20da452a4841cdfb8eb78e29544e:/src/parse-lexical.lisp

diff --git a/src/parse-lexical.lisp b/src/parse-lexical.lisp
index 9fe6bb8..1e9a76c 100644
--- a/src/parse-lexical.lisp
+++ b/src/parse-lexical.lisp
@@ -37,6 +37,11 @@ (defclass sod-token-scanner (token-scanner)
    Not a lot here, apart from a character scanner to read from and the
    standard token scanner infrastructure."))
 
+(defmethod shared-initialize :after
+    ((scanner sod-token-scanner) slot-names &key)
+  (default-slot (scanner 'sod-parser::filename slot-names)
+    (scanner-filename (token-scanner-char-scanner scanner))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.
 
@@ -65,9 +70,19 @@ (defun scan-comment (scanner)
 		    (skip-many () (not #\newline))
 		    (? #\newline))))))
 
+(defmethod make-scanner-stream ((scanner sod-token-scanner))
+  (make-scanner-stream (token-scanner-char-scanner scanner)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Error reporting.
 
+(defvar *indicator-map* (make-hash-table)
+  "Hash table mapping indicator objects to human-readable descriptions.")
+
+(defun define-indicator (indicator description)
+  (setf (gethash indicator *indicator-map*) description)
+  indicator)
+
 (export 'syntax-error)
 (defun syntax-error (scanner expected &key (continuep t))
   "Signal a (maybe) continuable syntax error."
@@ -82,17 +97,39 @@ (defun syntax-error (scanner expected &key (continuep t))
 		   (:ellipsis "`...'")
 		   (t (format nil "<? ~S~@[ ~S~]>" type value)))))
 	   (show-expected (thing)
-	     (cond ((atom thing) (show-token thing nil))
-		   ((eq (car thing) :id)
-		    (format nil "`~A'" (cadr thing)))
-		   (t (format nil "<? ~S>" thing)))))
+	     (acond ((gethash thing *indicator-map*) it)
+		    ((atom thing) (show-token thing nil))
+		    ((eq (car thing) :id)
+		     (format nil "`~A'" (cadr thing)))
+		    (t (format nil "<? ~S>" thing)))))
     (funcall (if continuep #'cerror* #'error)
 	     "Syntax error: ~
-	      expected ~{#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
+	      expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
 	      but found ~A"
 	     (mapcar #'show-expected expected)
 	     (show-token (token-type scanner) (token-value scanner)))))
 
+(export 'lexer-error)
+(defun lexer-error (char-scanner expected consumedp)
+  "Signal a continuable lexical error."
+  (cerror* "Lexical error: ~
+	    expected ~{~#[<bug>~;~A~;~A or ~A~;:~A, ~]~} ~
+	    but found ~/sod::show-char/~
+	    ~@[ at ~A~]"
+	   (mapcar (lambda (exp)
+		     (typecase exp
+		       (character (format nil "~/sod::show-char/" exp))
+		       (string (format nil "`~A'" exp))
+		       ((cons (eql :digit) *) (format nil "<radix-~A digit>"
+						      (cadr exp)))
+		       ((eql :eof) "<end-of-file>")
+		       ((eql :any) "<character>")
+		       (t (format nil "<? ~S>" exp))))
+		   expected)
+	   (and (not (scanner-at-eof-p char-scanner))
+		(scanner-current-char char-scanner))
+	   (and consumedp (file-location char-scanner))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Token scanner protocol implementation.
 
@@ -105,29 +142,7 @@ (defmethod scanner-token ((scanner sod-token-scanner))
 	       (parse (many (acc init (+ (* acc radix) it) :min min)
 			(label (list :digit radix)
 			       (filter (lambda (ch)
-					 (digit-char-p ch radix)))))))
-
-	     (lexer-error (expected consumedp)
-	       ;; Report a lexical error.
-	       (cerror* "Lexical error: ~
-			 expected ~{~#[<bug>~;~A~;~A or ~A~;:~A, ~]~} ~
-			 but found ~/sod::show-char/~
-			 ~@[ at ~A~]"
-			(mapcar (lambda (exp)
-				  (typecase exp
-				    (character
-				     (format nil "~/sod::show-char/" exp))
-				    (string (format nil "`~A'" exp))
-				    ((cons (eql :digit) *)
-				     (format nil "<radix-~A digit>"
-					     (cadr exp)))
-				    ((eql :eof) "<end-of-file>")
-				    ((eql :any) "<character>")
-				    (t (format nil "<? ~S>" exp))))
-				expected)
-			(and (not (scanner-at-eof-p char-scanner))
-			     (scanner-current-char char-scanner))
-			(and consumedp (file-location char-scanner)))))
+					 (digit-char-p ch radix))))))))
 
 	;; Skip initial junk, and remember the place.
 	(loop
@@ -136,7 +151,7 @@ (defmethod scanner-token ((scanner sod-token-scanner))
 	  (cond-parse (:consumedp cp :expected exp)
 	    ((satisfies whitespace-char-p) (parse :whitespace))
 	    ((scan-comment char-scanner))
-	    (t (if cp (lexer-error exp cp) (return)))))
+	    (t (if cp (lexer-error char-scanner exp cp) (return)))))
 
 	;; Now parse something.
 	(cond-parse (:consumedp cp :expected exp)
@@ -193,6 +208,9 @@ (defmethod scanner-token ((scanner sod-token-scanner))
 	  ;; Report errors and try again.  Because we must have consumed some
 	  ;; input in order to get here (we've matched both :any and :eof) we
 	  ;; must make progress on every call.
-	  (t (assert cp) (lexer-error exp cp) (scanner-token scanner)))))))
+	  (t
+	   (assert cp)
+	   (lexer-error char-scanner exp cp)
+	   (scanner-token scanner)))))))
 
 ;;;----- That's all, folks --------------------------------------------------