blob: 11487cc395c56841a40f513ad3cf4dc52692c1ef (
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
|
(in-package :agnostic-lizard)
(defmethod metaenv-macroexpand-all (form (env walker-metaenv))
(let*
((replacement (funcall (metaenv-on-every-form-pre env) form env))
(hardwiring-needed-p
(and (consp replacement)
(find (first replacement) *hardwired-operators*)))
(expanded-raw (if hardwiring-needed-p replacement
(metaenv-macroexpand replacement env)))
(expanded (funcall (metaenv-on-macroexpanded-form env) expanded-raw env))
(function-like-p (and expanded (consp expanded)))
(operator (and function-like-p (first expanded)))
; If the operator has a dual macro/special-operator implementation,
; it is already macroexpanded by that point.
(specialp (special-operator-p operator))
(function-replacement
(if (or specialp hardwiring-needed-p)
(funcall (metaenv-on-special-form-pre env) expanded env)
(funcall (metaenv-on-function-form-pre env) expanded env)))
(full-expansion
(cond
((not function-like-p) expanded)
(specialp (metaenv-macroexpand-all-special-form
operator function-replacement env))
; Default handler works fine for both progn and function call forms,
; we define the same handler once more for progn just for the sake of
; explicitness
(t (metaenv-macroexpand-all-special-form
operator function-replacement env))))
(full-expansion-replacement
(if (and function-like-p (not specialp))
(funcall (metaenv-on-function-form env) full-expansion env)
(funcall (metaenv-on-special-form env) full-expansion env)))
(result (funcall (metaenv-on-every-form env) full-expansion-replacement env)))
result))
(defun walk-form (form env &rest handler-definitions)
"Walk the form inside the environment described by env using the handlers from handler-definitions.
Handlers get a form and a walker-metaenv environment description.
The return value of a handler is used instead of the form passed to the handler during further processing.
Handlers can be:
:on-every-form-pre — called before processing each form in an executable position
:on-macroexpanded-form — called for each form after macroexpanding its top operation; hardwired macros are passed unexpanded
:on-special-form-pre — called before processing a special form or a hardwired macro
:on-function-form-pre — called before processing a function call
:on-special-form — called after processing a special form or a hardwired macro
:on-function-form — called after processing a function call
:on-every-form — called after expanding each form in an executable position
env can be metaenv or walker-metaenv
"
(metaenv-macroexpand-all
form
(apply
'make-instance 'walker-metaenv
(append
handler-definitions
(when (subtypep 'walker-metaenv (type-of env))
(metaenv-clone-args env))))))
|
