src/lexer-impl.lisp: Don't always skip a token.

[sod] / src / lexer-proto.lisp

diff --git a/src/lexer-proto.lisp b/src/lexer-proto.lisp
index af2e535..349e2a0 100644 (file)
--- a/src/lexer-proto.lisp
+++ b/src/lexer-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
 
 ;;;----- 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
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by


@@ -40,6 +40,9 @@
 ;;;--------------------------------------------------------------------------
 ;;; Indicators and error messages.
 
 ;;;--------------------------------------------------------------------------
 ;;; Indicators and error messages.
 

+(defvar *indicator-map* (make-hash-table)
+  "Hash table mapping indicator objects to human-readable descriptions.")
+

 (export 'define-indicator)
 (defun define-indicator (indicator description)
   "Associate an INDICATOR with its textual DESCRIPTION.
 (export 'define-indicator)
 (defun define-indicator (indicator description)
   "Associate an INDICATOR with its textual DESCRIPTION.


@@ -49,7 +52,7 @@
   indicator)
 
 (export 'syntax-error)
   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)
   "Signal a (maybe) continuable syntax error."
   (labels ((show-token (type value)
             (if (characterp type)


@@ -68,7 +71,8 @@
                    ((eq (car thing) :id)
                     (format nil "`~A'" (cadr thing)))
                    (t (format nil "<? ~S>" thing)))))
                    ((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"
             "Syntax error: ~
              expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
              but found ~A"


@@ -76,12 +80,12 @@
             (show-token (token-type scanner) (token-value scanner)))))
 
 (export 'lexer-error)
             (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."
   "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: ~
+                         expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
+                         but found ~/sod::show-char/"

           (mapcar (lambda (exp)
                     (typecase exp
                       (character (format nil "~/sod::show-char/" exp))
           (mapcar (lambda (exp)
                     (typecase exp
                       (character (format nil "~/sod::show-char/" exp))


@@ -93,9 +97,9 @@
                       (t (format nil "<? ~S>" exp))))
                   expected)
           (and (not (scanner-at-eof-p char-scanner))
                       (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)
                      (&key (keep-end nil keep-end-p))
                      &rest token-types)
 (defparse skip-until (:context (context token-scanner-context)
                      (&key (keep-end nil keep-end-p))
                      &rest token-types)


@@ -110,8 +114,10 @@
               :keep-end ,(if keep-end-p keep-end
                              (> (length token-types) 1))))
 
               :keep-end ,(if keep-end-p keep-end
                              (> (length token-types) 1))))
 

+(export 'error)

 (defparse error (:context (context token-scanner-context)
 (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
   "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


@@ -121,14 +127,21 @@
    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
    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)
   `(parse-error-recover ,(parser-scanner context)
                        (parser () ,sub)

-                       (parser () ,recover)))
+                       (parser () ,recover)
+                       :ignore-unconsumed ,ignore-unconsumed
+                       :force-progress ,force-progress))

 
 ;;;--------------------------------------------------------------------------
 ;;; Lexical analysis utilities.
 
 
 ;;;--------------------------------------------------------------------------
 ;;; Lexical analysis utilities.
 

+(export 'scan-comment)

 (defun scan-comment (char-scanner)
   "Scan a comment (either `/* ... */' or `// ...') from CHAR-SCANNER.
 
 (defun scan-comment (char-scanner)
   "Scan a comment (either `/* ... */' or `// ...') from CHAR-SCANNER.