blob: c33de88d57e7cbe074f966093e7ffbc1257ccab6 (
plain)
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
(in-package :ast)
(defclass node ()
((token :accessor token
:initarg :token
:type token)))
(defgeneric stringify (node)
(:method ((node node))
(with-output-to-string (out)
(emit node out))))
(defparameter *indent* 0)
(defun emit-new-line (stream)
(write-char #\Newline stream)
(loop :for i :from 0 :below *indent*
:do (write-char #\Space stream)))
(defgeneric emit (node stream)
(:method ((node node) stream)
(write-string (token-literal node) stream)))
(defgeneric token-literal (node)
(:method ((node node))
(token:literal (token node))))
(defclass statement (node)
())
(defclass expression (node)
())
(defclass program (node)
((statements :accessor statements
:initform (make-array 10 :adjustable t :fill-pointer 0))))
(defmethod token-literal ((node program))
(if (> (length (statements node)) 0)
(token-literal (aref (statements node) 0))
""))
(defmethod emit ((node program) stream)
(loop :for stmt :across (statements node)
:do (emit stmt stream)))
(defclass identifier (expression)
())
(defclass let-statement (statement)
((name :accessor name
:initarg :name
:type identifier)
(value :accessor value
:initarg :value
:type expression)))
(defmethod emit ((node let-statement) stream)
(write-string (token-literal node) stream)
(write-char #\Space stream)
(emit (name node) stream)
(write-string " = " stream)
(emit (value node) stream)
(write-char #\; stream)
(write-char #\Newline stream))
(defclass return-statement (statement)
((return-value :accessor return-value
:initarg :return-value
:type expression)))
(defmethod emit ((node return-statement) stream)
(write-string (token-literal node) stream)
(write-char #\Space stream)
(emit (return-value node) stream)
(write-char #\; stream)
(write-char #\Newline stream))
(defclass integer-literal (expression)
((value :accessor value
:initarg :value
:type integer)))
(defclass prefix-expression (expression)
((operator :accessor operator
:initarg :operator
:type token-type)
(right :accessor right
:initarg :right
:type expression)))
(defmethod emit ((node prefix-expression) stream)
(write-char #\( stream)
(write-string (token-literal node) stream)
(emit (right node) stream)
(write-char #\) stream))
(defclass expression-statement (statement)
((expression :accessor expression
:initarg :expression
:type expression)))
(defmethod emit ((node expression-statement) stream)
(emit (expression node) stream)
(write-char #\; stream)
(write-char #\Newline stream))
(defclass boolean-expression (expression)
((value :accessor value
:initarg :value
:type boolean)))
(defclass infix-expression (expression)
((left :accessor left
:initarg :left
:type expression)
(operator :accessor operator
:initarg :operator
:type token-type)
(right :accessor right
:initarg :right
:type expression)))
(defmethod emit ((node infix-expression) stream)
(write-char #\( stream)
(emit (left node) stream)
(let ((tok (token:as-token (operator node))))
(format stream " ~a " (token:literal tok)))
(emit (right node) stream)
(write-char #\) stream))
(defclass if-expression (expression)
((con :accessor con
:initarg :condition
:type expression)
(consequence :accessor consequence
:initarg :consequence
:type block-statement)
(alternative :accessor alternative
:initform nil
:initarg :alternative
:type (or block-statement null))))
(defmethod emit ((node if-expression) stream)
(write-string "if (" stream)
(emit (con node) stream)
(write-string ") " stream)
(emit (consequence node) stream)
(unless (null (alternative node))
(write-string "else " stream)
(emit (alternative node) stream)))
(defclass block-statement (statement)
((statements :accessor statements
:initarg statements
:initform (make-array 0 :element-type 'statement
:adjustable t :fill-pointer 0)
:type (vector statement))))
(defmethod emit ((node block-statement) stream)
(write-char #\{ stream)
(let ((*indent* (+ 4 *indent*)))
(emit-new-line stream)
(loop :for stmt :across (statements node)
:do (emit stmt stream)))
(format stream "}"))
(defclass function-literal (expression)
((parameters :accessor parameters
:initarg :parameters
:initform (make-array 0 :element-type 'identifier
:adjustable t :fill-pointer 0)
:type (vector identifier))
(body :accessor body
:initarg :body
:type block-statement)))
(defmethod emit ((node function-literal) stream)
(write-string (token-literal node) stream)
(write-char #\( stream)
(loop :for param :across (parameters node)
:for i :from 1
:do (write-string (token-literal param) stream)
(when (< i (length (parameters node)))
(write-string ", " stream)))
(write-char #\) stream)
(emit (body node) stream))
(defclass call-expression (expression)
((fn-expr :accessor fn-expr
:initarg :function
:type expression)
(args :accessor args
:initarg :args
:initform (make-array 0 :element-type 'expression
:adjustable t :fill-pointer 0)
:type (vector expression))))
(defmethod emit ((node call-expression) stream)
(emit (fn-expr node) stream)
(write-char #\( stream)
(loop :for arg :across (args node)
:for i :from 1
:do (emit arg stream)
(when (< i (length (args node)))
(write-string ", " stream)))
(write-char #\) stream))
|
