Case-sensitivity goals, policy and implementation
- Subject: Case-sensitivity goals, policy and implementation
- From: Raymond Toy
- Date: Tue, 26 Oct 2004 13:57:34 -0400
>>>>> "Raymond" == Raymond Toy <raymond.toy@ericsson.com> writes:
>>>>> "James" == James Amundson <amundson@users.sourceforge.net> writes:
James> Yes, that would be great. I won't declare victory until I see the
James> implementation, though. I spent a little bit of time last night trying
James> to figure out where to stick the readtable-changing statements in the
James> maxima source, but I quickly became confused. If you feel like giving it
James> a shot, please do.
Raymond> I'm attaching a patch that implements this. This is just a proof of
This patch was pretty majorly broken---it broke the parser so that
f(x):=x was incorrectly parsed.
Here is another patch that works better. It also has the nice side
effect that if you downcase all the test files, it successfully runs
all the tests throught rtest11.mac (with 1 simple error in
rtest11.mac). make check then exists for some reason that I haven't
looked into.
Ray
Index: src/commac.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/commac.lisp,v
retrieving revision 1.17
diff -u -r1.17 commac.lisp
--- src/commac.lisp 19 Oct 2004 12:04:36 -0000 1.17
+++ src/commac.lisp 26 Oct 2004 17:45:35 -0000
@@ -468,7 +468,8 @@
(let* (#+(and gcl (not gmp)) (big-chunk-size 120)
#+(and gcl (not gmp)) (tentochunksize (expt 10 big-chunk-size))
string)
- (cond ((symbolp symb)(setq string (symbol-name symb)))
+ (cond ((symbolp symb)
+ (setq string (princ-to-string symb)))
((floatp symb)
(let ((a (abs symb)))
(cond ((or (eql a 0.0)
@@ -512,6 +513,7 @@
(defun implode (lis) (implode1 lis nil))
+
(defun implode1 (lis upcase &aux (ar *string-for-implode*) (leng 0))
(declare (type string ar) (fixnum leng))
(or (> (array-total-size ar) (setq leng (length lis)))
@@ -523,34 +525,11 @@
(cond ((typep v 'character))
((symbolp v) (setq v (aref (symbol-name v) 0)))
((numberp v) (setq v (code-char v))))
- (setf (aref ar i) (if upcase (char-upcase v) v)))
- (intern ar))
+ (setf (aref ar i) v))
+ (intern (symbol-name (read-from-string ar)) :maxima))
(defun bothcase-implode (lis &aux tem )
- (cond ((not (eql (car lis) #\$))
- (return-from bothcase-implode (implode1 lis nil))))
- (multiple-value-bind
- (sym there)
- (implode1 lis nil)
- (cond (there (if (setq tem (get sym 'upcase)) tem sym))
- (t
- ;; if all upper case lets not bother interning...
- (sloop for v in lis with haslower
- when (not (eql (char-upcase v) v))
- do (setq haslower t) (loop-finish)
- finally (or haslower (return-from bothcase-implode sym)))
- (multiple-value-bind
- (symup there)
- (implode1 lis t)
- (cond ((and there (or
- ;; not single symbols
- (cddr lis)
- (fboundp symup) (symbol-plist symup)))
-
- (setf (get sym 'upcase) symup)
- symup)
- (t (or there (unintern symup))
- sym)))))))
+ (implode1 lis nil))
(defun explode (symb &aux tem)
Index: src/init-cl.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/init-cl.lisp,v
retrieving revision 1.40
diff -u -r1.40 init-cl.lisp
--- src/init-cl.lisp 19 Oct 2004 12:04:37 -0000 1.40
+++ src/init-cl.lisp 26 Oct 2004 17:45:35 -0000
@@ -405,6 +405,7 @@
(setf *debugger-hook* #'maxima-lisp-debugger)
(let ((input-stream *standard-input*)
(batch-flag nil))
+ (setf (readtable-case *readtable*) :invert)
#+allegro
(progn
(set-readtable-for-macsyma)
@@ -425,7 +426,8 @@
(defun $to_lisp ()
(format t "~&Type (to-maxima) to restart~%")
- (let ((old-debugger-hook *debugger-hook*))
+ (let ((old-debugger-hook *debugger-hook*)
+ (*readtable* (copy-readtable nil)))
(catch 'to-maxima
(unwind-protect
(maxima-read-eval-print-loop)
Index: src/nparse.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/nparse.lisp,v
retrieving revision 1.18
diff -u -r1.18 nparse.lisp
--- src/nparse.lisp 19 Oct 2004 12:04:59 -0000 1.18
+++ src/nparse.lisp 26 Oct 2004 17:45:39 -0000
@@ -370,27 +370,8 @@
(implode charlist))
(mread-synerr "Lisp keyword expected."))))
-;; The vertical bar | switches between preserving or folding case,
-;; except that || is a literal |.
-
-;; Note that this function modifies LIST destructively.
(defun lisp-token-fixup-case (list)
- (let* ((list (cons nil list))
- (todo list)
- preserve)
- (loop
- (unless (cdr todo)
- (return (cdr list)))
- (cond
- ((char/= (cadr todo) #\|)
- (pop todo)
- (unless preserve
- (setf (car todo)
- (char-upcase (car todo)))))
- ((setf (cdr todo) (cddr todo))
- (if (char= (cadr todo) #\|)
- (pop todo)
- (setq preserve (not preserve))))))))
+ list)
(defvar $bothcases t)
(defun scan-token (flag)
Index: src/suprv1.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/suprv1.lisp,v
retrieving revision 1.18
diff -u -r1.18 suprv1.lisp
--- src/suprv1.lisp 19 Oct 2004 12:05:00 -0000 1.18
+++ src/suprv1.lisp 26 Oct 2004 17:45:39 -0000
@@ -159,19 +159,20 @@
(defmvar $% '$% "The last out-line computed, corresponds to lisp *"
no-reset)
-(defmvar $inchar '|$%i|
+(defmvar $inchar '$%I
"The alphabetic prefix of the names of expressions typed by the user.")
;;; jfa: begin case-sensitivity hack
;;; delete this when case-sensitivity is fixed!!!! 05/11/2004
+#+nil
(defmvar |$%i| '|$%I|
"%i = %I until maxima's case behavior is fixed.")
;;; jfa: end case-sensitivity hack
-(defmvar $outchar '|$%o|
+(defmvar $outchar '$%O
"The alphabetic prefix of the names of expressions returned by the system.")
-(defmvar $linechar '|$%t|
+(defmvar $linechar '$%T
"The alphabetic prefix of the names of intermediate displayed expressions.")
(defmvar $linenum 1 "the line number of the last expression."