Menu
▾
▴
matlisp-commit
|
From: Akshay S. <ak...@us...> - 2013-12-30 15:22:27
|
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 7ddfe787e54e485108ff96839495e7a6f0d490c2 (commit)
via 5cb54c25cb3aa489df3cfa6065f537d72d57cf19 (commit)
via cf2de4f3c12aeb90062dd7afd82120aa3e5647a7 (commit)
via 270890c43c5cfc819b9d551dcfe50167976af0e2 (commit)
via fbb6af74f62783e94dd623de0bb6a50d3a9325c4 (commit)
via ecbb04d8adfe7d75a4f6d064fcb0f14a66613556 (commit)
via c0248c645d3d100b8f2e4b6569b730cd29e7589b (commit)
via 32bce0a5847fc2b5ee46698b2e6e0a3a63466d4d (commit)
via 24fca164d6b861365bdc977de64a29e6107da555 (commit)
via 6dacaaaa8356ad476ac631eb95b93829a5f1e3f1 (commit)
via 03fc1d7dafa1157eea84f9df3f0a24f1b4b240cd (commit)
via 1d27fd93c94b99ff3f6fda26106e50c4d4cf1b01 (commit)
via 23f3205a3cad2be9a270bd0dc4acb57d42d8dbb2 (commit)
via 376d74de0a77839136869bcc27c5f877cb4a3bc8 (commit)
via 953ce0f60f25157a4fc5b5d31403433aeb47e894 (commit)
from 1f45e5ca07fb6ec6e83117fdb4a3ded5fa3e2b4f (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 7ddfe787e54e485108ff96839495e7a6f0d490c2
Author: Akshay Srinivasan <aks...@gm...>
Date: Mon Dec 30 20:52:46 2013 +0530
Saving changes.
diff --git a/matlisp.asd b/matlisp.asd
index 8b57116..7e638b7 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -183,8 +183,8 @@
(:file "mtimesdivide")))
(:module "matlisp-reader"
:pathname "reader"
- :components (#+nil(:file "infix")
- (:file "loadsave")))))
+ :components ((:file "infix")
+ (:file "loadsave")))))
;; (defclass f2cl-cl-source-file (asdf:cl-source-file)
diff --git a/packages.lisp b/packages.lisp
index 6d8868c..ca87d69 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -180,15 +180,14 @@
#:head #:strides #:store-size #:store
#:parent-tensor
;;Sub-tensor
- #:sub-tensor~ #:sub-tensor
+ #:subtensor~ #:subtensor
;;Store indexers
#:store-indexing
#:store-indexing-vec #:store-indexing-lst
;;Store accessors
- #:tensor-store-ref
- #:tensor-ref
+ #:ref #:store-ref
;;Type checking
- #:tensor-type-p #:vector-p #:matrix-p #:square-p)
+ #:tensor-typep #:tensor-vectorp #:tensor-matrixp #:tensor-squarep)
(:documentation "MATLISP routines"))
;;Transitioning to using the tensor-datastructures; eventually move things back to :matlisp
diff --git a/src/reader/infix.lisp b/src/reader/infix.lisp
index adaeabb..ecc72cc 100644
--- a/src/reader/infix.lisp
+++ b/src/reader/infix.lisp
@@ -255,7 +255,7 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *version* "1.3 28-JUN-96")
- (defparameter *print-infix-copyright* nil
+ (defparameter *print-infix-copyright* t
"If non-NIL, prints a copyright notice upon loading this file.")
(defun infix-copyright (&optional (stream *standard-output*))
@@ -280,6 +280,26 @@
(not (get :infix :dont-print-copyright)))
(infix-copyright)))
+;; Matlisp helpers
+(defparameter *ref-list* '((cons elt) (array aref) (matlisp:standard-tensor matlisp:ref)))
+
+(defmacro generic-ref (x &rest args)
+ `(etypecase ,x
+ ,@(mapcar #'(lambda (l) `(,(car l) (,(cadr l) ,x ,@args))) *ref-list*)))
+
+(define-setf-expander generic-ref (x &rest args &environment env)
+ (multiple-value-bind (dummies vals newval setter getter)
+ (get-setf-expansion x env)
+ (with-gensyms (store)
+ (values (append dummies newval)
+ (append vals (list getter))
+ `(,store)
+ (let ((arr (car newval)))
+ `(prog1 (etypecase ,arr
+ ,@(mapcar #'(lambda (l) `(,(car l) (setf (,(cadr l) ,arr ,@args) ,store))) *ref-list*))
+ ,setter))
+ `(generic-ref ,getter ,@args)))))
+
;;; ********************************
;;; Readtable **********************
;;; ********************************
@@ -291,7 +311,6 @@
`(let ((*readtable* *normal-readtable*))
(error 'parser-error :message (format-to-string ,format-string ,@args))))
-
(define-constant +blank-characters+ '(#\^m #\space #\tab #\return #\newline))
(define-constant +newline-characters+ '(#\newline #\^m #\linefeed #\return))
@@ -857,7 +876,7 @@
:infix (let ((indices (infix-read-delimited-list '\] '\, stream)))
(if (null indices)
(infix-error "No indices found in array reference.")
- `(aref ,left ,@indices))))
+ `(generic-ref ,left ,@indices))))
(define-character-tokenization #\(
#'(lambda (stream char)
commit 5cb54c25cb3aa489df3cfa6065f537d72d57cf19
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Dec 28 18:29:48 2013 +0530
Added a preliminary version of foreign-tensor.
diff --git a/src/classes/foreign.lisp b/src/classes/foreign.lisp
new file mode 100644
index 0000000..c277850
--- /dev/null
+++ b/src/classes/foreign.lisp
@@ -0,0 +1,73 @@
+(in-package #:matlisp)
+
+(defclass foreign-numeric-tensor (blas-numeric-tensor) ())
+
+(deft/method t/store-allocator (sym foreign-numeric-tensor) (size &optional initial-element)
+ (error "cannot allocate store for ~a" sym))
+
+(deft/method t/store-type (sym foreign-numeric-tensor) (&optional size)
+ 'foreign-vector)
+(deft/method t/store-size (sym foreign-numeric-tensor) (vec)
+ `(fv-size ,vec))
+(deft/method t/store-ref (sym foreign-numeric-tensor) (store idx)
+ `(the ,(field-type sym) (fv-ref ,store ,idx)))
+(deft/method t/store-set (sym foreign-numeric-tensor) (value store idx)
+ `(setf (fv-ref ,store ,idx) (the ,(field-type sym) ,value)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defgeneric cl->cffi-type (type)
+ (:method (type)
+ (ecase type
+ (character :char)
+ (single-float :float)
+ (double-float :double)
+ (string :string)
+ (t (error 'unknown-token :token type
+ :message "Don't know how to convert type to CFFI."))))))
+
+(deft/method with-field-element (sym foreign-numeric-tensor) (decl &rest body)
+ (destructuring-bind (var val &optional (count 1)) decl
+ (with-gensyms (idx size point)
+ (let ((type (cl->cffi-type (store-element-type sym))))
+ `(let ((,size (t/compute-store-size ,sym ,count)))
+ (cffi:with-foreign-object (,point ,type ,size)
+ (let ((,var (make-foreign-vector :pointer ,point :type ,type :size ,size)))
+ ,@(when val
+ ;;No point rushing through this loop.
+ `((loop :for ,idx :from 0 :below ,size
+ :do (t/store-set ,sym ,val ,var ,idx))))
+ (locally
+ ,@body))))))))
+;;
+(defclass foreign-real-numeric-tensor (foreign-numeric-tensor real-numeric-tensor) ())
+(deft/method t/field-type (sym foreign-real-numeric-tensor) ()
+ 'real)
+
+(defleaf foreign-real-tensor (foreign-real-numeric-tensor) ())
+(deft/method t/field-type (sym foreign-real-tensor) ()
+ 'double-float)
+
+(defun make-foreign-real-tensor (dims pointer)
+ (let ((dims (make-index-store (etypecase dims
+ (vector (lvec->list dims))
+ (cons dims)
+ (fixnum (list dims))))))
+ (make-instance 'foreign-real-tensor
+ :dimensions dims
+ :store pointer
+ :strides (make-stride dims))))
+
+(with-field-element foreign-real-tensor (fv 0d0 10)
+ (let ((tens (make-foreign-real-tensor (idxv 2 2) fv)))
+ (axpy! 1 nil tens)
+ (copy tens 'real-tensor)))
+
+;;
+#+nil
+(progn
+(defclass foreign-complex-numeric-tensor (foreign-numeric-tensor complex-numeric-tensor) ())
+(deft/method t/field-type (sym foreign-complex-numeric-tensor) ()
+ 'complex)
+
+(t/store-type foreign-real-tensor)
+)
diff --git a/src/ffi/foreign-vector.lisp b/src/ffi/foreign-vector.lisp
index ef8c352..f6d6938 100644
--- a/src/ffi/foreign-vector.lisp
+++ b/src/ffi/foreign-vector.lisp
@@ -13,13 +13,13 @@
(format stream "~A " (fv-ref obj i)))
(format stream ")"))
-(defun fv-ref (x n)
+(definline fv-ref (x n)
(declare (type foreign-vector x)
(type fixnum n))
(assert (< -1 n (fv-size x)) nil 'out-of-bounds-error :requested n :bound (fv-size x) :message "From inside fv-ref.")
(cffi:mem-aref (fv-pointer x) (fv-type x) n))
-(defun (setf fv-ref) (value x n)
+(definline (setf fv-ref) (value x n)
(declare (type foreign-vector x)
(type fixnum n))
(assert (< -1 n (fv-size x)) nil 'out-of-bounds-error :requested n :bound (fv-size x) :message "From inside fv-ref.")
commit cf2de4f3c12aeb90062dd7afd82120aa3e5647a7
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Dec 28 14:49:40 2013 +0530
Made t/store-allocator behave the way sanity would induce.
diff --git a/src/base/template.lisp b/src/base/template.lisp
index 5cd13dd..14d5fa7 100644
--- a/src/base/template.lisp
+++ b/src/base/template.lisp
@@ -106,20 +106,24 @@
;;
(deft/generic (t/store-allocator #'subtypep) sym (size &optional initial-element))
(deft/method t/store-allocator (sym standard-tensor) (size &optional initial-element)
- (let ((size-sym (gensym))
- (type (macroexpand-1 `(t/store-element-type ,sym))))
- `(let ((,size-sym (t/compute-store-size ,sym ,size)))
- (make-array ,size-sym :element-type ',type :initial-element ,(or initial-element (if (subtypep type 'number) `(t/fid+ ,type) nil))))))
+ (with-gensyms (size-sym arr idx init)
+ (let ((type (macroexpand-1 `(t/store-element-type ,sym))))
+ `(let*-typed ((,size-sym (t/compute-store-size ,sym ,size))
+ ,@(when initial-element `((,init ,initial-element :type ,(field-type sym))))
+ (,arr (make-array ,size-sym :element-type ',type :initial-element ,(if (subtypep type 'number) `(t/fid+ ,type) nil)) :type ,(store-type sym)))
+ ,@(when initial-element
+ `((very-quickly
+ (loop :for ,idx :from 0 :below ,size-sym
+ :do (t/store-set ,sym ,init ,arr ,idx)))))
+ ,arr))))
;;
(deft/generic (with-field-element #'subtypep) sym (decl &rest body))
(deft/method with-field-element (sym standard-tensor) (decl &rest body)
- (destructuring-bind (var val) decl
- `(let-typed ((,var (t/store-allocator ,sym 1) :type ,(store-type sym)))
- (t/store-set ,sym ,val ,var 0)
+ (destructuring-bind (var init &optional (count 1)) decl
+ `(let-typed ((,var (t/store-allocator ,sym ,count ,init) :type ,(store-type sym)))
(locally
,@body))))
;;
-
(deft/generic (t/store-type #'subtypep) sym (&optional size))
(deft/method t/store-type (sym standard-tensor) (&optional (size '*))
`(simple-array ,(store-element-type sym) (,size)))
commit 270890c43c5cfc819b9d551dcfe50167976af0e2
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Dec 28 14:12:38 2013 +0530
Using with-field-element macro to make pointers for foreign functions.
diff --git a/src/base/template.lisp b/src/base/template.lisp
index b7fe327..5cd13dd 100644
--- a/src/base/template.lisp
+++ b/src/base/template.lisp
@@ -85,7 +85,6 @@
(macroexpand-1 `(t/field-type ,clname)))
;;This is useful for Eigenvalue decompositions
(deft/generic (t/complexified-type #'subtypep) sym ())
-
(defun complexified-type (type)
(macroexpand-1 `(t/complexified-type ,type)))
@@ -96,21 +95,30 @@
(defun store-element-type (clname)
(macroexpand-1 `(t/store-element-type ,clname)))
-
+;;
(deft/generic (t/compute-store-size #'subtypep) sym (size))
(deft/method t/compute-store-size (sym standard-tensor) (size)
size)
-
+;;
(deft/generic (t/store-size #'subtypep) sym (ele))
(deft/method t/store-size (sym standard-tensor) (ele)
`(length ,ele))
-
+;;
(deft/generic (t/store-allocator #'subtypep) sym (size &optional initial-element))
(deft/method t/store-allocator (sym standard-tensor) (size &optional initial-element)
(let ((size-sym (gensym))
(type (macroexpand-1 `(t/store-element-type ,sym))))
`(let ((,size-sym (t/compute-store-size ,sym ,size)))
(make-array ,size-sym :element-type ',type :initial-element ,(or initial-element (if (subtypep type 'number) `(t/fid+ ,type) nil))))))
+;;
+(deft/generic (with-field-element #'subtypep) sym (decl &rest body))
+(deft/method with-field-element (sym standard-tensor) (decl &rest body)
+ (destructuring-bind (var val) decl
+ `(let-typed ((,var (t/store-allocator ,sym 1) :type ,(store-type sym)))
+ (t/store-set ,sym ,val ,var 0)
+ (locally
+ ,@body))))
+;;
(deft/generic (t/store-type #'subtypep) sym (&optional size))
(deft/method t/store-type (sym standard-tensor) (&optional (size '*))
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index 73305ca..6e6f155 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -37,23 +37,20 @@
(deft/method t/blas-axpy! (sym blas-numeric-tensor) (a x st-x y st-y)
(let ((apy? (null x)))
(using-gensyms (decl (a x y))
- (with-gensyms (sto-x stp-x)
+ (with-gensyms (sto-x)
`(let (,@decl)
(declare (type ,sym ,@(unless apy? `(,x)) ,y)
,@(when apy? `((ignore ,x))))
- (let ((,sto-x ,(if apy? `(t/store-allocator ,sym 1) `(store ,x)))
- (,stp-x ,(if apy? 0 st-x)))
- (declare (type ,(store-type sym) ,sto-x)
- (type index-type ,stp-x))
- ,@(when apy?
- `((t/store-set ,sym (t/fid* ,(field-type sym)) ,sto-x 0)))
- (,(macroexpand-1 `(t/blas-axpy-func ,sym))
- (the index-type (size ,y))
- (the ,(field-type sym) ,a)
- ,sto-x ,stp-x
- (the ,(store-type sym) (store ,y)) (the index-type ,st-y)
- ,(if apy? 0 `(head ,x)) (head ,y))
- ,y))))))
+ ,(recursive-append
+ (when apy?
+ `(with-field-element ,sym (,sto-x (t/fid* ,(field-type sym)))))
+ `(,(macroexpand-1 `(t/blas-axpy-func ,sym))
+ (the index-type (size ,y))
+ (the ,(field-type sym) ,a)
+ ,(if apy? sto-x `(the ,(store-type sym) (store ,x))) (the index-type ,(if apy? 0 st-x))
+ (the ,(store-type sym) (store ,y)) (the index-type ,st-y)
+ ,(if apy? 0 `(head ,x)) (head ,y)))
+ ,y)))))
(deft/generic (t/axpy! #'subtypep) sym (a x y))
(deft/method t/axpy! (sym standard-tensor) (a x y)
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index 0e4207b..c0815e6 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -37,23 +37,20 @@
(deft/method t/blas-copy! (sym blas-numeric-tensor) (x st-x y st-y)
(let ((ncp? (null st-x)))
(using-gensyms (decl (x y))
- (with-gensyms (sto-x stp-x)
+ (with-gensyms (sto-x)
`(let (,@decl)
(declare (type ,sym ,@(unless ncp? `(,x)) ,y)
,@(when ncp? `((type ,(field-type sym) ,x))))
- (let ((,sto-x ,(if ncp? `(t/store-allocator ,sym 1) `(store ,x)))
- (,stp-x ,(if ncp? 0 st-x)))
- (declare (type ,(store-type sym) ,sto-x)
- (type index-type ,stp-x))
- ,@(when ncp?
- `((t/store-set ,sym ,x ,sto-x 0)))
- (,(macroexpand-1 `(t/blas-copy-func ,sym))
- (the index-type (size ,y))
- (the ,(store-type sym) ,sto-x) (the index-type ,stp-x)
- (the ,(store-type sym) (store ,y)) (the index-type ,st-y)
- ,(if ncp? 0 `(head ,x)) (head ,y)))
+ ,(recursive-append
+ (when ncp?
+ `(with-field-element ,sym (,sto-x ,x)))
+ `(,(macroexpand-1 `(t/blas-copy-func ,sym))
+ (the index-type (size ,y))
+ ,(if ncp? sto-x `(the ,(store-type sym) (store ,x))) (the index-type ,(if ncp? 0 st-x))
+ (the ,(store-type sym) (store ,y)) (the index-type ,st-y)
+ ,(if ncp? 0 `(head ,x)) (head ,y)))
,y)))))
-
+
;;
(deft/generic (t/copy! #'(lambda (a b) (strict-compare (list #'subtypep #'subtypep) a b))) (clx cly) (x y))
(deft/method t/copy! ((clx standard-tensor) (cly standard-tensor)) (x y)
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index 6b5825d..f3d136a 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -32,23 +32,23 @@
'ddot)
(deft/method t/blas-dot-func (sym complex-tensor) (&optional (conjp t))
(if conjp 'zdotc 'zdotu))
-;;
+;;a
(deft/generic (t/blas-dot #'subtypep) sym (x y &optional conjp num-y?))
(deft/method t/blas-dot (sym blas-numeric-tensor) (x y &optional (conjp t) (num-y? nil))
(using-gensyms (decl (x y))
(with-gensyms (sto)
- `(let (,@decl
- ,@(when num-y? `((,sto (t/store-allocator ,sym 1)))))
- (declare (type ,sym ,x ,@(unless num-y? `(,y)))
- ,@(when num-y? `((type ,(field-type sym) ,y)
- (type ,(store-type sym) ,sto))))
- ,@(when num-y? `((t/store-set ,sym ,y ,sto 0)))
- (,(macroexpand-1 `(t/blas-dot-func ,sym ,conjp))
- (aref (the index-store-vector (dimensions ,x)) 0)
- (the ,(store-type sym) (store ,x)) (aref (the index-store-vector (strides ,x)) 0)
- (the ,(store-type sym) ,(if num-y? sto `(store ,y))) ,(if num-y? 0 `(aref (the index-store-vector (strides ,y)) 0))
- (head ,x) ,(if num-y? 0 `(head ,y)))))))
+ `(let (,@decl)
+ (declare (type ,sym ,x)
+ (type ,(if num-y? (field-type sym) sym) ,y))
+ ,(recursive-append
+ (when num-y?
+ `(with-field-element ,sym (,sto ,y)))
+ `(,(macroexpand-1 `(t/blas-dot-func ,sym ,conjp))
+ (aref (dimensions ,x) 0)
+ (the ,(store-type sym) (store ,x)) (aref (strides ,x) 0)
+ ,(if num-y? sto `(the ,(store-type sym) (store ,y))) ,(if num-y? 0 `(aref (strides ,y) 0))
+ (head ,x) ,(if num-y? 0 `(head ,y))))))))
(deft/generic (t/dot #'subtypep) sym (x y &optional conjp num-y?))
(deft/method t/dot (sym standard-tensor) (x y &optional (conjp t) (num-y? nil))
@@ -143,8 +143,8 @@
(defmethod dot ((x standard-tensor) (y t) &optional (conjugate-p t))
(let ((clx (class-name (class-of x))))
- (assert (member clx *tensor-type-leaves*)
- nil 'tensor-abstract-class :tensor-class (list clx))
+ (assert (member clx *tensor-type-leaves*)
+ nil 'tensor-abstract-class :tensor-class (list clx))
(compile-and-eval
`(defmethod dot ((x ,clx) (y t) &optional (conjugate-p t))
(let ((y (t/coerce ,(field-type clx) y)))
@@ -160,4 +160,3 @@
(t/dot ,clx x y t t)
(t/dot ,clx x y nil t))))))
(dot x y conjugate-p)))
-
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index 8f70505..eb89d74 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -45,22 +45,18 @@
(deft/method t/blas-scdi! (sym blas-numeric-tensor) (x st-x y st-y &optional (scal? t))
(let ((numx? (null st-x)))
(using-gensyms (decl (x y))
- (with-gensyms (sto-x stp-x)
+ (with-gensyms (sto-x)
`(let (,@decl)
(declare (type ,sym ,@(unless numx? `(,x)) ,y)
,@(when numx? `((type ,(field-type sym) ,x))))
- (let ((,sto-x ,(if numx? `(t/store-allocator ,sym 1) `(store ,x)))
- (,stp-x ,(if numx? 0 st-x)))
- (declare (type ,(store-type sym) ,sto-x)
- (type index-type ,stp-x))
- ,@(when numx?
- `((t/store-set ,sym ,x ,sto-x 0)))
- (,(macroexpand-1 `(t/blas-scdi-func ,sym ,scal?))
- (the index-type (size ,y))
- ,sto-x ,stp-x
- (the ,(store-type sym) (store ,y)) (the index-type ,st-y)
- ,(if numx? 0 `(head ,x)) (head ,y))
- ,y))))))
+ ,(recursive-append
+ (when numx? `(with-field-element ,sym (,sto-x ,x)))
+ `(,(macroexpand-1 `(t/blas-scdi-func ,sym ,scal?))
+ (the index-type (size ,y))
+ ,(if numx? sto-x `(the ,(store-type sym) (store ,x))) (the index-type ,(if numx? 0 st-x))
+ (the ,(store-type sym) (store ,y)) (the index-type ,st-y)
+ ,(if numx? 0 `(head ,x)) (head ,y)))
+ ,y)))))
(deft/method t/scdi! (sym standard-tensor) (x y &key (scal? t) (numx? nil))
(using-gensyms (decl (x y))
commit fbb6af74f62783e94dd623de0bb6a50d3a9325c4
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Dec 28 14:10:43 2013 +0530
Uncommented single float versions.
diff --git a/src/classes/numeric.lisp b/src/classes/numeric.lisp
index 632a85a..3e00da2 100644
--- a/src/classes/numeric.lisp
+++ b/src/classes/numeric.lisp
@@ -1,5 +1,8 @@
(in-package #:matlisp)
+(defun subfieldp (a b)
+ (subtypep (field-type a) (field-type b)))
+
(defclass numeric-tensor (standard-tensor) ())
(deft/method t/field-type (sym numeric-tensor) ()
'number)
@@ -29,16 +32,18 @@
(defmethod print-element ((tensor real-numeric-tensor)
element stream)
(format stream "~11,5,,,,,'Eg" element))
+
;;Real tensor
(defleaf real-tensor (real-numeric-tensor) ())
(deft/method t/field-type (sym real-tensor) ()
'double-float)
-#+nil
-(progn
- (defleaf sreal-tensor (real-numeric-tensor) ())
- (deft/method t/field-type (sym sreal-tensor) ()
- 'single-float))
+(deft/method t/complexified-type (sym real-tensor) ()
+ 'complex-tensor)
+
+(defleaf sreal-tensor (real-numeric-tensor) ())
+(deft/method t/field-type (sym sreal-tensor) ()
+ 'single-float)
;;Complex tensor
(defclass complex-numeric-tensor (blas-numeric-tensor) ())
@@ -55,9 +60,9 @@
;;Comment this block if you want to use (simple-array (complex double-float) (*))
;;as the underlying store. This will make Lisp-implementations of gemm .. faster
-;;but you'll lose the ability to use tensor-realpart~/imagpart~.
+;;but you'll lose the ability to use tensor-realpart~/imagpart~.
(progn
- (deft/method t/store-element-type (sym complex-numeric-tensor) ()
+ (deft/method t/store-element-type (sym complex-numeric-tensor) ()
(let ((cplx-type (macroexpand-1 `(t/field-type ,sym))))
(second cplx-type)))
@@ -72,7 +77,7 @@
(idx-s (gensym))
(type (macroexpand-1 `(t/store-element-type ,sym))))
`(let ((,store-s ,store)
- (,idx-s ,idx))
+ (,idx-s ,idx))
(declare (type (simple-array ,type) ,store-s))
(complex (aref ,store-s (* 2 ,idx-s)) (aref ,store-s (1+ (* 2 ,idx-s)))))))
@@ -107,8 +112,6 @@
(deft/method t/field-type (sym complex-tensor) ()
'(complex double-float))
-#+nil
-(progn
- (defleaf scomplex-tensor (complex-numeric-tensor) ())
- (deft/method t/store-element-type (sym scomplex-tensor) ()
- 'single-float))
+(defleaf scomplex-tensor (complex-numeric-tensor) ())
+(deft/method t/store-element-type (sym scomplex-tensor) ()
+ '(complex single-float))
commit ecbb04d8adfe7d75a4f6d064fcb0f14a66613556
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 17:21:16 2013 +0530
Moved the foreign-structure :print-function to print-object method.
diff --git a/src/ffi/foreign-vector.lisp b/src/ffi/foreign-vector.lisp
index 1521986..ef8c352 100644
--- a/src/ffi/foreign-vector.lisp
+++ b/src/ffi/foreign-vector.lisp
@@ -1,20 +1,18 @@
(in-package #:matlisp-ffi)
(defstruct (foreign-vector
- (:conc-name fv-)
- (:print-function (lambda (obj stream depth)
- (declare (ignore depth))
- (format stream "#F(")
- (let ((sz (fv-size obj)))
- (dotimes (i sz)
- (format stream (if (= i (- sz 1))
- "~A)"
- "~A ") (fv-ref obj i)))))))
+ (:conc-name fv-))
(pointer (cffi:null-pointer)
:type cffi:foreign-pointer)
(size 0 :type fixnum)
(type nil :type symbol))
+(defmethod print-object ((obj foreign-vector) stream)
+ (format stream "#F(")
+ (dotimes (i (fv-size obj))
+ (format stream "~A " (fv-ref obj i)))
+ (format stream ")"))
+
(defun fv-ref (x n)
(declare (type foreign-vector x)
(type fixnum n))
commit c0248c645d3d100b8f2e4b6569b730cd29e7589b
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 17:19:02 2013 +0530
Raised foreign-vector to be one of the matlisp-specialized-array.
diff --git a/src/ffi/ffi-cffi-implementation-specific.lisp b/src/ffi/ffi-cffi-implementation-specific.lisp
index d9d112f..7669c98 100644
--- a/src/ffi/ffi-cffi-implementation-specific.lisp
+++ b/src/ffi/ffi-cffi-implementation-specific.lisp
@@ -53,15 +53,8 @@
(defun vector-data-address (vec)
"
Returns the pointer address of where the actual data store of the object VEC.
-
-VEC - must be a either a (complex double-float), (complex single-float)
-or a specialized array type in CMU Lisp. This currently means
-VEC is a simple-array of one dimension of one of the following types:
-
- double-float
- single-float
- or a
- system-area-pointer
+VEC is a simple-array of one dimension of type 'matlisp-specialized-array.
+VEC can also be a foreign-vector.
Returns
1 - system area pointer to the actual data
@@ -75,9 +68,13 @@ Returns
(with-optimization (:speed 3 :safety 0 :space 0)
;;vec is either a simple-array or a system-area-pointer itself.
(declare (type matlisp-specialized-array vec))
- (if (typep vec '(simple-array * (*)))
- (vector-sap-interpreter-specific vec)
- vec)))
+ (etypecase vec
+ ((simple-array * (*))
+ (vector-sap-interpreter-specific vec))
+ (cffi:foreign-pointer
+ vec)
+ (foreign-vector
+ (fv-pointer vec)))))
#+(or sbcl cmu ccl)
(defmacro with-vector-data-addresses (vlist &body body)
diff --git a/src/ffi/ffi-cffi.lisp b/src/ffi/ffi-cffi.lisp
index 5175304..10c7649 100644
--- a/src/ffi/ffi-cffi.lisp
+++ b/src/ffi/ffi-cffi.lisp
@@ -143,6 +143,9 @@
;; Supporting multidimensional arrays is a pain.
;; Only support types that we currently use.
+(definline allowed-fv-type? (x)
+ (member (fv-type x) '(:double :float :int :uint :int64 :uint64)))
+
(deftype matlisp-specialized-array ()
`(or (simple-array double-float (*))
(simple-array single-float (*))
@@ -157,7 +160,8 @@
(simple-array (unsigned-byte 64) *)
(simple-array (unsigned-byte 32) *)
;;
- cffi:foreign-pointer))
+ cffi:foreign-pointer
+ (and foreign-vector (satisfies allowed-fv-type?))))
;; Very inefficient - compilation wise, not runtime wise-
;; (but portable!) way of supporting both SAPs and simple-arrays.
@@ -177,16 +181,18 @@ Example:
>>
"
(labels ((with-pointer-or-vector-data-address (vlist body)
- (let ((inc-body (ecase (length vlist)
- (2 nil)
- (4 `((incf-sap ,(nth 2 vlist) ,(nth 0 vlist) ,(nth 3 vlist)))))))
- `(if (cffi:pointerp ,(cadr vlist))
- (let (,(car vlist) ,(cadr vlist))
- ,@inc-body
- ,@body)
- (cffi-sys:with-pointer-to-vector-data (,(car vlist) ,(cadr vlist))
- ,@inc-body
- ,@body))))
+ (destructuring-bind (addr vec &key inc-type inc) vlist
+ (let ((inc-body (when inc-type
+ `((incf-sap ,addr ,inc-type ,@(when inc `(,inc)))))))
+ `(etypecase vec
+ ((simple-array * (*))
+ (cffi-sys:with-pointer-to-vector-data (,addr ,vec)
+ ,@inc-body
+ ,@body))
+ ((or foreign-vector cffi:foreign-pointer)
+ (let ((,addr (if (typep vec foreign-vector) (fv-pointer ,vec) ,vec)))
+ ,@inc-body
+ ,@body))))))
(frob (v body)
(if (null v)
body
commit 32bce0a5847fc2b5ee46698b2e6e0a3a63466d4d
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 17:15:57 2013 +0530
Changed "subfieldp" to be the template sorting function; now lapack methods.
diff --git a/src/lapack/chol.lisp b/src/lapack/chol.lisp
index fabbbd9..9d5d265 100644
--- a/src/lapack/chol.lisp
+++ b/src/lapack/chol.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/lapack-potrf-func #'subtypep) sym ())
+(deft/generic (t/lapack-potrf-func #'subfieldp) sym ())
(deft/method t/lapack-potrf-func (sym real-tensor) ()
'dpotrf)
(deft/method t/lapack-potrf-func (sym complex-tensor) ()
@@ -92,7 +92,7 @@
(potrf! A uplo)))
;;
-(deft/generic (t/lapack-potrs-func #'subtypep) sym ())
+(deft/generic (t/lapack-potrs-func #'subfieldp) sym ())
(deft/method t/lapack-potrs-func (sym real-tensor) ()
'dpotrs)
(deft/method t/lapack-potrs-func (sym complex-tensor) ()
diff --git a/src/lapack/eig.lisp b/src/lapack/eig.lisp
index ed67faf..98b0fcc 100644
--- a/src/lapack/eig.lisp
+++ b/src/lapack/eig.lisp
@@ -1,6 +1,6 @@
(in-package #:matlisp)
-(deft/generic (t/lapack-geev-func #'subtypep) sym ())
+(deft/generic (t/lapack-geev-func #'subfieldp) sym ())
(deft/method t/lapack-geev-func (sym real-tensor) ()
'dgeev)
@@ -12,7 +12,7 @@
;;
(deft/generic (t/geev-output-fix #'subtypep) sym (wr wi))
(deft/method t/geev-output-fix (sym real-numeric-tensor) (wr wi)
- (let ((csym (or (complexified-type sym) (error "No corresponding complex-tensor defined for type ~a." sym))))
+ (let ((csym (complexified-type sym)))
(using-gensyms (decl (wr wi))
(with-gensyms (ret i)
`(let* (,@decl
diff --git a/src/lapack/geqr.lisp b/src/lapack/geqr.lisp
index 2c52eba..7d9695f 100644
--- a/src/lapack/geqr.lisp
+++ b/src/lapack/geqr.lisp
@@ -1,6 +1,6 @@
(in-package #:matlisp)
-(deft/generic (t/lapack-geqrf-func #'subtypep) sym ())
+(deft/generic (t/lapack-geqrf-func #'subfieldp) sym ())
(deft/method t/lapack-geqrf-func (sym real-tensor) ()
'matlisp-lapack:dgeqrf)
(deft/method t/lapack-geqrf-func (sym complex-tensor) ()
diff --git a/src/lapack/least-squares.lisp b/src/lapack/least-squares.lisp
index ef4f911..6c50794 100644
--- a/src/lapack/least-squares.lisp
+++ b/src/lapack/least-squares.lisp
@@ -1,6 +1,6 @@
(in-package :matlisp)
-(deft/generic (t/lapack-gelsy-func #'subtypep) sym ())
+(deft/generic (t/lapack-gelsy-func #'subfieldp) sym ())
(deft/method t/lapack-gelsy-func (sym real-tensor) ()
'dgelsy)
diff --git a/src/lapack/lu.lisp b/src/lapack/lu.lisp
index 1c5e7f7..1325c6b 100644
--- a/src/lapack/lu.lisp
+++ b/src/lapack/lu.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/lapack-getrf-func #'subtypep) sym ())
+(deft/generic (t/lapack-getrf-func #'subfieldp) sym ())
(deft/method t/lapack-getrf-func (sym real-tensor) ()
'dgetrf)
(deft/method t/lapack-getrf-func (sym complex-tensor) ()
@@ -142,7 +142,7 @@
;; (let* ((min (lvec-min (dimensions lu)))
;; (
;;
-(deft/generic (t/lapack-getrs-func #'subtypep) sym ())
+(deft/generic (t/lapack-getrs-func #'subfieldp) sym ())
(deft/method t/lapack-getrs-func (sym real-tensor) ()
'dgetrs)
(deft/method t/lapack-getrs-func (sym complex-tensor) ()
commit 24fca164d6b861365bdc977de64a29e6107da555
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 17:12:50 2013 +0530
Changed "subfieldp" to be the method sort...
[truncated message content] |
Thanks for helping keep SourceForge clean.
X