so I'm trying to make a with-typed-mref macro so that I can do (mref m 0 0), e.g., and have this be a nice fast call to aref down in the body of my loops. This sort of works and I even got it to work two levels of nesting deep so that I can do
(with-typed-matrix (m integer)
(with-typed-matrix (n integer)
...
and things work properly. I had to resort to some macroexpand hackery to do this, but when I go three levels deep, it breaks down. Interestingly, I seem to get the proper (somewhat recursive) expansion of mref such that the first and last with-typed-mrefs seem to work, but the one in the middle is "lost". any suggestions on how to improve the macroexpand stuff so that I get arbitrary recursive nesting of these forms?
(defmacro with-typed-mref ((z element-type) &body body &environment env)
(let ((vals (gensym)))
`(let ((,vals (matrix-vals ,z)))
(declare (type (simple-array ,element-type *) ,vals))
(macrolet ((mref (mat &rest args)
(if (eql ',z mat)
`(aref ,',vals ,@args)
(macroexpand `(mref ,',z ,@args) ,env)))
(row-major-mref (mat &rest args)
(if (eql ',z mat)
`(row-major-aref ,',vals ,@args)
(macroexpand `(row-major-mref ,',z ,@args) ,env))))
,@body))))
(PROGN
(DEFMETHOD MLOGAND-RANGE
((M BIT-MATRIX) (N BIT-MATRIX) STARTR ENDR STARTC ENDC &KEY
IN-PLACE)
(DESTRUCTURING-BIND
(MR MC)
(DIM M)
(LET ((P (MAKE-INSTANCE 'BIT-MATRIX :ROWS MR :COLS MC)))
(WITH-TYPED-MREF (M (UNSIGNED-BYTE 1))
(WITH-TYPED-MREF
(N (UNSIGNED-BYTE 1))
(WITH-TYPED-MREF (P (UNSIGNED-BYTE 1))
(DO ((I STARTR (1+ I)))
((> I ENDR))
(DECLARE
(DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(DO ((J STARTC
(1+ J)))
((> J ENDC))
(DECLARE
(DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(SETF (MREF P I J)
(LOGAND
(MREF M I
J)
(MREF N I
J))))))))
P))))
(define-symbol-macro .mref-expanders. nil)
(defmacro with-typed-mref ((z element-type) &body body &environment env)
(let ((vals (gensym "MATRIX-")))
`(let ((,vals (matrix-vals ,z)))
(declare (type (simple-array ,element-type *) ,vals))
(symbol-macrolet
((.mref-expanders. ,(acons z vals (macroexpand-1 '.mref-expanders. env))))
(macrolet
((mref (mat &rest args &environment env)
(let ((vals (cdr (assoc mat (macroexpand-1 '.mref-expanders. env)))))
`(aref ,vals ,@args)))
(row-major-mref (mat &rest args &environment env)
(let ((vals (cdr (assoc mat (macroexpand-1 '.mref-expanders. env)))))
`(row-major-aref ,vals ,@args))))
,@body)))))
(nice rhyme!)
(define-symbol-macro .mref-expanders. nil)
(defmacro with-typed-mref ((z element-type) &body body)
(let ((vals (gensym "MATRIX-")))
`(let ((,vals (matrix-vals ,z)))
(declare (type (simple-array ,element-type *) ,vals))
(symbol-macrolet ((.mref-expanders. ,(acons z vals ())))
(macrolet ((mref (mat &rest args &environment env)
(let ((vals (cdr (assoc mat (macroexpand-1 '.mref-expanders. env)))))
`(aref ,vals ,@args)))
(row-major-mref (mat &rest args &environment env)
(let ((vals (cdr (assoc mat (macroexpand-1 '.mref-expanders. env)))))
`(row-major-aref ,vals ,@args))))
,@body)))))
(defconstant +var-alist-sym+ (gensym))
(defmacro with-typed-mref ((z element-type) &body body &environment env)
(let ((vals (gensym "MATRIX-")))
`(let ((,vals (matrix-vals ,z)))
(declare (type (simple-array ,element-type *) ,vals))
, (multiple-value-bind (val-alist expanded-p)
(macroexpand-1 +var-alist-sym+ env)
(if expanded-p
`(symbol-macrolet ((,+var-alist-sym+
,(acons z vals val-alist)))
,@body)
`(symbol-macrolet ((,+var-alist-sym+ ,(acons z vals ())))
(macrolet ((mref (mat &rest args &environment env)
(let ((vals (cdr (assoc mat
(macroexpand-1 ',+var-alist-sym+ env)))))
`(aref ,vals ,@args)))
(row-major-mref (mat &rest args &environment env)
(let ((vals (cdr (assoc mat
(macroexpand-1 ',+var-alist-sym+ env)))))
`(row-major-aref ,vals ,@args))))
,@body)))))))
is this moving in the right direction?
(defmacro with-typed-mref ((z element-type) &body body &environment env)
(let ((vals (gensym "MATRIX-")))
`(let ((,vals (matrix-vals ,z)))
(declare (type (simple-array ,element-type *) ,vals))
(symbol-macrolet ((.mref-expanders
(acons ',z ,(lambda (&rest args)
`(aref ',vals ,@args))
(macroexpand .mref-expanders ,env)))
(.row-major-mref-expanders
(acons ',z ,(lambda (&rest args)
`(row-major-aref ',vals ,@args))
(macroexpand .row-major-mref-expanders ,env))))
(macrolet ((mref (&whole whole mat &rest args)
(if (assoc mat .mref-expanders)
`(,(assoc mat .mref-expanders) ,@args)
whole))
(row-major-mref (&whole whole mat &rest args)
(if (assoc mat .row-major-mref-expanders)
`(,(assoc mat .row-major-mref-expanders) ,@args)
whole)))
,@body)))))ok, this seems to work as expected:
(defmacro with-typed-mref ((z element-type) &body body &environment env)
(let ((vals (gensym "MATRIX-")))
`(let ((,vals (matrix-vals ,z)))
(declare (type (simple-array ,element-type *) ,vals))
(macrolet ((mref (&whole whole mat &rest args)
(if (eql ',z mat)
`(aref ,',vals ,@args)
(macroexpand whole ,env)))
(row-major-mref (&whole whole mat &rest args)
(if (eql ',z mat)
`(row-major-aref ,',vals ,@args)
(macroexpand whole ,env))))
,@body))))