1 files changed, 61 insertions, 0 deletions
diff --git a/generic-walking.lisp b/generic-walking.lisp
new file mode 100644
index 0000000..11487cc
--- /dev/null
+++ b/generic-walking.lisp
@@ -0,0 +1,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))))))