Plaster

common-lisp
;;; Template mechanism (defmacro define-template (name &rest args)) (defun template-type (&rest template-args)) (defgeneric constructor (template-type)) (defgeneric place (template-type qualifier)) (define-template 2vec+ vec <s> <t> (a b) (let ((type (template-type 'vec <s> <t>))) `(declare (type ,type a b)) `(,(constructor type) ,@(loop for i from 0 below <s> collect `(+ (,(place type i) a) (,(place type i) b)))))) (define-2vec+ 2 single-float) ;; ===> (defun 2vec+/2/single-float (a b) (declare (type vec2 a b)) (vec2 (+ (vx2 a) (vx2 b)) (+ (vy2 a) (vy2 b)))) (define-template 2nvec+ <s> <t> (a b) (let ((type (template-type 'vec <s> <t>))) `(declare (type ,type a b)) (loop for i from 0 below <s> collect `(setf (,(place type i) a) (+ (,(place type i) a) (,(place type i) b)))) 'a)) (define-2nvec+ 3 ub32) ;; ===> (defun 2nvec+/3/ub32 (a b) (declare (type uvec3 a b)) (setf (uvx3 a) (+ (uvx3 a) (uvx3 b))) (setf (uvy3 a) (+ (uvy3 a) (uvy3 b))) a) (define-template* vsqrlen vec <s> <t> (a) `(declare (type ,type a)) `(+ ,@(loop for i from 0 below <s> collect `(expt (,(place type i) a) 2)))) (define-vsqrlen 4 double-float) ;; ==> (defun vsqrlen/4/double-float (a) (declare (type dvec4 a)) (+ (expt (dvx4 a) 2) (expt (dvy4 a) 2) (expt (dvz4 a) 2) (expt (dvw4 a) 2))) ;;; Dispatch mechanism (defmacro define-dispatch (name args &rest template-combinations)) (define-dispatch vsqrlen (a) (2 3 4) (single-float double-float ub32 sb32)) ;; ==> (defun vqsrlen (a) (etypecase a (vec2 (vsqrlen/2/single-float a)) (vec3 (vsqrlen/3/single-float a)) (vec4 (vsqrlen/4/single-float a)) (dvec2 (vsqrlen/2/double-float a)) (dvec3 (vsqrlen/3/double-float a)) (dvec4 (vsqrlen/4/double-float a)) (uvec2 (vsqrlen/2/ub32 a)) (uvec3 (vsqrlen/3/ub32 a)) (uvec4 (vsqrlen/4/ub32 a)) (ivec2 (vsqrlen/2/sb32 a)) (ivec3 (vsqrlen/3/sb32 a)) (ivec4 (vsqrlen/4/sb32 a)))) ;; + possible impl-specific type inference expanders

Annotations