about summary refs log tree commit diff stats
path: root/shell/macroexpand.mu
blob: 48d9bf928c3a60ad94908458aab81c88dcf14490 (plain) (blame)
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
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
  # trace "macroexpand " expr-ah {{{
  {
    compare trace, 0
    break-if-=
    var stream-storage: (stream byte 0x200)
    var stream/ecx: (addr stream byte) <- address stream-storage
    write stream, "macroexpand "
    print-cell expr-ah, stream, 0/no-trace
    trace trace, "mac", stream
  }
  # }}}
  # loop until convergence
  {
    var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
    compare expanded?, 0/false
    loop-if-!=
  }
  # trace "=> " expr-ah {{{
  {
    compare trace, 0
    break-if-=
    var stream-storage: (stream byte 0x200)
    var stream/ecx: (addr stream byte) <- address stream-storage
    write stream, "=> "
    print-cell expr-ah, stream, 0/no-trace
    trace trace, "mac", stream
  }
  # }}}
}

# return true if we found any macros
fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
  var expr-ah/esi: (addr handle cell) <- copy _expr-ah
  # trace "macroexpand-iter " expr {{{
  {
    compare trace, 0
    break-if-=
    var stream-storage: (stream byte 0x200)
    var stream/ecx: (addr stream byte) <- address stream-storage
    write stream, "macroexpand-iter "
    print-cell expr-ah, stream, 0/no-trace
    trace trace, "mac", stream
  }
  # }}}
  # if expr is a non-pair, return
  var expr/eax: (addr cell) <- lookup *expr-ah
  {
    var nil?/eax: boolean <- nil? expr
    compare nil?, 0/false
    break-if-=
    # nil is a literal
    trace-text trace, "mac", "nil"
    trace-higher trace
    return 0/false
  }
  {
    var expr-type/eax: (addr int) <- get expr, type
    compare *expr-type, 0/pair
    break-if-=
    # non-pairs are literals
    trace-text trace, "mac", "non-pair"
    trace-higher trace
    return 0/false
  }
  # if expr is a literal pair, return
  var first-ah/ebx: (addr handle cell) <- get expr, left
  var rest-ah/ecx: (addr handle cell) <- get expr, right
  var first/eax: (addr cell) <- lookup *first-ah
  {
    var litfn?/eax: boolean <- litfn? first
    compare litfn?, 0/false
    break-if-=
    # litfn is a literal
    trace-text trace, "mac", "literal function"
    trace-higher trace
    return 0/false
  }
  {
    var litmac?/eax: boolean <- litmac? first
    compare litmac?, 0/false
    break-if-=
    # litmac is a literal
    trace-text trace, "mac", "literal macro"
    trace-higher trace
    return 0/false
  }
  var result/edi: boolean <- copy 0/false
  # for each builtin, expand only what will later be evaluated
  $macroexpand-iter:anonymous-function: {
    var fn?/eax: boolean <- fn? first
    compare fn?, 0/false
    break-if-=
    # fn: expand every expression in the body
    trace-text trace, "mac", "anonymous function"
    # skip parameters
    var rest/eax: (addr cell) <- lookup *rest-ah
    {
      rest-ah <- get rest, right
      rest <- lookup *rest-ah
      {
        var done?/eax: boolean <- nil? rest
        compare done?, 0/false
      }
      break-if-!=
      var curr-ah/eax: (addr handle cell) <- get rest, left
      var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
      result <- or macro-found?
      loop
    }
    trace-higher trace
    return result
  }
  # builtins with "special" evaluation rules
  $macroexpand-iter:quote: {
    # trees starting with single quote create literals
    var quote?/eax: boolean <- symbol-equal? first, "'"
    compare quote?, 0/false
    break-if-=
    #
    trace-text trace, "mac", "quote"
    trace-higher trace
    return 0/false
  }
  # TODO: expand within backquotes
  $macroexpand-iter:def: {
    # trees starting with "def" define globals
    var def?/eax: boolean <- symbol-equal? first, "def"
    compare def?, 0/false
    break-if-=
    #
    trace-text trace, "mac", "def"
    var rest/eax: (addr cell) <- lookup *rest-ah
    rest-ah <- get rest, right  # skip name
    rest <- lookup *rest-ah
    var val-ah/edx: (addr handle cell) <- get rest, left
    var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
    trace-higher trace
    return macro-found?
  }
  $macroexpand-iter:set: {
    # trees starting with "set" mutate bindings
    var set?/eax: boolean <- symbol-equal? first, "set"
    compare set?, 0/false
    break-if-=
    #
    trace-text trace, "mac", "set"
    var rest/eax: (addr cell) <- lookup *rest-ah
    rest-ah <- get rest, right  # skip name
    rest <- lookup *rest-ah
    var val-ah/edx: (addr handle cell) <- get rest, left
    var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
    trace-higher trace
    return macro-found?
  }
  # 'and' is like a function for macroexpansion purposes
  # 'or' is like a function for macroexpansion purposes
  # 'if' is like a function for macroexpansion purposes
  # 'while' is like a function for macroexpansion purposes
  # if car(expr) is a symbol defined as a macro, expand it
  {
    var definition-h: (handle cell)
    var definition-ah/edx: (addr handle cell) <- address definition-h
    maybe-lookup-symbol-in-globals first, definition-ah, globals, trace
    var definition/eax: (addr cell) <- lookup *definition-ah
    compare definition, 0
    break-if-=
    # definition found
    {
      var definition-type/eax: (addr int) <- get definition, type
      compare *definition-type, 0/pair
    }
    break-if-!=
    # definition is a pair
    {
      var definition-car-ah/eax: (addr handle cell) <- get definition, left
      var definition-car/eax: (addr cell) <- lookup *definition-car-ah
      var macro?/eax: boolean <- litmac? definition-car
      compare macro?, 0/false
    }
    break-if-=
    # definition is a macro
    var macro-definition-ah/eax: (addr handle cell) <- get definition, right
    # TODO: check car(macro-definition) is litfn
    apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    return 1/true
  }
  # no macro found; process any macros within args
  trace-text trace, "mac", "recursing into function definition"
  var curr-ah/ebx: (addr handle cell) <- copy first-ah
  $macroexpand-iter:loop: {
#?     clear-screen 0/screen
#?     dump-trace trace
    var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
    result <- or macro-found?
    var rest/eax: (addr cell) <- lookup *rest-ah
    {
      var nil?/eax: boolean <- nil? rest
      compare nil?, 0/false
    }
    break-if-!=
    curr-ah <- get rest, left
    rest-ah <- get rest, right
    loop
  }
  return result
}

