| Paste number 34363: | slyrus |
| Pasted by: | matrix macro hackery |
| 2 years, 10 hours ago | |
| #lisp | |
| Paste contents: |
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)))) |
Annotations for this paste:
| Annotation number 1: | the final product |
| Pasted by: | slyrus |
| 2 years, 9 hours ago | |
| Paste contents: |
| 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)))) |
| Annotation number 2: | no, this isn't right... |
| Pasted by: | slyrus |
| 2 years, 8 hours ago | |
| Paste contents: |
| 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))))) |
| Annotation number 3: | seems to work for me |
| Pasted by: | cmm |
| 2 years, 8 hours ago | |
| Paste contents: |
| (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))))))) |
| Annotation number 4: | pkhuong, what am I doing wrong? |
| Pasted by: | slyrus |
| 2 years, 6 hours ago | |
| Paste contents: |
| (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))))) |
| Annotation number 5: | the (next) final product |
| Pasted by: | slyrus |
| 2 years, 6 hours ago | |
| Paste contents: |
| (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))))) |