doc/list-exports: Use `documentation' to find more categories.

[sod] / src / fragment-parse.lisp

diff --git a/src/fragment-parse.lisp b/src/fragment-parse.lisp
index c958da3..fcaa92e 100644 (file)
--- a/src/fragment-parse.lisp
+++ b/src/fragment-parse.lisp
@@ -40,9 +40,9 @@
    takes into account comments (both C and C++ style), string and character
    literals."
 
-  (let ((char-scanner (token-scanner-char-scanner scanner))
-       (delim nil)
-       (stack nil))
+  (let* ((char-scanner (token-scanner-char-scanner scanner))
+        (delim-match nil) (delim-found nil) (delim-loc nil)
+        (stack nil) (start nil) (tokstart nil) (eofwhine t))
     (with-parser-context (character-scanner-context :scanner char-scanner)
 
       ;; Hack.  If the first character is a newline then discard it
@@ -51,11 +51,20 @@
       (parse #\newline)
 
       ;; This seems the easiest way of gathering stuff.
+      (setf start (file-location char-scanner))
       (with-scanner-place (place char-scanner)
 
-       (flet ((push-delim (d)
-                (push delim stack)
-                (setf delim d))
+       (flet ((push-delim (found match)
+                (push (list delim-found delim-match delim-loc) stack)
+                (setf delim-found found
+                      delim-match match
+                      delim-loc tokstart))
+
+              (pop-delim ()
+                (destructuring-bind (found match loc) (pop stack)
+                  (setf delim-found found
+                        delim-match match
+                        delim-loc loc)))
 
               (result ()
                 (let* ((output (scanner-interval char-scanner place))
@@ -71,6 +80,7 @@
 
          ;; March through characters until we reach the end.
          (loop
+           (setf tokstart (file-location char-scanner))
            (cond-parse (:consumedp cp :expected exp)
 
              ;; Whitespace and comments are universally dull.
@@ -80,31 +90,58 @@
              ;; See if we've reached the end.  We must leave the delimiter
              ;; in the scanner, so `if-char' and its various friends aren't
              ;; appropriate.
-             ((lisp (if (and (null delim)
+             ((lisp (if (and (null delim-match)
+                             (not (scanner-at-eof-p char-scanner))
                              (member (scanner-current-char char-scanner)
                                      end-chars))
                         (values (result) t t)
                         (values end-chars nil nil)))
               (return (values it t t)))
              (:eof
-              (lexer-error char-scanner '(:any))
+              (when eofwhine
+                (lexer-error char-scanner nil))
+              (loop
+                (unless delim-found (return))
+                (info-with-location delim-loc
+                                    "Unmatched `~C' found here" delim-found)
+                (pop-delim))
+              (info-with-location start "C fragment started here")
               (return (values (result) t t)))
 
              ;; Opening and closing brackets.  Opening brackets push things
-             ;; onto a stack; closing brackets pop things off again.
-             (#\( (push-delim #\)))
-             (#\[ (push-delim #\]))
-             (#\{ (push-delim #\}))
-             ((or #\) #\] #\})
-              (if (eql it delim)
-                  (setf delim (pop stack))
-                  (cerror* "Unmatched `~C'" it)))
+             ;; onto a stack; closing brackets pop things off again.  Pop a
+             ;; bracket even if it doesn't match, to encourage progress
+             ;; towards finding an end-delimiter.
+             (#\( (push-delim #\( #\)))
+             (#\[ (push-delim #\[ #\]))
+             (#\{ (push-delim #\{ #\}))
+             ((lisp (let ((char (scanner-current-char char-scanner)))
+                      (case char
+                        ((#\) #\] #\})
+                         (unless (eql char delim-match)
+                           (lexer-error char-scanner
+                                        (and delim-match
+                                             (list delim-match)))
+                           (when delim-loc
+                             (info-with-location
+                              delim-loc
+                              "Mismatched `~C' found here" delim-found)))
+                         (scanner-step char-scanner)
+                         (when delim-match (pop-delim))
+                         (values char t t))
+                        (t
+                         (values '(#\) #\] #\}) nil nil))))))
 
              ;; String and character literals.
              ((seq ((quote (or #\" #\'))
                     (nil (skip-many ()
-                             (or (and #\\ :any) (not quote))))
-                    (nil (char quote)))))
+                           (or (and #\\ :any) (not quote))))
+                    (nil (or (char quote)
+                             (seq (:eof)
+                               (lexer-error char-scanner (list quote))
+                               (info-with-location tokstart
+                                                   "Literal started here")
+                               (setf eofwhine nil)))))))
 
              ;; Anything else.
              (:any)
@@ -112,6 +149,8 @@
              ;; This really shouldn't be able to happen.
              (t
               (assert cp)
+              (when (scanner-at-eof-p char-scanner)
+                (setf eofwhine nil))
               (lexer-error char-scanner exp)))))))))
 
 (export 'parse-delimited-fragment)