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

   1 (cl:in-package #:sod)
   2
   3 (defun play-fetch-token (string)
   4   (with-parser-context (string-parser :string string)
   5     (labels ((digit (radix)
   6                (parse (filter (lambda (ch)
   7                                 (digit-char-p ch radix)))))
   8              (number (radix &optional (initial 0))
   9                (parse (many (a initial (+ (* radix a) it))
  10                         (digit radix))))
  11              (numeric (radix sigil)
  12                (parse (seq ((first (peek (seq ((nil (funcall sigil))
  13                                                (d (digit radix)))
  14                                            d)))
  15                             (result (number radix first)))
  16                         result))))
  17  (multiple-value-call #'values
  18     (loop
  19        (parse :whitespace)
  20
  21        (cond-parse ()
  22
  23          ;; Give up at end-of-file.
  24          (:eof
  25           (return (values :eof nil)))
  26
  27          ;; Pick out comments.
  28          ((peek (and #\/ #\*))
  29           (parse (skip-many ()          ; this may fail at eof; don't worry
  30                    (and (skip-many () (not #\*))
  31                         (skip-many (:min 1) #\*))
  32                    (not #\/)))
  33           (if-parse :eof ()
  34             (cerror* "Unterminated comment")
  35             (parse :any)))
  36          ((and (peek (seq (#\/ #\/)))
  37                (skip-many () (not #\newline))
  38                (or :eof #\newline)))
  39
  40          ;; Quoted strings and characters.
  41          ((or #\' #\")
  42           (let ((quote it)
  43                 (out (make-string-output-stream)))
  44             (parse (skip-many ()
  45                      (or (seq ((ch (satisfies (lambda (ch)
  46                                                 (and (char/= ch #\\)
  47                                                      (char/= ch quote))))))
  48                            (write-char ch out))
  49                          (seq (#\\ (ch :any))
  50                            (write-char ch out)))))
  51             (if-parse :eof ()
  52               (cerror* "Unterminated ~:[string~;character~] constant"
  53                        (char= quote #\'))
  54               (parse :any))
  55             (let ((string (get-output-stream-string out)))
  56               (ecase quote
  57                 (#\" (return (values :string string)))
  58                 (#\' (case (length string)
  59                        (0 (cerror* "Empty character constant")
  60                           (return (values :char #\?)))
  61                        (1 (return (values :char (char string 0))))
  62                        (t (cerror* "Multiple characters in ~
  63                                     character constant")
  64                           (return (values :char (char string 0))))))))))
  65
  66          ;; Identifiers.
  67          ((seq ((first (satisfies (lambda (ch)
  68                                     (or (char= ch #\_)
  69                                         (alpha-char-p ch)))))
  70                 (ident (many (out (let ((s (make-string-output-stream)))
  71                                     (write-char first s)
  72                                     s)
  73                                   (progn (write-char it out) out)
  74                               :final (get-output-stream-string out))
  75                          (satisfies (lambda (ch)
  76                                       (or (char= ch #\_)
  77                                           (alphanumericp ch)))))))
  78             (return (values :id ident))))
  79
  80          ;; Numbers -- uses the machinery in the labels above.
  81          ((or (seq (#\0
  82                     (i (or (numeric 8 (parser () (or #\o #\O)))
  83                            (numeric 16 (parser () (or #\x #\X)))
  84                            (number 8))))
  85                 i)
  86               (seq ((first (digit 10))
  87                     (rest (number 10 first)))
  88                 rest))
  89           (return (values :integer it)))
  90
  91          ;; Special separator tokens.
  92          ("..."
  93           (return (values :ellipsis :ellipsis)))
  94
  95          ;; Anything else is a standalone delimiter character.
  96          (:any
  97           (return (values it it)))))
  98     (parse (list () :any))))))