;;;----- 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
;;;--------------------------------------------------------------------------
;;; Indicators and error messages.
-(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
;; 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)))))
;;;--------------------------------------------------------------------------
(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
(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)
(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)
;; 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 --------------------------------------------------
~mdw / sod / blobdiff