[Maxima-commits] CVS: maxima/src displa.lisp, 1.38, 1.39 dskfn.lisp, 1.20, 1.21 grind.lisp, 1.33, 1.34 suprv1.lisp, 1.67, 1.68

[Robert D. <rob...@us...>]

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

Modified Files:
	displa.lisp dskfn.lisp grind.lisp suprv1.lisp 
Log Message:
Store reverse alias with leading % or $ (do not call STRIPDOLLAR
before putting reverse alias onto property list).
This avoid name collision between a Maxima identifier and
a similarly-named Lisp identifier (e.g. $T and T).

Index: displa.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/displa.lisp,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -d -r1.38 -r1.39
--- displa.lisp	14 Mar 2008 19:04:00 -0000	1.38
+++ displa.lisp	29 Mar 2008 21:29:20 -0000	1.39
@@ -227,7 +227,7 @@
 	  ((not (symbolp atom)) (exploden atom))
 	  ((and (setq dummy (get atom 'reversealias))
 		(not (and (member atom $aliases :test #'eq) (get atom 'noun))))
-	   (exploden dummy))
+	   (exploden (stripdollar dummy)))
 	  ((not (eq (getop atom) atom))
        (makestring (getop atom)))
 	  (t (setq dummy (exploden atom))

Index: dskfn.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/dskfn.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- dskfn.lisp	23 Mar 2008 22:45:25 -0000	1.20
+++ dskfn.lisp	29 Mar 2008 21:29:20 -0000	1.21
@@ -172,12 +172,12 @@
 	 (when (setq val (and (member item (cdr $aliases) :test #'eq) (get item 'reversealias)))
 	   (dskdefprop rename val 'reversealias)
 	   (pradd2lnc rename '$aliases)
-	   (dskdefprop (makealias val) rename 'alias)
+	   (dskdefprop val rename 'alias)
 	   (and greatorder (not (assoc 'greatorder alrdystrd :test #'eq))
 		(setq x (list* nil 'greatorder (cdr x))))
 	   (and lessorder (not (assoc 'lessorder alrdystrd :test #'eq))
 		(setq x (list* nil 'lessorder (cdr x))))
-	   (setq x (list* nil (makealias val) (cdr x))))
+	   (setq x (list* nil val (cdr x))))
 	 (cond ((setq val (get item 'noun))
 		(setq x (list* nil val (cdr x)))
 		(dskdefprop rename val 'noun))

Index: grind.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/grind.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- grind.lisp	17 Nov 2007 17:38:06 -0000	1.33
+++ grind.lisp	29 Mar 2008 21:29:20 -0000	1.34
@@ -147,7 +147,7 @@
      (cond ((numberp x) (setq y (exploden x)))
 	   ((and (setq y (safe-get x 'reversealias))
 		 (not (and (member x $aliases :test #'eq) (get x 'noun))))
-	    (setq y (exploden y)))
+	    (setq y (exploden (stripdollar y))))
 	   ((setq y (rassoc x aliaslist :test #'eq)) (return (msize (car y) l r lop rop)))
        ((null (setq y (exploden x))))
        ((safe-get x 'noun) (return (msize-atom (get x 'noun) l r)))

Index: suprv1.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/suprv1.lisp,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -d -r1.67 -r1.68
--- suprv1.lisp	17 Feb 2008 01:42:49 -0000	1.67
+++ suprv1.lisp	29 Mar 2008 21:29:21 -0000	1.68
@@ -713,7 +713,7 @@
 	 (if (not (eq x y))
 	     (merror "~M already is aliased." x)))
 	(t (putprop x y'alias)
-	   (putprop y (stripdollar x) 'reversealias)
+	   (putprop y x 'reversealias)
 	   (add2lnc y $aliases)
 	   y)))
 
@@ -726,7 +726,7 @@
 	  (y (remprop x 'reversealias)
 	     (remprop x 'noun)
 	     (setf $aliases (delete x $aliases :count 1 :test #'eq))
-	     (remprop (setq x (makealias y)) 'alias) (remprop x 'verb) x))))
+	     (remprop (setq x y) 'alias) (remprop x 'verb) x))))
 
 (defmfun stripdollar (x)
   (cond ((not (atom x))
@@ -744,7 +744,7 @@
 
 (defmfun fullstrip1 (x)
   (or (and (numberp x) x)
-      (get x 'reversealias)
+      (let ((y (get x 'reversealias))) (if y (stripdollar y)))
       (let ((u (rassoc x aliaslist :test #'eq)))
 	(if u (implode (string*1 (car u)))))
       (stripdollar x)))
@@ -818,7 +818,7 @@
 
 
 (mapc #'(lambda (x) (putprop (car x) (cadr x) 'alias)
-		(putprop (cadr x) (caddr x) 'reversealias))
+		(putprop (cadr x) (car x) 'reversealias))
       '(($block mprog block) ($lambda lambda lambda)
 	($abs mabs abs) ($subst $substitute subst)
 	($go mgo go) ($signum %signum signum)
@@ -1041,7 +1041,7 @@
     ((null l))
   ((lambda (x)
      (putprop (car l) x 'alias)
-     (putprop x (stripdollar (car l)) 'reversealias))
+     (putprop x (car l) 'reversealias))
    ($nounify (car l))))
 
 ($nounify '$sum)