mdw@git.distorted.org.uk Git - sod/blob - src/lexer-proto.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Protocol for lexical analysis
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensble Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Class definition.
  30
  31 (export 'sod-token-scanner)
  32 (defclass sod-token-scanner (token-scanner)
  33   ((char-scanner :initarg :char-scanner :reader token-scanner-char-scanner))
  34   (:documentation
  35    "A token scanner for SOD input files.
  36
  37    Not a lot here, apart from a character scanner to read from and the
  38    standard token scanner infrastructure."))
  39
  40 ;;;--------------------------------------------------------------------------
  41 ;;; Indicators and error messages.
  42
  43 (defvar *indicator-map* (make-hash-table)
  44   "Hash table mapping indicator objects to human-readable descriptions.")
  45
  46 (export 'define-indicator)
  47 (defun define-indicator (indicator description)
  48   "Associate an INDICATOR with its textual DESCRIPTION.
  49
  50    Updates the the `*indicator-map*'."
  51   (setf (gethash indicator *indicator-map*) description)
  52   indicator)
  53
  54 (export 'syntax-error)
  55 (defun syntax-error (scanner expected &key (continuep t))
  56   "Signal a (maybe) continuable syntax error."
  57   (labels ((show-token (type value)
  58              (if (characterp type)
  59                  (format nil "~/sod::show-char/" type)
  60                  (case type
  61                    (:id (format nil "<identifier~@[ `~A'~]>" value))
  62                    (:int "<integer-literal>")
  63                    (:string "<string-literal>")
  64                    (:char "<character-literal>")
  65                    (:eof "<end-of-file>")
  66                    (:ellipsis "`...'")
  67                    (t (format nil "<? ~S~@[ ~S~]>" type value)))))
  68            (show-expected (thing)
  69              (acond ((gethash thing *indicator-map*) it)
  70                     ((atom thing) (show-token thing nil))
  71                     ((eq (car thing) :id)
  72                      (format nil "`~A'" (cadr thing)))
  73                     (t (format nil "<? ~S>" thing)))))
  74     (funcall (if continuep #'cerror* #'error)
  75              "Syntax error: ~
  76               expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
  77               but found ~A"
  78              (mapcar #'show-expected expected)
  79              (show-token (token-type scanner) (token-value scanner)))))
  80
  81 (export 'lexer-error)
  82 (defun lexer-error (char-scanner expected consumedp)
  83   "Signal a continuable lexical error."
  84   (cerror* "Lexical error: ~
  85             expected ~{~#[<bug>~;~A~;~A or ~A~;:~A, ~]~} ~
  86             but found ~/sod::show-char/~
  87             ~@[ at ~A~]"
  88            (mapcar (lambda (exp)
  89                      (typecase exp
  90                        (character (format nil "~/sod::show-char/" exp))
  91                        (string (format nil "`~A'" exp))
  92                        ((cons (eql :digit) *) (format nil "<radix-~A digit>"
  93                                                       (cadr exp)))
  94                        ((eql :eof) "<end-of-file>")
  95                        ((eql :any) "<character>")
  96                        (t (format nil "<? ~S>" exp))))
  97                    expected)
  98            (and (not (scanner-at-eof-p char-scanner))
  99                 (scanner-current-char char-scanner))
 100            (and consumedp (file-location char-scanner))))
 101
 102 (export 'skip-until)
 103 (defparse skip-until (:context (context token-scanner-context)
 104                       (&key (keep-end nil keep-end-p))
 105                       &rest token-types)
 106   "Discard tokens until we find one listed in TOKEN-TYPES.
 107
 108    If KEEP-END is true then retain the found token for later; otherwise
 109    discard it.  KEEP-END defaults to true if multiple TOKEN-TYPES are given;
 110    otherwise false.  If end-of-file is encountered then the indicator list is
 111    simply the list of TOKEN-TYPES; otherwise the result is `nil'."
 112   `(skip-until ,(parser-scanner context)
 113                (list ,@token-types)
 114                :keep-end ,(if keep-end-p keep-end
 115                               (> (length token-types) 1))))
 116
 117 (export 'error)
 118 (defparse error (:context (context token-scanner-context)
 119                  (&key) sub &optional (recover t))
 120   "Try to parse SUB; if it fails then report an error, and parse RECOVER.
 121
 122    This is the main way to recover from errors and continue parsing.  Even
 123    then, it's not especially brilliant.
 124
 125    If the SUB parser succeeds then just propagate its result: it's like we
 126    were never here.  Otherwise, try to recover in a sensible way so we can
 127    continue parsing.  The details of this recovery are subject to change, but
 128    the final action is generally to invoke the RECOVER parser and return its
 129    result."
 130   `(parse-error-recover ,(parser-scanner context)
 131                         (parser () ,sub)
 132                         (parser () ,recover)))
 133
 134 ;;;--------------------------------------------------------------------------
 135 ;;; Lexical analysis utilities.
 136
 137 (export 'scan-comment)
 138 (defun scan-comment (char-scanner)
 139   "Scan a comment (either `/* ... */' or `// ...') from CHAR-SCANNER.
 140
 141    The result isn't interesting."
 142   (with-parser-context (character-scanner-context :scanner char-scanner)
 143     (parse (or (and "/*"
 144                     (and (skip-many ()
 145                            (and (skip-many () (not #\*))
 146                                 (label "*/" (skip-many (:min 1) #\*)))
 147                            (not #\/))
 148                          #\/))
 149                (and "//"
 150                     (skip-many () (not #\newline))
 151                     (? #\newline))))))
 152
 153 ;;;----- That's all, folks --------------------------------------------------