67 lines
2.2 KiB
Common Lisp
67 lines
2.2 KiB
Common Lisp
#|
|
|
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)))))))))
|