Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-169-g4f3bb15
|
From: Akshay S. <ak...@us...> - 2012-08-09 10:16:56
|
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 4f3bb155a516c02c49dd085b37283ca431f4d24b (commit)
via b68ae3c41607d5c2efb16bb20e0b5398183bc0a1 (commit)
via 5a902f797e8dfef15f1d8d048c5f9ad156f1c192 (commit)
from 529111481665902bb1459b434d8d6607c2467ca4 (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 4f3bb155a516c02c49dd085b37283ca431f4d24b
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Aug 9 15:42:13 2012 +0530
Changed exponentiation operator from ^^ to **
diff --git a/src/reader/infix.lisp b/src/reader/infix.lisp
index 7bf947e..dd48ac0 100644
--- a/src/reader/infix.lisp
+++ b/src/reader/infix.lisp
@@ -289,7 +289,7 @@
(defmacro infix-error (format-string &rest args)
`(let ((*readtable* *normal-readtable*))
- (error 'parser-error (format-to-string ,format-string ,@args))))
+ (error 'parser-error :message (format-to-string ,format-string ,@args))))
(defun infix-reader (stream subchar arg)
;; Read either #I(...) or #I"..."
@@ -427,7 +427,7 @@
(let ((operator (get-token-prefix-operator token)))
(if operator
(funcall operator stream)
- (infix-error "~A is not a prefix operator" token))))
+ (infix-error "\"~A\" is not a prefix operator" token))))
(defun get-next-token (stream left)
(let ((token (read-token stream)))
@@ -437,14 +437,15 @@
(let ((operator (get-token-infix-operator token)))
(if operator
(funcall operator stream left)
- (infix-error "~A is not an infix operator" token))))
+ (infix-error "\"~A\" is not an infix operator" token))))
;;; Fix to read-delimited-list so that it works with tokens, not
;;; characters.
(defun infix-read-delimited-list (end-token delimiter-token stream)
(do ((next-token (peek-token stream) (peek-token stream))
- (list nil))
+ (list nil)
+ (count 0 (1+ count)))
((same-token-p next-token end-token)
;; We've hit the end. Remove the end-token from the stream.
(read-token stream)
@@ -452,7 +453,7 @@
;; Note that this does the right thing with [] and ().
(nreverse list))
;; Ignore the delimiters.
- (when (same-token-p next-token delimiter-token)
+ (when (and (same-token-p next-token delimiter-token) (> count 0))
(read-token stream))
;; Gather the expression until the next delimiter.
(push (gather-superiors delimiter-token stream) list)))
@@ -464,7 +465,7 @@
(defparameter *operator-ordering*
'(( \[ \( \! ) ; \[ is array reference
- ( ^^ ) ; exponentiation
+ ( ** ) ; exponentiation
( ~ ) ; lognot
( * / % ) ; % is mod
( + - )
@@ -492,7 +493,7 @@
((find op2 ops :test #'same-token-p)
(return t)))))
-(defparameter *right-associative-operators* '(^^ =))
+(defparameter *right-associative-operators* '(** =))
(defun operator-right-associative-p (operator)
(find operator *right-associative-operators*))
@@ -582,6 +583,7 @@
(define-token-operator else
:prefix (infix-error "ELSE clause without an IF."))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\+
#'(lambda (stream char)
(declare (ignore char))
@@ -596,6 +598,7 @@
(define-token-operator +=
:infix `(incf ,left ,(gather-superiors '+= stream)))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\-
#'(lambda (stream char)
(declare (ignore char))
@@ -610,16 +613,24 @@
(define-token-operator -=
:infix `(decf ,left ,(gather-superiors '-= stream)))
+;;*--------------------------------------------------------------;;
(define-character-tokenization #\*
#'(lambda (stream char)
- (declare (ignore char))
- (cond ((char= (peek-char nil stream t nil t) #\=)
- (read-char stream t nil t)
- '*=)
- (t
- '*))))
+ (declare (ignore char))
+ (let ((pchar (peek-char nil stream t nil t)))
+ (case pchar
+ (#\=
+ (read-char stream t nil t)
+ '*=)
+ (#\*
+ (read-char stream t nil t)
+ '**)
+ (t
+ '*)))))
+
(define-token-operator *
:infix `(* ,left ,(gather-superiors '* stream)))
+
(define-token-operator *=
:infix `(,(if (symbolp left)
'setq
@@ -627,6 +638,10 @@
,left
(* ,left ,(gather-superiors '*= stream))))
+(define-token-operator **
+ :infix `(expt ,left ,(gather-superiors '** stream)))
+
+;;---------------------------------------------------------------;;
(define-character-tokenization #\/
#'(lambda (stream char)
(declare (ignore char))
@@ -635,9 +650,11 @@
'/=)
(t
'/))))
+
(define-token-operator /
:infix `(/ ,left ,(gather-superiors '/ stream))
:prefix `(/ ,(gather-superiors '/ stream)))
+
(define-token-operator /=
:infix `(,(if (symbolp left)
'setq
@@ -645,19 +662,16 @@
,left
(/ ,left ,(gather-superiors '/= stream))))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\^
#'(lambda (stream char)
- (declare (ignore char))
- (cond ((char= (peek-char nil stream t nil t) #\^)
- (read-char stream t nil t)
- '^^)
- (t
- '^))))
-(define-token-operator ^^
- :infix `(expt ,left ,(gather-superiors '^^ stream)))
+ (declare (ignore stream char))
+ '^))
+
(define-token-operator ^
:infix `(logxor ,left ,(gather-superiors '^ stream)))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\|
#'(lambda (stream char)
(declare (ignore char))
@@ -669,6 +683,7 @@
(define-token-operator \|
:infix `(logior ,left ,(gather-superiors '\| stream)))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\&
#'(lambda (stream char)
(declare (ignore char))
@@ -680,27 +695,35 @@
(define-token-operator \&
:infix `(logand ,left ,(gather-superiors '\& stream)))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\%
#'(lambda (stream char)
(declare (ignore stream char))
'\%))
+
(define-token-operator \%
:infix `(mod ,left ,(gather-superiors '\% stream)))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\~
#'(lambda (stream char)
(declare (ignore stream char))
'\~))
+
(define-token-operator \~
:prefix `(lognot ,(gather-superiors '\~ stream)))
+;;---------------------------------------------------------------;;
(define-character-tokenization #\,
#'(lambda (stream char)
(declare (ignore stream char))
'\,))
+
(define-token-operator \,
:infix `(progn ,left ,(gather-superiors '\, stream)))
+;;---------------------------------------------------------------;;
+
(define-character-tokenization #\=
#'(lambda (stream char)
(declare (ignore char))
@@ -816,6 +839,7 @@
#'(lambda (stream char)
(declare (ignore stream char))
'\)))
+
(define-token-operator \)
:infix (infix-error "Extra close paren \")\" in infix expression"))
@@ -931,14 +955,14 @@
("a*b*c" (* a b c))
("a*b+c" (+ (* a b) c))
("a/b" (/ a b))
- ("a^^b" (expt a b))
+ ("a**b" (expt a b))
("foo/-bar" (/ foo (- bar)))
- ("1+2*3^^4" (+ 1 (* 2 (expt 3 4))))
- ("1+2*3^^4+5" (+ 1 (* 2 (expt 3 4)) 5))
- ("2*3^^4+1" (+ (* 2 (expt 3 4)) 1))
- ("2+3^^4*5" (+ 2 (* (expt 3 4) 5)))
- ("2^^3^^4" (expt 2 (expt 3 4)))
- ("x^^2 + y^^2" (+ (expt x 2) (expt y 2)))
+ ("1+2*3**4" (+ 1 (* 2 (expt 3 4))))
+ ("1+2*3**4+5" (+ 1 (* 2 (expt 3 4)) 5))
+ ("2*3**4+1" (+ (* 2 (expt 3 4)) 1))
+ ("2+3**4*5" (+ 2 (* (expt 3 4) 5)))
+ ("2**3**4" (expt 2 (expt 3 4)))
+ ("x**2 + y**2" (+ (expt x 2) (expt y 2)))
("(1+2)/3" (/ (+ 1 2) 3))
("(a=b)" (setq a b))
("(a=b,b=c)" (progn (setq a b) (setq b c)))
@@ -1014,8 +1038,8 @@
("a/b*c" (* (/ a b) c))
("a/b/c" (/ a b c))
("/a/b" (/ (* a b)))
- ("a^^b^^c" (expt a (expt b c)))
- ("a(d)^^b^^c" (expt (a d) (expt b c)))
+ ("a**b**c" (expt a (expt b c)))
+ ("a(d)**b**c" (expt (a d) (expt b c)))
("a<b+c<d" (< a (+ b c) d))
("1*~2+3" (+ (* 1 (lognot 2)) 3))
("1+~2*3" (+ 1 (* (lognot 2) 3)))
@@ -1035,10 +1059,10 @@
("a%b" (mod a b))
;; Comment character -- must have carriage return after semicolon.
- ("x^^2 ; the x coordinate
- + y^^2 ; the y coordinate" :error)
- ("x^^2 ; the x coordinate
- + y^^2 ; the y coordinate
+ ("x**2 ; the x coordinate
+ + y**2 ; the y coordinate" :error)
+ ("x**2 ; the x coordinate
+ + y**2 ; the y coordinate
" (+ (expt x 2) (expt y 2)))
;; Errors
commit b68ae3c41607d5c2efb16bb20e0b5398183bc0a1
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Aug 9 15:39:54 2012 +0530
Tweaked error messages
diff --git a/src/conditions.lisp b/src/conditions.lisp
index 52f4673..5fdbfed 100644
--- a/src/conditions.lisp
+++ b/src/conditions.lisp
@@ -31,14 +31,14 @@
(defcondition dimension-mismatch (generic-error)
()
- (:method print-object ((c generic-error) stream)
- (format stream "Dimension mismatch.")
+ (:method print-object ((c dimension-mismatch) stream)
+ (format stream "Dimension mismatch.~%")
(call-next-method)))
(defcondition assumption-violated (generic-error)
()
(:method print-object ((c assumption-violated) stream)
- (format stream "An assumption assumed when writing the software has been violated. Proceed with caution.")
+ (format stream "An assumption assumed when writing the software has been violated. Proceed with caution.~%")
(call-next-method)))
(defcondition invalid-type (generic-error)
@@ -55,7 +55,7 @@
(:documentation "Given invalid arguments to the function.")
(:method print-object ((c invalid-arguments) stream)
(when (slot-boundp c 'argument-number)
- (format stream "The argument ~a, given to the function is invalid (or has not been given)." (argnum c)))
+ (format stream "The argument ~a, given to the function is invalid (or has not been given).~%" (argnum c)))
(call-next-method)))
(defcondition invalid-value (generic-error)
@@ -77,7 +77,10 @@
(defcondition parser-error (generic-error)
()
- (:documentation "Macro reader encountered an error while parsing the stream."))
+ (:documentation "Macro reader encountered an error while parsing the stream.")
+ (:method print-object ((c parser-error) stream)
+ (format stream "Macro reader encountered an error while parsing the stream.~%")
+ (call-next-method)))
(defcondition coercion-error (generic-error)
((from :reader from :initarg :from)
@@ -115,14 +118,14 @@
(:documentation "Object is not a permutation.")
(:report (lambda (c stream)
(declare (ignore c))
- (format stream "Object is not a permutation."))))
+ (format stream "Object is not a permutation.~%"))))
(define-condition permutation-permute-error (permutation-error)
((sequence-length :reader seq-len :initarg :seq-len)
(group-rank :reader group-rank :initarg :group-rank))
(:documentation "Cannot permute sequence.")
(:report (lambda (c stream)
- (format stream "Cannot permute sequence.")
+ (format stream "Cannot permute sequence.~%")
(when (slots-boundp c 'sequence-length 'group-rank)
(format stream "~%sequence-length : ~a group-rank: ~a" (seq-len c) (group-rank c))))))
commit 5a902f797e8dfef15f1d8d048c5f9ad156f1c192
Author: Akshay Srinivasan <aks...@gm...>
Date: Thu Aug 9 14:29:31 2012 +0530
Moved infix into a new package
diff --git a/AUTHORS b/AUTHORS
index 2617a30..5f68edf 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -6,3 +6,6 @@ It is now being refactored by Akshay Srinivasan.
Some of code was originally written by Nicholas Neuss for
Femlisp (www.femlisp.org); it has been used here
(with modification or otherwise) with the author's consent.
+
+The infix reader is modified and included here with the
+permission of its original author Mark Kantrowitz.
diff --git a/matlisp.asd b/matlisp.asd
index db5f43a..61cf5b1 100644
--- a/matlisp.asd
+++ b/matlisp.asd
@@ -160,10 +160,9 @@
:depends-on ("matlisp-base" "matlisp-classes" "matlisp-level-1" "matlisp-level-2" "matlisp-level-3")
:components ((:file "mplusminus")
(:file "mtimesdivide")))
- #+nil
(:module "matlisp-reader"
:pathname "reader"
- :components ((:file "slicing")))))
+ :components ((:file "infix")))))
;; (defclass f2cl-cl-source-file (asdf:cl-source-file)
diff --git a/packages.lisp b/packages.lisp
index 8d71112..276480c 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -64,7 +64,6 @@
#:tensor-store-not-consecutive
))
-;;foreign-vector stuff must go to ffi-...
(defpackage "MATLISP-UTILITIES"
(:use #:common-lisp #:matlisp-conditions)
(:export #:ensure-list
@@ -86,6 +85,11 @@
#:inlining #:definline
#:with-optimization #:quickly #:very-quickly #:slowly #:quickly-if))
+;;Modified version of Mark Kantrowitz' infix package.
+(defpackage "MATLISP-INFIX"
+ (:use #:common-lisp #:matlisp-conditions #:matlisp-utilities)
+ (:export #:test-infix #:string->prefix))
+
(defpackage "MATLISP-FFI"
(:use #:common-lisp #:cffi #:matlisp-utilities #:matlisp-conditions)
;; TODO: Check if this is implementation-agnostic.
diff --git a/src/reader/infix.lisp b/src/reader/infix.lisp
index c545434..7bf947e 100644
--- a/src/reader/infix.lisp
+++ b/src/reader/infix.lisp
@@ -250,13 +250,8 @@
;;; Package Cruft ******************
;;; ********************************
-(defpackage #:infix (:use #-:lucid #:common-lisp
- #+:lucid "LISP" #+:lucid "LUCID-COMMON-LISP")
- (:export #:test-infix #:string->prefix))
-
-(in-package #:infix)
-
-(pushnew :infix *features*)
+(in-package #:matlisp-infix)
+(pushnew :matlisp-infix *features*)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *version* "1.3 28-JUN-96")
@@ -294,7 +289,7 @@
(defmacro infix-error (format-string &rest args)
`(let ((*readtable* *normal-readtable*))
- (error ,format-string ,@args)))
+ (error 'parser-error (format-to-string ,format-string ,@args))))
(defun infix-reader (stream subchar arg)
;; Read either #I(...) or #I"..."
diff --git a/src/reader/slicing.lisp b/src/reader/slicing.lisp
index 692081e..63a2efb 100644
--- a/src/reader/slicing.lisp
+++ b/src/reader/slicing.lisp
@@ -59,138 +59,7 @@
(not (member x '(t nil))))
(numberp x)))
-(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 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))
- (idxp (x) (or (consp x)
- (and (symbolp x)
- (not (member x '(t nil))))
- (numberp x)))
- (get-idx-expr (limlst)
- (format t "~a~%" 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)
- (format t "~a ~%" ret)
- (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
- (#\[ 'matlisp:sub-tensor~)
- (#\{ 'matlisp: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)
diff --git a/src/utilities/macros.lisp b/src/utilities/macros.lisp
index 6871843..de09899 100644
--- a/src/utilities/macros.lisp
+++ b/src/utilities/macros.lisp
@@ -1,5 +1,8 @@
(in-package #:matlisp-utilities)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+;;Note to self: do not indent!
+
(defmacro define-constant (name value &optional doc)
"
Keeps the lisp implementation from defining constants twice.
@@ -464,4 +467,4 @@
`(with-optimization (:speed 1)
,@forms))
-
+)
diff --git a/src/utilities/string.lisp b/src/utilities/string.lisp
index 388bf1e..c15fd01 100644
--- a/src/utilities/string.lisp
+++ b/src/utilities/string.lisp
@@ -5,7 +5,4 @@
(apply #'concatenate (cons 'string strings)))
(defun format-to-string (fmt &rest args)
- (let ((ret (make-array 0 :element-type 'character :adjustable t :fill-pointer t)))
- (with-output-to-string (ostr ret)
- (apply #'format (append `(,ostr ,fmt) args)))
- ret))
+ (apply #'format (append (list nil fmt) args)))
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 3 +
matlisp.asd | 3 +-
packages.lisp | 6 ++-
src/conditions.lisp | 17 ++++---
src/reader/infix.lisp | 101 ++++++++++++++++++++--------------
src/reader/slicing.lisp | 131 ---------------------------------------------
src/utilities/macros.lisp | 5 ++-
src/utilities/string.lisp | 5 +--
8 files changed, 84 insertions(+), 187 deletions(-)
hooks/post-receive
--
matlisp
|
