X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/239fa5bd3dff0b38b0cebdd3438311f21c24ba4f..1c2db39a35b4efe99594b2a53737d4f0971d01d8:/src/lexer-impl.lisp diff --git a/src/lexer-impl.lisp b/src/lexer-impl.lisp index f474590..1686179 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,18 +39,62 @@ (defmethod make-scanner-stream ((scanner sod-token-scanner)) ;;;-------------------------------------------------------------------------- ;;; 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 "" stream)) +(defun show-char (char) + "Format CHAR as a string in a readable way." + (cond ((null char) "") ((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 (not (null (cdr token-types))))) + "This is the implementation of the `skip-until' parser." + (do ((consumedp nil t)) + ((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 + &key ignore-unconsumed force-progress) + "This is the implementation of the `error' parser." + (multiple-value-bind (result win consumedp) (funcall parser) + (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 + ;; important thing to do here is to make sure that we make some + ;; progress. If we consumed any tokens then we're fine, and we'll + ;; just try the provided recovery strategy. Otherwise, if we're + ;; not at EOF, then we can ensure progress by discarding the + ;; 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) + (when (and force-progress (not consumedp)) (scanner-step scanner)) + (funcall recover))))) ;;;-------------------------------------------------------------------------- ;;; Token scanning. @@ -64,7 +108,18 @@ (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)))))))) + (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 @@ -73,7 +128,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 char-scanner exp cp) (return))))) + (t (if cp (lexer-error char-scanner exp) (return))))) ;; Now parse something. (cond-parse (:consumedp cp :expected exp) @@ -91,13 +146,25 @@ (defmethod scanner-token ((scanner sod-token-scanner)) (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) @@ -132,7 +199,7 @@ (defmethod scanner-token ((scanner sod-token-scanner)) ;; 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 --------------------------------------------------