chiark - git - mdw - 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 (export 'define-indicator)
  44 (defun define-indicator (indicator description)
  45   "Associate an INDICATOR with its textual DESCRIPTION.
  46
  47    Updates the the `*indicator-map*'."
  48   (setf (gethash indicator *indicator-map*) description)
  49   indicator)
  50
  51 (export 'syntax-error)
  52 (defun syntax-error (scanner expected &key (continuep t))
  53   "Signal a (maybe) continuable syntax error."
  54   (labels ((show-token (type value)
  55              (if (characterp type)
  56                  (format nil "~/sod::show-char/" type)
  57                  (case type
  58                    (:id (format nil "<identifier~@[ `~A'~]>" value))
  59                    (:string "<string-literal>")
  60                    (:char "<character-literal>")
  61                    (:eof "<end-of-file>")
  62                    (:ellipsis "`...'")
  63                    (t (format nil "<? ~S~@[ ~S~]>" type value)))))
  64            (show-expected (thing)
  65              (acond ((gethash thing *indicator-map*) it)
  66                     ((atom thing) (show-token thing nil))
  67                     ((eq (car thing) :id)
  68                      (format nil "`~A'" (cadr thing)))
  69                     (t (format nil "<? ~S>" thing)))))
  70     (funcall (if continuep #'cerror* #'error)
  71              "Syntax error: ~
  72               expected ~{~#[<bug>~;~A~;~A or ~A~:;~A, ~]~} ~
  73               but found ~A"
  74              (mapcar #'show-expected expected)
  75              (show-token (token-type scanner) (token-value scanner)))))
  76
  77 (export 'lexer-error)
  78 (defun lexer-error (char-scanner expected consumedp)
  79   "Signal a continuable lexical error."
  80   (cerror* "Lexical error: ~
  81             expected ~{~#[<bug>~;~A~;~A or ~A~;:~A, ~]~} ~
  82             but found ~/sod::show-char/~
  83             ~@[ at ~A~]"
  84            (mapcar (lambda (exp)
  85                      (typecase exp
  86                        (character (format nil "~/sod::show-char/" exp))
  87                        (string (format nil "`~A'" exp))
  88                        ((cons (eql :digit) *) (format nil "<radix-~A digit>"
  89                                                       (cadr exp)))
  90                        ((eql :eof) "<end-of-file>")
  91                        ((eql :any) "<character>")
  92                        (t (format nil "<? ~S>" exp))))
  93                    expected)
  94            (and (not (scanner-at-eof-p char-scanner))
  95                 (scanner-current-char char-scanner))
  96            (and consumedp (file-location char-scanner))))
  97
  98 ;;;--------------------------------------------------------------------------
  99 ;;; Lexical analysis utilities.
 100
 101 (defun scan-comment (char-scanner)
 102   "Scan a comment (either `/* ... */' or `// ...') from CHAR-SCANNER.
 103
 104    The result isn't interesting."
 105   (with-parser-context (character-scanner-context :scanner char-scanner)
 106     (parse (or (and "/*"
 107                     (and (skip-many ()
 108                            (and (skip-many () (not #\*))
 109                                 (label "*/" (skip-many (:min 1) #\*)))
 110                            (not #\/))
 111                          #\/))
 112                (and "//"
 113                     (skip-many () (not #\newline))
 114                     (? #\newline))))))
 115
 116 ;;;----- That's all, folks --------------------------------------------------