Menu
▾
▴
matlisp-commit
|
From: Akshay S. <ak...@us...> - 2012-08-03 03:51:57
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".
The branch, tensor has been updated
via b9bf26aaa85df12dec80c1c5b822d8821ed6e9df (commit)
via fbb318b4ac5ed7192722ad350298173c4d391a6b (commit)
via 5649455cf8b1d1c0f073d52bda626d393dab67c3 (commit)
via a640a37462d29cefa33c54e9e08c89ded77f29d3 (commit)
via 05cac9e6e247823c2fc6f058da9b3904983e1edb (commit)
via a4355472b2268ce43bafae38350d0e76f186c953 (commit)
via a922933e28c83cbbc1bf9a2dc7ae3341b76fb2cc (commit)
from 8ccded8d5db3d1918b7af875f4dbddd16dc75f28 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit b9bf26aaa85df12dec80c1c5b822d8821ed6e9df
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Aug 3 09:16:59 2012 +0530
o Added idxv back.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 784d858..a1898e7 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -30,6 +30,9 @@
(make-array (length contents) :element-type 'index-type
:initial-contents contents))
+(definline idxv (&rest contents)
+ (apply #'make-index-store contents))
+
;;
(defclass standard-tensor ()
((rank
commit fbb318b4ac5ed7192722ad350298173c4d391a6b
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Aug 3 09:14:24 2012 +0530
o Added test conditions in make-tensor-maker to create a matrix instance
when rank = 2, and a vector when rank = 1. "change-class" inside the initilize
instance of standard-tensor, in the earlier scheme was too slow.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 2fbe3f8..784d858 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -77,7 +77,6 @@
:documentation "The actual storage for the tensor."))
(:documentation "Basic tensor class."))
-;;
(defclass standard-matrix (standard-tensor)
((rank
:accessor rank
@@ -86,6 +85,7 @@
:documentation "For a matrix, rank = 2."))
(:documentation "Basic matrix class."))
+;;
(defmethod initialize-instance :after ((matrix standard-matrix) &rest initargs)
(declare (ignore initargs))
(mlet*
@@ -293,8 +293,9 @@
(let-typed ((stds (allocate-index-store rank) :type index-store-vector))
(setf (strides tensor) stds)
(very-quickly
- (loop :for i :downfrom (1- rank) :to 0
- :for st = 1 :then (the index-type (* st (aref dims i)))
+ (loop
+ :for i :downfrom (1- rank) :to 0
+ :and st = 1 :then (the index-type (* st (aref dims i)))
:do (setf (aref stds i) st)))))
;;
(mlet* ((stds (strides tensor) :type index-store-vector)
@@ -313,16 +314,7 @@
(cond
((<= ns 0) (error 'tensor-invalid-dimension-value :argument i :dimension ns :tensor tensor))
((< st 0) (error 'tensor-invalid-stride-value :argument i :stride st :tensor tensor))))))
- (setf (number-of-elements tensor) (reduce #'* dims))
- (cond
- ((= rank 2)
- (let ((cocl (getf (get-tensor-counterclass (class-name (class-of tensor))) :matrix)))
- (assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
- (change-class tensor cocl)))
- ((= rank 1)
- (let ((cocl (getf (get-tensor-counterclass (class-name (class-of tensor))) :vector)))
- (assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
- (change-class tensor cocl))))))
+ (setf (number-of-elements tensor) (reduce #'* dims))))
;;
(defgeneric tensor-store-ref (tensor store-idx)
@@ -426,7 +418,7 @@
;;
(defun tensor-type-p (tensor subscripts)
-"
+ "
Syntax
======
(tensor-type-p tensor subscripts)
@@ -447,7 +439,7 @@
Also does symbolic association; checking for
a square matrix:
> (tensor-type-p ten '(a a))
-"
+ "
(declare (type standard-tensor tensor))
(mlet* (((rank dims) (slot-values tensor '(rank dimensions))
:type (index-type index-store-vector)))
@@ -470,13 +462,13 @@
nil)))))))
(parse-sub subscripts 0)))))
-(definline vector-p (tensor)
- (declare (type standard-tensor tensor))
- (tensor-type-p tensor '(*)))
+(definline matrix-p (ten)
+ (declare (type standard-tensor ten))
+ (= (slot-value ten 'rank) 2))
-(definline matrix-p (tensor)
- (declare (type standard-tensor tensor))
- (tensor-type-p tensor '(* *)))
+(definline vector-p (ten)
+ (declare (type standard-tensor ten))
+ (= (slot-value ten 'rank) 1))
(defun square-p (tensor)
(let* ((rank (rank tensor))
@@ -560,20 +552,12 @@
(t
(error 'parser-error :message "Error parsing subscript-list.")))))))
(multiple-value-bind (nhd ndim nstd) (sub-tread 0 subscripts hd nil nil)
- (let ((nrnk (length ndim)))
- (declare (type index-type nrnk))
- (cond
- ((null ndim) (tensor-store-ref tensor nhd))
- ((= nrnk 1) (let ((cocl (getf (get-tensor-counterclass (class-name (class-of tensor))) :vector)))
- (assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
- (make-instance cocl
- :parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (make-index-store ndim) :strides (make-index-store nstd))))
- ((= nrnk 2) (let ((cocl (getf (get-tensor-counterclass (class-name (class-of tensor))) :matrix)))
- (assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
- (make-instance cocl
- :parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (make-index-store ndim) :strides (make-index-store nstd))))
- (t (make-instance (class-name (class-of tensor))
- :parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (make-index-store ndim) :strides (make-index-store nstd)))))))))
+ (if (null ndim) (tensor-store-ref tensor nhd)
+ (make-instance
+ (let ((nrnk (length ndim)))
+ (if (> nrnk 2) (class-name (class-of tensor))
+ (let ((cocl (get-tensor-counterclass (class-name (class-of tensor)))))
+ (assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
+ (ecase nrnk (2 (getf cocl :matrix)) (1 (getf cocl :vector))))))
+ :parent-tensor tensor :store (store tensor) :head nhd
+ :dimensions (make-index-store ndim) :strides (make-index-store nstd)))))))
diff --git a/src/level-1/realimag.lisp b/src/level-1/realimag.lisp
index 266bb95..ec51f8a 100644
--- a/src/level-1/realimag.lisp
+++ b/src/level-1/realimag.lisp
@@ -43,7 +43,7 @@
"
(etypecase tensor
(real-tensor tensor)
- (complex-tensor (make-instance 'real-tensor
+ (complex-tensor (make-instance (ecase (rank tensor) (2 'real-matrix) (1 'real-vector) (t 'real-tensor))
:parent-tensor tensor :store (store tensor)
:dimensions (dimensions tensor)
:strides (map 'index-store-vector #'(lambda (x) (* 2 x)) (strides tensor))
@@ -65,7 +65,7 @@
"
(etypecase tensor
(real-tensor tensor)
- (complex-tensor (make-instance 'real-tensor
+ (complex-tensor (make-instance (ecase (rank tensor) (2 'real-matrix) (1 'real-vector) (t 'real-tensor))
:parent-tensor tensor :store (store tensor)
:dimensions (dimensions tensor)
:strides (map 'index-store-vector #'(lambda (x) (* 2 x)) (strides tensor))
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index 51fa64b..3933496 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -1,15 +1,19 @@
(in-package #:matlisp)
(defmacro make-tensor-maker (func-name (tensor-class))
- (let ((opt (get-tensor-class-optimization tensor-class)))
+ (let ((opt (get-tensor-class-optimization tensor-class))
+ (cocl (get-tensor-counterclass tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (assert cocl nil 'tensor-cannot-find-counter-class :tensor-class tensor-class)
`(defun ,func-name (&rest args)
(labels ((make-dims (dims)
(declare (type cons dims))
(let* ((vdim (make-index-store dims))
(ss (reduce #'* vdim))
- (store (,(getf opt :store-allocator) ss)))
- (make-instance ',tensor-class :store store :dimensions vdim)))
+ (store (,(getf opt :store-allocator) ss))
+ (rnk (length vdim)))
+ (make-instance (case rnk (2 ',(getf cocl :matrix)) (1 ',(getf cocl :vector)) (t ',tensor-class))
+ :store store :dimensions vdim)))
(make-from-array (arr)
(declare (type (array * *) arr))
(let* ((ret (make-dims (array-dimensions arr)))
commit 5649455cf8b1d1c0f073d52bda626d393dab67c3
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Aug 2 20:06:20 2012 +0530
o Replaced reference to row-stride in blas-helpers.lisp
diff --git a/src/base/blas-helpers.lisp b/src/base/blas-helpers.lisp
index 94d5e21..00f8bc6 100644
--- a/src/base/blas-helpers.lisp
+++ b/src/base/blas-helpers.lisp
@@ -38,8 +38,8 @@
(defun blas-matrix-compatible-p (matrix op)
(declare (type standard-matrix matrix))
- (let ((rs (row-stride matrix))
- (cs (col-stride matrix)))
+ (let ((rs (aref (strides matrix) 0))
+ (cs (aref (strides matrix) 1)))
(declare (type index-type rs cs))
(cond
((= cs 1) (values :row-major rs (fortran-nop op)))
commit a640a37462d29cefa33c54e9e08c89ded77f29d3
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Aug 2 00:16:03 2012 +0530
o Saving changes. Inline functions.
diff --git a/packages.lisp b/packages.lisp
index 1bded66..2d65f54 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -75,6 +75,8 @@
#:format-to-string #:string+
#:linear-array-type
#:list-dimensions
+ #:lvec-foldl #:lvec-foldr #:lvec-max #:lvec-min #:lvec-eq
+ #:lvec->list #:lvec->list!
;;Macros
#:when-let #:if-let #:if-ret #:with-gensyms #:let-rec
#:mlet* #:make-array-allocator #:let-typed
diff --git a/src/base/generic-copy.lisp b/src/base/generic-copy.lisp
index 4445153..d560d93 100644
--- a/src/base/generic-copy.lisp
+++ b/src/base/generic-copy.lisp
@@ -48,7 +48,7 @@
(let ((lst (make-list (array-rank to))))
(mod-dotimes (idx (make-index-store (array-dimensions to)))
do (progn
- (idx->list! idx lst)
+ (lvec->list! idx lst)
(setf (apply #'aref to lst) (apply #'aref from lst)))))
to)
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index d7e9d02..2fbe3f8 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -17,18 +17,18 @@
=======
Allocates index storage.")
-(defun make-index-store (&rest contents)
-"
+(definline make-index-store (contents)
+ "
Syntax
======
(MAKE-INDEX-STORE &rest CONTENTS)
Purpose
=======
- Allocates index storage with initial elements from the list CONTENTS."
- (let ((size (length contents)))
- (make-array size :element-type 'index-type
- :initial-contents contents)))
+ Allocates index storage with initial elements from the list CONTENTS.
+ "
+ (make-array (length contents) :element-type 'index-type
+ :initial-contents contents))
;;
(defclass standard-tensor ()
@@ -273,14 +273,14 @@
;;
(defmethod initialize-instance :before ((tensor standard-tensor) &rest initargs)
- (let ((dims (getf initargs :dimensions)))
- (assert (getf initargs :dimensions) nil 'invalid-arguments :argnum :dimensions
- :message "Dimensions are necessary for creating the tensor object.")
- (when (consp dims)
- (setf (getf initargs :dimensions) (apply #'make-index-store dims)))))
+ (assert (getf initargs :dimensions) nil 'invalid-arguments :argnum :dimensions
+ :message "Dimensions are necessary for creating the tensor object."))
(defmethod initialize-instance :after ((tensor standard-tensor) &rest initargs)
(declare (ignore initargs))
+ (let ((dims (dimensions tensor)))
+ (when (consp dims)
+ (setf (slot-value tensor 'dimensions) (make-index-store dims))))
(mlet*
(((dims hd ss) (slot-values tensor '(dimensions head store-size))
:type (index-store-vector index-type index-type))
@@ -290,13 +290,12 @@
;;Row-ordered by default.
(unless (and (slot-boundp tensor 'strides)
(= (length (strides tensor)) rank))
- (mlet* ((stds (allocate-index-store rank)
- :type index-store-vector))
- (setf (strides tensor) stds)
- (do ((i (1- rank) (1- i))
- (st 1 (* st (aref dims i))))
- ((< i 0))
- (setf (aref stds i) st))))
+ (let-typed ((stds (allocate-index-store rank) :type index-store-vector))
+ (setf (strides tensor) stds)
+ (very-quickly
+ (loop :for i :downfrom (1- rank) :to 0
+ :for st = 1 :then (the index-type (* st (aref dims i)))
+ :do (setf (aref stds i) st)))))
;;
(mlet* ((stds (strides tensor) :type index-store-vector)
(L-idx (store-indexing-vec (map `index-store-vector #'1- dims) hd stds dims) :type index-type))
@@ -569,12 +568,12 @@
(assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
(make-instance cocl
:parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (apply #'make-index-store ndim) :strides (apply #'make-index-store nstd))))
+ :dimensions (make-index-store ndim) :strides (make-index-store nstd))))
((= nrnk 2) (let ((cocl (getf (get-tensor-counterclass (class-name (class-of tensor))) :matrix)))
(assert cocl nil 'tensor-cannot-find-counter-class :tensor-class (class-name (class-of tensor)))
(make-instance cocl
:parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (apply #'make-index-store ndim) :strides (apply #'make-index-store nstd))))
+ :dimensions (make-index-store ndim) :strides (make-index-store nstd))))
(t (make-instance (class-name (class-of tensor))
:parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (apply #'make-index-store ndim) :strides (apply #'make-index-store nstd)))))))))
+ :dimensions (make-index-store ndim) :strides (make-index-store nstd)))))))))
diff --git a/src/classes/real-tensor.lisp b/src/classes/real-tensor.lisp
index f2c13a8..e7b8602 100644
--- a/src/classes/real-tensor.lisp
+++ b/src/classes/real-tensor.lisp
@@ -41,10 +41,10 @@ Allocates real storage. Default initial-element = 0d0.")
;;
(defmethod initialize-instance ((tensor real-tensor) &rest initargs)
(if (getf initargs :store)
- (setf (store-size tensor) (length (getf initargs :store)))
+ (setf (slot-value tensor 'store-size) (length (getf initargs :store)))
(let ((size (reduce #'* (getf initargs :dimensions))))
- (setf (store tensor) (allocate-real-store size)
- (store-size tensor) size)))
+ (setf (slot-value tensor 'store) (allocate-real-store size)
+ (slot-value tensor 'store-size) size)))
(call-next-method))
;;
diff --git a/src/ffi/foreign-vector.lisp b/src/ffi/foreign-vector.lisp
index ed036c3..f70c459 100644
--- a/src/ffi/foreign-vector.lisp
+++ b/src/ffi/foreign-vector.lisp
@@ -112,10 +112,3 @@
,@body))
`(with-fortran-matrix ,(car array-list)
,@body)))
-
-(defmacro make-array-allocator (allocator-name type init &optional (doc ""))
- `(definline ,allocator-name (size &optional (initial-element ,init))
- ,@(unless (string= doc "")
- `(,doc))
- (make-array size
- :element-type ,type :initial-element initial-element)))
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index ce870da..3e13987 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -133,7 +133,7 @@
is stored in Y and Y is returned.
")
(:method :before ((alpha number) (x standard-tensor) (y standard-tensor))
- (assert (idx= (dimensions x) (dimensions y)) nil
+ (assert (lvec-eq (dimensions x) (dimensions y) #'=) nil
'tensor-dimension-mismatch))
(:method ((alpha number) (x complex-tensor) (y real-tensor))
(error 'coercion-error :from 'complex-tensor :to 'real-tensor)))
@@ -185,17 +185,17 @@
X,Y must have the same dimensions.
")
(:method :before ((alpha number) (x standard-tensor) (y standard-tensor))
- (unless (idx= (dimensions x) (dimensions y))
+ (unless (lvec-eq (dimensions x) (dimensions y) #'=)
(error 'tensor-dimension-mismatch))))
(defmethod axpy ((alpha number) (x real-tensor) (y real-tensor))
(let ((ret (if (complexp alpha)
- (copy! y (apply #'make-complex-tensor (idx->list (dimensions y))))
+ (copy! y (apply #'make-complex-tensor (lvec->list (dimensions y))))
(copy y))))
(axpy! alpha x ret)))
(defmethod axpy ((alpha number) (x complex-tensor) (y real-tensor))
- (let ((ret (copy! y (apply #'make-complex-tensor (idx->list (dimensions y))))))
+ (let ((ret (copy! y (apply #'make-complex-tensor (lvec->list (dimensions y))))))
(axpy! alpha y ret)))
(defmethod axpy ((alpha number) (x real-tensor) (y complex-tensor))
@@ -212,7 +212,7 @@
(defmethod axpy ((alpha number) (x (eql nil)) (y real-tensor))
(let ((ret (if (complexp alpha)
- (copy! y (apply #'make-complex-tensor (idx->list (dimensions y))))
+ (copy! y (apply #'make-complex-tensor (lvec->list (dimensions y))))
(copy y))))
(axpy! alpha nil ret)))
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index 24e087f..1afffce 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -113,7 +113,7 @@
the type of Y. For example,
a COMPLEX-MATRIX cannot be copied to a
REAL-MATRIX but the converse is possible."
- (assert (idx= (dimensions x) (dimensions y)) nil
+ (assert (lvec-eq (dimensions x) (dimensions y) #'=) nil
'tensor-dimension-mismatch))
(defmethod copy! ((x standard-tensor) (y standard-tensor))
@@ -164,14 +164,14 @@
"
(declare (type standard-tensor tensor))
(let* ((dims (dimensions tensor))
- (ret (make-array (idx->list dims)
+ (ret (make-array (lvec->list dims)
:element-type (if-ret (getf (get-tensor-class-optimization (class-name (class-of tensor))) :element-type)
(error 'tensor-cannot-find-optimization :tensor-class (class-name (class-of tensor)))))))
(declare (type index-store-vector dims))
(let ((lst (make-list (rank tensor))))
(very-quickly
(mod-dotimes (idx dims)
- do (setf (apply #'aref ret (idx->list! idx lst)) (tensor-ref tensor idx))))
+ do (setf (apply #'aref ret (lvec->list! idx lst)) (tensor-ref tensor idx))))
ret)))
(defmethod copy! :before ((x standard-tensor) (y array))
@@ -183,7 +183,7 @@
(assert (and
(= (rank x) (array-rank y))
(reduce #'(lambda (x y) (and x y))
- (mapcar #'= (idx->list (dimensions x)) (array-dimensions y))))
+ (mapcar #'= (lvec->list (dimensions x)) (array-dimensions y))))
nil 'dimension-mismatch))
(defmethod copy! ((x real-tensor) (y array))
@@ -193,7 +193,7 @@
(mod-dotimes (idx (dimensions x))
with (linear-sums
(of-x (strides x) (head x)))
- do (setf (apply #'aref y (idx->list! idx lst))
+ do (setf (apply #'aref y (lvec->list! idx lst))
(aref sto-x of-x)))))
y)
@@ -204,7 +204,7 @@
(mod-dotimes (idx (dimensions x))
with (linear-sums
(of-x (strides x) (head x)))
- do (setf (apply #'aref y (idx->list! idx lst))
+ do (setf (apply #'aref y (lvec->list! idx lst))
(complex (aref sto-x (* 2 of-x)) (aref sto-x (1+ (* 2 of-x))))))))
y)
@@ -216,8 +216,8 @@
:given (array-element-type x) :expected (element-type y))
(assert (and
(= (array-rank x) (rank y))
- (reduce #'(lambda (x y) (and x y))
- (mapcar #'= (array-dimensions x) (idx->list (dimensions y)))))
+ (reduce #'(lambda (x y) (= x y))
+ (mapcar #'= (array-dimensions x) (lvec->list (dimensions y)))))
nil 'dimension-mismatch))
(defmethod copy! ((x array) (y real-tensor))
@@ -227,7 +227,7 @@
(mod-dotimes (idx (dimensions y))
with (linear-sums
(of-y (strides y) (head y)))
- do (setf (aref sto-y of-y) (apply #'aref x (idx->list! idx lst))))))
+ do (setf (aref sto-y of-y) (apply #'aref x (lvec->list! idx lst))))))
y)
(defmethod copy! ((x array) (y complex-tensor))
@@ -237,7 +237,7 @@
(mod-dotimes (idx (dimensions y))
with (linear-sums
(of-y (strides y) (head y)))
- do (let-typed ((ele (apply #'aref x (idx->list! idx lst)) :type complex-type))
+ do (let-typed ((ele (apply #'aref x (lvec->list! idx lst)) :type complex-type))
(setf (aref sto-y (* 2 of-y)) (realpart ele)
(aref sto-y (1+ (* 2 of-y))) (imagpart ele))))))
y)
@@ -246,12 +246,12 @@
;;Generic function defined in src;base;generic-copy.lisp
(defmethod copy ((tensor real-tensor))
- (let* ((ret (apply #'make-real-tensor (idx->list (dimensions tensor)))))
+ (let* ((ret (apply #'make-real-tensor (lvec->list (dimensions tensor)))))
(declare (type real-tensor ret))
(copy! tensor ret)))
(defmethod copy ((tensor complex-tensor))
- (let* ((ret (apply #'make-complex-tensor (idx->list (dimensions tensor)))))
+ (let* ((ret (apply #'make-complex-tensor (lvec->list (dimensions tensor)))))
(declare (type complex-tensor ret))
(copy! tensor ret)))
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index 15bf751..8b777ee 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -131,7 +131,7 @@
")
(:method :before ((x standard-vector) (y standard-vector) &optional (conjugate-p t))
(declare (ignore conjugate-p))
- (unless (idx= (dimensions x) (dimensions y))
+ (unless (lvec-eq (dimensions x) (dimensions y) #'=)
(error 'tensor-dimension-mismatch))))
(defmethod dot ((x number) (y number) &optional (conjugate-p t))
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index 5bdb664..15dfde7 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -108,7 +108,7 @@
(scal! alpha result)))
(defmethod scal ((alpha complex) (x real-tensor))
- (let* ((result (apply #'make-complex-tensor (idx->list (dimensions x)))))
+ (let* ((result (apply #'make-complex-tensor (lvec->list (dimensions x)))))
(declare (type complex-tensor result))
(copy! x result)
(scal! alpha result)))
diff --git a/src/level-1/swap.lisp b/src/level-1/swap.lisp
index 3d5fa31..081f8c3 100644
--- a/src/level-1/swap.lisp
+++ b/src/level-1/swap.lisp
@@ -62,7 +62,7 @@
;;Generic function in src;base;generic-swap.lisp
(defmethod swap! :before ((x standard-tensor) (y standard-tensor))
- (assert (idx= (dimensions x) (dimensions y)) nil
+ (assert (lvec-eq (dimensions x) (dimensions y) #'=) nil
'tensor-dimension-mismatch))
(defmethod swap! ((x complex-tensor) (y real-tensor))
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index e06b632..51fa64b 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -13,14 +13,15 @@
(make-from-array (arr)
(declare (type (array * *) arr))
(let* ((ret (make-dims (array-dimensions arr)))
- (st-r (store ret)))
+ (st-r (store ret))
+ (lst (make-list (rank ret))))
(declare (type ,tensor-class ret)
(type ,(linear-array-type (getf opt :store-type)) st-r))
(very-quickly
(mod-dotimes (idx (dimensions ret))
with (linear-sums
(of-r (strides ret) (head ret)))
- do ,(funcall (getf opt :value-writer) `(,(getf opt :coercer) (apply #'aref arr (idx->list idx))) 'st-r 'of-r)))
+ do ,(funcall (getf opt :value-writer) `(,(getf opt :coercer) (apply #'aref arr (lvec->list! idx lst))) 'st-r 'of-r)))
ret))
(make-from-list (lst)
(let* ((ret (make-dims (list-dimensions lst)))
@@ -50,3 +51,4 @@
;;Had to move it here in the wait for copy!
(definline sub-tensor (tensor subscripts)
(copy (sub-tensor~ tensor subscripts)))
+
diff --git a/src/utilities/lvec.lisp b/src/utilities/lvec.lisp
index 4620d9a..a46edf0 100644
--- a/src/utilities/lvec.lisp
+++ b/src/utilities/lvec.lisp
@@ -1,42 +1,42 @@
(in-package #:matlisp-utilities)
-(defun-compiler-macro lvec-foldl (func vec)
+(definline lvec-foldl (func vec)
(declare (type vector))
(loop
:for i :of-type fixnum :from 0 :below (length vec)
:for ret = (aref vec 0) :then (funcall func (aref vec i) ret)
:finally (return ret)))
-(defun-compiler-macro lvec-foldr (func vec)
+(definline lvec-foldr (func vec)
(declare (type vector))
(loop
:for i :of-type fixnum :downfrom (1- (length vec)) :to 0
:for ret = (aref vec (1- (length vec))) :then (funcall func (aref vec i) ret)
:finally (return ret)))
-(defun-compiler-macro lvec-max (vec)
+(definline lvec-max (vec)
(declare (type vector vec))
(loop :for ele :across vec
:for idx :of-type fixnum = 0 :then (+ idx 1)
:with max :of-type fixnum = (aref vec 0)
- :with max-idx :of-type index-type = 0
+ :with max-idx :of-type fixnum = 0
:do (when (> ele max)
(setf max ele
max-idx idx))
:finally (return (values max max-idx))))
-(defun-compiler-macro lvec-min (vec)
+(definline lvec-min (vec)
(declare (type vector vec))
(loop :for ele :across vec
:for idx :of-type fixnum = 0 :then (+ idx 1)
:with min :of-type fixnum = (aref vec 0)
- :with min-idx :of-type index-type = 0
+ :with min-idx :of-type fixnum = 0
:do (when (< ele min)
(setf min ele
min-idx idx))
:finally (return (values min min-idx))))
-(defun-compiler-macro lvec-eq (va vb &optional (test #'eq))
+(definline lvec-eq (va vb &optional (test #'eq))
(declare (type vector va vb))
(let ((la (length va))
(lb (length vb)))
@@ -48,12 +48,12 @@
:do (return nil)
:finally (return t)))))
-(defun-compiler-macro lvec->list (va)
+(definline lvec->list (va)
(declare (type vector va))
(loop :for ele :across va
:collect ele))
-(defun-compiler-macro lvec->list! (va la)
+(definline lvec->list! (va la)
(declare (type vector va)
(type list la))
(loop
diff --git a/src/utilities/macros.lisp b/src/utilities/macros.lisp
index 9eef3f4..6871843 100644
--- a/src/utilities/macros.lisp
+++ b/src/utilities/macros.lisp
@@ -59,6 +59,13 @@
`(progn
,@body))))
+(defmacro make-array-allocator (allocator-name type init &optional doc)
+ `(definline ,allocator-name (size &optional (initial-element ,init))
+ ,@(unless (null doc)
+ `(,doc))
+ (make-array size
+ :element-type ,type :initial-element initial-element)))
+
(defmacro let-typed (bindings &rest body)
"
This macro works basically like let, but also allows type-declarations
@@ -182,7 +189,7 @@
`(with-gensyms (a b c)
`(let ((,a 1) (,b 2) (,c 3))
(+ ,a ,b ,c))))
- => (LET ((A (GENSYM "A")) (B (GENSYM "B")) (C (GENSYM "C")))
+ => (LET ((A (GENSYM \"A\")) (B (GENSYM \"B\")) (C (GENSYM \"C\")))
`(LET ((,A 1) (,B 2) (,C 3))
(+ ,A ,B ,C)))
@end lisp
@@ -318,42 +325,7 @@
(destructuring-bind (labd args &rest body) lambda-func
(assert (eq labd 'lambda))
`(lambda ,args ,@(cdr (unquote-args body args)))))
-
-(defmacro defun-compiler-macro (func-name (&rest args) &body body)
- "
- Creates a compiler macro mirroring the function definition, this helps
- the compiler produce leaner code when argument types are better known in the
- local environment during compile time.
- DO NOT USE backquotes in the function definition, it will likely be mucked up.
-
- Example:
- @lisp
- > (macroexpand-1
- `(defun-compiler-macro lvec->list (va)
- (declare (type vector va))
- (loop :for ele :across va
- :collect ele)))
- => (PROGN
- (DEFUN LVEC->LIST (VA)
- (DECLARE (TYPE VECTOR VA))
- (LOOP :FOR ELE :ACROSS VA
- :COLLECT ELE))
- (DEFINE-COMPILER-MACRO LVEC->LIST (VA)
- (LIST 'LOCALLY (LIST 'DECLARE (LIST 'TYPE 'VECTOR VA))
- (LIST 'LOOP ':FOR 'ELE ':ACROSS VA ':COLLECT 'ELE))))
- T
- @end lisp
- "
- `(progn
- (defun ,func-name (,@args)
- ,@body)
- (define-compiler-macro ,func-name (,@args)
- (list 'locally
- ,@(cdr (unquote-args body (loop
- :for arg :in args
- :unless (and (symbolp arg) (string= (aref (symbol-name arg) 0) #\&))
- :collect (if (consp arg) (first arg) arg))))))))
-
+
(defmacro looped-mapcar ((func lst) &rest body)
"
A macro to use when caught between the efficiency of imperative looping, and
@@ -491,3 +463,5 @@
"
`(with-optimization (:speed 1)
,@forms))
+
+
diff --git a/tests/loopy-tests.lisp b/tests/loopy-tests.lisp
index e17a747..2ed4ed1 100644
--- a/tests/loopy-tests.lisp
+++ b/tests/loopy-tests.lisp
@@ -32,6 +32,9 @@
(time (axpy! 1d0 x y))
t))
+(definline idxv (&rest dims)
+ (make-array (length dims) :element-type 'index-type :initial-contents dims))
+
(defun test-mm-lisp (n)
(let ((t-a (make-real-tensor n n))
(t-b (make-real-tensor n n))
@@ -52,7 +55,7 @@
(hd-a (head t-a))
(hd-b (head t-b))
(hd-c (head t-c)))
- (declare (type (real-array *) st-a st-b st-c)
+ (declare (type real-store-vector st-a st-b st-c)
(type index-type rstrd-a cstrd-a rstrd-b cstrd-b rstrd-c cstrd-c nr-c
nc-c nc-a hd-a hd-b hd-c))
(mod-dotimes (idx (dimensions t-a))
@@ -63,7 +66,7 @@
do (setf (aref st-a of-a) (random 1d0)
(aref st-b of-b) (random 1d0)
(aref st-c of-c) 0d0))
- (time
+ (time
(very-quickly
(loop repeat nr-c
for rof-a of-type index-type = hd-a then (+ rof-a rstrd-a)
@@ -76,14 +79,27 @@
for of-b of-type index-type = cof-b then (+ of-b rstrd-b)
summing (* (aref st-a of-a) (aref st-b of-b)) into sum of-type real-type
finally (setf (aref st-c of-c) sum))))
- #+nil(mod-dotimes (idx (dimensions t-c))
+ #+nil
+ (mod-dotimes (idx (dimensions t-c))
with (loop-order :row-major)
with (linear-sums
- (of-a (idxv (row-stride t-a) 0) (head t-a))
- (of-b (idxv 0 (col-stride t-b)) (head t-b))
+ (rof-a (idxv rstrd-a 0) (head t-a))
+ (cof-b (idxv 0 cstrd-b) (head t-b))
(of-c (strides t-c) (head t-c)))
-...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X