Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-120-g6876d41
|
From: Akshay S. <ak...@us...> - 2012-07-07 07:30:58
|
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 6876d4167f165dbd6b9326251171d94020c99d64 (commit)
via 5b9abacfd46513064abdbc7f8ebe75c23d66b030 (commit)
via 1acff5176bfbef93576185057fe527cc70b9bb5a (commit)
from 9c1d88d3e0101d6764260ba190f852435335a5e2 (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 6876d4167f165dbd6b9326251171d94020c99d64
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Jul 7 12:54:41 2012 +0530
o Comments to reader.lisp
Using $x{..}$ instead of $x[..]$ does a copy instead of the
in-place-displaced slicing (ala MATLAB vs Numpy).
diff --git a/src/reader.lisp b/src/reader.lisp
index 3de78aa..dd39176 100644
--- a/src/reader.lisp
+++ b/src/reader.lisp
@@ -96,8 +96,11 @@
(t
(error 'parser-error)))))
-(defun parse-indexing-expression (stream char)
- (declare (ignore char))
+(defun parse-indexing-expression (stream macro-char)
+ (declare (ignore macro-char))
+ ;;macro-char is assumed to be #\$
+ ;;#\[...#\] uses sub-tensor~ (displaced)
+ ;;#\{...#\} uses sub-tensor (copied)
(labels ((pop-char () (read-char stream t nil t))
(pop-ichar () (read-interesting-char stream t nil t))
(peek () (peek-ahead-no-hang stream t nil t))
commit 5b9abacfd46513064abdbc7f8ebe75c23d66b030
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Jul 7 12:50:06 2012 +0530
o More tweaks to the reader.
This now works (x like previous log):
? $x[::2, 0:2]$
#<REAL-MATRIX #(2 2) :DISPLACED
1.0000 2.0000
7.0000 8.0000
>
?
diff --git a/src/reader.lisp b/src/reader.lisp
index dd45aca..3de78aa 100644
--- a/src/reader.lisp
+++ b/src/reader.lisp
@@ -52,7 +52,7 @@
((null (cddr lst)) ; '(\: \:)
'(quote \:))
((idxp (third lst)) ; '(\: \: num)
- `(list (list '\: ,(third lst)) 0 *))
+ `(list (list '\: ,(third lst)) 0))
(t
(error 'parser-error))))
((idxp (second lst)) ; '(\: num *)
@@ -71,14 +71,14 @@
(first lst))
((and (eq (second lst) #\:) ; '(num \:)
(null (cddr lst)))
- `(list '\: ,(first lst) '*))
+ `(list '\: ,(first lst)))
((and (eq (second lst) #\:) ; '(num \: \: *)
(eq (third lst) #\:))
(cond
((null (cdddr lst)) ; '(num \: \:)
- `(list '\: ,(first lst) '*))
+ `(list '\: ,(first lst)))
((idxp (fourth lst)) ; '(num \: \: num)
- `(list (list '\: ,(fourth lst)) ,(first lst) '*))
+ `(list (list '\: ,(fourth lst)) ,(first lst)))
(t
(error 'parser-error))))
((and (eq (second lst) #\:) ; '(num \: num *)
commit 1acff5176bfbef93576185057fe527cc70b9bb5a
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Jul 7 12:40:42 2012 +0530
o Added a python-like reader macro for array slicing.
This now works (after loading reader.lisp):
? (defvar x (make-real-tensor '((1 2 3) (4 5 6) (7 8 9))))
X
? $x[:, 0:2]$
#<REAL-MATRIX #(3 2) :DISPLACED
1.0000 2.0000
4.0000 5.0000
7.0000 8.0000
?
P.S: Reader macros are annoying to write.
o Added lots of checks to sub-tensor~, and an option to preserve rank.
diff --git a/README b/README
index 8863d66..029550d 100644
--- a/README
+++ b/README
@@ -20,6 +20,7 @@ This is the development branch of Matlisp.
** TODO : What remains ? (Help!)
*** Functionality
* Make everything in src/old/ compatible with new datastrutures.
+ * Add negative stride support, ala Python.
* Tensor contraction: Hard to do very quickly.
Might have to copy stuff into a contiguous array; like Femlisp.
* BLAS level-2 and level-3: most importantly Matrix multiplication.
diff --git a/packages.lisp b/packages.lisp
index 781846a..4ce172e 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -36,6 +36,7 @@
#:invalid-type #:given #:expected
#:invalid-value #:given #:expected
#:unknown-token #:token
+ #:parser-error
#:coercion-error #:from #:to
#:out-of-bounds-error #:requested #:bound
#:non-uniform-bounds-error #:assumed #:found
diff --git a/src/base/standard-tensor.lisp b/src/base/standard-tensor.lisp
index 3b5c8e1..37e7cd8 100644
--- a/src/base/standard-tensor.lisp
+++ b/src/base/standard-tensor.lisp
@@ -482,7 +482,7 @@
"
Symbols which are used to refer to slicing operations.")
-(defun sub-tensor~ (tensor subscripts)
+(defun sub-tensor~ (tensor subscripts &optional (preserve-rank nil))
"
Syntax
======
@@ -508,7 +508,9 @@
;; Get [:, :, 0:10:2] (0:10:2 = [i : 0 <= i < 10, i % 2 = 0])
> (sub-tensor~ X '(\: \: ((\: 2) 0 *)))
"
- (declare (type standard-tensor tensor))
+ (declare (type standard-tensor tensor)
+ (type list subscripts)
+ (type boolean preserve-rank))
(let ((rank (rank tensor))
(dims (dimensions tensor))
(stds (strides tensor))
@@ -522,23 +524,33 @@
:index-rank i :rank rank)
(values nhd (nreverse ndims) (nreverse nstds)))
(let ((csub (car subs)))
- (if (or (consp csub) (symbolp csub))
- (destructuring-bind (op &optional (ori 0) (end '*)) (ensure-list csub)
- (assert (or (typep end 'index-type) (eq end '*)) nil 'invalid-type
- :message "END must either be an integer or '*"
- :given (type-of end) :expected '(or (typep end 'index-type) (eq end '*)))
- (let ((op-val (if (consp op) (first op) op)))
- (assert (member op-val +array-slicing-symbols+) nil 'invalid-value
- :message "Cannot find OP in +array-slicing-symbols+"
- :given op-val :expected `(member op ,+array-slicing-symbols+)))
- (let* ((mul (if (consp op) (second op) 1))
- (dim (floor (- (if (eq end '*) (aref dims i) end) ori) mul)))
- (sub-tread (1+ i) (cdr subs) (+ nhd (* ori (aref stds i))) (cons dim ndims) (cons (* mul (aref stds i)) nstds))))
- (progn
- (assert (typep csub 'index-type) nil 'invalid-type
- :message "OP must be of type index-type"
- :given (type-of csub) :expected 'index-type)
- (sub-tread (1+ i) (cdr subs) (+ nhd (* csub (aref stds i))) ndims nstds)))))))
+ (cond
+ ((or (consp csub)
+ (and (symbolp csub) (member csub +array-slicing-symbols+)))
+ (destructuring-bind ((op &optional (step 1)) &optional (ori 0) (end (aref dims i))) (if (consp csub)
+ (cons (ensure-list (car csub)) (cdr csub))
+ (list (ensure-list csub)))
+ (assert (and (typep ori 'index-type) (< -1 ori (aref dims i))) nil 'tensor-index-out-of-bounds
+ :argument i :index ori :dimension (aref dims i))
+ (assert (and (typep ori 'index-type) (< ori end (1+ (aref dims i)))) nil 'invalid-value
+ :given end :expected `(> ,ori end ,(1+ (aref dims i))) :message "END is outside allowed bounds.")
+ (assert (and (typep step 'index-type) (< 0 step)) nil 'invalid-value
+ :given step :expected '(< 0 step) :message "STEP cannot be <= 0.")
+ (assert (member op +array-slicing-symbols+) nil 'invalid-value
+ :message "Cannot find OP in +array-slicing-symbols+"
+ :given op :expected `(member op ,+array-slicing-symbols+))
+ (let ((dim (ceiling (- end ori) step)))
+ (sub-tread (1+ i) (cdr subs) (+ nhd (* ori (aref stds i)))
+ (if (and (= dim 1) (not preserve-rank)) ndims (cons dim ndims))
+ (if (and (= dim 1) (not preserve-rank)) nstds (cons (* step (aref stds i)) nstds))))))
+ ((typep csub 'index-type)
+ (assert (< -1 csub (aref dims i)) nil 'tensor-index-out-of-bounds
+ :argument i :index csub :dimension (aref dims i))
+ (sub-tread (1+ i) (cdr subs) (+ nhd (* csub (aref stds i)))
+ (if (not preserve-rank) ndims (cons 1 ndims))
+ (if (not preserve-rank) nstds (cons (aref stds i) nstds))))
+ (t
+ (error 'parser-error :message "Error parsing subscript-list.")))))))
(multiple-value-bind (nhd ndim nstd) (sub-tread 0 subscripts hd nil nil)
(let ((nrnk (length ndim)))
(declare (type index-type nrnk))
diff --git a/src/conditions.lisp b/src/conditions.lisp
index 0a91466..a4e17a3 100644
--- a/src/conditions.lisp
+++ b/src/conditions.lisp
@@ -47,6 +47,10 @@
(format stream "Given unknown token: ~A.~%" (token c))
(call-next-method)))
+(defcondition parser-error (generic-error)
+ ()
+ (:documentation "Macro reader encountered an error while parsing the stream."))
+
(defcondition coercion-error (generic-error)
((from :reader from :initarg :from)
(to :reader to :initarg :to))
diff --git a/src/level-1/tensor-maker.lisp b/src/level-1/tensor-maker.lisp
index 029ba28..df44ae0 100644
--- a/src/level-1/tensor-maker.lisp
+++ b/src/level-1/tensor-maker.lisp
@@ -46,3 +46,7 @@
(make-tensor-maker make-real-tensor (real-tensor))
(make-tensor-maker make-complex-tensor (complex-tensor))
+
+;;Had to move it here in the wait for copy!
+(definline sub-tensor (tensor subscripts)
+ (copy (sub-tensor~ tensor subscripts)))
diff --git a/src/level-2/gemv.lisp b/src/level-2/gemv.lisp
index d793da8..8651f95 100644
--- a/src/level-2/gemv.lisp
+++ b/src/level-2/gemv.lisp
@@ -31,8 +31,8 @@
`(defun ,func (alpha A x beta y job)
(declare (type (getf opt :element-type) alpha beta)
(type ,tensor-class A x y)
- (type boolean job))
-
+ (type boolean job))
+ (tensor-t
;;There's no support for ":c", because there is no
diff --git a/src/old/reader.lisp b/src/old/reader.lisp
index 7893105..6a92ee1 100644
--- a/src/old/reader.lisp
+++ b/src/old/reader.lisp
@@ -280,11 +280,13 @@
(return val))))))
+(with-input-from-string (ostr "[1 2; 3 4]")
+ (parse-matrix-expression ostr #\[))
-(set-macro-character #\] (get-macro-character #\)))
-(set-macro-character #\[ #'parse-matrix-expression)
+;;(set-macro-character #\] (get-macro-character #\)))
+;;(set-macro-character #\[ #'parse-matrix-expression)
#|
(read-from-string "[ [1 2 ; 3 4] [5 ; 6] ; [7 8 9] ] 1000")
(read-from-string " 1 2 [2]
diff --git a/src/reader.lisp b/src/reader.lisp
new file mode 100644
index 0000000..dd45aca
--- /dev/null
+++ b/src/reader.lisp
@@ -0,0 +1,170 @@
+(in-package #:matlisp)
+
+;;TODO move things from old/reader.lisp; must adapt things to reading tensors.
+
+(define-constant +parser-ignored-characters+ '(#\^m #\space #\tab #\return #\newline))
+(define-constant +newline-characters+ '(#\newline #\^m #\linefeed #\return))
+
+(defun peek-ahead-no-hang (&optional (stream *standard-input*) (eof-error t) eof-value recursive-p)
+ (symbol-macrolet ((pop-char (read-char-no-hang stream eof-error eof-value recursive-p)))
+ (loop
+ for char = pop-char then pop-char
+ and c-prev = nil then char
+ until (cond
+ ((member char +parser-ignored-characters+) nil)
+ (t t))
+ finally (progn
+ (if char
+ (unread-char char stream)
+ (when (member c-prev +newline-characters+)
+ (unread-char c-prev stream)))
+ (return char)))))
+
+(defun peek-char-no-hang (&optional (stream *standard-input*) (eof-error t) eof-value recursive-p)
+ (let ((char (read-char-no-hang stream eof-error eof-value recursive-p)))
+ (when char
+ (unread-char char stream))
+ char))
+
+(defun read-interesting-char (&optional (stream *standard-input*) (eof-error t) eof-value recursive-p)
+ (symbol-macrolet ((pop-char (read-char-no-hang stream eof-error eof-value recursive-p)))
+ (loop
+ for char = pop-char then pop-char
+ and c-prev = nil then char
+ until (cond
+ ((member char +parser-ignored-characters+) nil)
+ (t t))
+ finally (return char))))
+;;---------------------------------------------------------------;;
+(defun get-slicing-subscript (lst)
+ (flet ((idxp (x)
+ (or (consp x)
+ (and (symbolp x)
+ (not (member x '(t nil))))
+ (numberp x))))
+ (cond
+ ((eq (first lst) #\:) ; '(\: * *)
+ (cond
+ ((null (cdr lst)) ; '(\:)
+ '(quote \:))
+ ((eq (second lst) #\:) ; '(\: \: *)
+ (cond
+ ((null (cddr lst)) ; '(\: \:)
+ '(quote \:))
+ ((idxp (third lst)) ; '(\: \: num)
+ `(list (list '\: ,(third lst)) 0 *))
+ (t
+ (error 'parser-error))))
+ ((idxp (second lst)) ; '(\: num *)
+ (cond
+ ((or (null (cddr lst))
+ (null (cdddr lst))) ; '(\: num) or '(\: num \:)
+ `(list '\: 0 ,(second lst)))
+ ((and (eq (third lst) #\:) ; '(\: num \: num)
+ (idxp (fourth lst)))
+ `(list (list '\: ,(third lst)) 0 ,(second lst)))
+ (t
+ (error 'parser-error))))))
+ ((idxp (first lst)) ; '(num *)
+ (cond
+ ((null (cdr lst)) ; '(num)
+ (first lst))
+ ((and (eq (second lst) #\:) ; '(num \:)
+ (null (cddr lst)))
+ `(list '\: ,(first lst) '*))
+ ((and (eq (second lst) #\:) ; '(num \: \: *)
+ (eq (third lst) #\:))
+ (cond
+ ((null (cdddr lst)) ; '(num \: \:)
+ `(list '\: ,(first lst) '*))
+ ((idxp (fourth lst)) ; '(num \: \: num)
+ `(list (list '\: ,(fourth lst)) ,(first lst) '*))
+ (t
+ (error 'parser-error))))
+ ((and (eq (second lst) #\:) ; '(num \: num *)
+ (idxp (third lst)))
+ (cond
+ ((or (null (cdddr lst)) ; '(num \: num) or '(num \: num \:)
+ (and (eq (fourth lst) #\:)
+ (null (cddddr lst))))
+ `(list '\: ,(first lst) ,(third lst)))
+ ((and (eq (fourth lst) #\:) ; '(num \: num \: num)
+ (idxp (fifth lst)))
+ `(list (list '\: ,(fifth lst)) ,(first lst) ,(third lst)))
+ (t
+ (error 'parser-error))))))
+ (t
+ (error 'parser-error)))))
+
+(defun parse-indexing-expression (stream char)
+ (declare (ignore char))
+ (labels ((pop-char () (read-char stream t nil t))
+ (pop-ichar () (read-interesting-char stream t nil t))
+ (peek () (peek-ahead-no-hang stream t nil t))
+ (idxp (x) (or (consp x)
+ (and (symbolp x)
+ (not (member x '(t nil))))
+ (numberp x)))
+ (get-idx-expr (limlst)
+ (loop
+ for char = (pop-char) then (pop-char)
+ counting t into n
+ if (not (member char limlst))
+ collect char into ret
+ else
+ do (progn
+ (unread-char char stream)
+ (return (read-from-string (make-array (1- n) :element-type 'character :initial-contents ret) nil nil)))
+ end)))
+ (let* ((tensor (get-idx-expr `(#\[ #\{ #\$)))
+ (idx-char (pop-ichar))
+ (sub-func (ecase idx-char
+ (#\[ 'sub-tensor~)
+ (#\{ 'sub-tensor)
+ (#\$ nil)))
+ (cidx-char (case idx-char
+ (#\[ #\])
+ (#\{ #\}))))
+ #+nil(format t "~a ~a ~a~%" tensor idx-char sub-func)
+ (labels ((get-index-list (cur-idx ret)
+ ;;#\, is the delimiting character
+ ;;#\: is the slicing character
+ (let ((pchar (peek)))
+ #+nil(format t "pchar: ~a ~%" pchar)
+ (cond
+ ((or (eq pchar cidx-char)
+ (eq pchar #\,))
+ (pop-char)
+ (let ((idx-lst (reverse cur-idx)))
+ (when (null idx-lst)
+ (error 'parser-error :message "No slicing argument given."))
+ (loop
+ for cur in idx-lst
+ and pcur = nil then cur
+ counting (eq cur #\:) into cnt
+ unless (<= cnt 2)
+ do (error 'parser-error :message "Too many slicing characters.")
+ when (and (idxp pcur) (idxp cur))
+ do (error 'parser-error :message "Invalid syntax specify slicing operation."))
+ (push (get-slicing-subscript idx-lst) ret))
+ (if (eq pchar #\,)
+ (get-index-list nil ret)
+ (progn
+ (unless (eq (pop-ichar) #\$)
+ (error 'parser-error :message "Invalid syntax: cannot find closing #\$."))
+ ;;And finally!
+ (cons 'list (reverse ret)))))
+ ((eq pchar #\:)
+ (pop-char)
+ (get-index-list (cons #\: cur-idx) ret))
+ (t
+ (let ((idxe (get-idx-expr (append +parser-ignored-characters+ `(#\: #\, ,cidx-char #\$)))))
+ (get-index-list (cons idxe cur-idx) ret)))))))
+ (if (null sub-func)
+ tensor
+ `(,sub-func ,tensor ,(get-index-list nil nil)))))))
+
+(set-macro-character #\$ #'parse-indexing-expression)
+
+#+nil(with-input-from-string (ostr "x[0:5, 0, 0]$ ")
+ (parse-indexing-expression ostr #\$))
-----------------------------------------------------------------------
Summary of changes:
README | 1 +
packages.lisp | 1 +
src/base/standard-tensor.lisp | 50 +++++++-----
src/conditions.lisp | 4 +
src/level-1/tensor-maker.lisp | 4 +
src/level-2/gemv.lisp | 4 +-
src/old/reader.lisp | 6 +-
src/reader.lisp | 173 +++++++++++++++++++++++++++++++++++++++++
8 files changed, 220 insertions(+), 23 deletions(-)
create mode 100644 src/reader.lisp
hooks/post-receive
--
matlisp
|
