From 906d165556192f9d411d1e5f57ec9bf4c92c0539 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Renaud=20Casenave-P=C3=A9r=C3=A9?= <renaud@casenave-pere.fr>
Date: Sun, 22 Mar 2015 22:39:39 +0100
Subject: [PATCH] Enhance the genericity of the walker

---
 src/render/shader/walker.lisp | 75 +++++++++++++++++++++++------------
 1 file changed, 49 insertions(+), 26 deletions(-)

diff --git a/src/render/shader/walker.lisp b/src/render/shader/walker.lisp
index b5532cd..2cfb874 100644
--- a/src/render/shader/walker.lisp
+++ b/src/render/shader/walker.lisp
@@ -5,36 +5,33 @@
 
 (in-package :cl-user)
 (defpackage stoe.shader.walker
-  (:nickname :walker)
-  (:use :cl :utils))
+  (:use :cl :utils)
+  (:nicknames :walker)
+  (:export :walk-1
+           :walk-list
+           :walk
+           :defhandler))
 (in-package :stoe.shader.walker)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *form-handlers* (make-hash-table)))
+  (defvar *form-handlers* (make-hash-table)
+    "A special variable containing the handlers for our dsl keywords."))
 
-(defun e-list (list)
-  "Apply `e' to all members of LIST."
-  (mapcar #'e list))
+(defvar *default-handler* nil
+  "A special variable containing the default handler used for unknown symbols.")
 
-(defmacro defhandler (symbol lambda-list &body body)
-  (let ((syms (safe-list symbol)))
-    (let ((func (intern (format nil "~A~A" 'handler- (first syms)))))
-      `(progn
-         (defun ,func ,lambda-list
-           ,@body)
-         (setf ,@(loop for sym in syms
-                    collect `(gethash sym *form-handlers*)
-                    collect `',func))))))
-
-(defun default-form-handler (first &rest form)
-  "Handle FORM when FIRST is not a special form."
-  `(list ,(if (symbolp first)
-              `',first
-              (e first)) ,@(e-list rest)))
+(defvar *env* nil
+  "A special variable used as a container for the macro environment.")
 
 (defun form-handler (first)
   "Retreive the handler for the symbol FIRST."
-  (gethash first *form-handlers* 'default-form-handler))
+  (gethash first *form-handlers* *default-handler*))
+
+(defun function-name-p (name)
+  "Return whether NAME is the name of a function."
+  (or (symbolp name)
+      (and (listp name) (eq (first name) 'setf) (symbolp (second name))
+           (not (cddr name)))))
 
 (defun compiler-macroexpand-1 (form &optional env)
   "Try and expand the compiler macro defined for the first element of FORM if it exists."
@@ -44,7 +41,7 @@
         (funcall *macroexpand-hook* cm form env)
         form)))
 
-(defun e (form)
+(defun walk-1 (form)
   "Walk across the specified form."
   (flet ((handle (form)
            (apply (form-handler (first form)) form)))
@@ -54,7 +51,7 @@
            (multiple-value-bind (form expanded)
                (macroexpand-1 form *env*)
              (cond (expanded
-                    (e form))
+                    (walk-1 form))
                    (t
                     (typecase form
                       (null nil)
@@ -62,6 +59,32 @@
                        (let ((next (compiler-macroexpand-1 form)))
                          (if (eq form next)
                              (handle form)
-                             (e next))))
+                             (walk-1 next))))
                       (t
-                       `',form)))))))))
+                       form)))))))))
+
+(defun walk-list (list)
+  "Apply `walk-1' to all members of LIST."
+  (mapcar #'walk-1 list))
+
+(defun default-form-handler (first &rest rest)
+  "Handle FORM when FIRST is not a special form."
+  (if (symbolp first)
+      `',first
+      (walk-1 first)) (walk-list rest))
+
+(defmacro defhandler (symbol lambda-list &body body)
+  (let ((syms (safe-list symbol)))
+    (let ((func (intern (format nil "~A~A" 'handler- (first syms)))))
+      `(progn
+         (defun ,func ,lambda-list
+           ,@body)
+         (setf ,@(loop for sym in syms
+                    collect `(gethash ',sym ,(intern (symbol-name '*form-handlers*)))
+                    collect `',func))))))
+
+(defun walk (form handlers default-handler)
+  "Walk the sexp FORM and transform it according to the rules defined in HANDLERS."
+  (let ((*form-handlers* handlers)
+        (*default-handler* default-handler))
+    (walk-1 form)))