Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch extensible updated. 2012-02-23-177-g856c601
|
From: Akshay S. <ak...@us...> - 2012-12-28 01:47:49
|
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, extensible has been updated
via 856c60140465482aaa72f021360c4c795073ad6f (commit)
via 0166ce8014b662aca4a91484eb2458e7e87be8ac (commit)
from 1c74913ff22ddc869220e6ee124bcf272b188d12 (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 856c60140465482aaa72f021360c4c795073ad6f
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Dec 27 19:41:16 2012 -0600
o Ported level-2 BLAS.
diff --git a/matlisp.asd b/matlisp.asd
index de18f1a..17f0086 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -124,6 +124,8 @@
:depends-on ("matlisp-base")
:components ((:file "real-tensor")
(:file "complex-tensor")
+ #+maxima
+ (:file "symbolic-tensor")
(:file "matrix"
:depends-on ("real-tensor" "complex-tensor"))))
(:module "matlisp-level-1"
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index ab9554d..6fc9eb5 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -123,6 +123,16 @@
(generate-typed-num-axpy! complex-typed-num-axpy!
(complex-tensor zaxpy *complex-l1-fcall-lb*))
+
+;;Symbolic
+#+maxima
+(progn
+ (generate-typed-axpy! symbolic-typed-axpy!
+ (symbolic-tensor nil 0))
+
+ (generate-typed-num-axpy! symbolic-typed-num-axpy!
+ (symbolic-tensor nil 0)))
+
;;---------------------------------------------------------------;;
(defgeneric axpy! (alpha x y)
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index 4e5b665..9a42abf 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -113,6 +113,15 @@
(generate-typed-num-copy! complex-typed-num-copy!
(complex-tensor zcopy *complex-l1-fcall-lb*))
+
+;;Symbolic
+#+maxima
+(progn
+(generate-typed-copy! symbolic-typed-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
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index fb85d4e..7302d70 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -88,6 +88,7 @@
(generate-typed-dot complex-typed-dot
(complex-tensor zdotu zdotc *complex-l1-fcall-lb*))
+#+maxima
(generate-typed-dot symbolic-typed-dot
(symbolic-tensor nil nil 0))
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index d55de3c..472a186 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -182,6 +182,21 @@
(generate-typed-num-div! complex-typed-num-div!
(complex-tensor zediv *complex-l1-fcall-lb*))
+
+;;Symbolic
+#+maxima
+(progn
+ (generate-typed-num-scal! symbolic-typed-num-scal!
+ (real-tensor nil 0))
+
+ (generate-typed-scal! symbolic-typed-scal!
+ (real-tensor nil 0))
+
+ (generate-typed-div! symbolic-typed-div!
+ (real-tensor nil 0))
+
+ (generate-typed-num-div! symbolic-typed-num-div!
+ (real-tensor nil 0)))
;;---------------------------------------------------------------;;
(defgeneric scal! (alpha x)
diff --git a/src/level-1/swap.lisp b/src/level-1/swap.lisp
index 9de6966..6df8506 100644
--- a/src/level-1/swap.lisp
+++ b/src/level-1/swap.lisp
@@ -63,6 +63,11 @@
(generate-typed-swap! complex-typed-swap!
(complex-tensor zswap *complex-l1-fcall-lb*))
+
+#+maxima
+(generate-typed-swap! symbolic-typed-swap!
+ (symbolic-tensor nil 0))
+
;;---------------------------------------------------------------;;
;;Generic function in src;base;generic-swap.lisp
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index f8b8885..ba233ae 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -49,7 +49,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))
;;Had to move it here in the wait for copy!
diff --git a/src/level-2/gemv.lisp b/src/level-2/gemv.lisp
index c483454..2dba31a 100644
--- a/src/level-2/gemv.lisp
+++ b/src/level-2/gemv.lisp
@@ -1,74 +1,81 @@
(in-package #:matlisp)
(defmacro generate-typed-gemv! (func
- (matrix-class vector-class
- blas-gemv-func
+ (tensor-class blas-gemv-func
fortran-call-lb))
;;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 matrix-class)))
- (assert opt nil 'tensor-cannot-find-optimization :tensor-class matrix-class)
+ (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))
+ (vector-class (getf opt :vector)))
`(definline ,func (alpha A x beta y job)
(declare (type ,(getf opt :element-type) alpha beta)
(type ,matrix-class A)
(type ,vector-class x y)
(type symbol job))
- (mlet*
- ((call-fortran? (> (max (nrows A) (ncols A)) ,fortran-call-lb))
- ((maj-A ld-A fop-A) (if call-fortran? (blas-matrix-compatible-p A job) (values nil 0 "?")) :type (symbol index-type (string 1))))
- (cond
- ((and maj-a call-fortran?)
- (let-typed ((nr-A (nrows A) :type index-type)
- (nc-A (ncols A) :type index-type))
- (when (eq maj-A :row-major)
- (rotatef nr-A nc-A))
- (,blas-gemv-func fop-a nr-A nc-A
- alpha (store A) ld-A
- (store x) (aref (strides x) 0)
- beta
- (store y) (aref (strides y) 0)
- (head A) (head x) (head y))))
- (t
- (let-typed ((nr-A (nrows A) :type index-type)
- (nc-A (ncols A) :type index-type)
- (rs-A (row-stride A) :type index-type)
- (cs-A (col-stride A) :type index-type)
- (sto-A (store A) :type ,(linear-array-type (getf opt :store-type)))
+ ,(let
+ ((lisp-routine
+ `(let-typed ((nr-A (nrows A) :type index-type)
+ (nc-A (ncols A) :type index-type)
+ (rs-A (row-stride A) :type index-type)
+ (cs-A (col-stride A) :type index-type)
+ (sto-A (store A) :type ,(linear-array-type (getf opt :store-type)))
;
- (stp-x (aref (strides x) 0) :type index-type)
- (sto-x (store x) :type ,(linear-array-type (getf opt :store-type)))
- (hd-x (head x) :type index-type)
+ (stp-x (aref (strides x) 0) :type index-type)
+ (sto-x (store x) :type ,(linear-array-type (getf opt :store-type)))
+ (hd-x (head x) :type index-type)
;
- (stp-y (aref (strides y) 0) :type index-type)
- (sto-y (store y) :type ,(linear-array-type (getf opt :store-type))))
- (when (eq job :t)
- (rotatef nr-A nc-A)
- (rotatef rs-A cs-A))
- (very-quickly
- (loop repeat nr-A
- for of-y of-type index-type = (head y) then (+ of-y stp-y)
- for rof-A of-type index-type = (head A) then (+ rof-A rs-A)
- do (let-typed ((val (* beta ,(funcall (getf opt :reader) 'sto-y 'of-y)) :type ,(getf opt :element-type)))
- (loop repeat nc-A
- for of-x of-type index-type = hd-x then (+ of-x stp-x)
- for of-A of-type index-type = rof-A then (+ of-A cs-A)
- summing (* ,(funcall (getf opt :reader) 'sto-x 'of-x)
- ,(funcall (getf opt :reader) 'sto-A 'of-A)) into dotp of-type ,(getf opt :element-type)
- finally ,(funcall (getf opt :value-writer)
- `(+ (* alpha dotp) val) 'sto-y 'of-y)))))))))
+ (stp-y (aref (strides y) 0) :type index-type)
+ (sto-y (store y) :type ,(linear-array-type (getf opt :store-type))))
+ (when (eq job :t)
+ (rotatef nr-A nc-A)
+ (rotatef rs-A cs-A))
+ (very-quickly
+ (loop :repeat nr-A
+ :for of-y :of-type index-type := (head y) :then (+ of-y stp-y)
+ :for rof-A :of-type index-type := (head A) :then (+ rof-A rs-A)
+ :do (let-typed ((val (,(getf opt :f*) beta (,(getf opt :reader) sto-y of-y)) :type ,(getf opt :element-type)))
+ (loop :repeat nc-A
+ :for of-x :of-type index-type := hd-x :then (+ of-x stp-x)
+ :for of-A :of-type index-type := rof-A :then (+ of-A cs-A)
+ :with dot :of-type ,(getf opt :element-type) = (,(getf opt :fid+))
+ :do (let-typed ((xval (,(getf opt :reader) sto-x of-x) :type ,(getf opt :element-type))
+ (Aval (,(getf opt :reader) sto-A of-A) :type ,(getf opt :element-type)))
+ (setf dot (,(getf opt :f+) dot (,(getf opt :f*) xval Aval))))
+ :finally (,(getf opt :value-writer) (,(getf opt :f+) (,(getf opt :f*) alpha dot) val) sto-y of-y))))))))
+ (if blas-gemv-func
+ `(mlet*
+ ((call-fortran? (> (max (nrows A) (ncols A)) ,fortran-call-lb))
+ ((maj-A ld-A fop-A) (if call-fortran? (blas-matrix-compatible-p A job) (values nil 0 "?")) :type (symbol index-type (string 1))))
+ (cond
+ ((and maj-a call-fortran?)
+ (let-typed ((nr-A (nrows A) :type index-type)
+ (nc-A (ncols A) :type index-type))
+ (when (eq maj-A :row-major)
+ (rotatef nr-A nc-A))
+ (,blas-gemv-func fop-a nr-A nc-A
+ alpha (store A) ld-A
+ (store x) (aref (strides x) 0)
+ beta
+ (store y) (aref (strides y) 0)
+ (head A) (head x) (head y))))
+ (t
+ ,lisp-routine)))
+ lisp-routine))
y)))
;;Real
(generate-typed-gemv! real-base-typed-gemv!
- (real-matrix real-vector dgemv *real-l2-fcall-lb*))
+ (real-tensor dgemv *real-l2-fcall-lb*))
(definline real-typed-gemv! (alpha A x beta y job)
(real-base-typed-gemv! alpha A x beta y (ecase job ((:n :t) job) (:h :t) (:c :n))))
;;Complex
(generate-typed-gemv! complex-base-typed-gemv!
- (complex-matrix complex-vector zgemv *complex-l2-fcall-lb*))
+ (complex-tensor zgemv *complex-l2-fcall-lb*))
(definline complex-typed-gemv! (alpha A x beta y job)
(declare (type complex-matrix A)
@@ -87,6 +94,11 @@
(complex-typed-num-scal! #c(-1d0 0d0) (tensor-realpart~ y))
y)))
+;;Symbolic
+#+maxima
+(generate-typed-gemv! symbolic-base-typed-gemv!
+ (symbolic-tensor nil 0))
+
;;---------------------------------------------------------------;;
(defgeneric gemv! (alpha A x beta y &optional job)
commit 0166ce8014b662aca4a91484eb2458e7e87be8ac
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Dec 27 17:01:44 2012 -0600
o Added "symbolic-tensor", sort of works with Maxima.
o Ported all level-1 stuff.
diff --git a/matlisp.asd b/matlisp.asd
index 61a7721..de18f1a 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -139,9 +139,9 @@
:depends-on ("copy" "tensor-maker" "realimag"))
(:file "dot"
:depends-on ("realimag"))
- #+nil(:file "axpy"
+ (:file "axpy"
:depends-on ("copy" "scal"))
- #+nil(:file "trans"
+ (:file "trans"
:depends-on ("scal" "copy"))))
#+nil
(:module "matlisp-level-2"
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index e27d9d8..a0bbef8 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -337,7 +337,7 @@
(defmacro define-tensor
((tensor-class element-type store-element-type store-type &rest class-decls) &key
- f+ f- finv+ fid+ f* f/ finv* fid*
+ f+ f- finv+ fid+ f* f/ finv* fid* fconj
matrix vector
store-allocator coercer coercer-unforgiving reader value-writer reader-writer swapper)
;;Error checking
@@ -376,6 +376,7 @@
:f/ ',f/
:finv* ',finv*
:fid* ',fid*
+ :fconj ',fconj
:reader ',reader
:value-writer ',value-writer
:reader-writer ',reader-writer
diff --git a/src/classes/complex-tensor.lisp b/src/classes/complex-tensor.lisp
index 03a8fab..73e624a 100644
--- a/src/classes/complex-tensor.lisp
+++ b/src/classes/complex-tensor.lisp
@@ -110,6 +110,7 @@
:f/ complex-type.f/
:finv* complex-type.finv*
:fid* complex-type.fid*
+ :fconj complex-type.fconj
;;
:store-allocator allocate-complex-store
:coercer coerce-complex
diff --git a/src/classes/real-tensor.lisp b/src/classes/real-tensor.lisp
index 8b0a9ec..44239aa 100644
--- a/src/classes/real-tensor.lisp
+++ b/src/classes/real-tensor.lisp
@@ -86,13 +86,12 @@ Allocates real storage. Default initial-element = 0d0.")
:f/ real-type.f/
:finv* real-type.finv*
:fid* real-type.fid*
+ :fconj nil
;;
:store-allocator allocate-real-store
:coercer coerce-real
:coercer-unforgiving coerce-real-unforgiving
;;
- :matrix real-matrix :vector real-vector
- ;;
:reader real-type.reader
:value-writer real-type.value-writer
:reader-writer real-type.reader-writer
diff --git a/src/classes/symbolic-tensor.lisp b/src/classes/symbolic-tensor.lisp
new file mode 100644
index 0000000..be7986c
--- /dev/null
+++ b/src/classes/symbolic-tensor.lisp
@@ -0,0 +1,126 @@
+(in-package #:matlisp)
+
+(deftype symbolic-type ()
+ "Symbolic type associated with Maxima"
+ '(or number symbol list))
+
+(deftype symbolic-store-vector (&optional (size '*))
+ "The type of the storage structure for a REAL-MATRIX"
+ `(simple-array symbolic-type (,size)))
+
+;;Field definitions
+(definline symbolic-type.f+ (a b)
+ (declare (type symbolic-type a b))
+ (maxima::add a b))
+
+(definline symbolic-type.f- (a b)
+ (declare (type symbolic-type a b))
+ (maxima::sub a b))
+
+(definline symbolic-type.finv+ (a)
+ (declare (type symbolic-type a))
+ (maxima::mul -1 a))
+
+(definline symbolic-type.fid+ ()
+ 0)
+
+(definline symbolic-type.f* (a b)
+ (declare (type symbolic-type a b))
+ (maxima::mul a b))
+
+(definline symbolic-type.f/ (a b)
+ (declare (type symbolic-type a b))
+ (maxima::div a b))
+
+(definline symbolic-type.finv* (a)
+ (declare (type symbolic-type a))
+ (maxima::div 1 a))
+
+(definline symbolic-type.fid* ()
+ 1)
+
+(definline symbolic-type.fconj (a)
+ (maxima::meval `((maxima::$conjugate maxima::simp) ,a)))
+
+(definline symbolic-type.diff (a x)
+ (etypecase a
+ (symbolic-type
+ (maxima::$diff a x))
+ (symbolic-tensor
+ (make-instance 'symbolic-tensor
+ :dimensions (copy-seq (dimensions a))
+ :store (map 'symbolic-store-vector #'(lambda (f) (maxima::$diff f x)) (store a))))))
+;;
+;;Store definitions
+(definline symbolic-type.reader (tstore idx)
+ (declare (type index-type idx)
+ (type symbolic-store-vector tstore))
+ (aref tstore idx))
+
+(definline symbolic-type.value-writer (value store idx)
+ (declare (type index-type idx)
+ (type symbolic-store-vector store)
+ (type symbolic-type value))
+ (setf (aref store idx) value))
+
+(definline symbolic-type.reader-writer (fstore fidx tstore tidx)
+ (declare (type index-type fidx tidx)
+ (type symbolic-store-vector fstore tstore))
+ (setf (aref tstore tidx) (aref fstore fidx)))
+
+(definline symbolic-type.swapper (fstore fidx tstore tidx)
+ (declare (type index-type fidx tidx)
+ (type symbolic-store-vector fstore tstore))
+ (rotatef (aref tstore tidx) (aref fstore fidx)))
+
+;;
+(make-array-allocator allocate-symbolic-store 'symbolic-type 0
+"(allocate-symbolic-store size [initial-element])
+Allocates symbolic storage. Default initial-element = 0.")
+
+(definline coerce-symbolic-unforgiving (x)
+ (coerce x 'symbolic-type))
+
+(defun coerce-symbolic (x)
+ (restart-case (coerce-symbolic-unforgiving x)
+ (use-value (value) (coerce-symbolic value))))
+
+(define-tensor (symbolic-tensor symbolic-type symbolic-type symbolic-store-vector
+ (:documentation "Tensor class with symbolic double elements."))
+ :matrix symbolic-matrix :vector symbolic-vector
+ ;;
+ :f+ symbolic-type.f+
+ :f- symbolic-type.f-
+ :finv+ symbolic-type.finv+
+ :fid+ symbolic-type.fid+
+ :f* symbolic-type.f*
+ :f/ symbolic-type.f/
+ :finv* symbolic-type.finv*
+ :fid* symbolic-type.fid*
+ :fconj symbolic-type.fconj
+ ;;
+ :store-allocator allocate-symbolic-store
+ :coercer coerce-symbolic
+ :coercer-unforgiving coerce-symbolic-unforgiving
+ ;;
+ :reader symbolic-type.reader
+ :value-writer symbolic-type.value-writer
+ :reader-writer symbolic-type.reader-writer
+ :swapper symbolic-type.swapper)
+
+(defmethod initialize-instance ((tensor symbolic-tensor) &rest initargs)
+ (if (getf initargs :store)
+ (setf (slot-value tensor 'store-size) (length (getf initargs :store)))
+ (let ((size (reduce #'* (getf initargs :dimensions))))
+ (setf (slot-value tensor 'store) (allocate-symbolic-store size)
+ (slot-value tensor 'store-size) size)))
+ (call-next-method))
+
+;;
+(defmethod (setf tensor-ref) ((value number) (tensor symbolic-tensor) subscripts)
+ (let ((sto-idx (store-indexing subscripts tensor)))
+ (setf (tensor-store-ref tensor sto-idx) (coerce-symbolic value))))
+
+(defmethod print-element ((tensor symbolic-tensor)
+ element stream)
+ (format stream "~a" element))
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index df29906..ab9554d 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -32,22 +32,14 @@
;;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)))
+ (let* ((opt (get-tensor-class-optimization-hashtable tensor-class)))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
`(definline ,func (alpha from to)
(declare (type ,tensor-class from to)
(type ,(getf opt :element-type) alpha))
- (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
- (let ((f-sto (store from))
+ ,(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
@@ -58,12 +50,25 @@
with (linear-sums
(f-of (strides from) (head from))
(t-of (strides to) (head to)))
- do (let ((f-val ,(funcall (getf opt :reader) 'f-sto 'f-of))
- (t-val ,(funcall (getf opt :reader) 't-sto 't-of)))
+ 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 (+ (* f-val alpha) t-val)))
(declare (type ,(getf opt :element-type) t-new))
- ,(funcall (getf opt :value-writer) 't-new 't-sto 't-of)))))))))
+ (,(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))
@@ -76,28 +81,33 @@
`(definline ,func (num-from to)
(declare (type ,tensor-class to)
(type ,(getf opt :element-type) num-from))
- (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 :coercer) 1) :type ,(getf opt :element-type)))
- ,(funcall (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
- (let-typed
+ ,(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 ,(funcall (getf opt :reader) 't-sto 't-of) :type ,(getf opt :element-type)))
- ,(funcall (getf opt :value-writer) '(+ num-from val) 't-sto 't-of))))))))
+ ((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
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index fd92ddf..fb85d4e 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -27,10 +27,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(defmacro generate-typed-dot (func (tensor-class blas-func blasc-func conj-func fortran-lb))
+(defmacro generate-typed-dot (func (tensor-class blas-func blasc-func fortran-lb))
(let* ((opt (get-tensor-class-optimization-hashtable tensor-class))
- (conj? (and blasc-func conj-func))
- (blas? (or blas-func blasc-func)))
+ (conj? (getf opt :fconj))
+ (blas? (and blas-func (if conj? blasc-func t))))
(assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
`(definline ,func (x y conjugate-p)
(declare (type ,tensor-class x y)
@@ -41,9 +41,9 @@
((lisp-routine
`(let-typed
((stp-x (aref (strides x) 0) :type index-type)
- (sto-x (store x) :type complex-store-vector)
+ (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 complex-store-vector)
+ (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
@@ -52,7 +52,7 @@
: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+))
:do (let-typed ((xval ,(recursive-append
- (when conjp `(,conj-func))
+ (when conjp `(,conj?))
`(,(getf opt :reader) sto-x of-x)) :type ,(getf opt :element-type))
(yval (,(getf opt :reader) sto-y of-y) :type ,(getf opt :element-type)))
(setf dot (,(getf opt :f+) dot (,(getf opt :f*) xval yval))))
@@ -83,10 +83,13 @@
lisp-routine)))))
(generate-typed-dot real-typed-dot
- (real-tensor ddot nil nil *real-l1-fcall-lb*))
+ (real-tensor ddot nil *real-l1-fcall-lb*))
(generate-typed-dot complex-typed-dot
- (complex-tensor zdotu zdotc complex-type.fconj *complex-l1-fcall-lb*))
+ (complex-tensor zdotu zdotc *complex-l1-fcall-lb*))
+
+(generate-typed-dot symbolic-typed-dot
+ (symbolic-tensor nil nil 0))
;;---------------------------------------------------------------;;
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index 4ce8f18..f8b8885 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -50,6 +50,8 @@
(make-tensor-maker make-real-tensor (real-tensor))
(make-tensor-maker make-complex-tensor (complex-tensor))
+(make-tensor-maker make-symbolic-tensor (symbolic-tensor))
+
;;Had to move it here in the wait for copy!
(definline sub-tensor (tensor subscripts)
(copy (sub-tensor~ tensor subscripts)))
-----------------------------------------------------------------------
Summary of changes:
matlisp.asd | 6 +-
src/base/standard-tensor.lisp | 3 +-
src/classes/complex-tensor.lisp | 1 +
src/classes/real-tensor.lisp | 3 +-
src/classes/symbolic-tensor.lisp | 126 ++++++++++++++++++++++++++++++++++++++
src/level-1/axpy.lisp | 82 +++++++++++++++---------
src/level-1/copy.lisp | 9 +++
src/level-1/dot.lisp | 20 ++++---
src/level-1/scal.lisp | 15 +++++
src/level-1/swap.lisp | 5 ++
src/level-1/tensor-maker.lisp | 2 +
src/level-2/gemv.lisp | 106 ++++++++++++++++++--------------
12 files changed, 287 insertions(+), 91 deletions(-)
create mode 100644 src/classes/symbolic-tensor.lisp
hooks/post-receive
--
matlisp
|
