Add a simple handler for `let'

This commit is contained in:
Renaud Casenave-Péré 2015-03-25 17:37:27 +01:00
parent 2c0f5f1904
commit f12a8076d0
2 changed files with 19 additions and 3 deletions

View file

@ -21,9 +21,24 @@
(defvar *current-indent* 0 (defvar *current-indent* 0
"Keep the number of space needed for the next directive.") "Keep the number of space needed for the next directive.")
(defvar *env* nil
"A special variable used as a container for the macro environment.")
(defhandler newshader (newshader lambda-list &rest body) (defhandler newshader (newshader lambda-list &rest body)
(walk-list body)) (walk-list body))
(defhandler let (let bindings &rest body)
(let* ((names (loop for binding in bindings
collect (safe-first binding)))
(symbol-macrolet-names (loop for name in names
when (nth-value 1 (macroexpand-1 name *env*))
collect name)))
(apply #'concatenate 'string
(append (loop for binding in bindings
collect (format nil "~(~a ~a~)~@[ = ~a~];~%" (second binding) (first binding)
(walk-list (cddr binding))))
(walk-list body)))))
(defun default-handler (first &rest rest) (defun default-handler (first &rest rest)
"Handle a simple function call." "Handle a simple function call."
(format nil "~@[~vt~]~(~a~) (~{~a~^, ~});~%" (format nil "~@[~vt~]~(~a~) (~{~a~^, ~});~%"
@ -35,4 +50,4 @@
(defun glsl-compile (form) (defun glsl-compile (form)
(let ((*current-indent* 0)) (let ((*current-indent* 0))
(walk form *form-handlers* #'default-handler))) (walk form *form-handlers* #'default-handler *env*)))

View file

@ -83,8 +83,9 @@
collect `(gethash ',sym ,(intern (symbol-name '*form-handlers*))) collect `(gethash ',sym ,(intern (symbol-name '*form-handlers*)))
collect `',func)))))) collect `',func))))))
(defun walk (form handlers default-handler) (defun walk (form handlers default-handler env)
"Walk the sexp FORM and transform it according to the rules defined in HANDLERS." "Walk the sexp FORM and transform it according to the rules defined in HANDLERS."
(let ((*form-handlers* handlers) (let ((*form-handlers* handlers)
(*default-handler* default-handler)) (*default-handler* default-handler)
(*env* env))
(walk-1 form))) (walk-1 form)))