Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-98-g1231d97
|
From: Akshay S. <ak...@us...> - 2012-06-29 03:24:36
|
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 1231d97cfa4e89109805a7a5284d939bbd65f5f9 (commit)
from 848eaaca232c394753e19a057fa732c9937a8a39 (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 1231d97cfa4e89109805a7a5284d939bbd65f5f9
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Jun 29 08:50:00 2012 +0530
Added scal!-generating macro and scal! methods.
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..8be2f0a
--- /dev/null
+++ b/TODO
@@ -0,0 +1,8 @@
+* Write documentation. Maybe move to TeXinfo (like femlisp).
+ Fix the formatting for docstrings.
+* Write tests
+* Get the python-bridge working with burgled-batteries, nothing beats
+ matplotlib for plotting.
+* Add infix to Matlisp
+* Support linking to libraries ? Might have to parse function declarations
+ with cffi-grovel.
\ No newline at end of file
diff --git a/matlisp.asd b/matlisp.asd
index 371e5a9..3ff85aa 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -3,14 +3,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Copyright (c) 2000 The Regents of the University of California.
-;;; All rights reserved.
-;;;
+;;; All rights reserved.
+;;;
;;; Permission is hereby granted, without written agreement and without
;;; license or royalty fees, to use, copy, modify, and distribute this
;;; software and its documentation for any purpose, provided that the
;;; above copyright notice and the following two paragraphs appear in all
;;; copies of this software.
-;;;
+;;;
;;; IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY
;;; FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
;;; ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF
@@ -34,184 +34,184 @@
(in-package #:matlisp-system)
(asdf:defsystem matlisp-packages
- :pathname #.(translate-logical-pathname "matlisp:srcdir;")
- :components
- ((:file "packages")))
+ :depends-on (#:cffi)
+ :pathname #.(translate-logical-pathname "matlisp:srcdir;")
+ :components
+ ((:file "packages")))
(asdf:defsystem matlisp-utilities
- :pathname #.(translate-logical-pathname "matlisp:srcdir;")
- :depends-on ("matlisp-packages")
- :components ((:module "utilities"
- :pathname "src/"
- :components ((:file "utilities")))))
+ :pathname #.(translate-logical-pathname "matlisp:srcdir;")
+ :depends-on ("matlisp-packages")
+ :components ((:module "utilities"
+ :pathname "src/"
+ :components ((:file "utilities")))))
(asdf:defsystem lazy-loader
- :pathname #.(translate-logical-pathname "matlisp:lib;")
- :depends-on ("matlisp-packages")
- :components
- ((:file "lazy-loader"
- ;; you need the load-only here,
- ;; otherwise, Allegro tries to
- ;; load the DLL (SO)'s twice
- ;; and fails.
- )))
+ :pathname #.(translate-logical-pathname "matlisp:lib;")
+ :depends-on (#:cffi #:matlisp-packages)
+ :components
+ ((:file "lazy-loader"
+ ;; you need the load-only here,
+ ;; otherwise, Allegro tries to
+ ;; load the DLL (SO)'s twice
+ ;; and fails.
+ )))
(asdf:defsystem fortran-names
- :pathname #.(translate-logical-pathname "matlisp:src;")
- :depends-on ("matlisp-packages")
- :components
- ((:file "f77-mangling")))
+ :pathname #.(translate-logical-pathname "matlisp:src;")
+ :depends-on ("matlisp-packages")
+ :components
+ ((:file "f77-mangling")))
(asdf:defsystem matlisp
- :pathname #.(translate-logical-pathname "matlisp:srcdir;")
- :depends-on ("lazy-loader"
- "matlisp-packages"
- "matlisp-utilities"
- "fortran-names")
- :components
- ((:module "foreign-interface"
- :pathname "src/"
- :components ((:file "ffi-cffi")
- (:file "ffi-cffi-interpreter-specific")
- ))
- (:module "foreign-functions"
- :pathname "src/"
- :depends-on ("foreign-interface")
- :components ((:file "blas")
- (:file "lapack")
- (:file "dfftpack")))
- (:module "matlisp-essentials"
- :pathname "src/"
- :depends-on ("foreign-interface"
- "foreign-functions")
- :components ((:file "conditions")
- (:file "standard-tensor")
- (:file "loopy"
- :depends-on ("standard-tensor"))
- (:file "real-tensor"
- :depends-on ("standard-tensor"))
- (:file "complex-tensor"
- :depends-on ("standard-tensor"))
- (:file "standard-matrix"
- :depends-on ("standard-tensor"))
- ;; (:file "real-matrix"
- ;; :depends-on ("standard-matrix"))
- ;; (:file "complex-matrix"
- ;; :depends-on ("standard-matrix"))
- (:file "print"
- :depends-on ("standard-tensor" "standard-matrix"))))))
+ :pathname #.(translate-logical-pathname "matlisp:srcdir;")
+ :depends-on (#:cffi "lazy-loader"
+ "matlisp-packages" "matlisp-utilities"
+ "fortran-names")
+ :components
+ ((:module "foreign-interface"
+ :pathname "src/"
+ :components ((:file "ffi-cffi")
+ (:file "ffi-cffi-interpreter-specific")
+ ))
+ (:module "foreign-functions"
+ :pathname "src/"
+ :depends-on ("foreign-interface")
+ :components ((:file "blas")
+ (:file "lapack")
+ (:file "dfftpack")))
+ (:module "matlisp-essentials"
+ :pathname "src/"
+ :depends-on ("foreign-interface"
+ "foreign-functions")
+ :components ((:file "conditions")
+ (:file "standard-tensor")
+ (:file "loopy"
+ :depends-on ("standard-tensor"))
+ (:file "real-tensor"
+ :depends-on ("standard-tensor"))
+ (:file "complex-tensor"
+ :depends-on ("standard-tensor"))
+ (:file "standard-matrix"
+ :depends-on ("standard-tensor"))
+ ;; (:file "real-matrix"
+ ;; :depends-on ("standard-matrix"))
+ ;; (:file "complex-matrix"
+ ;; :depends-on ("standard-matrix"))
+ (:file "print"
+ :depends-on ("standard-tensor" "standard-matrix"))))))
;; (defclass f2cl-cl-source-file (asdf:cl-source-file)
;; ())
-
+
;; (defmethod asdf:source-file-type ((f f2cl-cl-source-file) (m asdf:module))
;; "l")
;; (asdf:defsystem matlisp-f2cl-macros
;; :pathname #.(translate-logical-pathname "matlisp:srcdir;lib-src;")
;; :depends-on ("matlisp-packages")
-;; :default-component-class f2cl-cl-source-file
+;; :default-component-class f2cl-cl-source-file
;; :components
;; ((:file "macros")))
;; (asdf:defsystem matlisp
;; :pathname #.(translate-logical-pathname "matlisp:srcdir;")
;; :depends-on ("lazy-loader"
-;; "matlisp-packages"
-;; "matlisp-utilities"
-;; "fortran-names"
-;; "matlisp-f2cl-macros")
+;; "matlisp-packages"
+;; "matlisp-utilities"
+;; "fortran-names"
+;; "matlisp-f2cl-macros")
;; :components
;; ((:module "foreign-interface"
-;; :pathname "src/"
-;; :components ((:file "ffi-cffi")
-;; (:file "ffi-cffi-interpreter-specific")
-;; ))
+;; :pathname "src/"
+;; :components ((:file "ffi-cffi")
+;; (:file "ffi-cffi-interpreter-specific")
+;; ))
;; (:module "foreign-functions"
-;; :pathname "src/"
-;; :depends-on ("foreign-interface")
-;; :components ((:file "blas")
-;; (:file "lapack")
-;; (:file "dfftpack")
-;; #+nil (:file "ranlib")))
+;; :pathname "src/"
+;; :depends-on ("foreign-interface")
+;; :components ((:file "blas")
+;; (:file "lapack")
+;; (:file "dfftpack")
+;; #+nil (:file "ranlib")))
;; (:module "matlisp-essentials"
-;; :pathname "src/"
-;; :depends-on ("foreign-interface"
-;; "foreign-functions")
-;; :components ((:file "conditions")
-;; (:file "standard-matrix")
-;; (:file "real-matrix"
-;; :depends-on ("standard-matrix"))
-;; (:file "complex-matrix"
-;; :depends-on ("standard-matrix"))
-;; ;; (:file "ref"
-;; ;; :depends-on ("matrix"))
-;; (:file "copy"
-;; :depends-on ("standard-matrix"))
-;; (:file "print"
-;; :depends-on ("standard-matrix"))))
-
+;; :pathname "src/"
+;; :depends-on ("foreign-interface"
+;; "foreign-functions")
+;; :components ((:file "conditions")
+;; (:file "standard-matrix")
+;; (:file "real-matrix"
+;; :depends-on ("standard-matrix"))
+;; (:file "complex-matrix"
+;; :depends-on ("standard-matrix"))
+;; ;; (:file "ref"
+;; ;; :depends-on ("matrix"))
+;; (:file "copy"
+;; :depends-on ("standard-matrix"))
+;; (:file "print"
+;; :depends-on ("standard-matrix"))))
+
;; (:module "matlisp-blas-wrappers"
-;; :pathname "src/"
-;; :depends-on ("foreign-interface"
-;; "foreign-functions"
-;; "matlisp-essentials")
-;; :components ((:file "axpy")
-;; (:file "scal")
-;; (:file "swap")
-;; (:file "gemv")
-;; (:file "gemm")))
+;; :pathname "src/"
+;; :depends-on ("foreign-interface"
+;; "foreign-functions"
+;; "matlisp-essentials")
+;; :components ((:file "axpy")
+;; (:file "scal")
+;; (:file "swap")
+;; (:file "gemv")
+;; (:file "gemm")))
;; (:module "matlisp-lapack-wrappers"
-;; :pathname "src/"
-;; :depends-on ("foreign-interface"
-;; "foreign-functions"
-;; "matlisp-essentials")
-;; :components ((:file "gels")
-;; (:file "gesv")
-;; (:file "geev")
-;; (:file "getrf")
-;; (:file "getrs")
-;; (:file "potrf")
-;; (:file "potrs")))
+;; :pathname "src/"
+;; :depends-on ("foreign-interface"
+;; "foreign-functions"
+;; "matlisp-essentials")
+;; :components ((:file "gels")
+;; (:file "gesv")
+;; (:file "geev")
+;; (:file "getrf")
+;; (:file "getrs")
+;; (:file "potrf")
+;; (:file "potrs")))
;; (:module "matlisp-functions"
;; :pathname "src/"
-;; :depends-on ("foreign-interface"
-;; "foreign-functions"
-;; "matlisp-essentials"
-;; "matlisp-blas-wrappers"
-;; "matlisp-lapack-wrappers")
-;; :components ((:file "compat")
-;; (:file "help")
-;; (:file "special")
-;; (:file "reader")
-;; (:file "trans")
-;; (:file "realimag")
-;; (:file "submat")
-;; (:file "reshape")
-;; (:file "join")
-;; (:file "svd")
-;; (:file "sum")
-;; (:file "norm")
-;; (:file "dot")
-;; (:file "trace")
-;; (:file "seq")
-;; (:file "vec")
-;; (:file "map")
-;; (:file "mplus")
-;; (:file "mminus")
-;; (:file "mtimes")
-;; (:file "mdivide")
-;; (:file "msqrt")
-;; (:file "fft")
-;; (:file "geqr")))
+;; :depends-on ("foreign-interface"
+;; "foreign-functions"
+;; "matlisp-essentials"
+;; "matlisp-blas-wrappers"
+;; "matlisp-lapack-wrappers")
+;; :components ((:file "compat")
+;; (:file "help")
+;; (:file "special")
+;; (:file "reader")
+;; (:file "trans")
+;; (:file "realimag")
+;; (:file "submat")
+;; (:file "reshape")
+;; (:file "join")
+;; (:file "svd")
+;; (:file "sum")
+;; (:file "norm")
+;; (:file "dot")
+;; (:file "trace")
+;; (:file "seq")
+;; (:file "vec")
+;; (:file "map")
+;; (:file "mplus")
+;; (:file "mminus")
+;; (:file "mtimes")
+;; (:file "mdivide")
+;; (:file "msqrt")
+;; (:file "fft")
+;; (:file "geqr")))
;; (:module "special-functions"
-;; :pathname "src/"
-;; :depends-on ("matlisp-functions")
-;; :components
-;; ((:file "specfun")))))
+;; :pathname "src/"
+;; :depends-on ("matlisp-functions")
+;; :components
+;; ((:file "specfun")))))
;; Add-on packages
;; (asdf:defsystem matlisp-quadpack
@@ -219,131 +219,131 @@
;; :depends-on ("matlisp-f2cl-macros")
;; :components
;; ((:module "quadpack-interface"
-;; :pathname "src/"
-;; :components
-;; ((:file "quadpack")))
+;; :pathname "src/"
+;; :components
+;; ((:file "quadpack")))
;; (:module "lib-src"
-;; :components
-;; ((:module "quadpack"
-;; :components
-;; (
-;; ;; Support
-;; (:file "dqwgtf")
-;; (:file "dqcheb")
-;; (:file "dqk15w")
-;; (:file "dqwgts")
-;; (:file "dqwgtc")
-;; (:file "dgtsl")
-;; (:file "xerror")
-
-;; ;; Core integration routines
-;; (:file "dqk15")
-;; (:file "dqk31")
-;; (:file "dqk41")
-;; (:file "dqk51")
-;; (:file "dqk61")
-;; (:file "dqk21")
-;; (:file "dqk15i")
-;; (:file "dqelg")
-;; (:file "dqpsrt")
-;; (:file "dqc25s"
-;; :depends-on ("dqcheb" "dqk15w"))
-;; (:file "dqmomo")
-;; (:file "dqc25c"
-;; :depends-on ("dqcheb"
-;; "dqk15w"))
-;; (:file "dqc25f"
-;; :depends-on ("dgtsl"
-;; "dqcheb"
-;; "dqk15w"
-;; "dqwgtf"))
-;; ;; Basic integrators
-;; (:file "dqage"
-;; :depends-on ("dqk15"
-;; "dqk31"
-;; "dqk41"
-;; "dqk51"
-;; "dqk61"
-;; "dqk21"
-;; "dqpsrt"))
-;; (:file "dqagie"
-;; :depends-on ("dqelg"
-;; "dqk15i"
-;; "dqpsrt"))
-;; (:file "dqagpe"
-;; :depends-on ("dqelg"
-;; "dqpsrt"
-;; "dqk21"
-;; ))
-;; (:file "dqagse"
-;; :depends-on ("dqk21"
-;; "dqelg"
-;; "dqpsrt"))
-;; (:file "dqawfe"
-;; :depends-on ("dqagie"
-;; "dqawoe"
-;; "dqelg"))
-;; (:file "dqawoe"
-;; :depends-on ("dqc25f"
-;; "dqpsrt"
-;; "dqelg"))
-;; (:file "dqawse"
-;; :depends-on ("dqc25s"
-;; "dqmomo"
-;; "dqpsrt"))
-;; (:file "dqawce"
-;; :depends-on ("dqc25c"
-;; "dqpsrt"))
-;; ;; Simplified interface routines
-;; (:file "dqng"
-;; :depends-on ("xerror"))
-;; (:file "dqag"
-;; :depends-on ("dqage"
-;; "xerror"))
-;; (:file "dqags"
-;; :depends-on ("dqagse"
-;; "xerror"))
-;; (:file "dqagi"
-;; :depends-on ("dqagie"
-;; "xerror"))
-;; (:file "dqawf"
-;; :depends-on ("dqawfe"
-;; "xerror"))
-;; (:file "dqawo"
-;; :depends-on ("dqawoe"
-;; "xerror"))
-;; (:file "dqaws"
-;; :depends-on ("dqawse"
-;; "xerror"))
-;; (:file "dqawc"
-;; :depends-on ("dqawce"
-;; "xerror"))))))))
+;; :components
+;; ((:module "quadpack"
+;; :components
+;; (
+;; ;; Support
+;; (:file "dqwgtf")
+;; (:file "dqcheb")
+;; (:file "dqk15w")
+;; (:file "dqwgts")
+;; (:file "dqwgtc")
+;; (:file "dgtsl")
+;; (:file "xerror")
+
+;; ;; Core integration routines
+;; (:file "dqk15")
+;; (:file "dqk31")
+;; (:file "dqk41")
+;; (:file "dqk51")
+;; (:file "dqk61")
+;; (:file "dqk21")
+;; (:file "dqk15i")
+;; (:file "dqelg")
+;; (:file "dqpsrt")
+;; (:file "dqc25s"
+;; :depends-on ("dqcheb" "dqk15w"))
+;; (:file "dqmomo")
+;; (:file "dqc25c"
+;; :depends-on ("dqcheb"
+;; "dqk15w"))
+;; (:file "dqc25f"
+;; :depends-on ("dgtsl"
+;; "dqcheb"
+;; "dqk15w"
+;; "dqwgtf"))
+;; ;; Basic integrators
+;; (:file "dqage"
+;; :depends-on ("dqk15"
+;; "dqk31"
+;; "dqk41"
+;; "dqk51"
+;; "dqk61"
+;; "dqk21"
+;; "dqpsrt"))
+;; (:file "dqagie"
+;; :depends-on ("dqelg"
+;; "dqk15i"
+;; "dqpsrt"))
+;; (:file "dqagpe"
+;; :depends-on ("dqelg"
+;; "dqpsrt"
+;; "dqk21"
+;; ))
+;; (:file "dqagse"
+;; :depends-on ("dqk21"
+;; "dqelg"
+;; "dqpsrt"))
+;; (:file "dqawfe"
+;; :depends-on ("dqagie"
+;; "dqawoe"
+;; "dqelg"))
+;; (:file "dqawoe"
+;; :depends-on ("dqc25f"
+;; "dqpsrt"
+;; "dqelg"))
+;; (:file "dqawse"
+;; :depends-on ("dqc25s"
+;; "dqmomo"
+;; "dqpsrt"))
+;; (:file "dqawce"
+;; :depends-on ("dqc25c"
+;; "dqpsrt"))
+;; ;; Simplified interface routines
+;; (:file "dqng"
+;; :depends-on ("xerror"))
+;; (:file "dqag"
+;; :depends-on ("dqage"
+;; "xerror"))
+;; (:file "dqags"
+;; :depends-on ("dqagse"
+;; "xerror"))
+;; (:file "dqagi"
+;; :depends-on ("dqagie"
+;; "xerror"))
+;; (:file "dqawf"
+;; :depends-on ("dqawfe"
+;; "xerror"))
+;; (:file "dqawo"
+;; :depends-on ("dqawoe"
+;; "xerror"))
+;; (:file "dqaws"
+;; :depends-on ("dqawse"
+;; "xerror"))
+;; (:file "dqawc"
+;; :depends-on ("dqawce"
+;; "xerror"))))))))
;; (asdf:defsystem matlisp-minpack
;; :pathname #.(translate-logical-pathname "matlisp:srcdir;")
;; :depends-on ("matlisp-f2cl-macros")
;; :components
;; ((:module "lib-src"
-;; :components
-;; ((:module "minpack"
-;; :components
-;; ((:file "dpmpar")
-;; (:file "enorm")
-;; (:file "fdjac2")
-;; (:file "qrsolv")
-;; (:file "lmpar")
-;; (:file "qrfac")
-;; (:file "lmdif")
-;; (:file "lmdif1")
-;; (:file "lmder")
-;; (:file "lmder1")
-;; (:file "dogleg")
-;; (:file "qform")
-;; (:file "r1mpyq")
-;; (:file "r1updt")
-;; (:file "hybrj" :depends-on ("dogleg" "qform" "r1mpyq" "r1updt"))
-;; (:file "hybrj1" :depends-on ("hybrj"))
-;; ))))))
+;; :components
+;; ((:module "minpack"
+;; :components
+;; ((:file "dpmpar")
+;; (:file "enorm")
+;; (:file "fdjac2")
+;; (:file "qrsolv")
+;; (:file "lmpar")
+;; (:file "qrfac")
+;; (:file "lmdif")
+;; (:file "lmdif1")
+;; (:file "lmder")
+;; (:file "lmder1")
+;; (:file "dogleg")
+;; (:file "qform")
+;; (:file "r1mpyq")
+;; (:file "r1updt")
+;; (:file "hybrj" :depends-on ("dogleg" "qform" "r1mpyq" "r1updt"))
+;; (:file "hybrj1" :depends-on ("hybrj"))
+;; ))))))
;; (asdf:defsystem matlisp-odepack
;; :pathname #.(translate-logical-pathname "matlisp:srcdir;")
@@ -351,7 +351,7 @@
;; :components
;; ((:module "src"
;; :components
-;; ((:file "dlsode")))))
+;; ((:file "dlsode")))))
;; (asdf:defsystem matlisp-colnew
;; :pathname #.(translate-logical-pathname "matlisp:srcdir;")
diff --git a/packages.lisp b/packages.lisp
index ee8fbf4..5226d68 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -153,8 +153,8 @@
;;; Define the packages and symbols for Matlisp.
-(defpackage :utilities
- (:use :common-lisp)
+(defpackage "UTILITIES"
+ (:use #:common-lisp)
(:export #:ensure-list
#:zip #:zip-eq
#:cut-cons-chain!
@@ -175,9 +175,9 @@
#:foreign-vector #:make-foreign-vector #:foreign-vector-p
#:fv-ref #:fv-pointer #:fv-size #:fv-type))
-(defpackage :fortran-ffi-accessors
- (:nicknames :ffi)
- (:use :common-lisp :cffi :utilities)
+(defpackage "FORTRAN-FFI-ACCESSORS"
+ (:nicknames #:ffi)
+ (:use #:common-lisp #:cffi #:utilities)
;; TODO: Check if this is implementation-agnostic.
;; #+:cmu (:use :common-lisp :c-call :cffi :utilities)
;; #+:sbcl (:use :common-lisp :cffi :utilities)
@@ -191,8 +191,8 @@
)
(:documentation "Fortran foreign function interface"))
-(defpackage :blas
- (:use :common-lisp :fortran-ffi-accessors)
+(defpackage "BLAS"
+ (:use #:common-lisp #:ffi)
(:export
;;BLAS Level 1
;;------------
@@ -216,8 +216,8 @@
#:zgemm #:ztrmm #:ztrsm #:zherk #:zher2k)
(:documentation "BLAS routines"))
-(defpackage :lapack
- (:use :common-lisp :fortran-ffi-accessors)
+(defpackage "LAPACK"
+ (:use #:common-lisp #:ffi)
(:export
#:dgesv #:dgeev #:dgetrf #:dgetrs #:dgesvd
#:zgesv #:zgeev #:zgetrf #:zgetrs #:zgesvd
@@ -227,11 +227,32 @@
#:dgelsy)
(:documentation "LAPACK routines"))
-(defpackage :dfftpack
- (:use :common-lisp :fortran-ffi-accessors)
+(defpackage "DFFTPACK"
+ (:use #:common-lisp #:fortran-ffi-accessors)
(:export #:zffti #:zfftf #:zfftb #:zffti #:zfftf #:zfftb)
(:documentation "FFT routines"))
+(defpackage "MATLISP"
+ (:use #:common-lisp #:fortran-ffi-accessors #:blas #:lapack #:dfftpack #:utilities)
+ (:export #:integer4-type #:integer4-array #:allocate-integer4-store
+ #:index-type #:index-array #:allocate-index-store #:make-index-store
+ ;;Standard-tensor
+ #:standard-tensor
+ #:rank #:dimensions #:number-of-elements
+ #:head #:strides #:store-size #:store
+ ;;Sub-tensor
+ #:sub-tensor
+ #:parent-tensor
+ ;;Store indexers
+ #:store-indexing
+ #:store-indexing-internal #:store-indexing-vec #:store-indexing-lst
+ ;;Store accessors
+ #:tensor-store-ref
+ #:tensor-ref
+ ;;Type checking
+ #:tensor-type-p #:vector-p #:matrix-p #:square-p)
+ (:documentation "MATLISP routines"))
+
;;Transitioning to using the tensor-datastructures; eventually move things back to :matlisp
;; Stolen from f2cl.
@@ -309,26 +330,6 @@
;; "ZEROIN")
;; (:documentation "Other useful routines"))
-(defpackage :matlisp
- (:use :common-lisp :fortran-ffi-accessors :blas :lapack :dfftpack :utilities)
- (:export #:integer4-type #:integer4-array #:allocate-integer4-store
- #:index-type #:index-array #:allocate-index-store #:make-index-store
- ;;Standard-tensor
- #:standard-tensor
- #:rank #:dimensions #:number-of-elements
- #:head #:strides #:store-size #:store
- ;;Sub-tensor
- #:sub-tensor
- #:parent-tensor
- ;;Store indexers
- #:store-indexing
- #:store-indexing-internal #:store-indexing-vec #:store-indexing-lst
- ;;Store accessors
- #:tensor-store-ref
- #:tensor-ref
- ;;Type checking
- #:tensor-type-p #:vector-p #:matrix-p #:square-p)
- (:documentation "MATLISP routines"))
;; (defpackage :matlisp
;; (:use :common-lisp :fortran-ffi-accessors :blas :lapack :dfftpack :quadpack :matlisp-lib :utilities)
diff --git a/src/blas-helpers.lisp b/src/blas-helpers.lisp
index 29f2813..78c33cb 100644
--- a/src/blas-helpers.lisp
+++ b/src/blas-helpers.lisp
@@ -19,7 +19,7 @@
(rs (row-stride matrix) :type fixnum)
(cs (col-stride matrix) :type fixnum)
(ne (number-of-elements matrix) :type fixnum))
- (very-quickly
+ (very-quickly
(cond
((or (= nc 1) (= cs (* nr rs))) (values t rs ne))
((or (= nr 1) (= rs (* nc cs))) (values t cs ne))
@@ -35,3 +35,55 @@
((= rs 1) (values :col-major cs (fortran-op op)))
;;Lets not confound lisp's type declaration.
(t (values nil -1 "?")))))
+
+
+(defun col-major-p (strides dims)
+ (declare (type (index-array *) strides dims))
+ (very-quickly
+ (loop
+ for off across strides
+ and dim across dims
+ and accumulated-off = 1 then (* accumulated-off dim)
+ unless (= off accumulated-off) do (return nil)
+ finally (return t))))
+
+(defun row-major-p (strides dims)
+ (declare (type (index-array *) strides dims))
+ (very-quickly
+ (loop
+ for idx of-type index-type from (1- (length dims)) downto 0
+ for dim of-type index-type = (aref dims idx)
+ for off of-type index-type = (aref strides idx)
+ and accumulated-off of-type index-type = 1 then (* accumulated-off dim)
+ unless (= off accumulated-off) do (return nil)
+ finally (return t))))
+
+(defun same-dimension-p (a b)
+ (declare (type (index-array *) a b))
+ (let ((l-a (length a)))
+ (when (= l-a (length b))
+ (very-quickly
+ (loop
+ for i from 0 below l-a
+ unless (= (aref a i) (aref b i))
+ do (return nil)
+ finally (return t))))))
+
+(defun consecutive-store-p (strides dims)
+ (declare (type (index-array *) strides dims))
+ (let* ((stride-dims (very-quickly
+ (sort (apply #'vector
+ (loop
+ for std across strides
+ and dim across dims
+ collect `(,std ,dim)))
+ #'< :key #'car)))
+ (stride-min (first (aref stride-dims 0))))
+ (declare (type index-type stride-min)
+ (type (simple-vector *) stride-dims))
+ (very-quickly
+ (loop
+ for st-di across stride-dims
+ and accumulated-off = stride-min then (* accumulated-off (second st-di))
+ unless (= (first st-di) accumulated-off) do (return nil)
+ finally (return stride-min)))))
diff --git a/src/complex-tensor.lisp b/src/complex-tensor.lisp
index 35bbd13..4a636cf 100644
--- a/src/complex-tensor.lisp
+++ b/src/complex-tensor.lisp
@@ -35,7 +35,7 @@ Default initial-element = 0d0."
:type (complex-base-array *)))
(:documentation "Tensor class with complex elements."))
-(defclass complex-sub-tensor (complex-tensor sub-tensor)
+(defclass complex-sub-tensor (complex-tensor standard-sub-tensor)
()
(:documentation "Sub-tensor class with complex elements."))
@@ -84,13 +84,14 @@ Cannot hold complex numbers."))
(let ((realpart (realpart element))
(imagpart (imagpart element)))
(format stream (if (zerop imagpart)
- " ~11,4,,,,,'Eg "
+ "~11,5,,,,,'Eg"
"#C(~11,4,,,,,'Ee ~11,4,,,,,'Ee)")
realpart imagpart)))
;;
-(defun make-complex-tensor (&rest subs)
+(defun make-complex-tensor-dims (&rest subs)
(let* ((dims (make-index-store subs))
(ss (reduce #'* dims))
(store (allocate-complex-store ss)))
(make-instance 'complex-tensor :store store :dimensions dims)))
+
diff --git a/src/conditions.lisp b/src/conditions.lisp
index e58b119..781f435 100644
--- a/src/conditions.lisp
+++ b/src/conditions.lisp
@@ -39,6 +39,7 @@
(defmethod print-object ((c invalid-value) stream)
(format stream "Given object ~A, expected ~A.~%" (given c) (expected c))
(call-next-method))
+
;;---------------------------------------------------------------;;
(define-condition unknown-token (generic-error)
((token :reader token :initarg :token))
@@ -49,6 +50,17 @@
(call-next-method))
;;---------------------------------------------------------------;;
+(define-condition coercion-error (generic-error)
+ ((from :reader from :initarg :from)
+ (to :reader to :initarg :to))
+ (:documentation "Cannot coerce one type into another."))
+
+(defmethod print-object ((c coercion) stream)
+ (format stream "Cannot coerce ~a into ~a." (from c) (to c))
+ (call-next-method))
+
+
+;;---------------------------------------------------------------;;
(define-condition matlisp-error (error)
;;Optional argument for error-handling.
((tensor :reader tensor :initarg :tensor)))
@@ -119,3 +131,10 @@
(:documentation "Cannot find optimization information for the given tensor class")
(:report (lambda (c stream)
(format stream "Cannot find optimization information for the given tensor class: ~a." (tensor-class c)))))
+
+(define-condition tensor-dimension-mismatch (matlisp-error)
+ ()
+ (:documentation "The dimensions of the given tensors are not suitable for continuing with the operation.")
+ (:report (lambda (c stream)
+ (declare (ignore c))
+ (format stream "The dimensions of the given tensors are not suitable for continuing with the operation."))))
diff --git a/src/copy.lisp b/src/copy.lisp
index 91c1031..4c21264 100644
--- a/src/copy.lisp
+++ b/src/copy.lisp
@@ -76,9 +76,9 @@
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(in-package :matlisp)
+(in-package #:matlisp)
-(defmacro generate-typed-copy!-func (func (tensor-class blas-func))
+(defmacro generate-typed-copy! (func (tensor-class blas-func))
;;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.
@@ -111,7 +111,7 @@
do ,(funcall (getf opt :reader-writer) 'f-sto 'f-of 't-sto 't-of))))
to))))
-(defmacro generate-typed-num-copy!-func (func (tensor-class blas-func))
+(defmacro generate-typed-num-copy! (func (tensor-class blas-func))
;;Be very careful when using functions generated by this macro.
;;Indexes can be tricky and this has no safety net
;;(you don't see a matrix-ref do you ?)
@@ -143,13 +143,12 @@
do ,(funcall (getf opt :value-writer) 'num-from 't-sto 't-of))))
to))))
-(generate-typed-copy!-func real-typed-copy! (real-tensor dcopy))
-(generate-typed-num-copy!-func real-typed-num-copy! (real-tensor dcopy))
+(generate-typed-copy! real-typed-copy! (real-tensor dcopy))
+(generate-typed-num-copy! real-typed-num-copy! (real-tensor dcopy))
-(generate-typed-copy!-func complex-typed-copy! (complex-tensor zcopy))
-(generate-typed-num-copy!-func complex-typed-num-copy! (complex-tensor zcopy))
+(generate-typed-copy! complex-typed-copy! (complex-tensor zcopy))
+(generate-typed-num-copy! complex-typed-num-copy! (complex-tensor zcopy))
;;---------------------------------------------------------------;;
-
(defgeneric copy! (from-tensor to-tensor)
(:documentation
"
@@ -172,75 +171,33 @@
the type of Y. For example,
a COMPLEX-MATRIX cannot be copied to a
REAL-MATRIX but the converse is possible.
-"))
-
-(defmethod copy! :before ((x standard-matrix) (y standard-matrix))
- (mlet* (((nr-x nc-x) (slot-values x '(number-of-rows number-of-cols)) :type (fixnum fixnum))
- ((nr-y nc-y) (slot-values y '(number-of-rows number-of-cols)) :type (fixnum fixnum)))
- (unless (and (= nr-x nr-y) (= nc-x nc-y))
- (error "Arguments X,Y to COPY! are of different dimensions."))))
-
-;;
-(defmethod copy! ((x standard-matrix) (y standard-matrix))
- (mlet* (((nr-x nc-x) (slot-values x '(number-of-rows number-of-cols))
- :type (fixnum fixnum)))
- (dotimes (i nr-x)
- (dotimes (j nc-x)
- (declare (type fixnum i j))
- (setf (matrix-ref-2d y i j) (matrix-ref-2d x i j))))
- y))
-
-;;
-(generate-typed-copy!-func real-tensor-copy! (real-tensor dcopy))
-
-(generate-typed-copy!-func real-double-copy!-typed real-matrix-store-type real-matrix blas:dcopy)
-
-(generate-typed-num-copy!-func real-double-num-copy!-typed
- double-float real-matrix-store-type real-matrix
- blas:dcopy
- (num
- (1x1-array
- (allocate-real-store 1)
- (setf (aref 1x1-array 0) num)
- :type (real-matrix-store-type 1))))
-
-(defmethod copy! ((x complex-matrix) (y real-matrix))
- (error "Cannot copy a COMPLEX-MATRIX into a REAL-MATRIX,
-don't know how to coerce a COMPLEX to a REAL"))
-
-(defmethod copy! ((x complex) (y real-matrix))
- (error "Cannot copy ~a to ~a, don't know how to coerce COMPLEX to REAL"
- x y))
-
-(defmethod copy! ((x real-matrix) (y real-matrix))
- (real-double-copy!-typed x y))
-
-(defmethod copy! ((x cl:real) (y real-matrix))
- (real-double-num-copy!-typed (coerce x 'double-float) y))
-
-;;
-(generate-typed-copy!-func complex-double-copy!-typed complex-matrix-store-type complex-matrix blas:zcopy)
-
-(generate-typed-num-copy!-func complex-double-num-copy!-typed
- complex-double-float complex-matrix-store-type complex-matrix
- blas:zcopy
- (num
- (1x1-z-array
- (allocate-complex-store 1)
- (setf (aref 1x1-z-array 0) (realpart num)
- (aref 1x1-z-array 1) (imagpart num))
- :type (complex-matrix-store-type 2))))
-
-(defmethod copy! ((x complex-matrix) (y complex-matrix))
- (complex-double-copy!-typed x y))
-
-(defmethod copy! ((x real-matrix) (y complex-matrix))
- (real-double-copy!-typed x (mrealpart~ y))
- (scal! 0d0 (mimagpart~ y))
- y)
-
-(defmethod copy! ((x number) (y complex-matrix))
- (complex-double-num-copy!-typed (complex-coerce x) y))
+")
+ (:method :before ((x standard-tensor) (y standard-tensor))
+ (unless (same-dimension-p (dimensions x) (dimensions y))
+ (error 'tensor-dimension-mismatch)))
+ (:method ((x standard-tensor) (y standard-tensor))
+ (mod-dotimes (idx (dimensions x))
+ do (setf (tensor-ref y idx) (tensor-ref x idx)))
+ y)
+ (:method ((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-matrix) (y complex-tensor))
+ (complex-typed-copy! x y))
+
+;; (defmethod copy! ((x real-matrix) (y complex-tensor))
+;; (real-double-copy!-typed x (mrealpart~ y))
+;; (scal! 0d0 (mimagpart~ y))
+;; y)
+
+(defmethod copy! ((x number) (y complex-tensor))
+ (complex-typed-num-copy! (coerce-complex x) y))
;;;;
(defgeneric copy (matrix)
diff --git a/src/loopy.lisp b/src/loopy.lisp
index 61c218f..9b27ad1 100644
--- a/src/loopy.lisp
+++ b/src/loopy.lisp
@@ -1,23 +1,5 @@
(in-package :matlisp)
-(defun column-major-p (offsets dims)
- (loop
- for off across offsets
- and dim across dims
- and accumulated-off = 1 then (* accumulated-off dim)
- unless (= off accumulated-off) do (return nil)
- finally (return t)))
-
-(defun row-major-p (offsets dims)
- (very-quickly
- (loop
- for idx of-type index-type from (1- (length dims)) downto 0
- for dim of-type index-type = (aref dims idx)
- for off of-type index-type = (aref offsets idx)
- and accumulated-off of-type index-type = 1 then (* accumulated-off dim)
- unless (= off accumulated-off) do (return nil)
- finally (return t))))
-
(defmacro mod-dotimes ((idx dims) &body body)
"
(mod-dotimes (idx {seq}) compound-form*)
diff --git a/src/realimag.lisp b/src/realimag.lisp
index 7f59e78..2036121 100644
--- a/src/realimag.lisp
+++ b/src/realimag.lisp
@@ -64,35 +64,53 @@
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(in-package "MATLISP")
+(in-package #:matlisp)
-(defun mrealpart~ (mat)
+(defun tensor-realpart~ (tensor)
"
Syntax
======
- (MREALPART~ matrix)
+ (tensor-realpart~ tensor)
Purpose
=======
- Returns a new SUB-REAL-MATRIX which is the real part of \"matrix\".
+ Returns a new tensor object which points to the real part of TENSOR.
+ Store is shared with TENSOR.
- Store is shared with \"matrix\".
-
- If \"matrix\" is a scalar, returns its real part.
-
- See IMAG, REALPART, IMAGPART
+ If TENSOR is a scalar, returns its real part.
"
+ (etypecase tensor
+ (real-tensor tensor)
+ (complex-tensor (make-instance 'real-sub-tensor
+ :parent-tensor tensor :store (store tensor)
+ :dimensions (dimensions tensor)
+ :strides (map '(index-array *) #'(lambda (x) (* 2 x)) (strides xten))
+ :head (the index-type (* 2 (head tensor)))))
+ (number (realpart tensor))))
+
+(defun tensor-imagpart~ (tensor)
+"
+ Syntax
+ ======
+ (tensor-imagpart~ tensor)
+
+ Purpose
+ =======
+ Returns a new tensor object which points to the \"imaginary\" part of TENSOR.
+ Store is shared with TENSOR.
- (typecase mat
- (real-matrix mat)
- (complex-matrix (make-instance 'sub-real-matrix
- :parent mat :store (store mat)
- :nrows (nrows mat) :ncols (ncols mat)
- :row-stride (* 2 (row-stride mat)) :col-stride (* 2 (col-stride mat))
- :head (* 2 (head mat))))
- (number (cl:realpart mat))))
-
-(defun mrealpart (mat)
+ If TENSOR is a scalar, returns its imaginary part.
+"
+ (etypecase tensor
+ (real-tensor tensor)
+ (complex-tensor (make-instance 'real-sub-tensor
+ :parent-tensor tensor :store (store tensor)
+ :dimensions (dimensions tensor)
+ :strides (map '(index-array *) #'(lambda (x) (* 2 x)) (strides xten))
+ :head (the index-type (+ 1 (* 2 (head tensor))))))
+ (number (imagpart tensor))))
+
+(defun tensor-realpart (mat)
"
Syntax
======
@@ -115,34 +133,6 @@
:head (* 2 (head mat)))))
(number (cl:realpart mat))))
-(defun mimagpart~ (mat)
-"
- Syntax
- ======
- (MIMAGPART~ matrix)
-
- Purpose
- =======
- Returns a new SUB-REAL-MATRIX which is the imaginary part of \"matrix\".
-
- Store is shared with \"matrix\".
-
- If \"matrix\" is a real-matrix, returns nil.
-
- If \"matrix\" is a scalar, returns its imaginary part.
-
- See IMAG, REALPART, IMAGPART
-"
- (typecase mat
- (real-matrix nil)
- (complex-matrix (make-instance 'sub-real-matrix
- :parent mat :store (store mat)
- :nrows (nrows mat) :ncols (ncols mat)
- :row-stride (* 2 (row-stride mat)) :col-stride (* 2 (col-stride mat))
- :head (+ 1 (* 2 (head mat)))))
- (number (cl:imagpart mat))))
-
-
(defun mimagpart (mat)
"
Syntax
@@ -198,4 +188,4 @@
See REAL, REALPART, IMAGPART
"
- (mimagpart matrix))
\ No newline at end of file
+ (mimagpart matrix))
diff --git a/src/scal.lisp b/src/scal.lisp
index a81af20..e0de476 100644
--- a/src/scal.lisp
+++ b/src/scal.lisp
@@ -67,34 +67,40 @@
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(in-package "MATLISP")
-
-(defmacro generate-typed-scal!-func (func element-type store-type matrix-type blas-func)
- ;;Be very careful when using functions generated by this macro.
- ;;Indexes can be tricky and this has no safety net
- ;;(you don't see a matrix-ref do you ?)
- ;;Use only after checking the arguments for compatibility.
- `(defun ,func (alpha mat-x)
- (declare (type ,matrix-type mat-x)
- (type ,element-type alpha)
- (optimize (safety 0) (speed 3)))
- (mlet* (((cp-x inc-x sz-x) (blas-copyable-p mat-x)
- :type (boolean fixnum fixnum))
- ((hd-x st-x) (slot-values mat-x '(head store))
- :type (fixnum (,store-type *))))
- (if cp-x
- (,blas-func sz-x alpha st-x inc-x :head-x hd-x)
- (mlet* (((nr-x nc-x rs-x cs-x) (slot-values mat-x '(number-of-rows number-of-cols row-stride col-stride))
- :type (fixnum fixnum fixnum fixnum)))
- ;;Choose the smaller of the loops.
- (when (> (nrows mat-x) (ncols mat-x))
- (rotatef nr-x nc-x)
- (rotatef rs-x cs-x))
- (loop for i from 0 below nr-x
- do (,blas-func nc-x alpha st-x cs-x :head-x (+ hd-x (* i rs-x)))))))
- mat-x))
-
-;;
+(in-package #:matlisp)
+
+(defmacro generate-typed-scal! (func (tensor-class blas-func))
+ (let ((opt (get-tensor-class-optimization tensor-class)))
+ (assert opt nil 'tensor-cannot-find-optimization :tensor-class tensor-class)
+ `(defun ,func (alpha to)
+ (declare (type ,tensor-class to)
+ (type ,(getf opt :element-type) alpha))
+ (let ((t-dims (dimensions to))
+ (t-stds (strides to))
+ (t-sto (store to))
+ (t-hd (head to)))
+ (declare (type (index-array *) t-dims t-stds)
+ (type index-type t-hd)
+ (type ,(linear-array-type (getf opt :store-type)) t-sto))
+ (if-let (min-stride (consecutive-store-p t-stds t-dims))
+ (,blas-func (number-of-elements to) alpha t-sto min-stride t-hd)
+ (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 t-dims)
+ with (linear-sums
+ (t-of t-stds t-hd))
+ do (let ((scal-val (* ,(funcall (getf opt :reader) 't-sto 't-of) alpha)))
+ ,(funcall (getf opt :value-writer) 'scal-val 't-sto 't-of))))))
+ to)))
+
+;; TODO: Maybe add zdscal support ? Don't think the difference between
+;; zdscal and zscal is significant, except for very large arrays.
+(generate-typed-scal! real-typed-scal! (real-tensor dscal))
+(generate-typed-scal! complex-typed-scal! (complex-tensor zscal))
+
+;;---------------------------------------------------------------;;
(defgeneric scal! (alpha x)
(:documentation
"
@@ -104,36 +110,16 @@
Purpose
=======
- Same as SCAL except that the result is
- stored in X.
+ X <- alpha .* X
"))
-;;
-(generate-typed-scal!-func real-double-dscal!-typed double-float real-matrix-store-type real-matrix blas:dscal)
-
-(defmethod scal! ((alpha number) (x number))
- (error "Cannot SCAL! two scalars, arg X must
-be a matrix to SCAL!"))
-
-(defmethod scal! ((alpha complex) (x real-matrix))
- (error "Cannot SCAL! a REAL-MATRIX by a COMPLEX, don't know
-how to coerce COMPLEX to REAL"))
+(defmethod scal! ((alpha number) (x real-tensor))
+ (real-typed-scal! (coerce-real alpha) x))
-(defmethod scal! ((alpha cl:real) (x real-matrix))
- (real-double-dscal!-typed (coerce alpha 'double-float) x))
+(defmethod scal! ((alpha number) (x complex-tensor))
+ (complex-typed-scal! (coerce-complex alpha) x))
;;
-(generate-typed-scal!-func complex-double-dscal!-typed double-float complex-matrix-store-type complex-matrix blas:zdscal)
-
-(generate-typed-scal!-func complex-double-zscal!-typed complex-double-float complex-matrix-store-type complex-matrix blas:zscal)
-
-(defmethod scal! ((alpha cl:real) (x complex-matrix))
- (complex-double-dscal!-typed (coerce alpha 'double-float) x))
-
-(defmethod scal! ((alpha complex) (x complex-matrix))
- (complex-double-zscal!-typed (complex-coerce alpha) x))
-
-;;;;
(defgeneric scal (alpha x)
(:documentation
"
@@ -143,11 +129,11 @@ how to coerce COMPLEX to REAL"))
Purpose
=======
- Computes and returns a new matrix equal to
+ Computes and returns a new tensor equal to
- alpha * X
+ alpha .* X
- where alpha is a scalar and X is a matrix.
+ where alpha is a scalar and X is a tensor.
"))
@@ -170,4 +156,4 @@ how to coerce COMPLEX to REAL"))
;;
(defmethod scal ((alpha number) (x complex-matrix))
(let ((result (copy x)))
- (scal! alpha result)))
\ No newline at end of file
+ (scal! alpha result)))
diff --git a/src/tensor-copy.lisp b/src/tensor-copy.lisp
deleted file mode 100644
index 9550fb6..0000000
--- a/src/tensor-copy.lisp
+++ /dev/null
@@ -1,60 +0,0 @@
-(in-package :matlisp)
-
-;;TODO-> use macrofied setf-ers and old {d, z} copy code to automate code-generation.
-(defun tensor-copy (from to)
- (declare (type real-tensor to from))
- (let ((st-f (store from))
- (st-t (store to)))
- (declare (type (real-array *) st-f st-t))
- (very-quickly
- (mod-dotimes (idx (dimensions from))
- with (linear-sums
- (of-t (strides to) (head to))
- (of-f (strides from) (head from)))
- do (setf (aref st-t of-t) (aref st-f of-f))))))
-
-(defun dimensions-check (a b)
- (declare (type (index-array *) a b))
- (let ((l-a (length a)))
- (when (= l-a (length b))
- (very-quickly
- (loop
- for i from 0 below l-a
- unless (= (aref a i) (aref b i))
- do (return nil)
- finally (return t))))))
-
-
-(defmacro generate-typed-copy!-func (func (tensor-class blas-func))
- ;;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)))
- `(defun ,func (from to)
- (declare (type tensor-type from to))
- (let ((f-dims (dimensions from))
- (f-stds (strides from))
- (f-sto (store from))
- (f-hd (head from))
- (t-dims (dimensions to))
- (t-stds (strides to))
- (t-sto (store to))
- (t-hd (head to)))
- (declare (type (index-array *) f-dims f-stds t-dims t-stds)
- (type index-type f-hd t-hd)
- (type ,(linear-array-type (getf opt :store-type)) f-sto t-sto))
- (if (or (and (row-major-p t-stds t-dims) (row-major-p f-stds f-dims))
- (and (col-major-p t-stds t-dims) (col-major-p f-stds f-dims)))
- (,blas-func (number-of-elements from) f-sto 1 t-sto 1 f-hd t-hd)
- (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 f-dims)
- with (linear-sums
- (f-of f-stds f-hd)
- (t-of t-stds t-hd))
- do ,(funcall (getf opt :reader-writer) 'f-sto 'f-of 't-sto 't-of))))
- to))))
-
-(generate-typed-copy!-func real-tensor-copy! (real-tensor dcopy))
diff --git a/src/utilities.lisp b/src/utilities.lisp
index a475531..3a26d44 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -234,6 +234,14 @@
(apply #'format (append `(,ostr ,fmt) args)))
ret))
+(declaim (inline seq-max))
+(defun seq-max (seq)
+ (reduce #'max seq))
+
+(declaim (inline seq-max))
+(defun seq-min (seq)
+ (reduce #'min seq))
+
;;---------------------------------------------------------------;;
(defstruct (foreign-vector
(:conc-name fv-)
-----------------------------------------------------------------------
Summary of changes:
TODO | 8 +
matlisp.asd | 530 +++++++++++++++++++++++-----------------------
packages.lisp | 63 +++---
src/blas-helpers.lisp | 54 +++++-
src/complex-tensor.lisp | 7 +-
src/conditions.lisp | 19 ++
src/copy.lisp | 111 +++-------
src/loopy.lisp | 18 --
src/realimag.lisp | 86 ++++-----
src/scal.lisp | 100 ++++-----
src/tensor-copy.lisp | 60 ------
src/utilities.lisp | 8 +
12 files changed, 504 insertions(+), 560 deletions(-)
create mode 100644 TODO
delete mode 100644 src/tensor-copy.lisp
hooks/post-receive
--
matlisp
|
