;;;----- 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
indicator)
(export 'syntax-error)
-(defun syntax-error (scanner expected &key (continuep t))
+(defun syntax-error (scanner expected &key (continuep t) location)
"Signal a (maybe) continuable syntax error."
(labels ((show-token (type value)
(if (characterp type)
((eq (car thing) :id)
(format nil "`~A'" (cadr thing)))
(t (format nil "<? ~S>" thing)))))
- (funcall (if continuep #'cerror* #'error)
+ (funcall (if continuep #'cerror*-with-location #'error-with-location)
+ (or location scanner)
"Syntax error: ~
expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
but found ~A"
(show-token (token-type scanner) (token-value scanner)))))
(export 'lexer-error)
-(defun lexer-error (char-scanner expected consumedp)
+(defun lexer-error (char-scanner expected &key location)
"Signal a continuable lexical error."
- (cerror* "Lexical error: ~
- expected ~{~#[<bug>~;~A~;~A or ~A~;:~A, ~]~} ~
- but found ~/sod::show-char/~
- ~@[ at ~A~]"
+ (cerror*-with-location (or location char-scanner)
+ "Lexical error: ~
+ ~:[unexpected~;~
+ expected ~:*~{~#[~;~A~;~A or ~A~:;~
+ ~@{~A, ~#[~;or ~A~]~}~]~} ~
+ but found~] ~
+ ~/sod::show-char/"
(mapcar (lambda (exp)
(typecase exp
(character (format nil "~/sod::show-char/" exp))
(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))))
+ (scanner-current-char char-scanner))))
(export 'skip-until)
(defparse skip-until (:context (context token-scanner-context)
(export 'error)
(defparse error (:context (context token-scanner-context)
- (&key) sub &optional (recover t))
+ (&key ignore-unconsumed force-progress)
+ sub &optional (recover t))
"Try to parse SUB; if it fails then report an error, and parse RECOVER.
This is the main way to recover from errors and continue parsing. Even
were never here. Otherwise, try to recover in a sensible way so we can
continue parsing. The details of this recovery are subject to change, but
the final action is generally to invoke the RECOVER parser and return its
- result."
+ result.
+
+ If IGNORE-UNCONSUMED evaluates non-nil, then just propagate a failure of
+ SUB if it didn't consume input. (This makes it suitable for use where the
+ parser containing `error' might be optional.)"
`(parse-error-recover ,(parser-scanner context)
(parser () ,sub)
- (parser () ,recover)))
+ (parser () ,recover)
+ :ignore-unconsumed ,ignore-unconsumed
+ :force-progress ,force-progress))
;;;--------------------------------------------------------------------------
;;; Lexical analysis utilities.
The result isn't interesting."
(with-parser-context (character-scanner-context :scanner char-scanner)
- (parse (or (and "/*"
- (and (skip-many ()
- (and (skip-many () (not #\*))
- (label "*/" (skip-many (:min 1) #\*)))
- (not #\/))
- #\/))
- (and "//"
- (skip-many () (not #\newline))
- (? #\newline))))))
+ (let ((start (file-location char-scanner)))
+ (parse (or (and "/*"
+ (lisp (let ((state nil))
+ (loop (cond ((scanner-at-eof-p char-scanner)
+ (lexer-error char-scanner
+ (list "*/"))
+ (info-with-location
+ start "Comment started here")
+ (return (values nil t t)))
+ ((char= (scanner-current-char
+ char-scanner)
+ #\*)
+ (setf state '*)
+ (scanner-step char-scanner))
+ ((and (eq state '*)
+ (char= (scanner-current-char
+ char-scanner)
+ #\/))
+ (scanner-step char-scanner)
+ (return (values nil t t)))
+ (t
+ (setf state nil)
+ (scanner-step char-scanner)))))))
+ (and "//"
+ (skip-many () (not #\newline))
+ (? #\newline)))))))
;;;----- That's all, folks --------------------------------------------------