lox/scanner.lisp at master · dnizzolo/lox · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
(in-package #:lox.scanner)

(defvar *keywords*
  (a:alist-hash-table
   '(("and" . :and) ("class" . :class) ("else" . :else) ("false" . :false)
     ("for" . :for) ("fun" . :fun) ("if" . :if) ("nil" . :nil)
     ("or" . :or) ("print" . :print) ("return" . :return) ("super" . :super)
     ("this" . :this) ("true" . :true) ("var" . :var) ("while" . :while))
   :test #'equal))

(defclass scanner ()
  ((source :initarg :source :reader source)
   (tokens :initform (make-array 256 :adjustable t :fill-pointer 0) :accessor tokens)
   (start :initform 0 :accessor start)
   (current :initform 0 :accessor current)
   (line :initform 1 :accessor line))
  (:default-initargs
   :source (a:required-argument :source)))

(defun make-scanner (source)
  (make-instance 'scanner :source source))

(defun scan-tokens (scanner)
  (if (at-end-p scanner)
      (tokens scanner)
      (progn
        (do ()
            ((at-end-p scanner))
          (setf (start scanner) (current scanner))
          (scan-token scanner))
        (vector-push-extend (make-token :eof nil (line scanner))
                            (tokens scanner))
        (tokens scanner))))

(defun scan-token (scanner &aux (char (advance scanner)))
  (case char
    (#\( (add-token scanner :left-paren))
    (#\) (add-token scanner :right-paren))
    (#\{ (add-token scanner :left-brace))
    (#\} (add-token scanner :right-brace))
    (#\, (add-token scanner :comma))
    (#\. (add-token scanner :dot))
    (#\- (add-token scanner :minus))
    (#\+ (add-token scanner :plus))
    (#\? (add-token scanner :question-mark))
    (#\: (add-token scanner :colon))
    (#\; (add-token scanner :semicolon))
    (#\* (add-token scanner :star))
    (#\! (add-token scanner (if (match scanner #\=) :bang-equal :bang)))
    (#\= (add-token scanner (if (match scanner #\=) :equal-equal :equal)))
    (#\< (add-token scanner (if (match scanner #\=) :less-equal :less)))
    (#\> (add-token scanner (if (match scanner #\=) :greater-equal :greater)))
    (#\/ (if (match scanner #\/)
             (do ((current-char char (peek scanner)))
                 ((or (char= current-char #\Newline)
                      (at-end-p scanner)))
               (advance scanner))
             (add-token scanner :slash)))
    ((#\Space #\Tab #\Return))
    (#\" (scan-string scanner))
    (#\Newline (incf (line scanner)))
    (t (cond ((digit-char-p char)
              (scan-number scanner))
             ((or (char= char #\_) (alpha-char-p char))
              (scan-identifier scanner))
             (t (report-error (line scanner)
                              (format nil "Unexpected character '~a'" char)))))))

(defun scan-identifier (scanner)
  (do ((current-char (peek scanner) (peek scanner)))
      ((not (or (digit-char-p current-char)
                (char= current-char #\_)
                (alpha-char-p current-char))))
    (advance scanner))
  (let* ((text (subseq (source scanner) (start scanner) (current scanner)))
         (type (gethash text *keywords* :identifier)))
    (add-token scanner type)))

(defun scan-number (scanner)
  (do ((current-char (peek scanner) (peek scanner)))
      ((not (digit-char-p current-char)))
    (advance scanner))
  (when (and (char= (peek scanner) #\.) (digit-char-p (peek-next scanner)))
    (advance scanner)
    (do ((current-char (peek scanner) (peek scanner)))
        ((not (digit-char-p current-char)))
      (advance scanner)))
  (add-token scanner :number
             (read-from-string (subseq (source scanner)
                                       (start scanner)
                                       (current scanner)))))

(defun scan-string (scanner)
  (do ((current-char (peek scanner) (peek scanner)))
      ((or (char= current-char #\")
           (at-end-p scanner)))
    (when (char= current-char #\Newline)
      (incf (line scanner)))
    (advance scanner))
  (if (at-end-p scanner)
      (report-error (line scanner) "Unterminated string")
      (progn
        (advance scanner)
        (add-token scanner :string (subseq (source scanner)
                                           (1+ (start scanner))
                                           (1- (current scanner)))))))

(defun at-end-p (scanner)
  (>= (current scanner) (length (source scanner))))

(defun peek (scanner)
  (if (at-end-p scanner)
      #\Nul
      (char (source scanner) (current scanner))))

(defun peek-next (scanner)
  (with-slots (source current) scanner
    (if (>= (1+ current) (length source))
        #\Nul
        (char source (1+ current)))))

(defun advance (scanner)
  (prog1 (char (source scanner) (current scanner))
    (incf (current scanner))))

(defun match (scanner expected)
  (with-slots (source current) scanner
    (cond ((at-end-p scanner) nil)
          ((char/= expected (char source current)) nil)
          (t (incf current)))))

(defun add-token (scanner token-type &optional literal)
  (let ((text (subseq (source scanner) (start scanner) (current scanner))))
    (vector-push-extend (make-token token-type text (line scanner) literal)
                        (tokens scanner))))