Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-304-g7ddfe78
|
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 sorting function.
diff --git a/src/level-1/axpy.lisp b/src/level-1/axpy.lisp
index 78cf827..73305ca 100644
--- a/src/level-1/axpy.lisp
+++ b/src/level-1/axpy.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/blas-axpy-func #'subtypep) sym ())
+(deft/generic (t/blas-axpy-func #'subfieldp) sym ())
(deft/method t/blas-axpy-func (sym real-tensor) ()
'daxpy)
(deft/method t/blas-axpy-func (sym complex-tensor) ()
diff --git a/src/level-1/copy.lisp b/src/level-1/copy.lisp
index c90bbff..0e4207b 100644
--- a/src/level-1/copy.lisp
+++ b/src/level-1/copy.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/blas-copy-func #'subtypep) sym ())
+(deft/generic (t/blas-copy-func #'subfieldp) sym ())
(deft/method t/blas-copy-func (sym real-tensor) ()
'dcopy)
(deft/method t/blas-copy-func (sym complex-tensor) ()
@@ -117,110 +117,6 @@
(,of-y (strides ,y) (head ,y)))
:do (t/store-set ,cly ,cx ,sto-y ,of-y)))
,y))))
-;;
-;;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?))
-(deft/method t/copy-triangle! (sym standard-tensor) (a b &optional (upper? t))
- (using-gensyms (decl (diag a b))
- (with-gensyms (sto-a sto-b strd-a strd-b dof-a dof-b of-a of-b)
- `(let* (,@decl
- (,sto-a (store ,a))
- (,strd-a (strides ,a))
- (,sto-b (store ,b))
- (,strd-b (strides ,b)))
- (declare (type ,sym ,a ,b)
- (type ,(store-type sym) ,sto-a ,sto-b)
- (type index-store-vector ,strd-a ,strd-b))
- (ecase ,diag
- (t
- (with-marking
- (very-quickly
- (:mark* ((ndiags (min (nrows ,a) (ncols ,a))))
- (loop :for i :from 0 :below ndiags
- :for ,dof-a :of-type index-type := (head ,a) :then (+ ,dof-a (:mark (lvec-foldr #'+ ,strd-a) :type index-type))
- :for ,dof-b :of-type index-type := (head ,b) :then (+ ,dof-b (:mark (lvec-foldr #'+ ,strd-b) :type index-type))
- :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)))
- :do (t/store-set ,sym (t/store-ref ,sym ,sto-a ,of-a) ,sto-b ,of-b)))))))
-
- ,b))))
-;;
-(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
- (,sto-a (store ,a))
- (,strd-a (strides ,a))
- (,sto-b (store ,b))
- (,strd-b (strides ,b)))
- (declare (type ,sym ,a ,b)
- (type ,(store-type sym) ,sto-a ,sto-b)
- (type index-store-vector ,strd-a ,strd-b))
- (with-marking
- (very-quickly
- (:mark* ((ndiags (min (nrows ,a) (ncols ,a))))
- (loop :for i :from 0 :below ndiags
- :for ,dof-a :of-type index-type := (head ,a) :then (+ ,dof-a (:mark (lvec-foldr #'+ ,strd-a) :type index-type))
- :for ,dof-b :of-type index-type := (head ,b) :then (+ ,dof-b (:mark (lvec-foldr #'+ ,strd-b) :type index-type))
- :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)))
- :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))))
-
-;;
-(defgeneric copy-triangle! (x y &key upper? diag?)
- (:method :before ((x standard-tensor) (y standard-tensor) &key upper? diag?)
- (assert (and (tensor-matrixp x) (tensor-matrixp y)
- (= (lvec-min (dimensions x)) (lvec-min (dimensions y))))
- nil 'tensor-dimension-mismatch)))
-
-
-(defmethod copy-triangle! ((x standard-tensor) (y standard-tensor) &key (upper? t) (diag? t))
- (let ((clx (class-name (class-of x)))
- (cly (class-name (class-of y))))
- (assert (and (member clx *tensor-type-leaves*)
- (member cly *tensor-type-leaves*)
- (eql clx cly))
- nil 'tensor-abstract-class :tensor-class (list clx cly))
- (compile-and-eval
- (let ((expr `())))
- `(defmethod copy-triangle! ((x ,clx) (y ,cly) &key (upper? t) (diag? t))
- (ecase diag?
- (t ;;copy diagonal
- (if upper? (t/copy-triangle! ,clx x y t) (t/copy-triangle! ,clx x y nil)))
- (number
- (let ((num (t/coerce ,(t/field-type clx) diag?)))
- (if upper? (t/copy-triangle! ,clx x y t) (t/copy-triangle! ,clx x y nil))
- (t/copy-diagonal! ,clx num y t)))
- (nil
- (let ((num
-
-|#
;;
(defmethod copy! :before ((x standard-tensor) (y standard-tensor))
@@ -266,6 +162,18 @@
(copy! x y)))
;;Generic function defined in src;base;generic-copy.lisp
-(defmethod copy ((tensor standard-tensor))
- (let* ((ret (zeros (the index-store-vector (dimensions tensor)) (class-name (class-of tensor)))))
- (copy! tensor ret)))
+(defmethod copy-generic ((tensor standard-tensor) type)
+ (cond
+ ((eql type 'array)
+ (let ((ret (make-array (lvec->list (dimensions tensor)))))
+ (copy! tensor ret)))
+ ((member type '(list cons))
+ (labels ((mtree (arr idx)
+ (let ((n (length idx)))
+ (if (= n (rank arr)) (apply #'ref arr idx)
+ (loop :for i :from 0 :below (aref (dimensions arr) n)
+ :collect (mtree arr (append idx (list i))))))))
+ (mtree tensor nil)))
+ ((or (not type) (subtypep type 'standard-tensor))
+ (let ((ret (zeros (dimensions tensor) (or type (class-of tensor)))))
+ (copy! tensor ret)))))
diff --git a/src/level-1/dot.lisp b/src/level-1/dot.lisp
index 3a81f7e..6b5825d 100644
--- a/src/level-1/dot.lisp
+++ b/src/level-1/dot.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/blas-dot-func #'subtypep) sym (&optional conjp))
+(deft/generic (t/blas-dot-func #'subfieldp) sym (&optional conjp))
(deft/method t/blas-dot-func (sym real-tensor) (&optional conjp)
'ddot)
(deft/method t/blas-dot-func (sym complex-tensor) (&optional (conjp t))
diff --git a/src/level-1/scal.lisp b/src/level-1/scal.lisp
index cedea4d..8f70505 100644
--- a/src/level-1/scal.lisp
+++ b/src/level-1/scal.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/blas-scdi-func #'subtypep) sym (&optional scal?))
+(deft/generic (t/blas-scdi-func #'subfieldp) sym (&optional scal?))
(deft/method t/blas-scdi-func (sym real-tensor) (&optional (scal? t))
(if scal?
@@ -39,7 +39,7 @@
'zescal
'zediv))
;;
-(deft/generic (t/blas-scdi! #'subtypep) sym (x st-x y st-y &optional scal?))
+(deft/generic (t/blas-scdi! #'subfieldp) sym (x st-x y st-y &optional scal?))
(deft/generic (t/scdi! #'subtypep) sym (x y &key scal? numx?))
(deft/method t/blas-scdi! (sym blas-numeric-tensor) (x st-x y st-y &optional (scal? t))
diff --git a/src/level-1/swap.lisp b/src/level-1/swap.lisp
index 2d0245b..880a197 100644
--- a/src/level-1/swap.lisp
+++ b/src/level-1/swap.lisp
@@ -27,7 +27,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package #:matlisp)
-(deft/generic (t/blas-swap-func #'subtypep) sym ())
+(deft/generic (t/blas-swap-func #'subfieldp) sym ())
(deft/method t/blas-swap-func (sym real-tensor) ()
'dswap)
(deft/method t/blas-swap-func (sym complex-tensor) ()
diff --git a/src/level-2/gemv.lisp b/src/level-2/gemv.lisp
index 75ba8a2..c305481 100644
--- a/src/level-2/gemv.lisp
+++ b/src/level-2/gemv.lisp
@@ -1,6 +1,6 @@
(in-package #:matlisp)
-(deft/generic (t/blas-gemv-func #'subtypep) sym ())
+(deft/generic (t/blas-gemv-func #'subfieldp) sym ())
(deft/method t/blas-gemv-func (sym real-tensor) ()
'dgemv)
(deft/method t/blas-gemv-func (sym complex-tensor) ()
diff --git a/src/level-3/gemm.lisp b/src/level-3/gemm.lisp
index 7c824c0..aadb836 100644
--- a/src/level-3/gemm.lisp
+++ b/src/level-3/gemm.lisp
@@ -1,6 +1,6 @@
(in-package #:matlisp)
-(deft/generic (t/blas-gemm-func #'subtypep) sym ())
+(deft/generic (t/blas-gemm-func #'subfieldp) sym ())
(deft/method t/blas-gemm-func (sym real-tensor) ()
'dgemm)
(deft/method t/blas-gemm-func (sym complex-tensor) ()
commit 6dacaaaa8356ad476ac631eb95b93829a5f1e3f1
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 17:08:57 2013 +0530
Added optional type for "copy" generic function.
diff --git a/src/base/generic-copy.lisp b/src/base/generic-copy.lisp
index aa30346..2f0dc7f 100644
--- a/src/base/generic-copy.lisp
+++ b/src/base/generic-copy.lisp
@@ -12,14 +12,14 @@
Copies the contents of X into Y. Returns Y.
")
(:method :before ((x array) (y array))
- (assert (list-eq (array-dimensions x) (array-dimensions y))
+ (assert (list-eq (array-dimensions x) (array-dimensions y))
nil 'dimension-mismatch)))
(defmethod copy! ((from cons) (to cons))
- (let-rec cdr-writer ((flst from) (tlst to))
- (unless (or (null flst) (null tlst))
- (setf (car tlst) (car flst))
- (cdr-writer (cdr flst) (cdr tlst))))
+ (do ((flst from (cdr flst))
+ (tlst to (cdr tlst)))
+ ((or (null flst) (null tlst)))
+ (setf (car tlst) (car flst)))
to)
(defmethod copy! ((from t) (to cons))
@@ -57,10 +57,10 @@
`(defmethod copy! ((x array) (y ,clname))
(let-typed ((sto-y (store y) :type (simple-array ,(store-element-type clname)))
(lst (make-list (array-rank x)) :type cons))
- (mod-dotimes (idx (dimensions y))
- :with (linear-sums
- (of-y (strides y) (head y)))
- :do (t/store-set ,clname (t/coerce ,(field-type clname) (apply #'aref x (lvec->list! idx lst))) sto-y of-y)))
+ (mod-dotimes (idx (dimensions y))
+ :with (linear-sums
+ (of-y (strides y) (head y)))
+ :do (t/store-set ,clname (t/coerce ,(field-type clname) (apply #'aref x (lvec->list! idx lst))) sto-y of-y)))
y))
(copy! x y)))
@@ -71,10 +71,10 @@
`(defmethod copy! ((x ,clname) (y array))
(let-typed ((sto-x (store x) :type (simple-array ,(store-element-type clname)))
(lst (make-list (array-rank y)) :type cons))
- (mod-dotimes (idx (dimensions x))
- :with (linear-sums
- (of-x (strides x) (head x)))
- :do (setf (apply #'aref y (lvec->list! idx lst)) (t/store-ref ,clname sto-x of-x))))
+ (mod-dotimes (idx (dimensions x))
+ :with (linear-sums
+ (of-x (strides x) (head x)))
+ :do (setf (apply #'aref y (lvec->list! idx lst)) (t/store-ref ,clname sto-x of-x))))
y))
(copy! x y)))
@@ -83,23 +83,47 @@
(let ((arr (make-array (list-dimensions x) :initial-contents x)))
(copy! arr y)))
;;
-(defgeneric copy (object)
- (:documentation
+(defgeneric copy-generic (object type)
+ (:documentation
"
Syntax
======
- (COPY x)
-
+ (COPY-GENERIC x type)
+
Purpose
=======
- Return a copy of X"))
+ Return a copy of X coerced to TYPE"))
+
+(definline copy (obj &optional type)
+ (copy-generic obj type))
-(defmethod copy ((num number))
- num)
+(defmethod copy-generic ((num number) type)
+ (if type (coerce num type) num))
-(defmethod copy ((lst cons))
- (copy-list lst))
+(defmethod copy-generic ((lst cons) type)
+ (cond
+ ((member type '(list cons nil)) (copy-tree lst))
+ ((eql type 'vector) (make-array (length lst) :initial-contents lst))
+ ((eql type 'array)
+ (make-array (list-dimensions lst) :initial-contents lst))
+ ((subtypep type 'standard-tensor)
+ (let ((ret (zeros (list-dimensions lst) type)))
+ (copy! lst ret)))
+ (t (error "don't know how to copy a list to type ~a" type))))
-(defmethod copy ((arr array))
- (let ((ret (make-array (array-dimensions arr) :element-type (array-element-type arr))))
- (copy! arr ret)))
+(defmethod copy-generic ((arr array) type)
+ (cond
+ ((member type '(array nil))
+ (let ((ret (make-array (array-dimensions arr) :element-type (array-element-type arr))))
+ (copy! arr ret)))
+ ((member type '(list cons))
+ (labels ((mtree (arr idx)
+ (let ((n (length idx)))
+ (if (= n (array-rank arr)) (apply #'aref arr idx)
+ (loop :for i :from 0 :below (array-dimension arr n)
+ :collect (mtree arr (append idx (list i))))))))
+ (mtree arr nil)))
+ ((subtypep type 'standard-tensor)
+ (let ((ret (zeros (array-dimensions arr) type)))
+ (copy! arr ret)))
+ (t (error "don't know how to copy a list to type ~a" type))))
commit 03fc1d7dafa1157eea84f9df3f0a24f1b4b240cd
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 17:06:35 2013 +0530
Removed coerce-tensor; the new copy method takes its place.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index b69c67a..3597250 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -93,11 +93,6 @@
tensor, for example #.(make-tensors ...)"
(make-load-form-saving-slots tensor :environment env))
-;;
-(definline coerce-tensor (x cly)
- (declare (type standard-tensor x))
- (copy! x (zeros (the index-store-vector (dimensions x)) cly)))
-
;;These should ideally be memoised (or not)
(definline rank (tensor)
(declare (type standard-tensor tensor))
commit 1d27fd93c94b99ff3f6fda26106e50c4d4cf1b01
Author: Akshay Srinivasan <aks...@gm...>
Date: Fri Dec 27 16:27:05 2013 +0530
Changed templates to be less verbose.
diff --git a/src/base/template.lisp b/src/base/template.lisp
index 65a296c..b7fe327 100644
--- a/src/base/template.lisp
+++ b/src/base/template.lisp
@@ -3,42 +3,28 @@
;;Field templates
(deft/generic (t/f+ #'subtypep) ty (&rest nums))
(deft/method t/f+ (ty number) (&rest nums)
- (let* ((decl (zipsym nums))
- (args (mapcar #'car decl)))
- `(let (,@decl)
- (declare (type ,ty ,@args))
- (cl:+ ,@args))))
+ `(cl:+ ,@(mapcar #'(lambda (x) `(the ,ty ,x)) nums)))
(deft/generic (t/f- #'subtypep) ty (&rest nums))
(deft/method t/f- (ty number) (&rest nums)
- (let* ((decl (zipsym nums))
- (args (mapcar #'car decl)))
- `(let (,@decl)
- (declare (type ,ty ,@args))
- (cl:- ,@args))))
+ `(cl:- ,@(mapcar #'(lambda (x) `(the ,ty ,x)) nums)))
(deft/generic (t/f* #'subtypep) ty (&rest nums))
(deft/method t/f* (ty number) (&rest nums)
- (let* ((decl (zipsym nums))
- (args (mapcar #'car decl)))
- `(let (,@decl)
- (declare (type ,ty ,@args))
- (cl:* ,@args))))
+ `(cl:* ,@(mapcar #'(lambda (x) `(the ,ty ,x)) nums)))
(deft/generic (t/f/ #'subtypep) ty (&rest nums))
(deft/method t/f/ (ty number) (&rest nums)
- (let* ((decl (zipsym nums))
- (args (mapcar #'car decl)))
- `(let (,@decl)
- (declare (type ,ty ,@args))
- (cl:/ ,@args))))
+ `(cl:/ ,@(mapcar #'(lambda (x) `(the ,ty ,x)) nums)))
+
+(deft/generic (t/f= #'subtypep) ty (&rest nums))
+(deft/method t/f= (ty number) (&rest nums)
+ `(cl:= ,@(mapcar #'(lambda (x) `(the ,ty ,x)) nums)))
;;
(deft/generic (t/fc #'subtypep) ty (num))
(deft/method t/fc (ty number) (num)
- (with-gensyms (num-sym)
- `(let ((,num-sym ,num))
- (cl:conjugate ,num-sym))))
+ `(cl:conjugate ,num))
(deft/method t/fc (ty real) (num)
num)
@@ -70,21 +56,11 @@
(deft/generic (t/fimagpart #'subtypep) ty (num))
(deft/method t/fimagpart (ty number) (num)
- (with-gensyms (num-sym)
- `(let ((,num-sym ,num))
- (cl:imagpart ,num-sym))))
+ `(cl:imagpart ,num))
(deft/method t/fimagpart (ty real) (num)
`(t/fid+ ,ty))
;;
-(deft/generic (t/f= #'subtypep) ty (&rest nums))
-(deft/method t/f= (ty number) (&rest nums)
- (let* ((decl (zipsym nums))
- (args (mapcar #'car decl)))
- `(let (,@decl)
- (declare (type ,ty ,@args))
- (cl:= ,@args))))
-
(deft/generic (t/fid+ #'subtypep) ty ())
(deft/method t/fid+ (ty number) ()
(coerce 0 ty))
@@ -107,16 +83,11 @@
(defun field-type (clname)
(macroexpand-1 `(t/field-type ,clname)))
+;;This is useful for Eigenvalue decompositions
+(deft/generic (t/complexified-type #'subtypep) sym ())
-;;Hack? Yes.
-(defun complexified-type (ten)
- (let ((ty (macroexpand-1 `(t/field-type ,ten))))
- (if (subtypep ty 'complex) ten
- (let* ((cty `(complex ,ty))
- (table-entry (or (gethash 't/field-type matlisp-template::*template-table*) (ERROR "Undefined template : ~a~%" 'T/FIELD-TYPE))))
- (car (find cty (mapcar #'(lambda (x) (list (cadr x) (funcall (car x) (cadr x))))
- (getf table-entry :methods))
- :key #'second :test #'list-eq))))))
+(defun complexified-type (type)
+ (macroexpand-1 `(t/complexified-type ,type)))
;;Beware of infinite loops here.
(deft/generic (t/store-element-type #'subtypep) sym ())
@@ -150,26 +121,11 @@
(deft/generic (t/store-ref #'subtypep) sym (store idx))
(deft/method t/store-ref (sym standard-tensor) (store idx)
- (let ((store-s (gensym))
- (idx-s (gensym)))
- `(let ((,store-s ,store)
- (,idx-s ,idx))
- (declare (type ,(store-type sym) ,store-s))
- (aref ,store-s ,idx-s))))
+ `(aref (the ,(store-type sym) ,store) (the index-type ,idx)))
(deft/generic (t/store-set #'subtypep) sym (value store idx))
(deft/method t/store-set (sym standard-tensor) (value store idx)
- (let ((store-s (gensym))
- (idx-s (gensym))
- (value-s (gensym))
- (type (macroexpand-1 `(t/field-type ,sym))))
- `(let ((,store-s ,store)
- (,idx-s ,idx)
- (,value-s ,value))
- (declare (type ,(store-type sym) ,store-s)
- (type ,type ,value-s))
- (setf (aref ,store-s ,idx-s) ,value-s)
- nil)))
+ `(setf (aref (the ,(store-type sym) ,store) (the index-type ,idx)) (the ,(field-type sym) ,value)))
(deft/generic (t/coerce #'subtypep) ty (val))
(deft/method t/coerce (ty number) (val)
@@ -195,7 +151,7 @@
;;This one is hard to get one's brain around.
(deft/generic (t/strict-coerce
#'(lambda (a b) (strict-compare (list #'subtypep #'(lambda (x y) (subtypep y x))) a b))
- #'(lambda (a b) (dict-compare (list #'subtypep #'subtypep) b a)))
+ #'(lambda (a b) (dict-compare (list #'subtypep #'subtypep) b a)))
(from to) (val))
;;Anything can be coerced into type "t"
commit 23f3205a3cad2be9a270bd0dc4acb57d42d8dbb2
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Dec 26 18:58:30 2013 +0530
Added compiler for store-size.
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index cc1dab1..b69c67a 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -124,7 +124,12 @@
Returns the number of elements the store of the tensor can hold
(which is not necessarily equal to its vector length).")
(:method ((tensor standard-tensor))
- (length (store tensor))))
+ (let ((clname (class-name (class-of tensor))))
+ (assert (member clname *tensor-type-leaves*) nil 'tensor-abstract-class :tensor-class clname)
+ (compile-and-eval
+ `(defmethod store-size ((tensor ,clname))
+ (t/store-size ,clname (store tensor))))
+ (store-size tensor))))
(defgeneric print-element (tensor
element stream)
commit 376d74de0a77839136869bcc27c5f877cb4a3bc8
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Dec 5 00:28:54 2013 -0800
Added an equality test in compute-t/dispatch.
diff --git a/src/utilities/functions.lisp b/src/utilities/functions.lisp
index e26251a..c131fa2 100644
--- a/src/utilities/functions.lisp
+++ b/src/utilities/functions.lisp
@@ -35,8 +35,8 @@
lst))
(defun list-eq (a b &optional (test #'eq))
- (if (or (atom a) (atom b)) (eq a b)
- (and (funcall test (car a) (car b)) (list-eq (cdr a) (cdr b) test))))
+ (if (or (atom a) (atom b)) (funcall test a b)
+ (and (list-eq (car a) (car b)) (list-eq (cdr a) (cdr b) test))))
(defun remmeth (func spls &optional quals)
(let ((meth (find-method func quals (mapcar #'(lambda (x) (if (consp x) x (find-class x))) spls) nil)))
diff --git a/src/utilities/template.lisp b/src/utilities/template.lisp
index 99f029c..f11fe68 100644
--- a/src/utilities/template.lisp
+++ b/src/utilities/template.lisp
@@ -36,10 +36,10 @@
(error "undefined template : ~a~%" name)))
(pred (getf data :predicate))
(meth (getf data :methods)))
- (or (car (loop :for spl :in meth
- :do (when (funcall pred args (second spl))
- (return spl))))
- (error "could not find a \"~a\" template for : ~a~%" name args)))))
+ (car (or
+ (find args meth :test #'list-eq :key #'second)
+ (find args meth :test pred :key #'second)
+ (error "could not find a \"~a\" template for : ~a~%" name args))))))
;;
(defun single-argp (name)
commit 953ce0f60f25157a4fc5b5d31403433aeb47e894
Author: Akshay Srinivasan <aks...@gm...>
Date: Wed Dec 4 23:20:23 2013 -0800
Renamed sub-tensor~ to subtensor~.
diff --git a/src/base/permutation.lisp b/src/base/permutation.lisp
index 02135a5..84f3517 100644
--- a/src/base/permutation.lisp
+++ b/src/base/permutation.lisp
@@ -198,7 +198,7 @@
(defmethod permute! ((A standard-tensor) (perm permutation-pivot-flip) &optional (arg 0))
(multiple-value-bind (t1 t2) (let ((slst (make-list (rank A) :initial-element '(* * *))))
(rplaca (nthcdr arg slst) (list 0 '* 1))
- (values (sub-tensor~ A slst nil) (sub-tensor~ A slst nil)))
+ (values (subtensor~ A slst nil) (subtensor~ A slst nil)))
(let-typed ((argstd (aref (strides A) arg) :type index-type)
(hd-sl (head t2) :type index-type)
(idiv (store perm) :type pindex-store-vector))
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index cccd99b..cc1dab1 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -107,6 +107,11 @@
(declare (type standard-tensor tensor))
(lvec-foldr #'* (the index-store-vector (dimensions tensor))))
+(definline dims (tensor)
+ (declare (type standard-tensor tensor))
+ (memoizing (tensor dims)
+ (lvec->list (the index-store-vector (dimensions tensor)))))
+
;;
(defgeneric store-size (tensor)
(:documentation "
@@ -361,11 +366,11 @@
:finally (return t))))
;;
-(defun sub-tensor~ (tensor subscripts &optional (preserve-rank nil))
+(defun subtensor~ (tensor subscripts &optional (preserve-rank nil))
"
Syntax
======
- (SUB-TENSOR~ TENSOR SUBSCRIPTS)
+ (SUBTENSOR~ TENSOR SUBSCRIPTS)
Purpose
=======
@@ -379,13 +384,13 @@
X
;; Get (:, 0, 0)
- > (sub-tensor~ X '((* * *) (0 * 1) (0 * 1)))
+ > (subtensor~ X '((* * *) (0 * 1) (0 * 1)))
;; Get (:, 2:5, :)
- > (sub-tensor~ X '((* * *) (2 * 5)))
+ > (subtensor~ X '((* * *) (2 * 5)))
;; Get (:, :, 0:2:10) (0:10:2 = [i : 0 <= i < 10, i % 2 = 0])
- > (sub-tensor~ X '((* * *) (* * *) (0 2 10)))
+ > (subtensor~ X '((* * *) (* * *) (0 2 10)))
Commentary
==========
@@ -449,7 +454,7 @@
(definline slice~ (x axis &optional (idx 0))
(let ((slst (make-list (rank x) :initial-element '(* * *))))
(rplaca (nthcdr axis slst) (list idx '* (1+ idx)))
- (sub-tensor~ x slst nil)))
+ (subtensor~ x slst nil)))
(definline row-slice~ (x idx)
(slice~ x 0 idx))
diff --git a/src/lapack/least-squares.lisp b/src/lapack/least-squares.lisp
index 7816998..ef4f911 100644
--- a/src/lapack/least-squares.lisp
+++ b/src/lapack/least-squares.lisp
@@ -138,14 +138,14 @@
(let* ((rank-A 0)
(mn (max (nrows A) (ncols A)))
(X (let ((*default-stride-ordering* :col-major)) (zeros (list mn (ncols B)) ',cla))))
- (copy! B (sub-tensor~ X `((0 * ,(nrows A)) (* * *)) t))
+ (copy! B (subtensor~ X `((0 * ,(nrows A)) (* * *)) t))
(multiple-value-bind (sto-a sto-b jpvt rank work-out info) (t/lapack-gelsy! ,cla A (or (blas-matrix-compatiblep A #\N) 0) X (or (blas-matrix-compatiblep X #\N) 0) rcond work)
;;TODO: Implement inverse permutation-action, and return jpvt.
(declare (ignore sto-a sto-b work-out jpvt))
(setf rank-a rank)
(unless (= info 0)
(error "gelsy returned ~a." info)))
- (values (copy (sub-tensor~ X `((0 * ,(ncols A)) (* * *)) t)) rank-a)))))
+ (values (copy (subtensor~ X `((0 * ,(ncols A)) (* * *)) t)) rank-a)))))
(gelsy A B rcond))
(t
(error "Don't know how to apply getrs! to classes ~a." (list cla clb))))))
diff --git a/src/level-1/sum.lisp b/src/level-1/sum.lisp
index dc6dada..73f4255 100644
--- a/src/level-1/sum.lisp
+++ b/src/level-1/sum.lisp
@@ -11,7 +11,7 @@
(type index-type ,axis))
(let ((,view (let ((slst (make-list (rank ,x) :initial-element '(* * *))))
(rplaca (nthcdr ,axis slst) (list 0 '* 1))
- (sub-tensor~ ,x slst nil)))
+ (subtensor~ ,x slst nil)))
(,argstd (aref (the index-store-vector (strides ,x)) ,axis)))
(declare (type ,sym ,view)
(type index-type ,argstd))
@@ -61,5 +61,3 @@
(t/sum ,clx x nil))))
(sum! x y axis)))
-
-
diff --git a/src/reader/loadsave.lisp b/src/reader/loadsave.lisp
index 5d51b9c..b35f5cb 100644
--- a/src/reader/loadsave.lisp
+++ b/src/reader/loadsave.lisp
@@ -41,7 +41,15 @@ returning two values: the string and the number of bytes read."
(split-seq #'(lambda (x) (or (char= x #\Newline) (char= x #\Return))) string))
;;
-(defun loadtxt (fname &key (delimiters '(#\Space #\Tab #\,)) (newlines '(#\Newline #\;)))
+;; (defmacro apply* ((&rest funcl) expr)
+;; (let ((syms (zip (mapcar #'gensym funcl) funcl)))
+;; `(multiple-value-bind (,@(mapcar #'car syms)) ,expr
+;; (values ,@(mapcar #'(lambda (x) `(apply ,(second x) ,(first x))) syms)))))
+
+;; (apply* (#'(lambda (x) (+ x 1)) #'(lambda (x) (- x 1))) (values 1 2))
+
+
+(defun loadtxt (fname &key (delimiters '(#\Space #\Tab #\,)) (newlines '(#\Newline #\;)) (skip-rows 0))
(let* ((f-string (file->string fname)))
(multiple-value-bind (lns nrows) (split-seq #'(lambda (x) (member x newlines)) f-string)
(unless (null lns)
diff --git a/src/special/map.lisp b/src/special/map.lisp
index 1edc1d2..c19b182 100644
--- a/src/special/map.lisp
+++ b/src/special/map.lisp
@@ -64,7 +64,7 @@
(let* ((v-x (slice~ x axis))
(st-x (aref (strides x) axis)))
(loop :for i :from 0 :below (aref (the index-store-vector (dimensions x)) axis)
- :collect (prog1 (funcall func (sub-tensor~ v-x nil))
+ :collect (prog1 (funcall func (subtensor~ v-x nil))
(incf (slot-value v-x 'head) st-x))))))
(defmacro tensor-foldl (type func ten init &key (init-type (field-type type)) (key nil))
diff --git a/src/special/random.lisp b/src/special/random.lisp
index 997d039..5f3ff5b 100644
--- a/src/special/random.lisp
+++ b/src/special/random.lisp
@@ -74,3 +74,8 @@
(rand (random 1d0))
(rande (draw-standard-exponential)))))
+(defun randi (&optional dims (arg 2))
+ (if dims
+ ;;Macro is used without hygiene: "arg".
+ (fill-tensor real-tensor ((coerce (random arg) 'double-float) (zeros dims 'real-tensor)))
+ (random arg)))
diff --git a/src/utilities/functions.lisp b/src/utilities/functions.lisp
index 6494995..e26251a 100644
--- a/src/utilities/functions.lisp
+++ b/src/utilities/functions.lisp
@@ -95,7 +95,7 @@
(if (atom car)
(if (or (null car) (eq car tag))
(cadr lst)
- (find-tag (cddr lst) tag))
+ (find-tag (cdr lst) tag))
(or (find-tag car tag) (find-tag (cdr lst) tag)))))
(defun ensure-args (args)
-----------------------------------------------------------------------
Summary of changes:
matlisp.asd | 4 +-
packages.lisp | 7 +-
src/base/generic-copy.lisp | 74 ++++++++----
src/base/permutation.lisp | 2 +-
src/base/standard-tensor.lisp | 29 +++--
src/base/template.lisp | 108 +++++++------------
src/classes/foreign.lisp | 73 ++++++++++++
src/classes/numeric.lisp | 29 +++--
src/ffi/ffi-cffi-implementation-specific.lisp | 21 ++--
src/ffi/ffi-cffi.lisp | 28 +++--
src/ffi/foreign-vector.lisp | 20 ++--
src/lapack/chol.lisp | 4 +-
src/lapack/eig.lisp | 4 +-
src/lapack/geqr.lisp | 2 +-
src/lapack/least-squares.lisp | 6 +-
src/lapack/lu.lisp | 4 +-
src/level-1/axpy.lisp | 27 ++---
src/level-1/copy.lisp | 147 +++++--------------------
src/level-1/dot.lisp | 31 +++---
src/level-1/scal.lisp | 26 ++---
src/level-1/sum.lisp | 4 +-
src/level-1/swap.lisp | 2 +-
src/level-2/gemv.lisp | 2 +-
src/level-3/gemm.lisp | 2 +-
src/reader/infix.lisp | 25 ++++-
src/reader/loadsave.lisp | 10 ++-
src/special/map.lisp ...
[truncated message content] |
