Menu
▾
▴
matlisp-commit
|
From: Akshay S. <ak...@us...> - 2013-06-19 09:14:41
|
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, classy has been updated
via 50fcc688d2f72e751722b74e994808ad90f4c1ce (commit)
via c108b24c014b002d9d0465ed895a8223a766230a (commit)
via 0b071d4d11400da962b99cbff50ee42afc443b0b (commit)
via ca0287f4334829367de787ba0e20947f53b6298c (commit)
via 24def88c5b5227b29154cee9e05d88d119ceade8 (commit)
via ba36a2d0877b66fc5b6b4055b9310b2e60a54186 (commit)
via c213febdfa60e0b1a9a11c796911eb5b93fef90e (commit)
from ea151122023fbd5d481a831645292fa3232b7b8b (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 50fcc688d2f72e751722b74e994808ad90f4c1ce
Author: Akshay Srinivasan <aks...@gm...>
Date: Wed Jun 19 02:07:37 2013 -0700
Cleanup.
diff --git a/matlisp.asd b/matlisp.asd
index 6a36308..1526b85 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -134,19 +134,18 @@
(:module "matlisp-level-1"
:pathname "level-1"
:depends-on ("matlisp-base" "matlisp-classes" "foreign-core")
- :components ((:file "tensor-maker")
+ :components ((:file "maker")
+ (:file "copy"
+ :depends-on ("maker"))
+ (:file "dot"
+ :depends-on ("maker"))
#+nil
(
(:file "swap")
-
- (:file "copy"
- :depends-on ("tensor-maker"))
(:file "realimag"
:depends-on ("copy"))
(:file "scal"
:depends-on ("copy" "tensor-maker" "realimag"))
- (:file "dot"
- :depends-on ("realimag"))
(:file "axpy"
:depends-on ("copy" "scal"))
(:file "trans"
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/maker.lisp
similarity index 100%
rename from src/level-1/tensor-maker.lisp
rename to src/level-1/maker.lisp
commit c108b24c014b002d9d0465ed895a8223a766230a
Author: Akshay Srinivasan <aks...@gm...>
Date: Wed Jun 19 02:05:50 2013 -0700
Migrated dot, copy to the new system.
diff --git a/src/base/blas-helpers.lisp b/src/base/blas-helpers.lisp
index 6b8b735..11ef0c0 100644
--- a/src/base/blas-helpers.lisp
+++ b/src/base/blas-helpers.lisp
@@ -77,6 +77,6 @@
(defun make-stride (dims)
(ecase *default-stride-ordering* (:row-major (make-stride-rmj dims)) (:col-major (make-stride-cmj dims))))
-(definline call-fortran? (x lb)
+(defun call-fortran? (x lb)
(declare (type standard-tensor x))
- (> (lvec-max (the index-store-vector (dimensions x))) lb))
+ (> (size x) lb))
diff --git a/src/base/generic-copy.lisp b/src/base/generic-copy.lisp
index 128d66c..543fa5c 100644
--- a/src/base/generic-copy.lisp
+++ b/src/base/generic-copy.lisp
@@ -90,6 +90,9 @@
=======
Return a copy of X"))
+(defmethod copy ((num number))
+ num)
+
(defmethod copy ((lst cons))
(copy-list lst))
diff --git a/src/base/tweakable.lisp b/src/base/tweakable.lisp
index 02f7e00..3ad44fc 100644
--- a/src/base/tweakable.lisp
+++ b/src/base/tweakable.lisp
@@ -27,13 +27,13 @@
")
;;Level 1--------------------------------------------------------;;
-(defparameter *real-l1-fcall-lb* 20000
+(defparameter *real-l1-fcall-lb* 50000
"If the size of the array is less than this parameter, the
lisp version of axpy is called in order to avoid FFI overheads.
The Fortran function is not called if the tensor does not have
a consecutive store (see blas-helpers.lisp/consecutive-store-p).")
-(defparameter *complex-l1-fcall-lb* 10000
+(defparameter *complex-l1-fcall-lb* 20000
"If the size of the array is less than this parameter, the
lisp version of axpy is called in order to avoid FFI overheads.
The Fortran function is not called if the tensor does not have
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index e67612d..0800470 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -136,24 +136,6 @@
(assert (very-quickly (lvec-eq (the index-store-vector (dimensions x)) (the index-store-vector (dimensions y)) #'=)) nil
'tensor-dimension-mismatch))
-;;This shouldn't happen ideally
-(defmethod copy! ((x t) (y standard-tensor))
- (let ((clname (class-name (class-of y))))
- (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
- (warn "copy! method being generated for '(t ~a), does not use BLAS." clname)
- (compile-and-eval
- `(defmethod copy! ((x t) (y ,clname))
- (let-typed ((sto-y (store y) :type (simple-array ,(store-element-type clname)))
- (cx (t/coerce ,(field-type clname) x) :type ,(field-type clname)))
- ;;This should be safe
- (very-quickly
- (mod-dotimes (idx (dimensions y))
- :with (linear-sums
- (of-y (strides y) (head y)))
- :do (t/store-set ,clname cx sto-y of-y))))
- y))
- (copy! x y)))
-
(defmethod copy! ((x standard-tensor) (y standard-tensor))
(let ((clx (class-name (class-of x)))
(cly (class-name (class-of y))))
@@ -166,142 +148,30 @@
`(defmethod copy! ((x ,clx) (y ,cly))
,(recursive-append
(when (subtypep clx 'blas-numeric-tensor)
- `(if (and (call-fortran? x (t/l1-lb ,clx)) (blas-copyable-p
-
- (mod-dotimes (idx (dimensions x))
- do (setf (tensor-ref y idx) (tensor-ref x idx)))
- y)
-
-(defmethod copy! ((x complex-tensor) (y real-tensor))
- (error 'coercion-error :from 'complex-tensor :to 'real-tensor))
-
-(defmethod copy! ((x real-tensor) (y real-tensor))
- (real-typed-copy! x y))
-
-(defmethod copy! ((x number) (y real-tensor))
- (real-typed-num-copy! (coerce-real x) y))
-
-(defmethod copy! ((x complex-tensor) (y complex-tensor))
- (complex-typed-copy! x y))
-
-(defmethod copy! ((x real-tensor) (y complex-tensor))
- ;;Borrowed from realimag.lisp
- (let ((tmp (make-instance 'real-tensor
- :parent-tensor y :store (store y)
- :dimensions (dimensions y)
- :strides (map 'index-store-vector #'(lambda (n) (* 2 n)) (strides y))
- :head (the index-type (* 2 (head y))))))
- (declare (type real-tensor tmp))
- (real-typed-copy! x tmp)
- ;;Increasing the head by 1 points us to the imaginary part.
- (incf (head tmp))
- (real-typed-num-copy! 0d0 tmp))
- y)
-
-(defmethod copy! ((x number) (y complex-tensor))
- (complex-typed-num-copy! (coerce-complex x) y))
-
-;; Copy between a Lisp array and a tensor
-(defun convert-to-lisp-array (tensor)
- "
- Syntax
- ======
- (convert-to-lisp-array tensor)
-
- Purpose
- =======
- Create a new Lisp array with the same dimensions as the tensor and
- with the same elements. This is a copy of the tensor.
-"
- (declare (type standard-tensor tensor))
- (let*-typed ((dims (dimensions tensor) :type index-store-vector)
- (ret (make-array (lvec->list dims)
- :element-type (or (getf (get-tensor-object-optimization tensor) :element-type)
- (error 'tensor-cannot-find-optimization :tensor-class (class-name (class-of tensor)))))))
- (let ((lst (make-list (rank tensor))))
- (very-quickly
- (mod-dotimes (idx dims)
- do (setf (apply #'aref ret (lvec->list! idx lst)) (tensor-ref tensor idx))))
- ret)))
-
-(defmethod copy! :before ((x standard-tensor) (y array))
- (assert (subtypep (getf (get-tensor-object-optimization x) :element-type)
- (array-element-type y))
- nil 'invalid-type
- :given (getf (get-tensor-object-optimization x) :element-type)
- :expected (array-element-type y))
- (assert (and
- (= (rank x) (array-rank y))
- (dolist (ele (mapcar #'= (lvec->list (dimensions x)) (array-dimensions y)) t)
- (unless ele (return nil))))
- nil 'dimension-mismatch))
-
-(defmethod copy! ((x real-tensor) (y array))
- (let-typed ((sto-x (store x) :type real-store-vector)
- (lst (make-list (rank x)) :type cons))
- (mod-dotimes (idx (dimensions x))
- with (linear-sums
- (of-x (strides x) (head x)))
- do (setf (apply #'aref y (lvec->list! idx lst))
- (aref sto-x of-x))))
- y)
-
-(defmethod copy! ((x complex-tensor) (y array))
- (let-typed ((sto-x (store x) :type complex-store-vector)
- (lst (make-list (rank x)) :type cons))
- (mod-dotimes (idx (dimensions x))
- with (linear-sums
- (of-x (strides x) (head x)))
- do (setf (apply #'aref y (lvec->list! idx lst))
- (complex (aref sto-x (* 2 of-x)) (aref sto-x (1+ (* 2 of-x)))))))
- y)
-
-;;
-(defmethod copy! :before ((x array) (y standard-tensor))
- (assert (subtypep (array-element-type x)
- (getf (get-tensor-object-optimization y) :element-type))
- nil 'invalid-type
- :given (array-element-type x) :expected (getf (get-tensor-object-optimization y) :element-type))
- (assert (and
- (= (array-rank x) (rank y))
- (dolist (ele (mapcar #'= (array-dimensions x) (lvec->list (dimensions y))) t)
- (unless ele (return nil))))
- nil 'dimension-mismatch))
-
-(defmethod copy! ((x array) (y real-tensor))
- (let-typed ((sto-y (store y) :type real-store-vector)
- (lst (make-list (array-rank x)) :type cons))
- (very-quickly
- (mod-dotimes (idx (dimensions y))
- with (linear-sums
- (of-y (strides y) (head y)))
- do (setf (aref sto-y of-y) (apply #'aref x (lvec->list! idx lst))))))
- y)
+ `(if-let (strd (and (call-fortran? x (t/l1-lb ,clx)) (blas-copyablep x y)))
+ (let ((sz (size x))) (t/blas-copy! ,clx sz x (first strd) y (second strd)))))
+ `(very-quickly (t/copy! (,clx ,cly) x y)))
+ y)))
+ (compile-and-eval
+ `(defmethod copy! ((x ,clx) (y ,cly))
+ (t/copy! (,clx ,cly) x y)
+ y)))
+ (copy! x y)))
-(defmethod copy! ((x array) (y complex-tensor))
- (let-typed ((sto-y (store y) :type real-store-vector)
- (lst (make-list (array-rank x)) :type cons))
- (very-quickly
- (mod-dotimes (idx (dimensions y))
- with (linear-sums
- (of-y (strides y) (head y)))
- 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)
+(defmethod copy! ((x t) (y standard-tensor))
+ (let ((cly (class-name (class-of y))))
+ (assert (and (member cly *tensor-type-leaves*))
+ nil 'tensor-abstract-class :tensor-class cly)
+ (compile-and-eval
+ `(defmethod copy! ((x t) (y ,cly))
+ ,(recursive-append
+ (when (subtypep cly 'blas-numeric-tensor)
+ `(if-let (strd (and (call-fortran? y (t/l1-lb ,cly)) (consecutive-storep y)))
+ (let ((sz (size y))) (t/blas-num-copy! ,cly sz x y strd))))
+ `(very-quickly (t/copy! (t ,cly) x y)))))
+ (copy! x y)))
-;;
;;Generic function defined in src;base;generic-copy.lisp
-
-(defmethod copy ((tensor real-tensor))
- (let* ((ret (apply #'make-real-tensor (lvec->list (dimensions tensor)))))
- (declare (type real-tensor ret))
+(defmethod copy ((tensor standard-tensor))
+ (let* ((ret (zeros (the index-store-vector (dimensions tensor)) (class-name (class-of tensor)))))
(copy! tensor ret)))
-
-(defmethod copy ((tensor complex-tensor))
- (let* ((ret (apply #'make-complex-tensor (lvec->list (dimensions tensor)))))
- (declare (type complex-tensor ret))
- (copy! tensor ret)))
-
-(defmethod copy ((tensor number))
- tensor)
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index dc26862..a7ac53e 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -105,7 +105,7 @@
")
(:method :before ((x standard-tensor) (y standard-tensor) &optional (conjugate-p t))
(declare (ignore conjugate-p))
- (unless (and (vector-p x) (vector-p y) (very-quickly (lvec-eq (the index-store-vector (dimensions x)) (the index-store-vector (dimensions y)) #'=)))
+ (unless (and (tensor-vectorp x) (tensor-vectorp y) (= (aref (the index-store-vector (dimensions x)) 0) (aref (the index-store-vector (dimensions y)) 0)))
(error 'tensor-dimension-mismatch))))
(defmethod dot ((x number) (y number) &optional (conjugate-p t))
@@ -119,24 +119,26 @@
(assert (and (member clx *tensor-type-leaves*)
(member cly *tensor-type-leaves*))
nil 'tensor-abstract-class :tensor-class (list clx cly))
- (if (eq clx cly)
- (progn
- (compile-and-eval
- `(defmethod dot ((x ,clx) (y ,cly) &optional (conjugate-p t))
- ,(recursive-append
- (when (subtypep clx 'blas-numeric-tensor)
- `(if (call-fortran? x (t/l1-lb ,clx))
- (if conjugate-p
- (t/blas-dot ,clx x y t)
- (t/blas-dot ,clx x y nil))))
- `(if conjugate-p
- ;;Please do your checks before coming here.
- (very-quickly (t/dot ,clx x y t))
- (very-quickly (t/dot ,clx x y nil))))))
- (dot x y conjugate-p))
- ;;You pay the piper if you like mixing types.
- ;;This is (or should be) a rare enough to not matter.
- (or (handler-case
- (dot (copy! x (zeros (dimensions x) cly)) y conjugate-p)
- (error () nil))
- (dot x (copy! y (zeros (dimensions y) clx)) conjugate-p)))))
+ (cond
+ ((eq clx cly)
+ (compile-and-eval
+ `(defmethod dot ((x ,clx) (y ,cly) &optional (conjugate-p t))
+ ,(recursive-append
+ (when (subtypep clx 'blas-numeric-tensor)
+ `(if (call-fortran? x (t/l1-lb ,clx))
+ (if conjugate-p
+ (t/blas-dot ,clx x y t)
+ (t/blas-dot ,clx x y nil))))
+ `(if conjugate-p
+ ;;Please do your checks before coming here.
+ (very-quickly (t/dot ,clx x y t))
+ (very-quickly (t/dot ,clx x y nil))))))
+ (dot x y conjugate-p))
+ ;;You pay the piper if you like mixing types.
+ ;;This is (or should be) a rare enough to not matter.
+ ((coerceable? clx cly)
+ (dot (copy! x (zeros (dimensions x) cly)) y conjugate-p))
+ ((coerceable? cly clx)
+ (dot x (copy! y (zeros (dimensions y) clx)) conjugate-p))
+ (t
+ (error "Don't know how to compute the dot product of ~a , ~a." clx cly)))))
commit 0b071d4d11400da962b99cbff50ee42afc443b0b
Author: Akshay Srinivasan <aks...@gm...>
Date: Wed Jun 19 01:28:54 2013 -0700
Cleaned up blas-helpers.lisp
diff --git a/matlisp.asd b/matlisp.asd
index 9c1efa3..6a36308 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -128,6 +128,7 @@
:components ((:file "numeric")
#+maxima
(:file "symbolic-tensor")
+ #+nil
(:file "matrix"
:depends-on ("numeric"))))
(:module "matlisp-level-1"
diff --git a/packages.lisp b/packages.lisp
index 96949cb..4168ed9 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -32,34 +32,34 @@
(:export
;;<conditon {accessors*}>
;;Generic errors
- #:generic-error #:message
+ #:generic-error
#:dimension-mismatch
#:assumption-violated
- #:invalid-type #:given #:expected
- #:invalid-arguments #:argnum
- #:invalid-value #:given #:expected
- #:unknown-token #:token
+ #:invalid-type
+ #:invalid-arguments
+ #:invalid-value
+ #:unknown-token
#:parser-error
- #:coercion-error #:from #:to
- #:out-of-bounds-error #:requested #:bound
- #:non-uniform-bounds-error #:assumed #:found
+ #:coercion-error
+ #:out-of-bounds-error
+ #:non-uniform-bounds-error
;;Permutation conditions
- #:permutation #:permutation
+ #:permutation
#:permutation-invalid-error
- #:permutation-permute-error #:seq-len #:group-rank
+ #:permutation-permute-error
;;Tensor conditions
- #:tensor-error #:tensor
- #:tensor-store-index-out-of-bounds #:index #:store-size
- #:tensor-insufficient-store #:store-size #:max-idx
- #:tensor-not-matrix #:rank
- #:tensor-not-vector #:rank
- #:tensor-index-out-of-bounds #:argument #:index #:dimension
- #:tensor-index-rank-mismatch #:index-rank #:rank
- #:tensor-invalid-head-value #:head
- #:tensor-invalid-dimension-value #:argument #:dimension
- #:tensor-invalid-stride-value #:argument #:stride
- #:tensor-cannot-find-counter-class #:tensor-class
- #:tensor-cannot-find-optimization #:tensor-class
+ #:tensor-error
+ #:tensor-store-index-out-of-bounds
+ #:tensor-insufficient-store
+ #:tensor-not-matrix
+ #:tensor-not-vector
+ #:tensor-index-out-of-bounds
+ #:tensor-index-rank-mismatch
+ #:tensor-invalid-head-value
+ #:tensor-invalid-dimension-value
+ #:tensor-invalid-stride-value
+ #:tensor-cannot-find-counter-class
+ #:tensor-cannot-find-optimization
#:tensor-dimension-mismatch
#:tensor-store-not-consecutive
#:tensor-method-does-not-exist
diff --git a/src/base/blas-helpers.lisp b/src/base/blas-helpers.lisp
index 07664c2..6b8b735 100644
--- a/src/base/blas-helpers.lisp
+++ b/src/base/blas-helpers.lisp
@@ -1,12 +1,35 @@
(in-package #:matlisp)
+
+(defun consecutive-storep (tensor)
+ (declare (type standard-tensor tensor))
+ (memoizing (tensor consecutive-storep)
+ (mlet* (((sort-std std-perm) (very-quickly (sort-permute-base (copy-seq (the index-store-vector (strides tensor))) #'<))
+ :type (index-store-vector pindex-store-vector))
+ (perm-dims (very-quickly (apply-action! (copy-seq (the index-store-vector (dimensions tensor))) std-perm)) :type index-store-vector))
+ (very-quickly
+ (loop
+ :for so-st :across sort-std
+ :for so-di :across perm-dims
+ :and accumulated-off := (aref sort-std 0) :then (the index-type (* accumulated-off so-di))
+ :unless (= so-st accumulated-off) :do (return (values nil perm-dims sort-std std-perm))
+ :finally (return (values (aref sort-std 0) perm-dims sort-std std-perm)))))))
+
+(defun blas-copyablep (ten-a ten-b)
+ (declare (type standard-tensor ten-a ten-b))
+ (when (= (rank ten-a) (rank ten-b))
+ (mlet*
+ (((csto-a? pdims-a tmp perm-a) (consecutive-storep ten-a) :type (t index-store-vector nil pindex-store-vector))
+ ((csto-b? pdims-b tmp perm-b) (consecutive-storep ten-b) :type (t index-store-vector nil pindex-store-vector)))
+ (when (and csto-a? csto-b? (very-quickly (lvec-eq perm-a perm-b)) (very-quickly (lvec-eq pdims-a pdims-b)))
+ (list csto-a? csto-b?)))))
(definline fortran-nop (op)
- (ecase op (#\T #\N) (#\N #\T)))
+ (ecase op (#\t #\n) (#\n #\t)))
(defun split-job (job)
(declare (type symbol job))
(let-typed ((name (symbol-name job) :type string))
- (loop :for x :across name :collect x)))
+ (loop :for x :across name :collect (char-downcase x))))
(definline flip-major (job)
(declare (type symbol job))
@@ -14,47 +37,10 @@
(:row-major :col-major)
(:col-major :row-major)))
-(defun blas-copyable-p (ten-a ten-b)
- (declare (type standard-tensor ten-a ten-b))
- (when (= (rank ten-a) (rank ten-b))
- (mlet*
- (((sort-std-a std-a-perm) (very-quickly (sort-permute-base (copy-seq (the index-store-vector (strides ten-a))) #'<)) :type (index-store-vector pindex-store-vector))
- (perm-a-dims (very-quickly (apply-action! (copy-seq (the index-store-vector (dimensions ten-a))) std-a-perm)) :type index-store-vector)
- ;;If blas-copyable then the strides must have the same sorting permutation.
- (sort-std-b (very-quickly (apply-action! (copy-seq (the index-store-vector (strides ten-b))) std-a-perm)) :type index-store-vector)
- (perm-b-dims (very-quickly (apply-action! (copy-seq (the index-store-vector (dimensions ten-b))) std-a-perm)) :type index-store-vector))
- (very-quickly
- (loop
- :for i :of-type index-type :from 0 :below (rank ten-a)
- :for sost-a :across sort-std-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 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)
- (= (aref perm-a-dims i) (aref perm-b-dims i)))
- (return nil))
- :finally (return (list (aref sort-std-a 0) (aref sort-std-b 0))))))))
-
-(definline consecutive-store-p (tensor)
- (declare (type standard-tensor tensor))
- (mlet* (((sort-std std-perm) (very-quickly (sort-permute-base (copy-seq (the index-store-vector (strides tensor))) #'<))
- :type (index-store-vector pindex-store-vector))
- (perm-dims (very-quickly (apply-action! (copy-seq (the index-store-vector (dimensions tensor))) std-perm)) :type index-store-vector))
- (very-quickly
- (loop
- :for so-st :across sort-std
- :for so-di :across perm-dims
- :and accumulated-off := (aref sort-std 0) :then (the index-type (* accumulated-off so-di))
- :unless (= so-st accumulated-off) :do (return nil)
-
- :finally (return (values t (aref sort-std 0)))))))
-
-(definline blas-matrix-compatible-p (matrix op)
- (declare (type standard-matrix matrix)
+(definline blas-matrix-compatiblep (matrix op)
+ (declare (type standard-tensor matrix)
(type character op))
+ (assert (tensor-matrixp matrix) nil 'tensor-not-matrix)
(let*-typed ((stds (strides matrix) :type index-store-vector)
(rs (aref stds 0) :type index-type)
(cs (aref stds 1) :type index-type))
diff --git a/src/base/permutation.lisp b/src/base/permutation.lisp
index 5777efe..0869622 100644
--- a/src/base/permutation.lisp
+++ b/src/base/permutation.lisp
@@ -1,8 +1,10 @@
(in-package #:matlisp)
;;This must match the type used in LAPACK
+;;(unsigned-byte 32)
+
(deftype pindex-type ()
- '(unsigned-byte 32))
+ 'fixnum)
(deftype pindex-store-vector (&optional (size '*))
`(simple-array pindex-type (,size)))
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 397e8e7..0544757 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -62,6 +62,18 @@
:documentation "Place for computable attributes of an object instance."))
(:documentation "Basic tensor class."))
+(defmacro memoizing ((tensor name) &rest body)
+ (declare (type symbol name))
+ (with-gensyms (tens)
+ `(let* ((,tens ,tensor))
+ (declare (type standard-tensor ,tens))
+ (multiple-value-bind (value present?) (gethash ',name (attributes ,tens))
+ (values-list
+ (if present?
+ value
+ (setf (gethash ',name (attributes ,tens))
+ (multiple-value-list (progn ,@body)))))))))
+
;;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)
"
@@ -69,30 +81,14 @@
tensor, for example #.(make-tensors ...)"
(make-load-form-saving-slots tensor :environment env))
-;;These should ideally be memoised
-(defgeneric rank (tensor)
- (:documentation "
- Syntax
- ======
- (rank tensor)
-
- Purpose
- =======
- Returns the rank of the tensor object.")
- (:method ((tensor standard-tensor))
- (length (dimensions tensor))))
-
-(defgeneric size (tensor)
- (:documentation "
- Syntax
- ======
- (size tensor)
+;;These should ideally be memoised (or not)
+(definline rank (tensor)
+ (declare (type standard-tensor tensor))
+ (length (the index-store-vector (dimensions tensor))))
- Purpose
- =======
- Returns the number of elements in the tensor.")
- (:method ((tensor standard-tensor))
- (lvec-foldr #'* (the index-store-vector (dimensions tensor)))))
+(definline size (tensor)
+ (declare (type standard-tensor tensor))
+ (lvec-foldr #'* (the index-store-vector (dimensions tensor))))
(defgeneric store-size (tensor)
(:documentation "
@@ -296,7 +292,7 @@
(setf (store-ref tensor idx) value)))
;;
-(defun tensor-typep (tensor subscripts)
+(defun tensor-typep (tensor subs)
"
Syntax
======
@@ -310,31 +306,35 @@
Examples
========
Checking for a vector:
- > (tensor-typep ten '(*))
+ > (tensor-typep ten '(class-name *))
Checking for a matrix with 2 columns:
- > (tensor-typep ten '(* 2))
+ > (tensor-typep ten '(real-tensor (* 2)))
"
(declare (type standard-tensor tensor))
- (let-typed ((rank (rank tensor) :type index-type)
- (dims (dimensions tensor) :type index-store-vector))
- (very-quickly
- (loop :for val :in subscripts
- :for i :of-type index-type := 0 :then (1+ i)
- :do (unless (or (eq val '*) (eq val (aref dims i)))
- (return nil))
- :finally (return (when (= (1+ i) rank) t))))))
-
-(definline matrix-p (ten)
+ (destructuring-bind (cls &optional subscripts) (ensure-list subs)
+ (and (typep tensor cls)
+ (if subscripts
+ (let-typed ((rank (rank tensor) :type index-type)
+ (dims (dimensions tensor) :type index-store-vector))
+ (very-quickly
+ (loop :for val :in subscripts
+ :for i :of-type index-type := 0 :then (1+ i)
+ :do (unless (or (eq val '*) (eq val (aref dims i)))
+ (return nil))
+ :finally (return (when (= (1+ i) rank) t)))))
+ t))))
+
+(definline tensor-matrixp (ten)
(declare (type standard-tensor ten))
(= (rank ten) 2))
-(definline vector-p (ten)
+(definline tensor-vectorp (ten)
(declare (type standard-tensor ten))
(= (rank ten) 1))
-(definline square-p (tensor)
+(definline tensor-squarep (tensor)
(let-typed ((dims (dimensions tensor) :type index-store-vector))
(lvec-foldr #'(lambda (a b) (if (eq a b) a nil)) dims)))
@@ -357,13 +357,13 @@
X
;; Get (:, 0, 0)
- > (sub-tensor~ X '((* * *) (0 * 1) (0 * 1)))
+ > (sub-tensor/ X '((* * *) (0 * 1) (0 * 1)))
;; Get (:, 2:5, :)
- > (sub-tensor~ X '((* * *) (2 * 5)))
+ > (sub-tensor/ X '((* * *) (2 * 5)))
;; Get (:, :, 0:2:10) (0:10:2 = [i : 0 <= i < 10, i % 2 = 0])
- > (sub-tensor~ X '((* * *) (* * *) (0 2 10)))
+ > (sub-tensor/ X '((* * *) (* * *) (0 2 10)))
Commentary
==========
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index c01039e..e67612d 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -133,7 +133,7 @@
;;
(defmethod copy! :before ((x standard-tensor) (y standard-tensor))
- (assert (lvec-eq (dimensions x) (dimensions y) #'=) nil
+ (assert (very-quickly (lvec-eq (the index-store-vector (dimensions x)) (the index-store-vector (dimensions y)) #'=)) nil
'tensor-dimension-mismatch))
;;This shouldn't happen ideally
@@ -166,7 +166,7 @@
`(defmethod copy! ((x ,clx) (y ,cly))
,(recursive-append
(when (subtypep clx 'blas-numeric-tensor)
-
+ `(if (and (call-fortran? x (t/l1-lb ,clx)) (blas-copyable-p
(mod-dotimes (idx (dimensions x))
do (setf (tensor-ref y idx) (tensor-ref x idx)))
commit ca0287f4334829367de787ba0e20947f53b6298c
Merge: ea15112 24def88
Author: Akshay Srinivasan <aks...@gm...>
Date: Tue Jun 18 23:34:49 2013 -0700
Merge branch 'tensor' into classy
Conflicts:
matlisp.asd
src/base/blas-helpers.lisp
src/base/standard-tensor.lisp
src/level-1/tensor-maker.lisp
src/utilities/functions.lisp
diff --cc matlisp.asd
index 5b8b043,dc7a129..9c1efa3
--- a/matlisp.asd
+++ b/matlisp.asd
@@@ -122,14 -125,12 +125,11 @@@
(:module "matlisp-classes"
:pathname "classes"
:depends-on ("matlisp-base")
- :components ((:file "real-tensor")
- (:file "complex-tensor")
+ :components ((:file "numeric")
#+maxima
(:file "symbolic-tensor")
- #+nil
(:file "matrix"
- :depends-on ("real-tensor" "complex-tensor"))))
- #+nil
+ :depends-on ("numeric"))))
(:module "matlisp-level-1"
:pathname "level-1"
:depends-on ("matlisp-base" "matlisp-classes" "foreign-core")
@@@ -146,7 -150,7 +149,8 @@@
(:file "axpy"
:depends-on ("copy" "scal"))
(:file "trans"
- :depends-on ("scal" "copy"))))
+ :depends-on ("scal" "copy")))))
++
#+nil
(:module "matlisp-level-2"
:pathname "level-2"
diff --cc src/base/blas-helpers.lisp
index f48901a,e34dc8b..07664c2
--- a/src/base/blas-helpers.lisp
+++ b/src/base/blas-helpers.lisp
@@@ -1,60 -1,47 +1,60 @@@
(in-package #:matlisp)
-;;Check dimensions of the tensors before passing the argument here!
+(definline fortran-nop (op)
+ (ecase op (#\T #\N) (#\N #\T)))
+
+(defun split-job (job)
+ (declare (type symbol job))
+ (let-typed ((name (symbol-name job) :type string))
+ (loop :for x :across name :collect x)))
+
+(definline flip-major (job)
+ (declare (type symbol job))
+ (case job
+ (:row-major :col-major)
+ (:col-major :row-major)))
+
(defun blas-copyable-p (ten-a ten-b)
(declare (type standard-tensor ten-a ten-b))
- (mlet*
- (((sort-std-a std-a-perm) (let-typed ((std-a (strides ten-a) :type index-store-vector))
- (very-quickly (sort-permute (copy-seq std-a) #'<)))
- :type (index-store-vector permutation-action))
- (perm-a-dims (permute (dimensions ten-a) std-a-perm) :type index-store-vector)
- ;;If blas-copyable then the strides must have the same sorting permutation.
- (sort-std-b (permute (strides ten-b) std-a-perm) :type index-store-vector)
- (perm-b-dims (permute (dimensions ten-b) std-a-perm) :type index-store-vector))
- (very-quickly
- (loop
- :for i :of-type index-type :from 0 :below (rank ten-a)
- :for sost-a :across sort-std-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 b-aoff :of-type index-type := (aref sort-std-b 0) :then (the index-type (* b-aoff (aref perm-b-dims (1- i))))
- ;;
- :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)))))))
+ (when (= (rank ten-a) (rank ten-b))
+ (mlet*
+ (((sort-std-a std-a-perm) (very-quickly (sort-permute-base (copy-seq (the index-store-vector (strides ten-a))) #'<)) :type (index-store-vector pindex-store-vector))
+ (perm-a-dims (very-quickly (apply-action! (copy-seq (the index-store-vector (dimensions ten-a))) std-a-perm)) :type index-store-vector)
+ ;;If blas-copyable then the strides must have the same sorting permutation.
+ (sort-std-b (very-quickly (apply-action! (copy-seq (the index-store-vector (strides ten-b))) std-a-perm)) :type index-store-vector)
+ (perm-b-dims (very-quickly (apply-action! (copy-seq (the index-store-vector (dimensions ten-b))) std-a-perm)) :type index-store-vector))
+ (very-quickly
+ (loop
+ :for i :of-type index-t...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X