From 64a7d83e80d33ca8b0b8ca0547c120a34022412c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Renaud=20Casenave-P=C3=A9r=C3=A9?= <renaud@casenave-pere.fr>
Date: Fri, 20 Mar 2015 16:44:37 +0100
Subject: [PATCH] Add the first part of a code walker for the shader dsl

---
 src/render/shader/walker.lisp | 67 +++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 src/render/shader/walker.lisp

diff --git a/src/render/shader/walker.lisp b/src/render/shader/walker.lisp
new file mode 100644
index 0000000..a2b9159
--- /dev/null
+++ b/src/render/shader/walker.lisp
@@ -0,0 +1,67 @@
+#|
+  This file is a part of stoe project.
+  Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
+|#
+
+(in-package :cl-user)
+(defpackage stoe.shader.walker
+  (:nickname :walker)
+  (:use :cl :utils))
+(in-package :stoe.shader.walker)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *form-handlers* (make-hash-table)))
+
+(defun e-list (list)
+  "Apply `e' to all members of LIST."
+  (mapcar #'e list))
+
+(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)))
+
+(defun form-handler (first)
+  "Retreive the handler for the symbol FIRST."
+  (gethash first *form-handlers* 'default-form-handler))
+
+(defun compiler-macroexpand-1 (form &optional env)
+  "Try and expand the compiler macro defined for the first element of FORM if it exists."
+  (let ((cm (and (listp form) (function-name-p (first form))
+                 (compiler-macro-function (first form) env))))
+    (if cm
+        (funcall *macroexpand-hook* cm form env)
+        form)))
+
+(defun e (form)
+  "Walk across the specified form."
+  (flet ((handle (form)
+           (apply (form-handler (first form)) form)))
+    (cond ((and (listp form) (gethash (first form) *form-handlers*))
+           (handle form))
+          (t
+           (multiple-value-bind (form expanded)
+               (macroexpand-1 form *env*)
+             (cond (expanded
+                    (e form))
+                   (t
+                    (typecase form
+                      (null nil)
+                      (list
+                       (let ((next (compiler-macroexpand-1 form)))
+                         (if (eq form next)
+                             (handle form)
+                             (e next))))
+                      (t
+                       `',form)))))))))