[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-109-g8bd064b

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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  8bd064bd60e799c45ed248e17ea9dac42960a631 (commit)
      from  71aca48b041b5be2cd4c6ab8d514b260bdc02b19 (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 8bd064bd60e799c45ed248e17ea9dac42960a631
Author: Akshay Srinivasan <aks...@gm...>
Date:   Thu Jul 5 18:33:43 2012 +0530

    Added swap!, added a :swapper field into tensor-class-optimization.

diff --git a/README.org b/README.org
index 05bc347..6dcc041 100644
--- a/README.org
+++ b/README.org
@@ -7,7 +7,7 @@ This is the development branch of Matlisp.
    * Added a specialisation agnostic macros {copy, scal} which generate
      functions by getting special method producing macros - produced
      by another macro {tensor-store-defs}.
-   * copy, scal work
+   * copy, scal, dot, swap work
    * tensor-{real, imag}part(~) work
    * sub-tensor~ works
    * print methods work
@@ -17,7 +17,6 @@ This is the development branch of Matlisp.
 
 ** TODO : What remains ? (Help!)
 *** Functionality
-   * Some stuff from BLAS level-1 is not yet abstracted.
    * BLAS level-2 and level-3: most importantly Matrix multiplication.
    * LAPACK: solving Linear equations, Eigenvalue decomposition.
    * DFFTPACK: computing FFTs
diff --git a/matlisp.asd b/matlisp.asd
index ec882aa..4278e36 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -107,6 +107,7 @@
 	    :depends-on ("matlisp-base" "matlisp-classes" "foreign-functions")
 	    :components ((:file "tensor-maker")
 			 (:file "copy")
+			 (:file "swap")
 			 (:file "dot")
 			 (:file "scal"
 				:depends-on ("copy"))
diff --git a/src/blas-helpers.lisp b/src/blas-helpers.lisp
index 1d7f147..04209bb 100644
--- a/src/blas-helpers.lisp
+++ b/src/blas-helpers.lisp
@@ -1,5 +1,6 @@
 (in-package :matlisp)
 
+;;Check dimensions of the tensors before passing the argument here!
 (defun blas-copyable-p (ten-a ten-b)
   (declare (type standard-tensor ten-a ten-b))
   (mlet*
@@ -10,18 +11,17 @@
     (perm-b-dims (permute (dimensions ten-b) std-a-perm) :type (index-array *)))
    (very-quickly
      (loop
+	for i of-type index-type from 0 below (rank ten-a)
 	for sost-a across sort-std-a
-	for sodi-a across perm-a-dims
-	for a-aoff of-type index-type = (aref sort-std-a 0) then (the index-type (* a-aoff sodi-a))
+	for a-aoff of-type index-type = (aref sort-std-a 0) then (the index-type (* a-aoff (aref perm-a-dims (1- i))))
 	;;
 	for sost-b across sort-std-b
-	for sodi-b across perm-b-dims
-	for b-aoff of-type index-type = (aref sort-std-b 0) then (the index-type (* b-aoff sodi-b))
+	for b-aoff of-type index-type = (aref sort-std-b 0) then (the index-type (* b-aoff (aref perm-b-dims (1- i))))
 	;;
-	do (unless (and (= sost-a a-aoff)
-			(= sost-b b-aoff)
-			(= sodi-a sodi-b))
-	     (return nil))
+	do (progn
+	     (unless (and (= sost-a a-aoff)
+			  (= sost-b b-aoff))
+	       (return nil)))
 	finally (return (list (aref sort-std-a 0) (aref sort-std-b 0)))))))
 
 (defun consecutive-store-p (tensor)
diff --git a/src/blas.lisp b/src/blas.lisp
index 3222da9..2c081f1 100644
--- a/src/blas.lisp
+++ b/src/blas.lisp
@@ -229,9 +229,9 @@
 	    Y(0),Y(INCY), ... , Y((N-1)*INCY)
 "
   (n :integer :input)
-  (dx (* :double-float) :output)
+  (dx (* :double-float :inc head-x) :output)
   (incx :integer :input)
-  (dy (* :double-float))
+  (dy (* :double-float :inc head-y))
   (incy :integer :input)
   )
 
@@ -431,9 +431,9 @@
 	    Y(0),Y(2*INCY), ... , Y(2*(N-1)*INCY)
 "
   (n :integer :input)
-  (zx (* :complex-double-float) :output)
+  (zx (* :complex-double-float :inc head-x) :output)
   (incx :integer :input)
-  (zy (* :complex-double-float))
+  (zy (* :complex-double-float :inc head-y))
   (incy :integer :input)
   )
 
diff --git a/src/complex-tensor.lisp b/src/complex-tensor.lisp
index aecac89..967ad68 100644
--- a/src/complex-tensor.lisp
+++ b/src/complex-tensor.lisp
@@ -70,7 +70,12 @@ Cannot hold complex numbers."))
   :reader-writer
   (lambda (fstore fidx tstore tidx)
     (setf (aref tstore (* 2 tidx)) (aref fstore (* 2 fidx))
-	  (aref tstore (1+ (* 2 tidx))) (aref fstore (1+ (* 2 fidx))))))
+	  (aref tstore (1+ (* 2 tidx))) (aref fstore (1+ (* 2 fidx)))))
+  :swapper
+  (lambda (fstore fidx tstore tidx)
+    (progn
+      (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)
 
diff --git a/src/real-tensor.lisp b/src/real-tensor.lisp
index c6c252c..0566539 100644
--- a/src/real-tensor.lisp
+++ b/src/real-tensor.lisp
@@ -49,7 +49,10 @@ Allocates real storage.  Default initial-element = 0d0.")
     (setf (aref store idx) value))
   :reader-writer
   (lambda (fstore fidx tstore tidx)
-    (setf (aref tstore tidx) (aref fstore fidx))))
+    (setf (aref tstore tidx) (aref fstore fidx)))
+  :swapper
+  (lambda (fstore fidx tstore tidx)
+    (rotatef (aref tstore tidx) (aref fstore fidx))))
 
 (setf (gethash 'real-sub-tensor *tensor-class-optimizations*) 'real-tensor)
 
diff --git a/src/standard-tensor.lisp b/src/standard-tensor.lisp
index 94db9a7..dc47457 100644
--- a/src/standard-tensor.lisp
+++ b/src/standard-tensor.lisp
@@ -96,6 +96,7 @@
   :reader (store idx) => result
   :value-writer (value store idx) => (store idx) <- value
   :reader-writer (fstore fidx tstore tidx) => (tstore tidx) <- (fstore fidx)
+  :swapper       (fstore fidx tstore tidx) => (tstore tidx) <-> (fstore fidx)
   o class-name (symbol) of the superclass whose optimizations
   are to be made use of.")
 
@@ -268,11 +269,12 @@
 	   (unless (< -1 idx (store-size tensor))
 	     (error 'tensor-store-index-out-of-bounds :index idx :store-size (store-size tensor) :tensor tensor))))
 
-(defmacro tensor-store-defs ((tensor-class element-type store-element-type) &key  store-allocator coercer reader value-writer reader-writer)
+(defmacro tensor-store-defs ((tensor-class element-type store-element-type) &key  store-allocator coercer reader value-writer reader-writer swapper)
   (let ((tensym  (gensym "tensor")))
     (assert store-allocator)
     (assert coercer)
     (assert (eq (first reader-writer) 'lambda))
+    (assert swapper)
     `(progn
        ,(destructuring-bind (lbd args &rest body) reader
 	  (assert (eq lbd 'lambda))
@@ -295,6 +297,7 @@
 		   :reader (macrofy ,reader)
 		   :value-writer (macrofy ,value-writer)
 		   :reader-writer (macrofy ,reader-writer)
+		   :swapper (macrofy ,swapper)
 		   :store-allocator ',store-allocator
 		   :coercer ',coercer
 		   :element-type ',element-type
diff --git a/src/swap.lisp b/src/swap.lisp
index 889576e..d0e334a 100644
--- a/src/swap.lisp
+++ b/src/swap.lisp
@@ -56,13 +56,35 @@
 ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(in-package "MATLISP")
+(in-package :matlisp)
 
-#+nil (use-package "BLAS")
-#+nil (use-package "LAPACK")
-#+nil (use-package "FORTRAN-FFI-ACCESSORS")
+(defmacro generate-typed-swap! (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 (x y)
+       (declare (type ,tensor-class x y))
+       (if-let (strd-p (blas-copyable-p x y))
+	 (,blas-func (number-of-elements x) (store x) (first strd-p) (store y) (second strd-p) (head x) (head y))
+	 (let ((f-sto (store x))
+	       (t-sto (store y)))
+	   (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 x))
+	       with (linear-sums
+		     (f-of (strides x) (head x))
+		     (t-of (strides y) (head y)))
+	       do ,(funcall (getf opt :swapper) 'f-sto 'f-of 't-sto 't-of)))))
+       y)))
 
-#+nil (export '(swap!))
+(generate-typed-swap! real-typed-swap! (real-tensor dswap))
+(generate-typed-swap! complex-typed-swap! (complex-tensor zswap))
+;;---------------------------------------------------------------;;
 
 (defgeneric swap! (x y)
   (:documentation
@@ -73,40 +95,24 @@
 
   Purpose
   =======
-  Given matrices X,Y, performs:
+  Given tensors X,Y, performs:
 
               X <-> Y
 
   and returns Y.
 
- X,Y need not have the same dimensions,
- but must have the same total number of 
- elements.  Practically, this is useful
- for adding a row and column vector of 
- the same size etc ...
-"))
+  X, Y must have the same dimensions.
+")
+  (:method :before ((x standard-tensor) (y standard-tensor))
+	   (unless (idx= (dimensions x) (dimensions y))
+	     (error 'tensor-dimension-mismatch)))
+  (:method ((x complex-tensor) (y real-tensor))
+    (error 'coercion-error :from 'complex-tensor :to 'real-tensor))
+  (:method ((x real-tensor) (y complex-tensor))
+    (error 'coercion-error :from 'complex-tensor :to 'real-tensor)))
 
-(defmethod swap! :before ((x standard-matrix) (y standard-matrix))
-  (let ((nxm-x (number-of-elements x))
-	(nxm-y (number-of-elements y)))
-    (declare (type fixnum nxm-x nxm-y))
-    (if (not (= nxm-x nxm-y))
-	(error "arguments X,Y to SWAP! not the same size"))))
+(defmethod swap! ((x real-tensor) (y real-tensor))
+  (real-typed-swap! x y))
 
-(defmethod swap! ((x real-matrix) (y real-matrix))
-  (let ((nxm (number-of-elements x)))
-    (dswap nxm (store x) 1 (store y) 1)
-    y))
-
-(defmethod swap! ((x complex-matrix) (y complex-matrix))
-  (let ((nxm (number-of-elements x)))
-    (zswap nxm (store x) 1 (store y) 1)
-    y))
-
-(defmethod swap! ((x real-matrix) (y complex-matrix))
-  (error "cannot SWAP! a real matrix with a complex one,
-don't know how to coerce COMPLEX to REAL"))
-
-(defmethod swap! ((x complex-matrix) (y real-matrix))
-  (error "cannot SWAP! a real matrix with a complex one,
-don't know how to coerce COMPLEX to REAL"))
+(defmethod swap! ((x complex-tensor) (y complex-tensor))
+  (complex-typed-swap! x y))

-----------------------------------------------------------------------

Summary of changes:
 README.org               |    3 +-
 matlisp.asd              |    1 +
 src/blas-helpers.lisp    |   16 +++++-----
 src/blas.lisp            |    8 ++--
 src/complex-tensor.lisp  |    7 ++++-
 src/real-tensor.lisp     |    5 ++-
 src/standard-tensor.lisp |    5 ++-
 src/swap.lisp            |   76 +++++++++++++++++++++++++---------------------
 8 files changed, 69 insertions(+), 52 deletions(-)


hooks/post-receive
-- 
matlisp


