1 fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
  2 +-- 11 lines: # trace "macroexpand " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------
 13   # loop until convergence
 14   {
 15     var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
 16     compare expanded?, 0/false
 17     loop-if-!=
 18   }
 19 +-- 11 lines: # trace "=> " expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------
 30 }
 31 
 32 # return true if we found any macros
 33 fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
 34   var expr-ah/esi: (addr handle cell) <- copy _expr-ah
 35 +-- 11 lines: # trace "macroexpand-iter " expr ------------------------------------------------------------------------------------------------------------------------------------------
 46   # if expr is a non-pair, return
 47   var expr/eax: (addr cell) <- lookup *expr-ah
 48   {
 49     var nil?/eax: boolean <- nil? expr
 50     compare nil?, 0/false
 51     break-if-=
 52     # nil is a literal
 53     trace-text trace, "mac", "nil"
 54     trace-higher trace
 55     return 0/false
 56   }
 57   {
 58     var expr-type/eax: (addr int) <- get expr, type
 59     compare *expr-type, 0/pair
 60     break-if-=
 61     # non-pairs are literals
 62     trace-text trace, "mac", "non-pair"
 63     trace-higher trace
 64     return 0/false
 65   }
 66   # if expr is a literal pair, return
 67   var first-ah/ebx: (addr handle cell) <- get expr, left
 68   var rest-ah/ecx: (addr handle cell) <- get expr, right
 69   var first/eax: (addr cell) <- lookup *first-ah
 70   {
 71     var litfn?/eax: boolean <- litfn? first
 72     compare litfn?, 0/false
 73     break-if-=
 74     # litfn is a literal
 75     trace-text trace, "mac", "literal function"
 76     trace-higher trace
 77     return 0/false
 78   }
 79   {
 80     var litmac?/eax: boolean <- litmac? first
 81     compare litmac?, 0/false
 82     break-if-=
 83     # litmac is a literal
 84     trace-text trace, "mac", "literal macro"
 85     trace-higher trace
 86     return 0/false
 87   }
 88   var result/edi: boolean <- copy 0/false
 89   # for each builtin, expand only what will later be evaluated
 90   $macroexpand-iter:anonymous-function: {
 91     var fn?/eax: boolean <- fn? first
 92     compare fn?, 0/false
 93     break-if-=
 94     # fn: expand every expression in the body
 95     trace-text trace, "mac", "anonymous function"
 96     # skip parameters
 97     var rest/eax: (addr cell) <- lookup *rest-ah
 98     {
 99       rest-ah <- get rest, right
100       rest <- lookup *rest-ah
101       {
102         var done?/eax: boolean <- nil? rest
103         compare done?, 0/false
104       }
105       break-if-!=
106       var curr-ah/eax: (addr handle cell) <- get rest, left
107       var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
108       result <- or macro-found?
109       loop
110     }
111     trace-higher trace
112     return result
113   }
114   # builtins with "special" evaluation rules
115   $macroexpand-iter:quote: {
116     # trees starting with single quote create literals
117     var quote?/eax: boolean <- symbol-equal? first, "'"
118     compare quote?, 0/false
119     break-if-=
120     #
121     trace-text trace, "mac", "quote"
122     trace-higher trace
123     return 0/false
124   }
125   $macroexpand-iter:backquote: {
126     # nested backquote not supported for now
127     var backquote?/eax: boolean <- symbol-equal? first, "`"
128     compare backquote?, 0/false
129     break-if-=
130     #
131     error trace, "nested backquote not supported yet"
132     trace-higher trace
133     return 0/false
134   }
135   $macroexpand-iter:def: {
136     # trees starting with "def" define globals
137     var def?/eax: boolean <- symbol-equal? first, "def"
138     compare def?, 0/false
139     break-if-=
140     #
141     trace-text trace, "mac", "def"
142     var rest/eax: (addr cell) <- lookup *rest-ah
143     rest-ah <- get rest, right  # skip name
144     rest <- lookup *rest-ah
145     var val-ah/edx: (addr handle cell) <- get rest, left
146     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
147     trace-higher trace
148     return macro-found?
149   }
150   $macroexpand-iter:set: {
151     # trees starting with "set" mutate bindings
152     var set?/eax: boolean <- symbol-equal? first, "set"
153     compare set?, 0/false
154     break-if-=
155     #
156     trace-text trace, "mac", "set"
157     var rest/eax: (addr cell) <- lookup *rest-ah
158     rest-ah <- get rest, right  # skip name
159     rest <- lookup *rest-ah
160     var val-ah/edx: (addr handle cell) <- get rest, left
161     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
162     trace-higher trace
163     return macro-found?
164   }
165   # 'and' is like a function for macroexpansion purposes
166   # 'or' is like a function for macroexpansion purposes
167   # 'if' is like a function for macroexpansion purposes
168   # 'while' is like a function for macroexpansion purposes
169   # if car(expr) is a symbol defined as a macro, expand it
170   {
171     var definition-h: (handle cell)
172     var definition-ah/edx: (addr handle cell) <- address definition-h
173     maybe-lookup-symbol-in-globals first, definition-ah, globals, trace
174     var definition/eax: (addr cell) <- lookup *definition-ah
175     compare definition, 0
176     break-if-=
177     # definition found
178     {
179       var definition-type/eax: (addr int) <- get definition, type
180       compare *definition-type, 0/pair
181     }
182     break-if-!=
183     # definition is a pair
184     {
185       var definition-car-ah/eax: (addr handle cell) <- get definition, left
186       var definition-car/eax: (addr cell) <- lookup *definition-car-ah
187       var macro?/eax: boolean <- litmac? definition-car
188       compare macro?, 0/false
189     }
190     break-if-=
191     # definition is a macro
192     var macro-definition-ah/eax: (addr handle cell) <- get definition, right
193     # TODO: check car(macro-definition) is litfn
194 #?     turn-on-debug-print
195     apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
196     return 1/true
197   }
198   # no macro found; process any macros within args
199   trace-text trace, "mac", "recursing into function definition"
200   var curr-ah/ebx: (addr handle cell) <- copy first-ah
201   $macroexpand-iter:loop: {
202 #?     clear-screen 0/screen
203 #?     dump-trace trace
204     var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
205     result <- or macro-found?
206     var rest/eax: (addr cell) <- lookup *rest-ah
207     {
208       var nil?/eax: boolean <- nil? rest
209       compare nil?, 0/false
210     }
211     break-if-!=
212     curr-ah <- get rest, left
213     rest-ah <- get rest, right
214     loop
215   }
216   return result
217 }
218 
219 fn test-macroexpand {
220   var globals-storage: global-table
221   var globals/edx: (addr global-table) <- address globals-storage
222   initialize-globals globals
223   # new macro: m
224   var sandbox-storage: sandbox
225   var sandbox/esi: (addr sandbox) <- address sandbox-storage
226   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
227   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
228   var trace-ah/eax: (addr handle trace) <- get sandbox, trace
229   var trace/eax: (addr trace) <- lookup *trace-ah
230   # invoke macro
231   initialize-sandbox-with sandbox, "(m 3 4)"
232   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
233   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
234   var result-h: (handle cell)
235   var result-ah/ebx: (addr handle cell) <- address result-h
236   read-cell gap, result-ah, 0/no-trace
237   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
238 #?   dump-cell-from-cursor-over-full-screen result-ah
239   var _result/eax: (addr cell) <- lookup *result-ah
240   var result/edi: (addr cell) <- copy _result
241   # expected
242   initialize-sandbox-with sandbox, "(+ 3 4)"
243   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
244   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
245   var expected-h: (handle cell)
246   var expected-ah/ecx: (addr handle cell) <- address expected-h
247   read-cell expected-gap, expected-ah, 0/no-trace
248 #?   dump-cell-from-cursor-over-full-screen expected-ah
249   var expected/eax: (addr cell) <- lookup *expected-ah
250   #
251   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
252   check assertion, "F - test-macroexpand"
253 }
254 
255 fn test-macroexpand-inside-anonymous-fn {
256   var globals-storage: global-table
257   var globals/edx: (addr global-table) <- address globals-storage
258   initialize-globals globals
259   # new macro: m
260   var sandbox-storage: sandbox
261   var sandbox/esi: (addr sandbox) <- address sandbox-storage
262   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
263   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
264   var trace-ah/eax: (addr handle trace) <- get sandbox, trace
265   var trace/eax: (addr trace) <- lookup *trace-ah
266   # invoke macro
267   initialize-sandbox-with sandbox, "(fn() (m 3 4))"
268   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
269   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
270   var result-h: (handle cell)
271   var result-ah/ebx: (addr handle cell) <- address result-h
272   read-cell gap, result-ah, 0/no-trace
273   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
274 #?   dump-cell-from-cursor-over-full-screen result-ah
275   var _result/eax: (addr cell) <- lookup *result-ah
276   var result/edi: (addr cell) <- copy _result
277   # expected
278   initialize-sandbox-with sandbox, "(fn() (+ 3 4))"
279   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
280   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
281   var expected-h: (handle cell)
282   var expected-ah/ecx: (addr handle cell) <- address expected-h
283   read-cell expected-gap, expected-ah, 0/no-trace
284 #?   dump-cell-from-cursor-over-full-screen expected-ah
285   var expected/eax: (addr cell) <- lookup *expected-ah
286   #
287   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
288   check assertion, "F - test-macroexpand-inside-anonymous-fn"
289 }
290 
291 fn test-macroexpand-inside-fn-call {
292   var globals-storage: global-table
293   var globals/edx: (addr global-table) <- address globals-storage
294   initialize-globals globals
295   # new macro: m
296   var sandbox-storage: sandbox
297   var sandbox/esi: (addr sandbox) <- address sandbox-storage
298   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
299   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
300   # invoke macro
301   initialize-sandbox-with sandbox, "((fn() (m 3 4)))"
302   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
303   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
304   var result-h: (handle cell)
305   var result-ah/ebx: (addr handle cell) <- address result-h
306   read-cell gap, result-ah, 0/no-trace
307   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
308 #?   dump-cell-from-cursor-over-full-screen result-ah
309   var _result/eax: (addr cell) <- lookup *result-ah
310   var result/edi: (addr cell) <- copy _result
311   # expected
312   initialize-sandbox-with sandbox, "((fn() (+ 3 4)))"
313   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
314   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
315   var expected-h: (handle cell)
316   var expected-ah/ecx: (addr handle cell) <- address expected-h
317   read-cell expected-gap, expected-ah, 0/no-trace
318 #?   dump-cell-from-cursor-over-full-screen expected-ah
319   var expected/eax: (addr cell) <- lookup *expected-ah
320   #
321   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
322   check assertion, "F - test-macroexpand-inside-fn-call"
323 }
324 
325 fn pending-test-macroexpand-inside-backquote-unquote {
326   var globals-storage: global-table
327   var globals/edx: (addr global-table) <- address globals-storage
328   initialize-globals globals
329   # new macro: m
330   var sandbox-storage: sandbox
331   var sandbox/esi: (addr sandbox) <- address sandbox-storage
332   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
333   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
334   # invoke macro
335   initialize-sandbox-with sandbox, "`(print [result is ] ,(m 3 4)))"
336   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
337   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
338   var result-h: (handle cell)
339   var result-ah/ebx: (addr handle cell) <- address result-h
340   read-cell gap, result-ah, 0/no-trace
341   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
342   dump-cell-from-cursor-over-full-screen result-ah
343   var _result/eax: (addr cell) <- lookup *result-ah
344   var result/edi: (addr cell) <- copy _result
345   # expected
346   initialize-sandbox-with sandbox, "`(print [result is ] ,(+ 3 4)))"
347   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
348   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
349   var expected-h: (handle cell)
350   var expected-ah/ecx: (addr handle cell) <- address expected-h
351   read-cell expected-gap, expected-ah, 0/no-trace
352   dump-cell-from-cursor-over-full-screen expected-ah
353   var expected/eax: (addr cell) <- lookup *expected-ah
354   #
355   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
356   check assertion, "F - test-macroexpand-inside-backquote-unquote"
357 }
358 
359 fn pending-test-macroexpand-inside-nested-backquote-unquote {
360   var globals-storage: global-table
361   var globals/edx: (addr global-table) <- address globals-storage
362   initialize-globals globals
363   # new macro: m
364   var sandbox-storage: sandbox
365   var sandbox/esi: (addr sandbox) <- address sandbox-storage
366   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
367   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
368   # invoke macro
369   initialize-sandbox-with sandbox, "`(a ,(m 3 4) `(b ,(m 3 4) ,,(m 3 4)))"
370   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
371   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
372   var result-h: (handle cell)
373   var result-ah/ebx: (addr handle cell) <- address result-h
374   read-cell gap, result-ah, 0/no-trace
375   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
376   dump-cell-from-cursor-over-full-screen result-ah
377   var _result/eax: (addr cell) <- lookup *result-ah
378   var result/edi: (addr cell) <- copy _result
379   # expected
380   initialize-sandbox-with sandbox, "`(a ,(+ 3 4) `(b ,(m 3 4) ,,(+ 3 4)))"
381   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
382   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
383   var expected-h: (handle cell)
384   var expected-ah/ecx: (addr handle cell) <- address expected-h
385   read-cell expected-gap, expected-ah, 0/no-trace
386   dump-cell-from-cursor-over-full-screen expected-ah
387   var expected/eax: (addr cell) <- lookup *expected-ah
388   #
389   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
390   check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
391 }
392 
393 # TODO: unquote-splice, nested and unnested