[Maxima-commits] CVS: maxima/src askp.lisp, 1.7, 1.8 cl-info.lisp, 1.32, 1.33 commac.lisp, 1.32, 1.

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Update of /cvsroot/maxima/maxima/src
In directory sc8-pr-cvs7.sourceforge.net:/tmp/cvs-serv6247/src

Modified Files:
	askp.lisp cl-info.lisp commac.lisp compar.lisp desoln.lisp 
	elim.lisp hyp.lisp irinte.lisp mactex.lisp matcom.lisp 
	merror.lisp mformt.lisp mrgmac.lisp mtrace.lisp nisimp.lisp 
	nparse.lisp ode2.lisp outmis.lisp rat3c.lisp series.lisp 
	suprv1.lisp sys-proclaim.lisp transl.lisp transs.lisp 
Log Message:
Commit patches submitted by Douglas Crosher to support Scieneer and Allegro.
With these changes, make and run_testsuite succeed for SBCL, Clisp, and GCL on Linux.

Index: askp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/askp.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8

--- askp.lisp	7 Nov 2005 17:37:11 -0000	1.7
+++ askp.lisp	27 Jul 2006 05:37:45 -0000	1.8
@@ -95,8 +95,8 @@
 ;;; Asks the user a question about the property of an object.
 ;;; Returns only $yes, $no or $unknown.
   (do ((end-flag) (answer))
-      (end-flag (cond ((memq answer '($yes $y |$y|)) '$yes)
-		      ((memq answer '($no $n |$n|)) '$no)
+      (end-flag (cond ((memq answer '($yes |$Y| |$y|)) '$yes)
+		      ((memq answer '($no |$N| |$n|)) '$no)
 		      ((memq answer '($unknown $uk)) '$unknown)))
     (setq answer (retrieve
 		  `((mtext) |Is  | ,object 
@@ -108,7 +108,7 @@
 		    ,property ,@fun-or-number |?|)
 		  nil))
     (cond 
-      ((memq answer '($yes $y |$y| |$n| $no $n $unknown $uk))
+      ((memq answer '($yes |$Y| |$y| |$N| |$n| $no $unknown $uk))
        (setq end-flag t))
       (t (mtell
 	  "~%Acceptable answers are Yes, Y, No, N, Unknown, Uk~%")))))

Index: cl-info.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/cl-info.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- cl-info.lisp	6 Apr 2006 21:06:59 -0000	1.32
+++ cl-info.lisp	27 Jul 2006 05:37:45 -0000	1.33
@@ -788,7 +788,7 @@
 	     :if-exists :append
 	     :if-does-not-exist :create)
        (cond ((< (file-position st) 10)
-	      (princ  #u"\nFile:\thotlist\tNode: Top\n\n* Menu: Hot list of favrite info items.\n\n" st)))
+	      (princ  #u"\nFile:\thotlist\tNode: Top\n\n* Menu: Hot list of favorite info items.\n\n" st)))
        (format st "* (~a)~a::~%" 
 	       (node file node)(node name node))))))
 

Index: commac.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/commac.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- commac.lisp	2 Jul 2006 04:54:29 -0000	1.32
+++ commac.lisp	27 Jul 2006 05:37:45 -0000	1.33
@@ -234,7 +234,7 @@
 	 finally (return `(progn ,@ tem))))
 
 (defmacro defquote  (fn (aa . oth) &body rest &aux help ans) 
-  (setq help (intern (format nil "~a-aux" fn)))
+  (setq help (intern (format nil "~a-~a" fn '#:aux)))
   (cond ((eq aa '&rest)
 	 (setq ans
 	       (list
@@ -547,6 +547,7 @@
 (defun implode (lis) (implode1 lis nil))
 
 
+#-(or scl allegro)
 (defun maybe-invert-string-case (string)
   ;; If STRING is all the same case, invert the case.  Otherwise, do
   ;; nothing.
@@ -563,6 +564,27 @@
 	  (t
 	   string))))
 
+#+(or scl allegro)
+(defun maybe-invert-string-case (string)
+  (cond (#+scl (eq ext:*case-mode* :lower)
+	 #+allegro (eq excl:*current-case-mode* :case-sensitive-lower)
+	 string)
+	(t
+	 ;; If STRING is all the same case, invert the case.  Otherwise, do
+	 ;; nothing.
+	 (flet ((alpha-upper-case-p (s)
+		  (not (some #'lower-case-p s)))
+		(alpha-lower-case-p (s)
+		  (not (some #'upper-case-p s))))
+	   ;; Don't explicitly add a package here.  It seems maxima sets
+	   ;; *package* as needed.
+	   (cond ((alpha-upper-case-p string)
+		  (string-downcase string))
+		 ((alpha-lower-case-p string)
+		  (string-upcase string))
+		 (t
+		  string))))))
+
 (defun intern-invert-case (string)
   ;; Like read-from-string with readtable-case :invert
   ;;
@@ -571,7 +593,7 @@
   (intern (maybe-invert-string-case string)))
 
 
-#-gcl
+#-(or gcl scl allegro)
 (let ((local-table (copy-readtable nil)))
   (setf (readtable-case local-table) :invert)
   (defun print-invert-case (sym)
@@ -579,6 +601,22 @@
 	  (*print-case* :upcase))
       (princ-to-string sym))))
 
+#+(or scl allegro)
+(let ((local-table (copy-readtable nil)))
+  (unless #+scl (eq ext:*case-mode* :lower)
+	  #+allegro (eq excl:*current-case-mode* :case-sensitive-lower)
+    (setf (readtable-case local-table) :invert))
+  (defun print-invert-case (sym)
+    (cond (#+scl (eq ext:*case-mode* :lower)
+	   #+allegro (eq excl:*current-case-mode* :case-sensitive-lower)
+	   (let ((*readtable* local-table)
+		 (*print-case* :downcase))
+	     (princ-to-string sym)))
+	  (t
+	   (let ((*readtable* local-table)
+		 (*print-case* :upcase))
+	     (princ-to-string sym))))))
+
 #+gcl
 (defun print-invert-case (sym)
   (cond ((symbolp sym)
@@ -665,6 +703,18 @@
 	 finally 
 	 (return (make-symbol (maybe-invert-string-case (coerce tem 'string))))))
 
+(defmacro make-mstring (string)
+  "Make a Maxima string.  The case is inverted for standard CL, and is not
+  changed for lower-case case-sensitive CL variants."
+  #-(or scl allegro)
+  `',(intern (print-invert-case (make-symbol (concatenate 'string "&" string))))
+  #+(or scl allegro)
+  `',(cond (#+scl (eq ext:*case-mode* :lower)
+	    #+allegro (eq excl:*current-case-mode* :case-sensitive-lower)
+	    (intern (concatenate 'string "&" string)))
+	   (t
+	    (intern (print-invert-case (make-symbol (concatenate 'string "&" string)))))))
+
 ;;for those window labels etc. that are wrong type.
 
 (defun flatc (sym)

Index: compar.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/compar.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- compar.lisp	20 Dec 2005 03:34:53 -0000	1.13
+++ compar.lisp	27 Jul 2006 05:37:45 -0000	1.14
@@ -568,13 +568,13 @@
 	 (setq $askexp (lmul evens)
 	       sign (cdr (assol $askexp locals)))
 	 (do () (nil)
-	   (cond ((zl-member sign '($zero $z |$z| 0 0.0))
+	   (cond ((zl-member sign '($zero |$Z| |$z| 0 0.0))
 		  (tdzero $askexp) (setq sign '$zero) (return t))
-		 ((memq sign '($pn $nonzero $n |$n| $nz $nonz $non0))
+		 ((memq sign '($pn $nonzero |$N| |$n| $nz $nonz $non0))
 		  (tdpn $askexp) (setq sign '$pos) (return t))
-		 ((memq sign '($pos $p |$p| $positive))
+		 ((memq sign '($pos |$P| |$p| $positive))
 		  (tdpos $askexp) (setq sign '$pos) (return t))
-		 ((memq sign '($neg $n |$n| $negative))
+		 ((memq sign '($neg |$N| |$n| $negative))
 		  (tdneg $askexp) (setq sign '$pos) (return t)))
 	   (setq sign (ask "Is  " $askexp "  zero or nonzero?")))
 	 (if minus (flip sign) sign))
@@ -586,13 +586,13 @@
 			   ((eq '$pn sign) "  positive or negative?")
 			   (t "  positive, negative, or zero?")))
 		(ans (cdr (assol $askexp locals)))) (nil)
-	     (cond ((and (memq ans '($pos $p |$p| $positive))
+	     (cond ((and (memq ans '($pos |$P| |$p| $positive))
 			 (memq sign '($pz $pn $pnz)))
 		    (tdpos $askexp) (setq sign '$pos) (return t))
-		   ((and (memq ans '($neg $n |$n| $negative))
+		   ((and (memq ans '($neg |$N| |$n| $negative))
 			 (memq sign '($nz $pn $pnz)))
 		    (tdneg $askexp) (setq sign '$neg) (return t))
-		   ((and (zl-member ans '($zero $z |$z| 0 0.0))
+		   ((and (zl-member ans '($zero |$Z| |$z| 0 0.0))
 			 (memq sign '($pz $nz $pnz)))
 		    (tdzero $askexp) (setq sign '$zero) (return t)))
 	     (setq ans (ask "Is  " $askexp dom)))

Index: desoln.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/desoln.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- desoln.lisp	7 Nov 2005 17:37:11 -0000	1.4
+++ desoln.lisp	27 Jul 2006 05:37:45 -0000	1.5
@@ -36,7 +36,7 @@
 	 ((not (eql ($length (setq $ovar (maref $vars 1)))
 		    1))
 	  (simplify ($error $ovar
-			    '|&contains more than one independent variable.|))))
+			    (make-mstring "contains more than one independent variable.")))))
        (setq $ovar (simplify ($inpart $ovar 1)))
        (setq $dispflag nil)
        (setq
@@ -66,7 +66,7 @@
 	 nil))
        (cond ((or (like $teqns '((mlist)))
 		  (like $teqns (list '(mlist) '((mlist)))))
-	      (simplify ($error '|&`desolve' can't handle this case.|)))
+	      (simplify ($error (make-mstring "`desolve' can't handle this case."))))
 	     (t (setq $teqns (simplify ($first $teqns)))))
        (cond ((not (like $flag t))
 	      (setq $teqns (simplify ($first $teqns)))))

Index: elim.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/elim.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- elim.lisp	7 Nov 2005 17:37:11 -0000	1.4
+++ elim.lisp	27 Jul 2006 05:37:45 -0000	1.5
@@ -30,12 +30,12 @@
        (setq $flag (setq $dispflag nil))
        (cond ((not (and ($listp $eqns)
 			($listp $vars)))
-	      (simplify ($error '|&The arguments must both be lists|))))
+	      (simplify ($error (make-mstring "The arguments must both be lists")))))
        (cond ((> ($length $vars)
 		 (setq $l ($length $eqns)))
-	      (simplify ($error '|&More variables then equations|))))
+	      (simplify ($error (make-mstring "More variables then equations")))))
        (cond ((eql $l 1)
-	      (simplify ($error '|&Can't eliminate from only one equation|))))
+	      (simplify ($error (make-mstring "Can't eliminate from only one equation")))))
        (cond ((eql ($length $vars) $l)
 	      (setq $vars ($reverse $vars))
 	      (setq $sv (maref $vars 1))

Index: hyp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/hyp.lisp,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -d -r1.81 -r1.82
--- hyp.lisp	30 Apr 2006 22:45:22 -0000	1.81
+++ hyp.lisp	27 Jul 2006 05:37:45 -0000	1.82
@@ -3272,7 +3272,7 @@
 (defun step4-int (a b c)
   (if (> a b)
       (step4-int b a c)
-      (let* ((s (gensym "STEP4_VAR_"))
+      (let* ((s (gensym (symbol-name '#:step4-var-)))
 	     (m (1- a))
 	     (n (1- b))
 	     (ell (sub c 3//2))
@@ -3571,7 +3571,7 @@
   ;; derive the remaining forms by differentiating this enough times.
   ;;
   ;; FIXME:  Do we need to assume z > 0?  We do that anyway, here.
-  (let* ((s (gensym "HYP_ATANH_"))
+  (let* ((s (gensym (symbol-name '#:hyp-atanh-)))
 	 (n (add a 1//2))
 	 (m (sub b 1))
 	 (ell (sub c 1//2))

Index: irinte.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/irinte.lisp,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- irinte.lisp	3 Mar 2006 18:34:58 -0000	1.16
+++ irinte.lisp	27 Jul 2006 05:37:45 -0000	1.17
@@ -286,10 +286,8 @@
 		(intira (distrexpandroot
 			 (cdr ($substitute
 			       (mul (power f -1)
-				    (add (setq met
-					       (make-symbol
-						"YANNIS")
-					       )
+				    (add (setq met (make-symbol
+						    (symbol-name '#:yannis)))
 					 (mul -1 e)))
 			       x funct)))
 			met)))

Index: mactex.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/mactex.lisp,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- mactex.lisp	22 Jul 2006 04:06:21 -0000	1.45
+++ mactex.lisp	27 Jul 2006 05:37:45 -0000	1.46
@@ -947,7 +947,7 @@
 ;; This stuff handles setting of LET rules
 
 (defprop | --> | "\\longrightarrow " texsym)
-(defprop | WHERE | "\\;\\mathbf{where}\\;" texsym)
+(defprop #.(intern (format nil " ~A " 'where)) "\\;\\mathbf{where}\\;" texsym)
 
 (defprop &>= ("\\ge ") texsym)
 (defprop &>= tex-infix tex)

Index: matcom.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/matcom.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- matcom.lisp	23 May 2006 04:51:41 -0000	1.11
+++ matcom.lisp	27 Jul 2006 05:37:45 -0000	1.12
@@ -528,7 +528,7 @@
 
 (defun announce-rule-firing (rulename expr simplified-expr)
   (let (($display2d nil) (stringdisp nil))
-    ($print '|&By| rulename '|&,| expr '|&-->| simplified-expr))
+    ($print (make-mstring "By") rulename '|&,| expr '|&-->| simplified-expr))
   simplified-expr)
 
 (defmspec $defrule (form)

Index: merror.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/merror.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- merror.lisp	23 Dec 2005 06:53:40 -0000	1.14
+++ merror.lisp	27 Jul 2006 05:37:45 -0000	1.15
@@ -18,7 +18,7 @@
 
 (defvar *mdebug* t "Enter the lisp debugger on an error if this is true")
 
-(defmvar $error '((mlist simp) |&No error.|)
+(defmvar $error `((mlist simp) ,(make-mstring "No error."))
   "During an MAXIMA-ERROR break this is bound to a list
   of the arguments to the call to MAXIMA-ERROR, with the message
   text in a compact format.")

Index: mformt.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/mformt.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- mformt.lisp	7 Nov 2005 17:37:11 -0000	1.6
+++ mformt.lisp	27 Jul 2006 05:37:45 -0000	1.7
@@ -166,20 +166,19 @@
   #-(or cl nil)
   (if (eq stream nil)
       (displa object)
-      (let ((|^R| t)
-	    (|^W| t)
-	    (outfiles (ncons stream))
-	    )
+      (let ((^r t)
+	    (^w t)
+	    (outfiles (ncons stream)))
 	(displa object)))
   #+(or cl nil)
-  ;; a bit of a kludge here. ^R and ^W still communicate something
+  ;; a bit of a kludge here. ^r and ^w still communicate something
   ;; to the displa package, but OUTFILES has not been implemented/hacked.
   (if (or (eq stream nil)
 	  (eq stream *standard-output*))
       (displa object)
       (let ((*standard-output* stream)
-	    (|^R| t)
-	    (|^W| t))
+	    (^r t)
+	    (^w t))
 	(displa object))))
 
 (defmfun mtell (&rest l)

Index: mrgmac.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/mrgmac.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- mrgmac.lisp	7 Nov 2005 17:37:11 -0000	1.8
+++ mrgmac.lisp	27 Jul 2006 05:37:45 -0000	1.9
@@ -210,9 +210,9 @@
   
   (prog (c s a)
      (setq
-      c (intern (format nil "C-~A" name)) 
-      s (intern (format nil "S-~A" name)) 
-      a (intern (format nil "A-~A" name)))
+      c (intern (format nil "~A-~A" '#:c name))
+      s (intern (format nil "~A-~A" '#:s name)) 
+      a (intern (format nil "~A-~A" '#:a name)))
 					;(setq silly `    (DEFINE-MACRO ,C ,(DEFC DESC))	)
      (define-macro c (defc desc))
      (define-macro s (defs desc))

Index: mtrace.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/mtrace.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- mtrace.lisp	2 Jan 2006 13:01:29 -0000	1.15
+++ mtrace.lisp	27 Jul 2006 05:37:45 -0000	1.16
@@ -517,7 +517,7 @@
 	  ((eq (caar option) keyword)
 	   (let ((return-to-trace-handle $trace_safety))
 	     (return (mapply (cadr option) predicate-arglist
-			     '|&A trace option predicate|)))))))
+			     (make-mstring "A trace option predicate"))))))))
 			
 
 (defun trace-enter-print (fun lev largs &aux (mlargs `((mlist) ,@largs)))
@@ -549,7 +549,7 @@
   (if (trace-option-p fun '$break)
       (do ((return-to-trace-handle nil)
 	   ($trace_break_arg `((mlist) ,@largs)))(nil)
-	($break '|&Trace entering| fun '|&level| lev)
+	($break (make-mstring "Trace entering") fun (make-mstring "level") lev)
 	(cond (($listp $trace_break_arg)
 	       (return (cdr $trace_break_arg)))
 	      (t
@@ -561,7 +561,7 @@
   (if (trace-option-p fun '$break)
       (let (($trace_break_arg ret-val)
 	    (return-to-trace-handle nil))
-	($break '|&Trace exiting| fun '|&level| lev)
+	($break (make-mstring "Trace exiting") fun (make-mstring "level") lev)
 	$trace_break_arg)
       ret-val))
 
@@ -705,7 +705,7 @@
 	(return-to-trace-handle nil))
     (case type
       ((mexpr)
-       (mapply prop largs '|&A traced function|))
+       (mapply prop largs (make-mstring "A traced function")))
       ((expr)
        (apply prop largs))
       ((subr lsubr)

Index: nisimp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/nisimp.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- nisimp.lisp	7 Nov 2005 17:37:11 -0000	1.5
+++ nisimp.lisp	27 Jul 2006 05:37:45 -0000	1.6
@@ -78,7 +78,7 @@
 		     (append (list '(mtext) pat '| --> | )
 			     (cond ((cddr l)
 				    (list (cadr l)
-					  '| WHERE | 
+					  '#.(intern (format nil " ~A " 'where))
 					  (cons (list (caddr l))
 						(cdddr l))))
 				   (t replacement))))

Index: nparse.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/nparse.lisp,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- nparse.lisp	7 Nov 2005 17:37:11 -0000	1.29
+++ nparse.lisp	27 Jul 2006 05:37:45 -0000	1.30
@@ -1530,29 +1530,29 @@
 (def-lpos	|$<=| $expr)
 (def-mheader	|$<=| (mleqp))
 
-(def-nud-equiv	|$NOT| parse-prefix)
+(def-nud-equiv	$not parse-prefix)
 ;LBP not needed
-(def-rbp	|$NOT| 70.)
-(def-pos	|$NOT| $clause)
-(def-rpos	|$NOT| $clause)
-(def-lpos	|$NOT| $clause)
-(def-mheader	|$NOT| (mnot))
+(def-rbp	$not 70.)
+(def-pos	$not $clause)
+(def-rpos	$not $clause)
+(def-lpos	$not $clause)
+(def-mheader	$not (mnot))
 
-(def-led-equiv	|$AND| parse-nary)
-(def-lbp	|$AND| 65.)
+(def-led-equiv	$and parse-nary)
+(def-lbp	$and 65.)
 ;RBP not needed
-(def-pos	|$AND| $clause)
+(def-pos	$and $clause)
 ;RPOS not needed
-(def-lpos	|$AND| $clause)
-(def-mheader	|$AND| (mand))
+(def-lpos	$and $clause)
+(def-mheader	$and (mand))
 
-(def-led-equiv	|$OR| parse-nary)
-(def-lbp	|$OR| 60.)
+(def-led-equiv	$or parse-nary)
+(def-lbp	$or 60.)
 ;RBP not needed
-(def-pos	|$OR| $clause)
+(def-pos	$or $clause)
 ;RPOS not needed
-(def-lpos	|$OR| $clause)
-(def-mheader	|$OR| (mor))
+(def-lpos	$or $clause)
+(def-mheader	$or (mor))
 
 (def-led-equiv	|$,| parse-nary)
 (def-lbp	|$,| 10.)
@@ -1562,19 +1562,19 @@
 (def-lpos	|$,| $any)
 (def-mheader	|$,| ($ev))
 
-(def-nud-equiv |$THEN| delim-err)
-(def-lbp |$THEN| 5.)
-(def-rbp |$THEN| 25.)
+(def-nud-equiv $then delim-err)
+(def-lbp $then 5.)
+(def-rbp $then 25.)
 
-(def-nud-equiv |$ELSE| delim-err)
-(def-lbp |$ELSE| 5.)
-(def-rbp |$ELSE| 25.)
+(def-nud-equiv $else delim-err)
+(def-lbp $else 5.)
+(def-rbp $else 25.)
 
-(def-nud-equiv |$ELSEIF| delim-err)
-(def-lbp  |$ELSEIF| 5.)
-(def-rbp  |$ELSEIF| 45.)
-(def-pos  |$ELSEIF| $any)
-(def-rpos |$ELSEIF| $clause)
+(def-nud-equiv $elseif delim-err)
+(def-lbp  $elseif 5.)
+(def-rbp  $elseif 45.)
+(def-pos  $elseif $any)
+(def-rpos $elseif $clause)
 
 ;No LBP - Default as high as possible
 (def-rbp     $if 45.)
@@ -1583,7 +1583,7 @@
 ;No LPOS
 (def-mheader $if (mcond))
 
-(def-nud (|$IF|) (op)
+(def-nud ($if) (op)
   (list* (pos op)
 	 (mheader op)
 	 (parse-condition op)))
@@ -1596,7 +1596,7 @@
 	 (case (first-c)
 	   (($else)   (list t (parse '$any (rbp (pop-c)))))
 	   (($elseif) (parse-condition (pop-c)))
-	   (t ; Note: $FALSE instead of () makes DISPLA suppress display!
+	   (t ; Note: $false instead of () makes DISPLA suppress display!
 	    (list t '$false)))))
 
 (def-mheader $do (mdo))

Index: ode2.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/ode2.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- ode2.lisp	7 Nov 2005 17:37:12 -0000	1.4
+++ ode2.lisp	27 Jul 2006 05:37:45 -0000	1.5
@@ -1324,9 +1324,9 @@
 	  (cond
 	    ((not (or (like $intp '$y)
 		      (like $intp '$n)))
-	     (setq $intp (simplify ($readonly '|&Is|
+	     (setq $intp (simplify ($readonly (make-mstring "Is")
 					      $nu
-					      '|&an integer?  Type Y or N.|)))
+					      (make-mstring "an integer?  Type Y or N."))))
 	     (go $loop)))
 	  (cond
 	    ((like $intp '$y)
@@ -1518,7 +1518,7 @@
 					     0))
 			  '&=)))
 	   (display-for-tr nil nil (trd-msymeval $x '$x))
-	   (display-for-tr nil nil '|&Not an equation|)
+	   (display-for-tr nil nil (make-mstring "Not an equation"))
 	   (simplify ($error))))))
 (eval-when (compile eval load)
   (defprop $boundtest t translated)
@@ -1529,7 +1529,7 @@
     (cond ((not (like (trd-msymeval $x '$x)
 		      (trd-msymeval $y '$y)))
 	   (display-for-tr nil nil (trd-msymeval $x '$x))
-	   (display-for-tr nil nil '|&Must not be bound|)
+	   (display-for-tr nil nil (make-mstring "Must not be bound"))
 	   (simplify ($error))))))
 (eval-when (compile eval load)
   (defprop $failure t translated)
@@ -1553,5 +1553,5 @@
 	 nil))
      '$ynew)))
 (eval-when (load compile) (meval '(($remove) $x $special $y $special)))
-(setq $msg1 '|&Not a proper differential equation|)
-(setq $msg2 '|&First order equation not linear in y'|)
+(setq $msg1 (make-mstring "Not a proper differential equation"))
+(setq $msg2 (make-mstring "First order equation not linear in y'"))

Index: outmis.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/outmis.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- outmis.lisp	7 Nov 2005 17:37:12 -0000	1.8
+++ outmis.lisp	27 Jul 2006 05:37:45 -0000	1.9
@@ -530,7 +530,7 @@
 (defun properties (x)
   (do ((y (symbol-plist x) (cddr y))
        (l (cons '(mlist simp) (and (boundp x)
-				   (if (optionp x) (ncons '|&SYSTEM VALUE|)
+				   (if (optionp x) (ncons (make-mstring "system value"))
 				       (ncons '$value)))))
        (prop))
       ((null y)
@@ -540,13 +540,13 @@
        (if (memq x (cdr $activecontexts))
 	   (nconc l (ncons '$activecontext)))
        (cond  ((null (symbol-plist x))
-	       (if (fboundp x) (nconc l (list '|&SYSTEM FUNCTION|)))))
+	       (if (fboundp x) (nconc l (list (make-mstring "system function"))))))
        l)
     ;; TOP-LEVEL PROPERTIES 
     (cond ((setq prop (assq (car y)
-			    '((bindtest . $bindtest)
+			    `((bindtest . $bindtest)
 			      (sp2 . $deftaylor) (sp2subs . $deftaylor)
-			      (assign . |&ASSIGN PROPERTY|)
+			      (assign . ,(make-mstring "assign property"))
 			      (nonarray . $nonarray) (grad . $gradef)
 			      (noun . $noun) (evfun . $evfun) (special . $special)
 			      (evflag . $evflag) (op . $operator) (alphabet . $alphabetic))))
@@ -555,22 +555,22 @@
 	  ((and (eq (car y) 'operators) (not (eq (cadr y) 'simpargs1)))
 	   (nconc l (list '$rule)))
 	  ((and (memq (car y) '(fexpr fsubr mfexpr*s mfexpr*))
-		(nconc l (ncons '|&SPECIAL EVALUATION FORM|))
+		(nconc l (ncons (make-mstring "special evaluation form")))
 		nil))
 	  ((and (or (get (car y) 'mfexpr*) (fboundp x))
-		(not (memq '|&SYSTEM FUNCTION| l)))
+		(not (memq (make-mstring "system function") l)))
 	   (nconc l
 		  (list (cond ((get x 'translated) '$transfun)
 			      ((mgetl x '($rule ruleof)) '$rule)
-			      (t '|&SYSTEM FUNCTION|)))))
-	  ((and (eq (car y) 'autoload) (not (memq '|&SYSTEM FUNCTION| l)))
+			      (t (make-mstring "system function"))))))
+	  ((and (eq (car y) 'autoload) (not (memq (make-mstring "system function") l)))
 	   (nconc l (ncons (if (memq x (cdr $props))
-			       '|&USER AUTOLOAD FUNCTION|
-			       '|&SYSTEM FUNCTION|))))
+			       (make-mstring "user autoload function")
+			       (make-mstring "system function")))))
 	  ((and (eq (car y) 'reversealias) (memq (car y) (cdr $aliases)))
 	   (nconc l (ncons '$alias)))
 	  ((eq (car y) 'data)
-	   (nconc l (cons '|&DATABASE INFO| (cdr ($facts x)))))
+	   (nconc l (cons (make-mstring "database info") (cdr ($facts x)))))
 	  ((eq (car y) 'mprops)
 	   ;; PROPS PROPERTIES
 	   (do ((y
@@ -578,10 +578,10 @@
 		 (cddr y)))
 	       ((null y))
 	     (cond ((setq prop (assq (car y)
-				     '((mexpr . $function)
+				     `((mexpr . $function)
 				       (mmacro . $macro)
-				       (hashar . |&HASHED ARRAY|)
-				       (aexpr . |&ARRAY FUNCTION|)
+				       (hashar . ,(make-mstring "hashed array"))
+				       (aexpr . ,(make-mstring "array function"))
 				       (atvalues . $atvalue)
 				       ($atomgrad . $atomgrad)
 				       ($numer . $numer)
@@ -594,12 +594,12 @@
 		    (nconc l (list (cdr prop))))
 		   ((eq (car y) 'array)
 		    (nconc l
-			   (list (cond ((get x 'array) '|&COMPLETE ARRAY|)
-				       (t '|&DECLARED ARRAY|)))))
+			   (list (cond ((get x 'array) (make-mstring "complete array"))
+				       (t (make-mstring "declared array"))))))
 		   ((and (eq (car y) '$props) (cdadr y))
 		    (nconc l
 			   (do ((y (cdadr y) (cddr y))
-				(l (list '(mlist) '|&USER PROPERTIES|)))
+				(l (list '(mlist) (make-mstring "user properties"))))
 			       ((null y) (list l))
 			     (nconc l (list (car y))))))))))))
 

Index: rat3c.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/rat3c.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- rat3c.lisp	21 May 2006 01:10:06 -0000	1.11
+++ rat3c.lisp	27 Jul 2006 05:37:46 -0000	1.12
@@ -452,6 +452,16 @@
 	   1073741561 1073741527 1073741503 1073741477 1073741467 1073741441
 	   1073741419 1073741399)
 	 ))
+      (1152921504606846975
+       '(setq bigprimes
+       '(576460752303423433 576460752303423389 576460752303423263
+         576460752303423061 576460752303422971 576460752303422881
+         576460752303422839 576460752303422801 576460752303422627
+         576460752303422617 576460752303422599 576460752303422557
+         576460752303422543 576460752303422533 576460752303422501
+         576460752303422479 576460752303422431 576460752303422429
+         576460752303422369 576460752303422309)
+       ))
       ;; Could always use the following, but it takes several seconds to compute
       ;; so if we want to autoload this file, it is tiresome.
       (t '(do ((i 0 (f1+ i))	   ;GENERATES 20 LARGEST PRIMES < WORD

Index: series.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/series.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- series.lisp	7 Nov 2005 17:37:12 -0000	1.6
+++ series.lisp	27 Jul 2006 05:37:46 -0000	1.7
@@ -58,9 +58,9 @@
 	  ((and x (not (eq (car x) 'err))) x)
 	  ($verbose
 	   (mtell "Unable to expand for the following reason:")
-	   (cond ((null x) (mtell "~%no reason given") '|&Unable to expand|)
+	   (cond ((null x) (mtell "~%no reason given") (make-mstring "Unable to expand"))
 		 (t (cdr x))))
-	  (t '|&Unable to expand|))))
+	  (t (make-mstring "Unable to expand")))))
 
 (defun out-of (e)
   (let  ((e      (cond ((and (boundp '*var) *var)

Index: suprv1.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/suprv1.lisp,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- suprv1.lisp	23 Apr 2006 18:00:30 -0000	1.35
+++ suprv1.lisp	27 Jul 2006 05:37:46 -0000	1.36
@@ -986,11 +986,22 @@
       name))
 
 
-#+cl
+#+(and cl (not scl) (not allegro))
 (defun casify-exploden (x)
   (cond ((char= (getcharn x 1) #\&)
 	 (cdr (exploden (string-upcase (string x)))))
 	(t (exploden x))))
+#+(or scl allegro)
+(defun casify-exploden (x)
+  (cond ((char= (getcharn x 1) #\&)
+	 (let ((string (string x)))
+	   (cond (#+scl (eq ext:*case-mode* :lower)
+		  #+allegro (eq excl:*current-case-mode* :case-sensitive-lower)
+		  (setf string (string-downcase string)))
+		 (t
+		  (setf string (string-upcase string))))
+	   (cdr (exploden string))))
+	(t (exploden x))))
 #-cl
 (defmfun casify-exploden (x)
   (setq x (exploden x))

Index: sys-proclaim.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/sys-proclaim.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- sys-proclaim.lisp	6 May 2006 01:27:37 -0000	1.8
+++ sys-proclaim.lisp	27 Jul 2006 05:37:46 -0000	1.9
@@ -6,36 +6,44 @@
                         (VECTOR FIXNUM) FIXNUM)
                 *)
             SLATEC::DQPSRT)) 
-(PROCLAIM '(FTYPE (FUNCTION (*) FIXNUM) MAXIMA::LINEL)) 
 (PROCLAIM
     '(FTYPE (FUNCTION (FIXNUM) *) MAXIMA::FRAME-INFO MAXIMA::DBM-UP)) 
+(PROCLAIM '(FTYPE (FUNCTION (*) FIXNUM) MAXIMA::LINEL)) 
 (PROCLAIM
     '(FTYPE (FUNCTION
-                (LONG-FLOAT LONG-FLOAT LONG-FLOAT LONG-FLOAT LONG-FLOAT
+                (LONG-FLOAT LONG-FLOAT LONG-FLOAT FIXNUM FIXNUM
[...3717 lines suppressed...]
+            MAXIMA::SP1TPLUS MAXIMA::EACHP MAXIMA::END
+            MAXIMA::TRAMP2$-M MAXIMA::EXPT$ MAXIMA::CEIL
+            MAXIMA::DEPENDS1 MAXIMA::NTHCOL MAXIMA::SCS MAXIMA::CNTXT
+            MAXIMA::POLYSUBST MAXIMA::DEFINE-MODE MAXIMA::NZEROS
+            MAXIMA::NTHCOL1 MAXIMA::ERRRJF-TRANSLATE MAXIMA::LINPOWER0
+            MAXIMA::ADD2LNC MAXIMA::PCTIMES1 MAXIMA::FIXVL
+            MAXIMA::RASSOCIATIVE MAXIMA::FIXVL1 MAXIMA::PSUMSQ1
+            MAXIMA::CPBER3 MAXIMA::ADDF MAXIMA::FPTIMES* MAXIMA::PAR
+            MAXIMA::DELETE-WITH-SIDE-EFFECTS-IF MAXIMA::CONST
+            MAXIMA::PDISREP2EXPAND MAXIMA::ADDMATRIX1
+            MAXIMA::ZL-INTERSECTION MAXIMA::LINPOWER MAXIMA::$POISTIMES
+            MAXIMA::IVAR MAXIMA::KINDP MAXIMA::$FUNMAKE MAXIMA::ORDFNA
+            MAXIMA::GCFACTOR MAXIMA::ORDFN MAXIMA::MAXIMA-REMF
+            MAXIMA::MGRP MAXIMA::FDEL MAXIMA::EXPONENT-OF
+            MAXIMA::INTERVAL MAXIMA::ORDERVAR MAXIMA::IVAR2
+            MAXIMA::$ZERO_FUN MAXIMA::$/ MAXIMA::PEEK-ONE-TOKEN-G
+            MAXIMA::META-ADD2LNC MAXIMA::PDISREP*EXPAND)) 
 (PROCLAIM
     '(FTYPE (FUNCTION NIL FIXNUM) MAXIMA::LISTEN MAXIMA::REALIT-SL
             MAXIMA::[MAX-TRUNC] MAXIMA::SYS-GCTIME MAXIMA::CHRCT

Index: transl.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/transl.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- transl.lisp	26 Mar 2006 19:16:30 -0000	1.21
+++ transl.lisp	27 Jul 2006 05:37:46 -0000	1.22
@@ -1390,7 +1390,7 @@
 
 (defun new-end-symbol ( &aux tem)
   (loop for i from 0
-	 do (setq tem (intern (format nil "test-~A" i)))
+	 do (setq tem (intern (format nil "~A-~A" '#:test i)))
 	 when (null (symbol-plist tem))
 	 do (return tem)))
 

Index: transs.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/transs.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- transs.lisp	8 Dec 2005 21:38:52 -0000	1.20
+++ transs.lisp	27 Jul 2006 05:37:46 -0000	1.21
@@ -84,7 +84,7 @@
   '`,(pathname (stripdollar $tr_output_file_default))) 
 
 (defmacro trlisp-outputname () 
-  '`,(make-pathname :type "LISP"))
+  '`,(make-pathname :type "LISP" :case :common))
 
 (defmacro trlisp-outputname-temp ()
   '`,(pathname "_trli_"))
@@ -232,7 +232,7 @@
   (and bin-file(setq  bin-file (maxima-string bin-file)))
   (and translation-output-file
        (setq  translation-output-file (maxima-string translation-output-file)))
-  (cond ((string-equal (pathname-type input-file) "LISP")
+  (cond ((string-equal (pathname-type input-file :case :common) "LISP")
 	 (setq result (list '(mlist) input-file)))
 	(t (setq result (translate-file input-file translation-output-file))
 	   (setq input-file (third result))))
@@ -330,7 +330,12 @@
 	(*print-pprint-dispatch* (copy-pprint-dispatch)))
     #-gcl
     (progn
+      #-(or scl allegro)
       (setf (readtable-case *readtable*) :invert)
+      #+(or scl allegro)
+      (unless #+scl (eq ext:*case-mode* :lower)
+	      #+allegro (eq excl:*current-case-mode* :case-sensitive-lower)
+	(setf (readtable-case *readtable*) :invert))
       (set-pprint-dispatch '(cons (member maxima::defmtrfun))
 			   #'pprint-defmtrfun))
     (loop while (and (setq expr (mread in-stream)) (consp expr))
@@ -373,7 +378,7 @@
 ;;       (OPEN-OUT-DSK X))
 
 (defun alter-pathname (pathname &rest options)
-  (apply 'make-pathname :defaults (pathname  pathname)  options))
+  (apply 'make-pathname :defaults (pathname  pathname) :case :common options))
 
 (defun delete-with-side-effects-if (test list)
   "Rudimentary DELETE-IF which, however, is guaranteed to call





[Maxima-commits] CVS: maxima/src askp.lisp, 1.7, 1.8 cl-info.lisp, 1.32, 1.33 commac.lisp, 1.32, 1.

Computer Algebra System written in Common Lisp