fn test-macroexpand {
  var globals-storage: global-table
  var globals/edx: (addr global-table) <- address globals-storage
  initialize-globals globals
  # new macro: m
  var sandbox-storage: sandbox
  var sandbox/esi: (addr sandbox) <- address sandbox-storage
  initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
  edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
  var trace-ah/eax: (addr handle trace) <- get sandbox, trace
  var trace/eax: (addr trace) <- lookup *trace-ah
  # invoke macro
  initialize-sandbox-with sandbox, "(m 3 4)"
  var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
  var gap/eax: (addr gap-buffer) <- lookup *gap-ah
  var result-h: (handle cell)
  var result-ah/ebx: (addr handle cell) <- address result-h
  read-cell gap, result-ah, 0/no-trace
  var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
#?   dump-cell-from-cursor-over-full-screen result-ah
  var _result/eax: (addr cell) <- lookup *result-ah
  var result/edi: (addr cell) <- copy _result
  # expected
  initialize-sandbox-with sandbox, "(+ 3 4)"
  var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
  var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
  var expected-h: (handle cell)
  var expected-ah/ecx: (addr handle cell) <- address expected-h
  read-cell expected-gap, expected-ah, 0/no-trace
#?   dump-cell-from-cursor-over-full-screen expected-ah
  var expected/eax: (addr cell) <- lookup *expected-ah
  #
  var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
  check assertion, "F - test-macroexpand"
}

fn test-macroexpand-inside-anonymous-fn {
  var globals-storage: global-table
  var globals/edx: (addr global-table) <- address globals-storage
  initialize-globals globals
  # new macro: m
  var sandbox-storage: sandbox
  var sandbox/esi: (addr sandbox) <- address sandbox-storage
  initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
  edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
  var trace-ah/eax: (addr handle trace) <- get sandbox, trace
  var trace/eax: (addr trace) <- lookup *trace-ah
  # invoke macro
  initialize-sandbox-with sandbox, "(fn() (m 3 4))"
  var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
  var gap/eax: (addr gap-buffer) <- lookup *gap-ah
  var result-h: (handle cell)
  var result-ah/ebx: (addr handle cell) <- address result-h
  read-cell gap, result-ah, 0/no-trace
  var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
#?   dump-cell-from-cursor-over-full-screen result-ah
  var _result/eax: (addr cell) <- lookup *result-ah
  var result/edi: (addr cell) <- copy _result
  # expected
  initialize-sandbox-with sandbox, "(fn() (+ 3 4))"
  var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
  var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
  var expected-h: (handle cell)
  var expected-ah/ecx: (addr handle cell) <- address expected-h
  read-cell expected-gap, expected-ah, 0/no-trace
#?   dump-cell-from-cursor-over-full-screen expected-ah
  var expected/eax: (addr cell) <- lookup *expected-ah
  #
  var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
  check assertion, "F - test-macroexpand-inside-anonymous-fn"
}

fn test-macroexpand-inside-fn-call {
  var globals-storage: global-table
  var globals/edx: (addr global-table) <- address globals-storage
  initialize-globals globals
  # new macro: m
  var sandbox-storage: sandbox
  var sandbox/esi: (addr sandbox) <- address sandbox-storage
  initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
  edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
  # invoke macro
  initialize-sandbox-with sandbox, "((fn() (m 3 4)))"
  var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
  var gap/eax: (addr gap-buffer) <- lookup *gap-ah
  var result-h: (handle cell)
  var result-ah/ebx: (addr handle cell) <- address result-h
  read-cell gap, result-ah, 0/no-trace
  var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
#?   dump-cell-from-cursor-over-full-screen result-ah
  var _result/eax: (addr cell) <- lookup *result-ah
  var result/edi: (addr cell) <- copy _result
  # expected
  initialize-sandbox-with sandbox, "((fn() (+ 3 4)))"
  var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
  var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
  var expected-h: (handle cell)
  var expected-ah/ecx: (addr handle cell) <- address expected-h
  read-cell expected-gap, expected-ah, 0/no-trace
#?   dump-cell-from-cursor-over-full-screen expected-ah
  var expected/eax: (addr cell) <- lookup *expected-ah
  #
  var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
  check assertion, "F - test-macroexpand-inside-fn-call"
}