X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/048d0b2d143b6a491ac73eed6ab972e97774391c..6afec9101d5ea87e3df4bda2239ffd05f8154fa6:/src/lexer-impl.lisp

diff --git a/src/lexer-impl.lisp b/src/lexer-impl.lisp
index 6fc6fcc..ccaca5c 100644
--- a/src/lexer-impl.lisp
+++ b/src/lexer-impl.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -39,40 +39,49 @@
 ;;;--------------------------------------------------------------------------
 ;;; Indicators and error messages.
 
-(defvar *indicator-map* (make-hash-table)
-  "Hash table mapping indicator objects to human-readable descriptions.")
-
-(defun show-char (stream char &optional colonp atsignp)
-  "Format CHAR to STREAM in a readable way.
-
-   Usable in `format''s ~/.../ command."
-  (declare (ignore colonp atsignp))
-  (cond ((null char) (write-string "<eof>" stream))
+(defun show-char (char)
+  "Format CHAR as a string in a readable way."
+  (cond ((null char) "<end-of-file>")
 	((and (graphic-char-p char) (char/= char #\space))
-	 (format stream "`~C'" char))
-	(t (format stream "<~(~:C~)>" char))))
+	 (format nil "`~C'" char))
+	(t (format nil "<~(~:C~)>" char))))
 
-(defun skip-until (scanner token-types &key keep-end)
+(defun %skip-until (scanner token-types
+		    &key (keep-end (not (null (cdr token-types)))))
   "This is the implementation of the `skip-until' parser."
   (do ((consumedp nil t))
-      ((member (token-type scanner) token-types)
+      ((let ((type (token-type scanner))
+	     (value (token-value scanner)))
+	 (some (lambda (spec)
+		 (multiple-value-bind (want-type want-value)
+		     (cond ((listp spec) (values (car spec) (cadr spec)))
+			   (t (values spec t)))
+		   (and (eq want-type type)
+			(or (eq want-value t)
+			    (equal want-value value)))))
+	       token-types))
        (unless keep-end (scanner-step scanner))
        (values nil t (or keep-end consumedp)))
     (when (scanner-at-eof-p scanner)
       (return (values token-types nil consumedp)))
     (scanner-step scanner)))
 
-(defun parse-error-recover (scanner parser recover)
+(defun parse-error-recover (scanner parser recover
+			    &key ignore-unconsumed force-progress action)
   "This is the implementation of the `error' parser."
   (multiple-value-bind (result win consumedp) (funcall parser)
-    (cond ((or win (and (not consumedp) (scanner-at-eof-p scanner)))
-	   ;; If we succeeded then there's nothing for us to do here.  On the
-	   ;; other hand, if we failed, didn't consume any tokens, and we're
-	   ;; at end-of-file, then there's not much hope of making onward
-	   ;; progress, so in this case we propagate the failure rather than
-	   ;; trying to recover.  And we assume that the continuation will
-	   ;; somehow arrange to report the problem, and avoid inundating the
-	   ;; user with error reports.
+    (cond ((or win
+	       (and (not consumedp)
+		    (or ignore-unconsumed
+			(scanner-at-eof-p scanner))))
+	   ;; If we succeeded, or if we didn't consume any tokens and the
+	   ;; caller's OK with that, then there's nothing for us to do here.
+	   ;; On the other hand, if we failed, didn't consume any tokens, and
+	   ;; we're at end-of-file, then there's not much hope of making
+	   ;; onward progress, so in this case we propagate the failure
+	   ;; rather than trying to recover.  And we assume that the
+	   ;; continuation will somehow arrange to report the problem, and
+	   ;; avoid inundating the user with error reports.
 	   (values result win consumedp))
 	  (t
 	   ;; Now we have to do some kind of sensible error recovery.  The
@@ -83,8 +92,9 @@
 	   ;; current token.  Finally, if we are at EOF then our best bet is
 	   ;; simply to propagate the current failure back to the caller, but
 	   ;; we handled that case above.
-	   (syntax-error scanner result :continuep t)
-	   (unless consumedp (scanner-step scanner))
+	   (syntax-error scanner result)
+	   (when action (funcall action))
+	   (when (and force-progress (not consumedp)) (scanner-step scanner))
 	   (funcall recover)))))
 
 ;;;--------------------------------------------------------------------------
@@ -99,7 +109,18 @@
 	       (parse (many (acc init (+ (* acc radix) it) :min min)
 			(label (list :digit radix)
 			       (filter (lambda (ch)
-					 (digit-char-p ch radix))))))))
+					 (digit-char-p ch radix)))))))
+	     (start-floc ()
+	       ;; This is a little nasty.  We scan the first token during
+	       ;; instance initialization, as a result of `shared-initialize'
+	       ;; on `token-scanner'.  Unfortunately, this happens before
+	       ;; we've had a chance to initialize our own `filename' slot.
+	       ;; This means that we can't use the SCANNER as a file
+	       ;; location, however tempting it might be.  So we have this
+	       ;; hack.
+	       (make-file-location (scanner-filename char-scanner)
+				   (scanner-line scanner)
+				   (scanner-column scanner))))
 
 	;; Skip initial junk, and remember the place.
 	(loop
@@ -108,7 +129,7 @@
 	  (cond-parse (:consumedp cp :expected exp)
 	    ((satisfies whitespace-char-p) (parse :whitespace))
 	    ((scan-comment char-scanner))
-	    (t (if cp (lexer-error char-scanner exp cp) (return)))))
+	    (t (if cp (lexer-error char-scanner exp) (return)))))
 
 	;; Now parse something.
 	(cond-parse (:consumedp cp :expected exp)
@@ -126,13 +147,25 @@
 				      (progn (write-char it out) out)
 				      :final (get-output-stream-string out))
 			     (or (and #\\ :any) (not quote))))
-		 (nil (char quote)))
+		 (nil (or (char quote)
+			  (seq (:eof)
+			    (lexer-error char-scanner (list quote))
+			    (info-with-location
+			     (start-floc) "Literal started here")))))
 	     (ecase quote
 	       (#\" contents)
 	       (#\' (case (length contents)
 		      (1 (char contents 0))
-		      (0 (cerror* "Empty character literal") #\?)
-		      (t (cerror* "Too many characters in literal")
+		      (0 (cerror*-with-location (start-floc)
+						'simple-lexer-error
+						:format-control
+						"Empty character literal")
+			 #\?)
+		      (t (cerror*-with-location (start-floc)
+						'simple-lexer-error
+						:format-control
+						"Too many characters ~
+						 in character literal")
 			 (char contents 0))))))
 	   (values (etypecase it
 		     (character :char)
@@ -155,6 +188,14 @@
 
 	  ;; Some special punctuation sequences are single tokens.
 	  ("..." (values :ellipsis nil))
+	  ("==" (values :eq))
+	  ("!=" (values :ne))
+	  ("<=" (values :le))
+	  (">=" (values :ge))
+	  ("&&" (values :and))
+	  ("||" (values :or))
+	  ("<<" (values :shl))
+	  (">>" (values :shr))
 
 	  ;; Any other character is punctuation.
 	  (:any (values it nil))
@@ -167,7 +208,7 @@
 	  ;; must make progress on every call.
 	  (t
 	   (assert cp)
-	   (lexer-error char-scanner exp cp)
+	   (lexer-error char-scanner exp)
 	   (scanner-token scanner)))))))
 
 ;;;----- That's all, folks --------------------------------------------------