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
               ;; no need for the MREF macrolet, it already exists
               `(symbol-macrolet ((,+var-alist-sym+
                                   ,(acons z vals val-alist)))
                  ,@body)
               ;; first contour
               `(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))))