Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-117-g9c1d88d
|
From: Akshay S. <ak...@us...> - 2012-07-06 15:31:25
|
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 9c1d88d3e0101d6764260ba190f852435335a5e2 (commit)
via e09abd6390492ec30a362f91a286558388cd7bec (commit)
from 9bb4a65ad72358711bb82ff45cded5462e739def (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 9c1d88d3e0101d6764260ba190f852435335a5e2
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Jul 6 20:56:47 2012 +0530
Added a redundant clause to convert rank-2 tensors into matrices.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 0adb655..3b5c8e1 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -540,13 +540,20 @@
:given (type-of csub) :expected 'index-type)
(sub-tread (1+ i) (cdr subs) (+ nhd (* csub (aref stds i))) ndims nstds)))))))
(multiple-value-bind (nhd ndim nstd) (sub-tread 0 subscripts hd nil nil)
- (cond
- ((null ndim) (tensor-store-ref tensor nhd))
- ((= (length ndim) 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))))
- (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))))))))
+ (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)))))))))
commit e09abd6390492ec30a362f91a286558388cd7bec
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Jul 6 20:51:41 2012 +0530
o Got rid of the tensor-sub-classes.
Checking whether 'parent-tensor slot is bound
is much more easier.
o Added vector subclass
o Classes is now automatically changed after initialization.
If rank = 2 {matrix} or rank = 1 {vector}.
diff --git a/packages.lisp b/packages.lisp
index 264a6da..781846a 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -54,7 +54,7 @@
#:tensor-invalid-head-value #:head
#:tensor-invalid-dimension-value #:argument #:dimension
#:tensor-invalid-stride-value #:argument #:stride
- #:tensor-cannot-find-sub-class #:tensor-class
+ #:tensor-cannot-find-counter-class #:tensor-class
#:tensor-cannot-find-optimization #:tensor-class
#:tensor-dimension-mismatch
))
diff --git a/src/base/blas-helpers.lisp b/src/base/blas-helpers.lisp
index ce40b7f..39de052 100644
--- a/src/base/blas-helpers.lisp
+++ b/src/base/blas-helpers.lisp
@@ -37,25 +37,26 @@
finally (return (aref sort-std 0))))))
-;; (defun blas-matrix-compatible-p (matrix &optional (op :n))
-;; (declare (optimize (safety 0) (speed 3))
-;; (type (or real-matrix complex-matrix) matrix))
-;; (mlet* (((rs cs) (slot-values matrix '(row-stride col-stride))
-;; :type (fixnum fixnum)))
-;; (cond
-;; ((= cs 1) (values :row-major rs (fortran-nop op)))
-;; ((= rs 1) (values :col-major cs (fortran-op op)))
-;; ;;Lets not confound lisp's type declaration.
-;; (t (values nil -1 "?")))))
+(defun blas-matrix-compatible-p (matrix &optional (op :n))
+ (declare (type standard-tensor matrix))
+ (let ((stds (strides matrix)))
+ (declare (type (index-array *) stds))
+ (if (not (= (array-dimension stds 0) 2)) nil
+ (let ((rs (aref stds 0))
+ (cs (aref stds 1)))
+ (declare (type index-type rs cs))
+ (cond
+ ((= cs 1) (values :row-major rs (fortran-nop op)))
+ ((= rs 1) (values :col-major cs (fortran-op op))))))))
-;; (definline fortran-op (op)
-;; (ecase op (:n "N") (:t "T")))
+(definline fortran-op (op)
+ (ecase op (:n "N") (:t "T")))
-;; (definline fortran-nop (op)
-;; (ecase op (:t "N") (:n "T")))
+(definline fortran-nop (op)
+ (ecase op (:t "N") (:n "T")))
-;; (defun fortran-snop (sop)
-;; (cond
-;; ((string= sop "N") "T")
-;; ((string= sop "T") "N")
-;; (t (error "Unrecognised fortran-op."))))
+(defun fortran-snop (sop)
+ (cond
+ ((string= sop "N") "T")
+ ((string= sop "T") "N")
+ (t (error "Unrecognised fortran-op."))))
diff --git a/src/base/loopy.lisp b/src/base/loopy.lisp
index 0948662..62254fe 100644
--- a/src/base/loopy.lisp
+++ b/src/base/loopy.lisp
@@ -212,7 +212,7 @@
;;list-dimensions does not parse the entire list, just goes through caaa..r's to find out the
;;dimensions if it is uniform.
(unless (< -1 (aref ,idx ,lst-rec-count-sym) (aref ,dims-sym ,lst-rec-count-sym))
- (error 'out-of-bounds-error :requested ,lst-rec-count-sym :bound (aref ,dims-sym ,lst-rec-count-sym)
+ (error 'out-of-bounds-error :requested (aref ,idx ,lst-rec-count-sym) :bound (aref ,dims-sym ,lst-rec-count-sym)
:message "Error in list-loop, given list is not uniform in dimensions."))
(if (consp (car ,lst-rec-lst-sym))
(,lst-rec-sym (1+ ,lst-rec-count-sym) (car ,lst-rec-lst-sym))
diff --git a/src/base/print.lisp b/src/base/print.lisp
index bcd5b19..7200306 100644
--- a/src/base/print.lisp
+++ b/src/base/print.lisp
@@ -105,5 +105,8 @@ of a matrix (default 0)
(defmethod print-object ((tensor standard-tensor) stream)
(print-unreadable-object (tensor stream :type t)
- (format stream "~A~%" (dimensions tensor))
+ (if (slot-boundp tensor 'parent-tensor)
+ (format stream "~A~,4T:DISPLACED~%" (dimensions tensor))
+ (format stream "~A~%" (dimensions tensor)))
(print-tensor tensor stream)))
+
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 2bd89c4..0adb655 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -48,6 +48,12 @@
:type index-type
:documentation "Total number of elements in the tensor.")
;;
+ (parent-tensor
+ :accessor parent-tensor
+ :initarg :parent-tensor
+ :type standard-tensor
+ :documentation "If the tensor is a view of another tensor, then this slot is bound.")
+ ;;
(head
:initarg :head
:initform 0
@@ -69,20 +75,70 @@
:documentation "The actual storage for the tensor."))
(:documentation "Basic tensor class."))
-(defclass standard-sub-tensor (standard-tensor)
- ((parent-tensor
- :initarg :parent-tensor
- :accessor parent-tensor))
- (:documentation "Basic sub-tensor class."))
+;;
+(defclass standard-matrix (standard-tensor)
+ ((rank
+ :accessor rank
+ :type index-type
+ :initform 2
+ :documentation "For a matrix, rank = 2."))
+ (:documentation "Basic matrix class."))
+
+(defmethod initialize-instance :after ((matrix standard-matrix) &rest initargs)
+ (declare (ignore initargs))
+ (mlet*
+ ((rank (rank matrix) :type index-type))
+ (unless (= rank 2)
+ (error 'tensor-not-matrix :rank rank :tensor matrix))))
+
+(defmethod update-instance-for-different-class :before ((old standard-tensor) (new standard-matrix) &rest initargs)
+ (declare (ignore initargs))
+ (unless (= (rank old) 2)
+ (error 'tensor-not-matrix :rank (rank old))))
;;
-(defparameter *sub-tensor-counterclass* (make-hash-table)
+(defclass standard-vector (standard-tensor)
+ ((rank
+ :accessor rank
+ :type index-type
+ :initform 1
+ :documentation "For a vector, rank = 1."))
+ (:documentation "Basic vector class."))
+
+(defmethod initialize-instance :after ((vector standard-vector) &rest initargs)
+ (declare (ignore initargs))
+ (mlet*
+ ((rank (rank vector) :type index-type))
+ (unless (= rank 1)
+ (error 'tensor-not-vector :rank rank :tensor vector))))
+
+(defmethod update-instance-for-different-class :before ((old standard-tensor) (new standard-vector) &rest initargs)
+ (declare (ignore initargs))
+ (unless (= (rank old) 1)
+ (error 'tensor-not-vector :rank (rank old))))
+
+;;
+(defparameter *tensor-counterclass* (make-hash-table)
"
- Contains the sub-tensor CLOS counterpart classes of every
- tensor class. This is used by sub-tensor~ and other in-place
- slicing functions to construct new objects.")
+ Contains the CLOS counterpart classes of every tensor class.
+ This is used to change the tensor class automatically to a matrix
+ and vector")
-(setf (gethash 'standard-tensor *sub-tensor-counterclass*) 'standard-sub-tensor)
+(defun get-tensor-counterclass (clname)
+ (declare (type symbol clname))
+ (let ((opt (gethash clname *tensor-counterclass*)))
+ (cond
+ ((null opt) nil)
+ ((symbolp opt)
+ (get-tensor-counterclass opt))
+ (t (values opt clname)))))
+
+(defun (setf get-tensor-counterclass) (value clname)
+ (setf (gethash clname *tensor-counterclass*) value))
+
+(setf (get-tensor-counterclass 'standard-tensor)
+ '(:matrix standard-matrix
+ :vector standard-vector))
;;
(defparameter *tensor-class-optimizations* (make-hash-table)
@@ -109,6 +165,9 @@
(get-tensor-class-optimization opt))
(t (values opt clname)))))
+(defun (setf get-tensor-class-optimization) (value clname)
+ (setf (gethash clname *tensor-class-optimizations*) value))
+
;; Akshay: I have no idea what this does, or why we want it
;; (inherited from standard-matrix.lisp
(defmethod make-load-form ((tensor standard-tensor) &optional env)
@@ -246,7 +305,16 @@
(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))))
+ (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))))))
;;
(defgeneric tensor-store-ref (tensor store-idx)
@@ -302,7 +370,7 @@
:coercer ',coercer
:element-type ',element-type
:store-type ',store-element-type)))
- (setf (gethash ',tensor-class *tensor-class-optimizations*) hst)))))
+ (setf (get-tensor-class-optimization ',tensor-class) hst)))))
;;
(defgeneric tensor-ref (tensor subscripts)
@@ -445,6 +513,8 @@
(dims (dimensions tensor))
(stds (strides tensor))
(hd (head tensor)))
+ (declare (type index-type rank hd)
+ (type (index-array *) dims stds))
(labels ((sub-tread (i subs nhd ndims nstds)
(if (null subs)
(progn
@@ -470,10 +540,13 @@
:given (type-of csub) :expected 'index-type)
(sub-tread (1+ i) (cdr subs) (+ nhd (* csub (aref stds i))) ndims nstds)))))))
(multiple-value-bind (nhd ndim nstd) (sub-tread 0 subscripts hd nil nil)
- (if (null ndim)
- (tensor-store-ref tensor nhd)
- (make-instance (if-ret (gethash (class-name (class-of tensor)) *sub-tensor-counterclass*)
- (error 'tensor-cannot-find-sub-class :tensor-class (class-of tensor)))
- :parent-tensor tensor :store (store tensor) :head nhd
- :dimensions (make-index-store ndim) :strides (make-index-store nstd)))))))
-
+ (cond
+ ((null ndim) (tensor-store-ref tensor nhd))
+ ((= (length ndim) 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))))
+ (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))))))))
diff --git a/src/classes/complex-tensor.lisp b/src/classes/complex-tensor.lisp
index c876f90..3ba3f1e 100644
--- a/src/classes/complex-tensor.lisp
+++ b/src/classes/complex-tensor.lisp
@@ -35,14 +35,17 @@
:type (complex-base-array *)))
(:documentation "Tensor class with complex elements."))
-(defclass complex-sub-tensor (complex-tensor standard-sub-tensor)
+(defclass complex-matrix (standard-matrix complex-tensor)
()
- (:documentation "Sub-tensor class with complex elements."))
+ (:documentation "Matrix class with complex elements."))
-;;Push the counter sub-class name into a hash-table so that we can
-;;refer to it later from class-ignorant functions.
-(setf (gethash 'complex-tensor *sub-tensor-counterclass*) 'complex-sub-tensor
- (gethash 'complex-sub-tensor *sub-tensor-counterclass*) 'complex-sub-tensor)
+(defclass complex-vector (standard-vector complex-tensor)
+ ()
+ (:documentation "Vector class with complex elements."))
+
+(setf (get-tensor-counterclass 'complex-tensor) '(:matrix complex-matrix :vector complex-vector)
+ (get-tensor-counterclass 'complex-matrix) 'complex-tensor
+ (get-tensor-counterclass 'complex-vector) 'complex-tensor)
;;
(defmethod initialize-instance ((tensor complex-tensor) &rest initargs)
@@ -77,12 +80,6 @@ Cannot hold complex numbers."))
(rotatef (aref tstore (* 2 tidx)) (aref fstore (* 2 fidx)))
(rotatef (aref tstore (1+ (* 2 tidx))) (aref fstore (1+ (* 2 fidx)))))))
-(setf (gethash 'complex-sub-tensor *tensor-class-optimizations*) 'complex-tensor)
-
-(defmethod (setf tensor-ref) ((value number) (tensor complex-tensor) subscripts)
- (let ((sto-idx (store-indexing subscripts tensor)))
- (setf (tensor-store-ref tensor sto-idx) (coerce-complex value))))
-
;;
(defmethod print-element ((tensor complex-tensor)
element stream)
@@ -92,3 +89,7 @@ Cannot hold complex numbers."))
"~11,5,,,,,'Eg"
"#C(~11,4,,,,,'Ee ~11,4,,,,,'Ee)")
realpart imagpart)))
+
+(defmethod (setf tensor-ref) ((value number) (tensor complex-tensor) subscripts)
+ (let ((sto-idx (store-indexing subscripts tensor)))
+ (setf (tensor-store-ref tensor sto-idx) (coerce-complex value))))
diff --git a/src/classes/matrix.lisp b/src/classes/matrix.lisp
index 49948e1..ad059aa 100644
--- a/src/classes/matrix.lisp
+++ b/src/classes/matrix.lisp
@@ -1,18 +1,7 @@
(in-package #:matlisp)
;;
-(defclass standard-matrix (standard-tensor)
- ((rank
- :accessor rank
- :type index-type
- :initform 2
- :documentation "For a matrix, rank = 2."))
- (:documentation "Basic matrix class."))
-
-(defmethod print-object ((tensor standard-matrix) stream)
- (print-unreadable-object (tensor stream :type t)
- (format stream "~A x ~A~%" (nrows tensor) (ncols tensor))
- (print-tensor tensor stream)))
+
(definline nrows (matrix)
(declare (type standard-matrix matrix))
@@ -37,12 +26,7 @@
(list (aref dims 0) (aref dims 1))))
;;
-(defmethod initialize-instance :after ((matrix standard-matrix) &rest initargs)
- (declare (ignore initargs))
- (mlet*
- ((rank (rank matrix) :type index-type))
- (unless (= rank 2)
- (error 'tensor-not-matrix :rank rank :tensor matrix))))
+
;;
(definline row-matrix-p (matrix)
@@ -99,35 +83,8 @@
matrix and a number"))
;;
-(defclass real-matrix (standard-matrix real-tensor)
- ()
- (:documentation "A class of matrices with real elements."))
-
-(defclass real-sub-matrix (real-matrix standard-sub-tensor)
- ()
- (:documentation "Sub-matrix class with real elements."))
-
-(setf (gethash 'real-matrix *sub-tensor-counterclass*) 'real-sub-matrix
- (gethash 'real-sub-matrix *sub-tensor-counterclass*) 'real-sub-matrix
- ;;
- (gethash 'real-matrix *tensor-class-optimizations*) 'real-tensor
- (gethash 'real-sub-matrix *tensor-class-optimizations*) 'real-tensor)
;;
-(defclass complex-matrix (standard-matrix complex-tensor)
- ()
- (:documentation "A class of matrices with complex elements."))
-
-(defclass complex-sub-matrix (complex-matrix standard-sub-tensor)
- ()
- (:documentation "Sub-matrix class with complex elements."))
-
-(setf (gethash 'complex-matrix *sub-tensor-counterclass*) 'complex-sub-matrix
- (gethash 'complex-sub-matrix *sub-tensor-counterclass*) 'complex-sub-matrix
- ;;
- (gethash 'complex-matrix *tensor-class-optimizations*) 'complex-tensor
- (gethash 'complex-sub-matrix *tensor-class-optimizations*) 'complex-tensor)
-
;;
(definline matrix-ref (matrix row &optional col)
diff --git a/src/classes/real-tensor.lisp b/src/classes/real-tensor.lisp
index 0db3b8f..89bfefc 100644
--- a/src/classes/real-tensor.lisp
+++ b/src/classes/real-tensor.lisp
@@ -23,21 +23,24 @@ Allocates real storage. Default initial-element = 0d0.")
:type (real-array *)))
(:documentation "Tensor class with real elements."))
-(defclass real-sub-tensor (real-tensor standard-sub-tensor)
+(defclass real-matrix (standard-matrix real-tensor)
()
- (:documentation "Sub-tensor class with real elements."))
+ (:documentation "A class of matrices with real elements."))
-;;Push the counter sub-class name into a hash-table so that we can
-;;refer to it later from class-ignorant functions.
-(setf (gethash 'real-tensor *sub-tensor-counterclass*) 'real-sub-tensor
- (gethash 'real-sub-tensor *sub-tensor-counterclass*) 'real-sub-tensor)
+(defclass real-vector (standard-vector real-tensor)
+ ()
+ (:documentation "A class of vector with real elements."))
+
+(setf (get-tensor-counterclass 'real-tensor) '(:matrix real-matrix :vector real-vector)
+ (get-tensor-counterclass 'real-matrix) 'real-tensor
+ (get-tensor-counterclass 'real-vector) 'real-tensor)
;;
(defmethod initialize-instance ((tensor real-tensor) &rest initargs)
(setf (store-size tensor) (length (getf initargs :store)))
(call-next-method))
-;;
+;;
(tensor-store-defs (real-tensor real-type real-type)
:store-allocator allocate-real-store
:coercer coerce-real
@@ -54,13 +57,11 @@ Allocates real storage. Default initial-element = 0d0.")
(lambda (fstore fidx tstore tidx)
(rotatef (aref tstore tidx) (aref fstore fidx))))
-(setf (gethash 'real-sub-tensor *tensor-class-optimizations*) 'real-tensor)
-
+;;
(defmethod (setf tensor-ref) ((value number) (tensor real-tensor) subscripts)
(let ((sto-idx (store-indexing subscripts tensor)))
(setf (tensor-store-ref tensor sto-idx) (coerce-real value))))
-;;
(defmethod print-element ((tensor real-tensor)
element stream)
(format stream "~11,5,,,,,'Eg" element))
diff --git a/src/conditions.lisp b/src/conditions.lisp
index 9864362..0a91466 100644
--- a/src/conditions.lisp
+++ b/src/conditions.lisp
@@ -67,7 +67,7 @@
((assumed :reader assumed :initarg :assumed)
(found :reader found :initarg :found))
(:documentation "Bounds are not uniform")
- (:method print-object ((c out-of-bounds-error) stream)
+ (:method print-object ((c non-uniform-bounds-error) stream)
(format stream "The bounds are not uniform, assumed bound : ~a, now found to be : ~a.~%" (assumed c) (found c))
(call-next-method)))
@@ -157,11 +157,11 @@ group-rank: ~a" (seq-len c) (group-rank c)))))
(:report (lambda (c stream)
(format stream "Stride of argument ~A must be >= 0, initialized with ~A." (argument c) (stride c)))))
-(define-condition tensor-cannot-find-sub-class (tensor-error)
+(define-condition tensor-cannot-find-counter-class (tensor-error)
((tensor-class :reader tensor-class :initarg :tensor-class))
- (:documentation "Cannot find sub-class of the given tensor class")
+ (:documentation "Cannot find the counter-class list of the given tensor class")
(:report (lambda (c stream)
- (format stream "Cannot find sub-class of the given tensor class: ~a." (tensor-class c)))))
+ (format stream "Cannot find the counter-class list of the given tensor class: ~a." (tensor-class c)))))
(define-condition tensor-cannot-find-optimization (tensor-error)
((tensor-class :reader tensor-class :initarg :tensor-class))
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index 35fa404..53be2cd 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -87,7 +87,7 @@
(defmethod axpy! ((alpha number) (x real-tensor) (y complex-tensor))
(let ((tmp (tensor-realpart~ y)))
- (declare (type real-sub-tensor tmp))
+ (declare (type real-tensor tmp))
(etypecase alpha
(cl:real (real-typed-axpy! (coerce-real alpha) x tmp))
(cl:complex
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index 76fc081..317c011 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -135,12 +135,12 @@
(defmethod copy! ((x real-tensor) (y complex-tensor))
;;Borrowed from realimag.lisp
- (let ((tmp (make-instance 'real-sub-tensor
+ (let ((tmp (make-instance 'real-tensor
:parent-tensor y :store (store y)
:dimensions (dimensions y)
:strides (map '(index-array *) #'(lambda (n) (* 2 n)) (strides y))
:head (the index-type (* 2 (head y))))))
- (declare (type real-sub-tensor tmp))
+ (declare (type real-tensor tmp))
(real-typed-copy! x tmp)
;;Increasing the head by 1 points us to the imaginary part.
(incf (head tmp))
diff --git a/src/level-1/realimag.lisp b/src/level-1/realimag.lisp
index 3a0bd0a..a042b94 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-sub-tensor
+ (complex-tensor (make-instance 'real-tensor
:parent-tensor tensor :store (store tensor)
:dimensions (dimensions tensor)
:strides (map '(index-array *) #'(lambda (x) (* 2 x)) (strides tensor))
@@ -65,7 +65,7 @@
"
(etypecase tensor
(real-tensor tensor)
- (complex-tensor (make-instance 'real-sub-tensor
+ (complex-tensor (make-instance 'real-tensor
:parent-tensor tensor :store (store tensor)
:dimensions (dimensions tensor)
:strides (map '(index-array *) #'(lambda (x) (* 2 x)) (strides tensor))
diff --git a/src/old/gemv.lisp b/src/level-2/gemv.lisp
similarity index 85%
rename from src/old/gemv.lisp
rename to src/level-2/gemv.lisp
index 4ce561b..d793da8 100644
--- a/src/old/gemv.lisp
+++ b/src/level-2/gemv.lisp
@@ -1,5 +1,40 @@
(in-package :matlisp)
+(defmacro generate-typed-copy! (func (tensor-class blas-func))
+ ;;Be very careful when using functions generated by this macro.
+ ;;Indexes can be tricky and this has no safety net
+ ;;Use only after checking the arguments for compatibility.
+ (let* ((opt (get-tensor-class-optimization tensor-class)))
+ (assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ `(defun ,func (from to)
+ (declare (type ,tensor-class from to))
+ (if-let (strd-p (blas-copyable-p from to))
+ (,blas-func (number-of-elements from) (store from) (first strd-p) (store to) (second strd-p) (head from) (head to))
+ (let ((f-sto (store from))
+ (t-sto (store to)))
+ (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
+ (very-quickly
+ ;;Can possibly make this faster (x2) by using ,blas-func in one of
+ ;;the inner loops, but this is to me messy and as of now unnecessary.
+ ;;SBCL can already achieve Fortran-ish speed inside this loop.
+ (mod-dotimes (idx (dimensions from))
+ with (linear-sums
+ (f-of (strides from) (head from))
+ (t-of (strides to) (head to)))
+ do ,(funcall (getf opt :reader-writer) 'f-sto 'f-of 't-sto 't-of)))))
+ to)))
+
+
+(defmacro generate-typed-gemv! (func (tensor-class blas-func))
+ (let* ((opt (get-tensor-class-optimization tensor-class)))
+ (assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ `(defun ,func (alpha A x beta y job)
+ (declare (type (getf opt :element-type) alpha beta)
+ (type ,tensor-class A x y)
+ (type boolean job))
+
+
+
;;There's no support for ":c", because there is no
;;equivalent of ":n" with complex conjugation.
(defmacro generate-typed-gemv!-func (func element-type store-type matrix-type blas-gemv-func blas-axpy-func blas-dot-func)
@@ -7,6 +42,7 @@
;;Indexes can be tricky and this has no safety net
;;Use only after checking the arguments for compatibility.
`(defun ,func (alpha A x beta y job)
+ (declare (tyep
(declare (type ,element-type alpha beta)
(type ,matrix-type A x y)
(type symbol job))
@@ -274,4 +310,4 @@
beta)
y)))
(declare (type standard-matrix y))
- (gemv! alpha A x 1d0 result job)))
\ No newline at end of file
+ (gemv! alpha A x 1d0 result job)))
diff --git a/tests/loopy-tests.lisp b/tests/loopy-tests.lisp
index 8998588..9f63e62 100644
--- a/tests/loopy-tests.lisp
+++ b/tests/loopy-tests.lisp
@@ -26,10 +26,16 @@
(if (null (cdr dims)) t
(modidx rem (cdr dims)))))
+(defun test-axpy ()
+ (let ((x (copy! pi (make-real-tensor 1000 1000)))
+ (y (make-real-tensor 1000 1000)))
+ (time (axpy! 1d0 x y))
+ t))
+
(defun test-mm-lisp (n)
- (let ((t-a (make-real-tensor-dims n n))
- (t-b (make-real-tensor-dims n n))
- (t-c (make-real-tensor-dims n n)))
+ (let ((t-a (make-real-tensor n n))
+ (t-b (make-real-tensor n n))
+ (t-c (make-real-tensor n n)))
(declare (type real-tensor t-a t-b t-c))
(let ((st-a (store t-a))
(st-b (store t-b))
@@ -55,9 +61,9 @@
do (incf (aref st-c of-c) (* (aref st-a of-a) (aref st-b of-b)))))))))
(defun test-mm-ddot (n)
- (let* ((t-a (make-real-tensor-dims n n))
- (t-b (make-real-tensor-dims n n))
- (t-c (make-real-tensor-dims n n))
+ (let* ((t-a (make-real-tensor n n))
+ (t-b (make-real-tensor n n))
+ (t-c (make-real-tensor n n))
(st-a (store t-a))
(st-b (store t-b))
(st-c (store t-c)))
-----------------------------------------------------------------------
Summary of changes:
packages.lisp | 2 +-
src/base/blas-helpers.lisp | 39 +++++++------
src/base/loopy.lisp | 2 +-
src/base/print.lisp | 5 +-
src/base/standard-tensor.lisp | 118 ++++++++++++++++++++++++++++++++------
src/classes/complex-tensor.lisp | 25 ++++----
src/classes/matrix.lisp | 47 +---------------
src/classes/real-tensor.lisp | 21 ++++---
src/conditions.lisp | 8 +-
src/level-1/axpy.lisp | 2 +-
src/level-1/copy.lisp | 4 +-
src/level-1/realimag.lisp | 4 +-
src/{old => level-2}/gemv.lisp | 38 ++++++++++++-
tests/loopy-tests.lisp | 18 ++++--
14 files changed, 209 insertions(+), 124 deletions(-)
rename src/{old => level-2}/gemv.lisp (85%)
hooks/post-receive
--
matlisp
|
