Fix for [ 1173788 ] assigning operators - case sensitivity problem?
- Subject: Fix for [ 1173788 ] assigning operators - case sensitivity problem?
- From: Raymond Toy
- Date: Thu, 07 Apr 2005 13:34:45 -0400
Here is a patch that fixes this bug. I (manually) ran the tests for
matchfix and friends in rtest13.mac. These tests pass.
Is that enough to say the patch is ok? I don't use matchfix and
friends so I don't really know if this is right or not.
Ray
P.S. This patch also fixes the (unreported) issue that the error
messages didn't get the case of the operator correct when the operator
is not defined.
Warning: Remote host denied X11 forwarding.
Index: src/nparse.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/nparse.lisp,v
retrieving revision 1.22
diff -u -r1.22 nparse.lisp
--- src/nparse.lisp 18 Jan 2005 11:10:36 -0000 1.22
+++ src/nparse.lisp 7 Apr 2005 17:13:26 -0000
@@ -71,7 +71,11 @@
(t ;(terpri)
))
(format t "Incorrect syntax: ")
- (apply 'format t sstring l)
+ (apply 'format t sstring (mapcar #'(lambda (x)
+ (if (symbolp x)
+ (print-invert-case x)
+ x))
+ l))
(cond ((output-stream-p *standard-input*)
(let ((n (get '*parse-window* 'length))
some ch
@@ -318,18 +322,22 @@
(defun read-command-token-aux (obj)
(let* (result
(ch (parse-tyipeek))
- (lis (if (eql ch -1) nil (parser-assoc (char-upcase ch) obj))))
+ (lis (if (eql ch -1)
+ nil
+ (parser-assoc #+nil (char-upcase ch)
+ ch
+ obj))))
(cond ((null lis)
nil)
(t
(parse-tyi)
(cond ((atom (cadr lis))
- ;; INFIX("ABC"); puts into macsyma-operators
- ;;something like: (#\A #\B #\C (ANS |$ABC|))
- ;; ordinary things are like:
- ;; (#\< (ANS $<) (#\= (ANS $<=)))
- ;; where if you fail at the #\< #\X
- ;; stage, then the previous step was permitted.
+ ;; INFIX("ABC"); puts into macsyma-operators
+ ;;something like: (#\A #\B #\C (ANS |$ABC|))
+ ;; ordinary things are like:
+ ;; (#\< (ANS $<) (#\= (ANS $<=)))
+ ;; where if you fail at the #\< #\X
+ ;; stage, then the previous step was permitted.
(setq result (read-command-token-aux (list (cdr lis) ))))
((null (cddr lis))
;; lis something like (#\= (ANS $<=))
@@ -337,7 +345,7 @@
;; starting with this.
(setq result
(and (eql (car (cadr lis)) 'ans)
- (cadr (cadr lis)))))
+ (cadr (cadr lis)))))
(t
(let ((res (and (eql (car (cadr lis)) 'ans)
(cadr (cadr lis))))
@@ -345,7 +353,7 @@
(setq result (or com-token res
(read-command-token-aux
(list (cadr lis))))))
- ))
+ ))
(or result (unparse-tyi ch))
result))))
@@ -1723,19 +1731,17 @@
;;; User extensibility:
(defmacro upcase (operator)
- `(setq operator (intern (string-upcase (string ,operator)))))
+ `(setq operator (intern (string-upcase (string ,operator)))))
(defmfun $prefix (operator &optional (rbp 180.)
(rpos '$any)
(pos '$any))
- (upcase operator)
(def-operator operator pos () () rbp rpos () t
'(nud . parse-prefix) 'msize-prefix 'dimension-prefix () ))
(defmfun $postfix (operator &optional (lbp 180.)
(lpos '$any)
(pos '$any))
- (upcase operator)
(def-operator operator pos lbp lpos () () t ()
'(led . parse-postfix) 'msize-postfix 'dimension-postfix () ))
@@ -1744,14 +1750,12 @@
(lpos '$any)
(rpos '$any)
(pos '$any))
- (upcase operator)
(def-operator operator pos lbp lpos rbp rpos t t
'(led . parse-infix) 'msize-infix 'dimension-infix () ))
(defmfun $nary (operator &optional (bp 180.)
(argpos '$any)
(pos '$any))
- (upcase operator)
(def-operator operator pos bp argpos bp () t t
'(led . parse-nary) 'msize-nary 'dimension-nary () ))
@@ -1759,12 +1763,10 @@
match &optional (argpos '$any)
(pos '$any))
;shouldn't MATCH be optional?
- (upcase operator)
(def-operator operator pos () argpos () () () ()
'(nud . parse-matchfix) 'msize-matchfix 'dimension-match match))
(defmfun $nofix (operator &optional (pos '$any))
- (upcase operator)
(def-operator operator pos () () () () () ()
'(nud . parse-nofix) 'msize-nofix 'dimension-nofix () ))