[Matlisp-commit] [matlisp-git]matlisp branch classy updated. 2012-02-23-282-g5481334

[Akshay S. <ak...@us...>]

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  5481334c9a288f9ced6967f1995d4d30d0e39e2f (commit)
       via  6f9bed41c2556366ed4f8bc79516e8c3c3a19ee0 (commit)
      from  5304b7204035eab0b7ac2664a6e1949a0689e741 (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 5481334c9a288f9ced6967f1995d4d30d0e39e2f
Author: Akshay Srinivasan <aks...@gm...>
Date:   Mon Sep 30 16:40:39 2013 -0700

    Fixed the copy-triangle macro, added copy-diagonal.

diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index 3399780..c06dcd2 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -120,8 +120,8 @@
 ;;
 ;;This macro is used for interfacing with lapack
 ;;Only to be used with matrices!
-(deft/generic (t/copy-triangle! #'subtypep) sym (a b &optional upper? diag?))
-(deft/method t/copy-triangle! (sym standard-tensor) (a b &optional (upper? nil) (diag? t))
+(deft/generic (t/copy-triangle! #'subtypep) sym (a b &optional upper?))
+(deft/method t/copy-triangle! (sym standard-tensor) (a b &optional (upper? t))
   (using-gensyms (decl (a b))
     (with-gensyms (sto-a sto-b strd-a strd-b dof-a dof-b of-a of-b)
       `(let* (,@decl
@@ -141,13 +141,27 @@
 			    :do (loop :for j :from 0 :below ,(if upper? `(1+ i) `(- ndiags i))
 				   :for ,of-a :of-type index-type := ,dof-a :then (,(if upper? '- '+) ,of-a (:mark (aref ,strd-a 0)))
 				   :for ,of-b :of-type index-type := ,dof-b :then (,(if upper? '- '+) ,of-b (:mark (aref ,strd-b 0)))
-				   ,@(unless diag? `(:unless (= j 0)))
-				   :do (progn
-					 ,(if diag?
-					      `(if (= 
-					 (t/store-set ,sym (t/store-ref ,sym ,sto-a ,of-a) ,sto-b ,of-b))))))))))
+				   :do (t/store-set ,sym (t/store-ref ,sym ,sto-a ,of-a) ,sto-b ,of-b))))))
 	   ,b))))
-
+;;
+(deft/generic (t/copy-diagonal! #'subtypep) sym (a b &optional num?))
+(deft/method t/copy-diagonal! (sym standard-tensor) (a b &optional (num? nil))
+  (using-gensyms (decl (a b))
+    (with-gensyms (sto-a sto-b of-a of-b)
+      `(let* (,@decl
+	      ,@(unless num? `((,sto-a (store ,a))))
+	      (,sto-b (store ,b)))
+	 (declare (type ,sym ,@(unless num? `(,a)) ,b)
+		  (type ,(store-type sym) ,@(unless num? `(,sto-a)) ,sto-b)
+		  ,@(when num? `((type ,(field-type sym) ,a))))
+	 (with-marking 
+	     (very-quickly
+	       (:mark* ((ndiags (lvec-min (dimensions ,b))))
+		       (loop :for i :from 0 :below ndiags
+			  ,@(unless num? `(:for ,of-a :of-type index-type := (head ,a) :then (+ ,of-a (:mark (lvec-foldr #'+ (strides ,a)) :type index-type))))
+			  :for ,of-b :of-type index-type := (head ,b) :then (+ ,of-b (:mark (lvec-foldr #'+ (strides ,b)) :type index-type))
+			  :do (t/store-set ,sym ,@(if num? `(,a) `((t/store-ref ,sym ,sto-a ,of-a))) ,sto-b ,of-b)))))
+	 ,b))))
 ;;
 (defmethod copy! :before ((x standard-tensor) (y standard-tensor))
   (assert (very-quickly (lvec-eq (the index-store-vector (dimensions x)) (the index-store-vector (dimensions y)) #'=)) nil

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

Summary of changes:
 README                |  279 ++++++++++++++++++++++++++-----------------------
 src/lapack/lu.lisp    |    4 +-
 src/level-1/copy.lisp |   30 ++++--
 3 files changed, 172 insertions(+), 141 deletions(-)


hooks/post-receive
-- 
matlisp