Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-180-g32fd231
|
From: Akshay S. <ak...@us...> - 2013-01-05 19:20:05
|
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 32fd23120cff0e68ba1b02290f19e0dd48185944 (commit)
via 2595c1c4e1a710d38b0c56c83921206d2473e8ae (commit)
from e916823ab6bd97795ad7eaea63ad778a423b0919 (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 32fd23120cff0e68ba1b02290f19e0dd48185944
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Jan 5 11:14:54 2013 -0800
GETRF wrapper function works.
diff --git a/packages.lisp b/packages.lisp
index 276480c..f46d776 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -76,6 +76,7 @@
#:list-dimensions
#:lvec-foldl #:lvec-foldr #:lvec-max #:lvec-min #:lvec-eq
#:lvec->list #:lvec->list!
+ #:compile-and-eval
;;Macros
#:when-let #:if-let #:if-ret #:with-gensyms #:let-rec
#:mlet* #:make-array-allocator #:let-typed #:let*-typed
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 8f08284..1c0397d 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -167,7 +167,7 @@
(let ((opt (if (symbolp value)
(get-tensor-class-optimization-hashtable clname)
value)))
- (setf (symbol-plist clname) opt
+ (setf (symbol-plist (getf opt :tensor)) opt
(symbol-plist (getf opt :matrix)) opt
(symbol-plist (getf opt :vector)) opt)))
diff --git a/src/lapack/getrf.lisp b/src/lapack/getrf.lisp
index f28098e..7e5f0eb 100644
--- a/src/lapack/getrf.lisp
+++ b/src/lapack/getrf.lisp
@@ -25,46 +25,51 @@
;;; ENHANCEMENTS, OR MODIFICATIONS.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(in-package #:matlisp)
-(in-package #:matlisp)
-
-(defmacro generate-typed-getrf! (func-name (matrix-class lapack-func))
- (let* ((opt (get-tensor-class-optimization matrix-class)))
- (assert opt nil 'tensor-cannot-find-optimization :tensor-class matrix-class)
+(defmacro generate-typed-getrf! (func-name (tensor-class lapack-func))
+ (let* ((opt (if-ret (get-tensor-class-optimization-hashtable tensor-class)
+ (error 'tensor-cannot-find-optimization :tensor-class tensor-class)))
+ (matrix-class (getf opt :matrix)))
`(defun ,func-name (A ipiv)
(declare (type ,matrix-class A)
(type permutation-pivot-flip ipiv))
(mlet* (((maj-A ld-A fop-A) (blas-matrix-compatible-p A :n) :type (symbol index-type nil)))
- (assert maj-A nil 'tensor-store-not-consecutive)
- (multiple-value-bind (new-A new-ipiv info)
- (,lapack-func
- (nrows A) (ncols A) (store A)
- ld-A (repr ipiv) 0)
- (declare (ignore new-A new-ipiv))
- ;;Convert from 1-based indexing to 0-based indexing, and fix
- ;;other Fortran-ic quirks
- (assert (= info 0) nil 'invalid-arguments :argnum (1- (- info)) :message (format-to-string "GETRF returned INFO: ~a." info))
- (let-typed ((pidv (repr ipiv) :type perrepr-vector))
- (very-quickly
- (loop for i from 0 below (length pidv)
- do (decf (aref pidv i)))))
- (if (eq maj-A :row-major)
- ;;Crout's decomposition
- (values A (list :decomposition-type :|U_ii=1| :column-permutation ipiv))
- ;;Dolittle's decomposition
- (values A (list :decomposition-type :|L_ii=1| :row-permutation ipiv))))))))
-
-(generate-typed-getrf! real-typed-getrf! (real-matrix dgetrf))
-(generate-typed-getrf! complex-typed-getrf! (complex-matrix zgetrf))
-
-#+nil
-(let ((A (make-real-tensor '((1 2)
- (3 4))))
- (idiv (make-pidx (perv 0 1))))
- (real-typed-getrf! A idiv))
-
-
-(defgeneric getrf! (A ipiv)
+ (if (not (eq maj-A :col-major))
+ (let*-typed ((dims (dimensions A) :type index-store-vector)
+ ;;Column major
+ (stds (let*-typed ((rank (rank A) :type fixnum)
+ (stds (allocate-index-store rank) :type index-store-vector))
+ (very-quickly
+ (loop
+ :for i :from 0 :below rank
+ :and st = 1 :then (the index-type (* st (aref dims i)))
+ :do (setf (aref stds i) st)))
+ stds)
+ :type index-store-vector)
+ (tmp (,(get tensor-class :copy) A (make-instance (class-of A) :dimensions dims :strides stds :store (,(get tensor-class :store-allocator) (lvec-foldr #'* dims))))))
+ (mlet* (((maj-tmp ld-tmp fop-tmp) (blas-matrix-compatible-p tmp :n) :type (nil index-type nil))
+ ((new-tmp new-ipiv info) (,lapack-func
+ (nrows tmp) (ncols tmp) (store tmp)
+ ld-tmp (repr ipiv) 0) :type (nil nil integer)))
+ (assert (= info 0) nil 'invalid-arguments :argnum (1- (- info)) :message (format-to-string "GETRF returned INFO: ~a." info))
+ (,(get tensor-class :copy) tmp A)))
+ (mlet* (((new-A new-ipiv info) (,lapack-func
+ (nrows A) (ncols A) (store A)
+ ld-A (repr ipiv) 0) :type (nil nil integer)))
+ (assert (= info 0) nil 'invalid-arguments :argnum (1- (- info)) :message (format-to-string "GETRF returned INFO: ~a." info))))
+ ;;Convert from 1-based indexing to 0-based indexing, and fix
+ ;;other Fortran-ic quirks
+ (let-typed ((pidv (repr ipiv) :type perrepr-vector))
+ (very-quickly
+ (loop for i from 0 below (length pidv)
+ do (decf (aref pidv i)))))
+ (values A ipiv)))))
+
+(generate-typed-getrf! real-typed-getrf! (real-tensor dgetrf))
+(generate-typed-getrf! complex-typed-getrf! (complex-tensor zgetrf))
+
+(defgeneric getrf! (A)
(:documentation
"
Syntax
@@ -92,9 +97,9 @@
IPIV is filled with the pivot indices that define the permutation
matrix P:
-
+
row i of the matrix was interchanged with row IPIV(i).
-
+
If IPIV is not provided, it is allocated by GESV.
Return Values
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index d945d7b..6301a0c 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -165,3 +165,34 @@
(defmethod dot ((x complex-vector) (y complex-vector) &optional (conjugate-p t))
(complex-typed-dot x y conjugate-p))
+
+#+nil
+(defmethod dot ((x standard-vector) (y standard-vector) &optional (conjugate-p t))
+ (let ((xcl (class-of x))
+ (ycl (class-of y)))
+ (unless (and (eq xcl (find-class (get (class-name xcl) :vector)))
+ (eq ycl (find-class (get (class-name ycl) :vector))))
+ (error "Arguments are not vectors!"))
+ (cond
+ ((eq (class-of x) (class-of y))
+ ;;Generate method
+ (let* ((classn (get (class-name xcl) :vector))
+ (dot-func (if-ret (get classn :dot)
+ (let ((dot-name (gensym (string+ (symbol-name classn) "-dot-"))))
+ (compile-and-eval
+ `(generate-typed-dot ,dot-name
+ (,classn nil nil 0)))
+ dot-name))))
+ (compile-and-eval
+ `(defmethod dot ((x ,classn) (y ,classn) &optional (conjugate-p t))
+ ,@(unless (get classn :fconj)
+ `((declare (ignore conjugate-p))))
+ ,(if (get classn :fconj)
+ `(,dot-func x y conjugate-p)
+ `(,dot-func x y t))))
+ ;;Call method
+ (dot x y conjugate-p)))
+ ((coercable? (class-name xcl) (class-name ycl))
+ ...)
+ ((coercable? (class-name xcl) (class-name ycl))
+ ...))))
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index eda04c5..cd2dd14 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -51,6 +51,7 @@
(make-tensor-maker make-real-tensor (real-tensor))
(make-tensor-maker make-complex-tensor (complex-tensor))
+
#+maxima
(make-tensor-maker make-symbolic-tensor (symbolic-tensor))
diff --git a/src/utilities/functions.lisp b/src/utilities/functions.lisp
index fb9d9fa..c0570e8 100644
--- a/src/utilities/functions.lisp
+++ b/src/utilities/functions.lisp
@@ -217,3 +217,10 @@
(lst-tread (cons 0 idx) (car lst))
(reverse idx))))))
(lst-tread (list 0) lst)))
+
+(defun compile-and-eval (source)
+ "
+ Compiles and evaluates the given @arg{source}. This should be
+ an ANSI compatible way of ensuring method compilation."
+ (funcall (compile nil `(lambda () ,source))))
+
commit 2595c1c4e1a710d38b0c56c83921206d2473e8ae
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 28 11:43:27 2012 -0600
o Now the generation macros push BLAS function names into the tensor
class optimization plist.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index a0bbef8..8f08284 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -163,10 +163,13 @@
(t (values opt clname)))))
(defun (setf get-tensor-class-optimization) (value clname)
- (setf (gethash clname *tensor-class-optimizations*) value
- (symbol-plist clname) (if (symbolp value)
- (get-tensor-class-optimization-hashtable clname)
- value)))
+ (setf (gethash clname *tensor-class-optimizations*) value)
+ (let ((opt (if (symbolp value)
+ (get-tensor-class-optimization-hashtable clname)
+ value)))
+ (setf (symbol-plist clname) opt
+ (symbol-plist (getf opt :matrix)) opt
+ (symbol-plist (getf opt :vector)) opt)))
;; Akshay: I have no idea what this does, or why we want it
;; (inherited from standard-matrix.lisp
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index 6fc9eb5..ee75e32 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -34,6 +34,8 @@
;;Use only after checking the arguments for compatibility.
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :axpy) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (alpha from to)
(declare (type ,tensor-class from to)
(type ,(getf opt :element-type) alpha))
@@ -78,6 +80,8 @@
;;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)
+ (setf (getf opt :num-axpy) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (num-from to)
(declare (type ,tensor-class to)
(type ,(getf opt :element-type) num-from))
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index 9a42abf..75a72c1 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -34,6 +34,8 @@
;;Use only after checking the arguments for compatibility.
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :copy) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (from to)
(declare (type ,tensor-class from to))
,(let
@@ -71,6 +73,8 @@
;;Use only after checking the arguments for compatibility.
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :num-copy) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (num-from to)
(declare (type ,tensor-class to)
(type ,(getf opt :element-type) num-from))
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index 7302d70..d945d7b 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -32,6 +32,8 @@
(conj? (getf opt :fconj))
(blas? (and blas-func (if conj? blasc-func t))))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :dot) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (x y conjugate-p)
(declare (type ,tensor-class x y)
,(if conj?
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index 472a186..517167c 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -31,6 +31,8 @@
(defmacro generate-typed-scal! (func (tensor-class fortran-func fortran-lb))
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :scal) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (from to)
(declare (type ,tensor-class from to))
,(let
@@ -64,6 +66,8 @@
(defmacro generate-typed-num-scal! (func (tensor-class blas-func fortran-lb))
(let ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :num-scal) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (alpha to)
(declare (type ,tensor-class to)
(type ,(getf opt :element-type) alpha))
@@ -91,6 +95,8 @@
(defmacro generate-typed-div! (func (tensor-class fortran-func fortran-lb))
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :div) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (from to)
(declare (type ,tensor-class from to))
,(let
@@ -124,6 +130,8 @@
(defmacro generate-typed-num-div! (func (tensor-class fortran-func fortran-lb))
(let ((opt (get-tensor-class-optimization tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :num-div) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (alpha to)
(declare (type ,tensor-class to)
(type ,(getf opt :element-type) alpha))
diff --git a/src/level-1/swap.lisp b/src/level-1/swap.lisp
index 6df8506..4c7650e 100644
--- a/src/level-1/swap.lisp
+++ b/src/level-1/swap.lisp
@@ -34,6 +34,8 @@
;;Use only after checking the arguments for compatibility.
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :swap) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (x y)
(declare (type ,tensor-class x y))
,(let
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index ba233ae..eda04c5 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -3,6 +3,8 @@
(defmacro make-tensor-maker (func-name (tensor-class))
(let ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ (setf (getf opt :maker) func-name
+ (get-tensor-class-optimization tensor-class) opt)
`(progn
(declaim (ftype (function (&rest t) ,tensor-class) ,func-name))
(defun ,func-name (&rest args)
diff --git a/src/level-2/gemv.lisp b/src/level-2/gemv.lisp
index 2dba31a..8ef7481 100644
--- a/src/level-2/gemv.lisp
+++ b/src/level-2/gemv.lisp
@@ -10,6 +10,8 @@
(error 'tensor-cannot-find-optimization :tensor-class tensor-class)))
(matrix-class (getf opt :matrix))
(vector-class (getf opt :vector)))
+ (setf (getf opt :gemv) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (alpha A x beta y job)
(declare (type ,(getf opt :element-type) alpha beta)
(type ,matrix-class A)
diff --git a/src/level-3/gemm.lisp b/src/level-3/gemm.lisp
index ecf1756..22b445b 100644
--- a/src/level-3/gemm.lisp
+++ b/src/level-3/gemm.lisp
@@ -33,6 +33,8 @@
(error 'tensor-cannot-find-optimization :tensor-class tensor-class)))
(matrix-class (getf opt :matrix))
(blas? (and blas-gemm-func blas-gemv-func)))
+ (setf (getf opt :gemm) func
+ (get-tensor-class-optimization tensor-class) opt)
`(definline ,func (alpha A B beta C job)
(declare (type ,(getf opt :element-type) alpha beta)
(type ,matrix-class A B C)
-----------------------------------------------------------------------
Summary of changes:
packages.lisp | 1 +
src/base/standard-tensor.lisp | 11 ++++--
src/lapack/getrf.lisp | 75 ++++++++++++++++++++++-------------------
src/level-1/axpy.lisp | 4 ++
src/level-1/copy.lisp | 4 ++
src/level-1/dot.lisp | 33 ++++++++++++++++++
src/level-1/scal.lisp | 8 ++++
src/level-1/swap.lisp | 2 +
src/level-1/tensor-maker.lisp | 3 ++
src/level-2/gemv.lisp | 2 +
src/level-3/gemm.lisp | 2 +
src/utilities/functions.lisp | 7 ++++
12 files changed, 113 insertions(+), 39 deletions(-)
hooks/post-receive
--
matlisp
|
