Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv2832
Modified Files: arrays.lisp Log Message: Have macros in the run-time.
--- /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2007/04/08 16:03:53 1.64 +++ /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2008/03/15 20:57:12 1.65 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.64 2007/04/08 16:03:53 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.65 2008/03/15 20:57:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -21,22 +21,20 @@
(in-package muerte)
-(defmacro vector-double-dispatch ((s1 s2) &rest clauses) +(defmacro/cross-compilation vector-double-dispatch ((s1 s2) &rest clauses) (flet ((make-double-dispatch-value (et1 et2) (+ (* #x100 (bt:enum-value 'movitz::movitz-vector-element-type et1)) (bt:enum-value 'movitz::movitz-vector-element-type et2)))) - `(progn - #+ignore - (warn "vdd: ~X" (+ (* #x100 (vector-element-type ,s1)) - (vector-element-type ,s2))) - (case (+ (ash (vector-element-type-code ,s1) 8) - (vector-element-type-code ,s2)) - ,@(loop for (keys . forms) in clauses - if (atom keys) - collect (cons keys forms) - else - collect (cons (make-double-dispatch-value (first keys) (second keys)) - forms)))))) + `(case (+ (ash (vector-element-type-code ,s1) 8) + (vector-element-type-code ,s2)) + ,@(mapcar (lambda (clause) + (destructuring-bind (keys . forms) + clause + (if (atom keys) + (cons keys forms) + (cons (make-double-dispatch-value (first keys) (second keys)) + forms)))) + clauses))))
(defmacro with-indirect-vector ((var form &key (check-type t)) &body body) `(let ((,var ,form))