Menu
▾
▴
matlisp-commit
|
From: Akshay S. <ak...@us...> - 2013-01-20 06:49:48
|
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 657120d7a8bc0b0e26bbb522697e75c9f5b92ec1 (commit)
from c8fdfac6f7cd8e4dd91f49bf7794a579cb8a5ffc (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 657120d7a8bc0b0e26bbb522697e75c9f5b92ec1
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Jan 19 22:44:18 2013 -0800
o Enclosed function generated functions inside eval-when.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 68301b2..101c7cb 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -355,7 +355,7 @@
;;Error checking
(assert (and f+ f- finv+ fid+ f* f/ finv* fid* f= store-allocator coercer coercer-unforgiving matrix vector reader value-writer reader-writer swapper))
;;
- `(progn
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
;;Class definitions
(defclass ,tensor-class (standard-tensor)
((store :type ,store-type))
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index b59480a..d161d97 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -34,41 +34,44 @@
;;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)
- `(defun ,func (alpha from to)
- (declare (type ,tensor-class from to)
- (type ,(getf opt :element-type) alpha))
- ,(let
- ((lisp-routine
- `(let ((f-sto (store from))
- (t-sto (store to)))
- (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
- (very-quickly
- (mod-dotimes (idx (dimensions from))
- with (linear-sums
- (f-of (strides from) (head from))
- (t-of (strides to) (head to)))
- do (let ((f-val (,(getf opt :reader) f-sto f-of))
- (t-val (,(getf opt :reader) t-sto t-of)))
- (declare (type ,(getf opt :element-type) f-val t-val))
- (let ((t-new (,(getf opt :f+) (,(getf opt :f*) f-val alpha) t-val)))
- (declare (type ,(getf opt :element-type) t-new))
- (,(getf opt :value-writer) t-new t-sto t-of))))))))
- (if blas-func
- `(let* ((call-fortran? (> (number-of-elements to)
- ,fortran-lb))
- (strd-p (when call-fortran? (blas-copyable-p from to))))
- (cond
- ((and call-fortran? strd-p)
- (,blas-func (number-of-elements from) alpha
- (store from) (first strd-p)
- (store to) (second strd-p)
- (head from) (head to)))
- (t
- ,lisp-routine)))
- lisp-routine))
- to)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (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))
+ (defun ,func (alpha from to)
+ (declare (type ,tensor-class from to)
+ (type ,(getf opt :element-type) alpha))
+ ,(let
+ ((lisp-routine
+ `(let ((f-sto (store from))
+ (t-sto (store to)))
+ (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
+ (very-quickly
+ (mod-dotimes (idx (dimensions from))
+ with (linear-sums
+ (f-of (strides from) (head from))
+ (t-of (strides to) (head to)))
+ do (let ((f-val (,(getf opt :reader) f-sto f-of))
+ (t-val (,(getf opt :reader) t-sto t-of)))
+ (declare (type ,(getf opt :element-type) f-val t-val))
+ (let ((t-new (,(getf opt :f+) (,(getf opt :f*) f-val alpha) t-val)))
+ (declare (type ,(getf opt :element-type) t-new))
+ (,(getf opt :value-writer) t-new t-sto t-of))))))))
+ (if blas-func
+ `(let* ((call-fortran? (> (number-of-elements to)
+ ,fortran-lb))
+ (strd-p (when call-fortran? (blas-copyable-p from to))))
+ (cond
+ ((and call-fortran? strd-p)
+ (,blas-func (number-of-elements from) alpha
+ (store from) (first strd-p)
+ (store to) (second strd-p)
+ (head from) (head to)))
+ (t
+ ,lisp-routine)))
+ lisp-routine))
+ to))))
(defmacro generate-typed-num-axpy! (func (tensor-class blas-func fortran-lb))
;;Be very careful when using functions generated by this macro.
@@ -77,62 +80,65 @@
;;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)
- `(defun ,func (num-from to)
- (declare (type ,tensor-class to)
- (type ,(getf opt :element-type) num-from))
- ,(let
- ((lisp-routine
- `(let-typed
- ((t-sto (store to) :type ,(linear-array-type (getf opt :store-type))))
- (very-quickly
- (mod-dotimes (idx (dimensions to))
- with (linear-sums
- (t-of (strides to) (head to)))
- do (let-typed
- ((val (,(getf opt :reader) t-sto t-of) :type ,(getf opt :element-type)))
- (,(getf opt :value-writer) (,(getf opt :f+) num-from val) t-sto t-of)))))))
- (if blas-func
- `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
- (min-strd (when call-fortran? (consecutive-store-p to))))
- (cond
- ((and call-fortran? min-strd)
- (let ((num-array (,(getf opt :store-allocator) 1)))
- (declare (type ,(linear-array-type (getf opt :store-type)) num-array))
- (let-typed ((id (,(getf opt :fid+)) :type ,(getf opt :element-type)))
- (,(getf opt :value-writer) id num-array 0))
- (,blas-func (number-of-elements to) num-from
- num-array 0
- (store to) min-strd
- 0 (head to))))
- (t
- ,lisp-routine)))
- lisp-routine))
- to)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (let ((opt (get-tensor-class-optimization-hashtable ',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))
+ (defun ,func (num-from to)
+ (declare (type ,tensor-class to)
+ (type ,(getf opt :element-type) num-from))
+ ,(let
+ ((lisp-routine
+ `(let-typed
+ ((t-sto (store to) :type ,(linear-array-type (getf opt :store-type))))
+ (very-quickly
+ (mod-dotimes (idx (dimensions to))
+ with (linear-sums
+ (t-of (strides to) (head to)))
+ do (let-typed
+ ((val (,(getf opt :reader) t-sto t-of) :type ,(getf opt :element-type)))
+ (,(getf opt :value-writer) (,(getf opt :f+) num-from val) t-sto t-of)))))))
+ (if blas-func
+ `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
+ (min-strd (when call-fortran? (consecutive-store-p to))))
+ (cond
+ ((and call-fortran? min-strd)
+ (let ((num-array (,(getf opt :store-allocator) 1)))
+ (declare (type ,(linear-array-type (getf opt :store-type)) num-array))
+ (let-typed ((id (,(getf opt :fid+)) :type ,(getf opt :element-type)))
+ (,(getf opt :value-writer) id num-array 0))
+ (,blas-func (number-of-elements to) num-from
+ num-array 0
+ (store to) min-strd
+ 0 (head to))))
+ (t
+ ,lisp-routine)))
+ lisp-routine))
+ to))))
;;Real
(generate-typed-axpy! real-typed-axpy!
- (real-tensor daxpy *real-l1-fcall-lb*))
+ (real-tensor daxpy *real-l1-fcall-lb*))
(generate-typed-num-axpy! real-typed-num-axpy!
- (real-tensor daxpy *real-l1-fcall-lb*))
+ (real-tensor daxpy *real-l1-fcall-lb*))
;;Complex
(generate-typed-axpy! complex-typed-axpy!
- (complex-tensor zaxpy *complex-l1-fcall-lb*))
+ (complex-tensor zaxpy *complex-l1-fcall-lb*))
(generate-typed-num-axpy! complex-typed-num-axpy!
- (complex-tensor zaxpy *complex-l1-fcall-lb*))
+ (complex-tensor zaxpy *complex-l1-fcall-lb*))
;;Symbolic
#+maxima
(progn
(generate-typed-axpy! symbolic-typed-axpy!
- (symbolic-tensor nil 0))
+ (symbolic-tensor nil 0))
(generate-typed-num-axpy! symbolic-typed-num-axpy!
- (symbolic-tensor nil 0)))
+ (symbolic-tensor nil 0)))
;;---------------------------------------------------------------;;
@@ -155,8 +161,8 @@
is stored in Y and Y is returned.
")
(:method :before ((alpha number) (x standard-tensor) (y standard-tensor))
- (assert (lvec-eq (dimensions x) (dimensions y) #'=) nil
- 'tensor-dimension-mismatch))
+ (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)))
@@ -209,8 +215,8 @@
X,Y must have the same dimensions.
")
(:method :before ((alpha number) (x standard-tensor) (y standard-tensor))
- (unless (lvec-eq (dimensions x) (dimensions y) #'=)
- (error 'tensor-dimension-mismatch))))
+ (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)
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index bdb16fb..6680e8a 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -34,37 +34,40 @@
;;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)
- `(defun ,func (from to)
- (declare (type ,tensor-class from to))
- ,(let
- ((lisp-routine
- `(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 (,(getf opt :reader-writer) f-sto f-of t-sto t-of))))))
- (if blas-func
- `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
- (strd-p (when call-fortran? (blas-copyable-p from to))))
- (cond
- ((and strd-p call-fortran?)
- (,blas-func (number-of-elements from)
- (store from) (first strd-p)
- (store to) (second strd-p)
- (head from) (head to)))
- (t
- ,lisp-routine)))
- lisp-routine))
- to)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (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))
+ (defun ,func (from to)
+ (declare (type ,tensor-class from to))
+ ,(let
+ ((lisp-routine
+ `(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 (,(getf opt :reader-writer) f-sto f-of t-sto t-of))))))
+ (if blas-func
+ `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
+ (strd-p (when call-fortran? (blas-copyable-p from to))))
+ (cond
+ ((and strd-p call-fortran?)
+ (,blas-func (number-of-elements from)
+ (store from) (first strd-p)
+ (store to) (second strd-p)
+ (head from) (head to)))
+ (t
+ ,lisp-routine)))
+ lisp-routine))
+ to))))
(defmacro generate-typed-num-copy! (func (tensor-class blas-func fortran-lb))
;;Be very careful when using functions generated by this macro.
@@ -73,59 +76,62 @@
;;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)
- `(defun ,func (num-from to)
- (declare (type ,tensor-class to)
- (type ,(getf opt :element-type) num-from))
- ,(let
- ((lisp-routine
- `(let-typed
- ((t-sto (store to) :type ,(linear-array-type (getf opt :store-type))))
- (very-quickly
- (mod-dotimes (idx (dimensions to))
- with (linear-sums
- (t-of (strides to) (head to)))
- do (,(getf opt :value-writer) num-from t-sto t-of))))))
- (if blas-func
- `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
- (min-stride (when call-fortran? (consecutive-store-p to))))
- (cond
- ((and call-fortran? min-stride)
- (let ((num-array (,(getf opt :store-allocator) 1)))
- (declare (type ,(linear-array-type (getf opt :store-type)) num-array))
- (,(getf opt :value-writer) num-from num-array 0)
- (,blas-func (number-of-elements to)
- num-array 0
- (store to) min-stride
- 0 (head to))))
- (t
- ,lisp-routine)))
- lisp-routine))
- to)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (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))
+ (defun ,func (num-from to)
+ (declare (type ,tensor-class to)
+ (type ,(getf opt :element-type) num-from))
+ ,(let
+ ((lisp-routine
+ `(let-typed
+ ((t-sto (store to) :type ,(linear-array-type (getf opt :store-type))))
+ (very-quickly
+ (mod-dotimes (idx (dimensions to))
+ with (linear-sums
+ (t-of (strides to) (head to)))
+ do (,(getf opt :value-writer) num-from t-sto t-of))))))
+ (if blas-func
+ `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
+ (min-stride (when call-fortran? (consecutive-store-p to))))
+ (cond
+ ((and call-fortran? min-stride)
+ (let ((num-array (,(getf opt :store-allocator) 1)))
+ (declare (type ,(linear-array-type (getf opt :store-type)) num-array))
+ (,(getf opt :value-writer) num-from num-array 0)
+ (,blas-func (number-of-elements to)
+ num-array 0
+ (store to) min-stride
+ 0 (head to))))
+ (t
+ ,lisp-routine)))
+ lisp-routine))
+ to))))
;;Real
(generate-typed-copy! real-typed-copy!
- (real-tensor dcopy *real-l1-fcall-lb*))
+ (real-tensor dcopy *real-l1-fcall-lb*))
(generate-typed-num-copy! real-typed-num-copy!
- (real-tensor dcopy *real-l1-fcall-lb*))
+ (real-tensor dcopy *real-l1-fcall-lb*))
;;Complex
(generate-typed-copy! complex-typed-copy!
- (complex-tensor zcopy *complex-l1-fcall-lb*))
+ (complex-tensor zcopy *complex-l1-fcall-lb*))
(generate-typed-num-copy! complex-typed-num-copy!
- (complex-tensor zcopy *complex-l1-fcall-lb*))
+ (complex-tensor zcopy *complex-l1-fcall-lb*))
;;Symbolic
#+maxima
(progn
-(generate-typed-copy! symbolic-typed-copy!
- (symbolic-tensor nil 0))
+ (generate-typed-copy! symbolic-typed-copy!
+ (symbolic-tensor nil 0))
-(generate-typed-num-copy! symbolic-typed-num-copy!
- (symbolic-tensor nil 0)))
+ (generate-typed-num-copy! symbolic-typed-num-copy!
+ (symbolic-tensor nil 0)))
;;---------------------------------------------------------------;;
;;Generic function defined in src;base;generic-copy.lisp
@@ -174,7 +180,7 @@
;; Copy between a Lisp array and a tensor
(defun convert-to-lisp-array (tensor)
-"
+ "
Syntax
======
(convert-to-lisp-array tensor)
@@ -189,11 +195,11 @@
(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)))
+ (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)
@@ -210,21 +216,21 @@
(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))))
+ (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)))))))
+ (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)
;;
@@ -242,23 +248,23 @@
(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))))))
+ (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)
(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))))))
+ (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)
;;
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index c3d571f..435cff1 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -34,22 +34,27 @@
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
(setf (getf opt :dot) func
(get-tensor-class-optimization tensor-class) opt)
- `(defun ,func (x y conjugate-p)
- (declare (type ,tensor-class x y)
- ,(if conj?
- `(type boolean conjugate-p)
- `(ignore conjugate-p)))
- ,(let
- ((lisp-routine
- `(let-typed
- ((stp-x (aref (strides x) 0) :type index-type)
- (sto-x (store x) :type ,(linear-array-type (getf opt :store-type)))
- (stp-y (aref (strides y) 0) :type index-type)
- (sto-y (store y) :type ,(linear-array-type (getf opt :store-type)))
- (nele (number-of-elements x) :type index-type))
- ,(labels ((main-loop (conjp)
- `(very-quickly
- (loop :repeat nele
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (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))
+ (defun ,func (x y conjugate-p)
+ (declare (type ,tensor-class x y)
+ ,(if conj?
+ `(type boolean conjugate-p)
+ `(ignore conjugate-p)))
+ ,(let
+ ((lisp-routine
+ `(let-typed
+ ((stp-x (aref (strides x) 0) :type index-type)
+ (sto-x (store x) :type ,(linear-array-type (getf opt :store-type)))
+ (stp-y (aref (strides y) 0) :type index-type)
+ (sto-y (store y) :type ,(linear-array-type (getf opt :store-type)))
+ (nele (number-of-elements x) :type index-type))
+ ,(labels ((main-loop (conjp)
+ `(very-quickly
+ (loop :repeat nele
:for of-x :of-type index-type = (head x) :then (+ of-x stp-x)
:for of-y :of-type index-type = (head y) :then (+ of-y stp-y)
:with dot :of-type ,(getf opt :element-type) = (,(getf opt :fid+))
@@ -64,42 +69,42 @@
,(main-loop t)
,(main-loop nil))
(main-loop nil))))))
- (if blas?
- `(let ((call-fortran? (> (number-of-elements x)
- ,fortran-lb)))
- (cond
- (call-fortran?
- ,(recursive-append
- (when conj?
- `(if conjugate-p
- (,blasc-func (number-of-elements x)
- (store x) (aref (strides x) 0)
- (store y) (aref (strides y) 0)
- (head x) (head y))))
- `(,blas-func (number-of-elements x)
- (store x) (aref (strides x) 0)
- (store y) (aref (strides y) 0)
- (head x) (head y))))
- (t
- ,lisp-routine)))
- lisp-routine)))))
+ (if blas?
+ `(let ((call-fortran? (> (number-of-elements x)
+ ,fortran-lb)))
+ (cond
+ (call-fortran?
+ ,(recursive-append
+ (when conj?
+ `(if conjugate-p
+ (,blasc-func (number-of-elements x)
+ (store x) (aref (strides x) 0)
+ (store y) (aref (strides y) 0)
+ (head x) (head y))))
+ `(,blas-func (number-of-elements x)
+ (store x) (aref (strides x) 0)
+ (store y) (aref (strides y) 0)
+ (head x) (head y))))
+ (t
+ ,lisp-routine)))
+ lisp-routine))))))
(generate-typed-dot real-typed-dot
- (real-tensor ddot nil *real-l1-fcall-lb*))
+ (real-tensor ddot nil *real-l1-fcall-lb*))
(generate-typed-dot complex-typed-dot
- (complex-tensor zdotu zdotc *complex-l1-fcall-lb*))
+ (complex-tensor zdotu zdotc *complex-l1-fcall-lb*))
#+maxima
(generate-typed-dot symbolic-typed-dot
- (symbolic-tensor nil nil 0))
+ (symbolic-tensor nil nil 0))
;;---------------------------------------------------------------;;
-
-
+
+
(defgeneric dot (x y &optional conjugate-p)
(:documentation
-"
+ "
Sytnax
======
(DOT x y [conjugate-p])
@@ -130,9 +135,9 @@
otherwise.
")
(:method :before ((x standard-vector) (y standard-vector) &optional (conjugate-p t))
- (declare (ignore conjugate-p))
- (unless (lvec-eq (dimensions x) (dimensions y) #'=)
- (error 'tensor-dimension-mismatch))))
+ (declare (ignore conjugate-p))
+ (unless (lvec-eq (dimensions x) (dimensions y) #'=)
+ (error 'tensor-dimension-mismatch))))
(defmethod dot ((x number) (y number) &optional (conjugate-p t))
(if conjugate-p
@@ -181,16 +186,16 @@
(let ((dot-name (gensym (string+ (symbol-name classn) "-dot-"))))
(compile-and-eval
`(generate-typed-dot ,dot-name
- (,classn nil nil 0)))
+ (,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))))
+ `((declare (ignore conjugate-p))))
,(if (get classn :fconj)
`(,dot-func x y conjugate-p)
`(,dot-func x y t))))
- ;;Call method
+ ;;Call method
(dot x y conjugate-p)))
((coercable? (class-name xcl) (class-name ycl))
...)
diff --git a/src/level-1/realimag.lisp b/src/level-1/realimag.lisp
index 52cea96..b38569c 100644
--- a/src/level-1/realimag.lisp
+++ b/src/level-1/realimag.lisp
@@ -29,7 +29,7 @@
(in-package #:matlisp)
(definline tensor-realpart~ (tensor)
-"
+ "
Syntax
======
(tensor-realpart~ tensor)
@@ -51,7 +51,7 @@
(number (realpart tensor))))
(definline tensor-imagpart~ (tensor)
-"
+ "
Syntax
======
(tensor-imagpart~ tensor)
@@ -73,7 +73,7 @@
(number (imagpart tensor))))
(definline tensor-realpart (tensor)
-"
+ "
Syntax
======
(tensor-realpart tensor)
@@ -89,7 +89,7 @@
(copy (tensor-realpart~ tensor)))
(definline tensor-imagpart (tensor)
-"
+ "
Syntax
======
(tensor-imagpart matrix)
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index 6013a9c..ad2749d 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -31,147 +31,159 @@
(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)
- `(defun ,func (from to)
- (declare (type ,tensor-class from to))
- ,(let
- ((lisp-routine
- `(let ((f-sto (store from))
- (t-sto (store to)))
- (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
- (very-quickly
- (mod-dotimes (idx (dimensions from))
- with (linear-sums
- (f-of (strides from) (head from))
- (t-of (strides to) (head to)))
- do (let*-typed ((val-f (,(getf opt :reader) f-sto f-of) :type ,(getf opt :element-type))
- (val-t (,(getf opt :reader) t-sto t-of) :type ,(getf opt :element-type))
- (mul (,(getf opt :f*) val-f val-t) :type ,(getf opt :element-type)))
- (,(getf opt :value-writer) mul t-sto t-of)))))))
- (if fortran-func
- `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
- (strd-p (when call-fortran? (blas-copyable-p from to))))
- (cond
- ((and strd-p call-fortran?)
- (,fortran-func (number-of-elements from)
- (store from) (first strd-p)
- (store to) (second strd-p)
- (head from) (head to)))
- (t
- ,lisp-routine)))
- lisp-routine))
- to)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (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))
+ (defun ,func (from to)
+ (declare (type ,tensor-class from to))
+ ,(let
+ ((lisp-routine
+ `(let ((f-sto (store from))
+ (t-sto (store to)))
+ (declare (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
+ (very-quickly
+ (mod-dotimes (idx (dimensions from))
+ with (linear-sums
+ (f-of (strides from) (head from))
+ (t-of (strides to) (head to)))
+ do (let*-typed ((val-f (,(getf opt :reader) f-sto f-of) :type ,(getf opt :element-type))
+ (val-t (,(getf opt :reader) t-sto t-of) :type ,(getf opt :element-type))
+ (mul (,(getf opt :f*) val-f val-t) :type ,(getf opt :element-type)))
+ (,(getf opt :value-writer) mul t-sto t-of)))))))
+ (if fortran-func
+ `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
+ (strd-p (when call-fortran? (blas-copyable-p from to))))
+ (cond
+ ((and strd-p call-fortran?)
+ (,fortran-func (number-of-elements from)
+ (store from) (first strd-p)
+ (store to) (second strd-p)
+ (head from) (head to)))
+ (t
+ ,lisp-routine)))
+ lisp-routine))
+ to))))
(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)
- `(defun ,func (alpha to)
- (declare (type ,tensor-class to)
- (type ,(getf opt :element-type) alpha))
- ,(let
- ((lisp-routine
- `(let ((t-sto (store to)))
- (declare (type ,(linear-array-type (getf opt :store-type)) t-sto))
- (very-quickly
- (mod-dotimes (idx (dimensions to))
- with (linear-sums
- (t-of (strides to) (head to)))
- do (let ((scal-val (,(getf opt :f*) (,(getf opt :reader) t-sto t-of) alpha)))
- (,(getf opt :value-writer) scal-val t-sto t-of)))))))
- (if blas-func
- `(let* ((call-fortran? (> (number-of-elements to) ,fortran-lb))
- (min-stride (when call-fortran? (consecutive-store-p to))))
- (cond
- ((and call-fortran? min-stride)
- (,blas-func (number-of-elements to) alpha (store to) min-stride (head to)))
- (t
- ,lisp-routine)))
- lisp-routine))
- to)))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (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-t...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X