Handle more operations and wrap in main function

Add handlers for infix operations (+ - * / %) and assignments.
Wrap the resulting code in a main function.
Prepare for the lambda-list processing
This commit is contained in:
Renaud Casenave-Péré 2015-03-29 19:02:59 +02:00
parent f8c1db2192
commit 1c1862dd6d
3 changed files with 63 additions and 22 deletions

View file

@ -13,7 +13,7 @@
(in-package :stoe.shader.compiler)
(defun %defshader (lambda-list body)
(let ((shader (glsl-compile (cons 'newshader (cons lambda-list body)))))
(let ((shader (glsl-compile lambda-list body)))
shader))
(defmacro defshader (name lambda-list &body body)

View file

@ -24,18 +24,36 @@
(defvar *env* nil
"A special variable used as a container for the macro environment.")
(defvar *verbose* nil
"Configure the verbosity of the compiler.
if non-nil, the dsl will be printed in comments together with the glsl code.")
(defmacro noop-handler (body)
`(format nil "/* ~((~{~a~^ ~})~) */~%" ,body))
(defhandler (declare block return-from catch load-time-value
macrolet symbol-macrolet flet labels let*
eval-when defun lambda tagbody setq function
the go unwind-protect progv quote) (&rest body)
"Handle the unsupported keywords. For the time being,
the forms comprised of these keywords will be printed in comments."
(noop-handler body))
(defhandler newshader (newshader lambda-list &rest body)
(declare (ignore newshader lambda-list))
(walk-list body))
(defhandler (progn locally) (progn &rest body)
"Handle the progn special form."
(declare (ignore progn))
(format nil "~{~a;~%~}" (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 "~@[~vt~]~(~a ~a~)~@[ = ~a~];~%"
"Handle the variables declaration special form."
(declare (ignore let))
(format nil "~{~a;~%~}~%~a"
(loop for binding in bindings
collect (format nil "~@[~vt~]~(~a~) ~(~a~)~@[ = ~(~a~)~]"
(when (> *current-indent* 0)
*current-indent*)
(second binding) (first binding)
@ -43,17 +61,40 @@
(not (cdddr binding)))
(walk-1 (third binding))
(walk-list (cddr binding)))))
(walk-list body)))))
(format nil "~{~a;~%~}" (walk-list body))))
(defhandler setf (setf &rest pairs)
"Handle the assignment special form."
(declare (ignore setf))
(let ((vars (loop for s in pairs by #'cddr collect s)))
(let ((expanded (loop for n in vars
for r in (rest pairs) by #'cddr
collect n collect (walk-1 r))))
(format nil "~@[~vt~]~{~(~a~) = ~(~a~)~^;~%~}"
(when (> *current-indent* 0)
*current-indent*)
expanded))))
(defhandler (+ - * / %) (op &rest body)
"Handle the standard infix operations."
(flet ((oper (a b)
(format nil "~a ~(~a~) ~a"
(if (listp a) (format t "(~a)" (walk-1 a)) a) op
(if (listp b) (format nil "(~a)" (walk-1 b)) b))))
(reduce #'oper body)))
(defun default-handler (first &rest rest)
"Handle a simple function call."
(format nil "~@[~vt~]~(~a (~{~a~^, ~})~);~%"
(format nil "~@[~vt~]~(~a~) (~{~(~a~)~^, ~})"
(when (> *current-indent* 0)
*current-indent*)
(if (symbolp first)
first
(walk-1 first)) (walk-list rest)))
(defun glsl-compile (form)
(let ((*current-indent* 0))
(walk form *form-handlers* #'default-handler *env*)))
(defun glsl-compile (lambda-list body)
(declare (ignore lambda-list))
(format nil "~%~a~%void main ()~%{~%~a}~%"
(let ((*current-indent* 2))
(walk `(progn ,body) *form-handlers* #'default-handler *env*))))

View file

@ -95,7 +95,7 @@
(defmacro defhandler (symbol lambda-list &body body)
(let ((syms (safe-list symbol)))
(let ((func (intern (format nil "~A~A" 'handler- (first syms)))))
(let ((func (intern (format nil "~a~a" 'handler- (first syms)))))
`(progn
(defun ,func ,lambda-list
,@body)