* algebra/indexedp.spad.pamphlet: Avoid direct use or RPLACD.

	* algebra/poly.spad.pamphlet: Likewise.
	* interp/define.boot (spadCompileOrSetq): Tidy replacement info.
	* interp/i-output.boot ($BinaryOperators): New.
	(binaryInfix?): Tidy.

6 files changed, 36 insertions, 8 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 8a01b9fb..79f4b4d7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
 2011-11-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* algebra/indexedp.spad.pamphlet: Avoid direct use or RPLACD.
+	* algebra/poly.spad.pamphlet: Likewise.
+	* interp/define.boot (spadCompileOrSetq): Tidy replacement info.
+	* interp/i-output.boot ($BinaryOperators): New.
+	(binaryInfix?): Tidy.
+
+2011-11-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/nruncomp.boot (genDeltaEntry): Split first argument into
 	separate arguments (operation and modemap).  Adjust callers.
 
diff --git a/src/algebra/indexedp.spad.pamphlet b/src/algebra/indexedp.spad.pamphlet
index 1b60ecc4..d17d342c 100644
--- a/src/algebra/indexedp.spad.pamphlet
+++ b/src/algebra/indexedp.spad.pamphlet
@@ -132,8 +132,11 @@ IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedType):
        0  == nil$List(Term) pretend %
        zero? x ==  null terms x
 
+       import %tail: List Term -> List Term from Foreign Builtin
+
        qsetrest!: (List Term, List Term) -> List Term
-       qsetrest!(l, e) == RPLACD(l, e)$Lisp
+       qsetrest!(l, e) ==
+         %store(%tail l,e)$Foreign(Builtin)
 
        -- PERFORMANCE CRITICAL; Should build list up
        --  by merging 2 sorted lists.   Doing this will
@@ -285,8 +288,11 @@ IndexedDirectProductAbelianGroup(A:AbelianGroup,S:OrderedType):
          [[termIndex u,a] for u in terms x
             | not zero?(a := n * termValue u)] pretend %
 
+       import %tail: List Term -> List Term from Foreign Builtin
+
        qsetrest!: (List Term, List Term) -> List Term
-       qsetrest!(l, e) == RPLACD(l, e)$Lisp
+       qsetrest!(l, e) ==
+         %store(%tail l,e)$Foreign(Builtin)
 
        x - y ==
          x' := terms x
diff --git a/src/algebra/poly.spad.pamphlet b/src/algebra/poly.spad.pamphlet
index b86755a0..aeca4bf1 100644
--- a/src/algebra/poly.spad.pamphlet
+++ b/src/algebra/poly.spad.pamphlet
@@ -151,8 +151,11 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
 
        ground?(p): Boolean == empty? p or (empty? rest p and zero? degree p)
 
+       import %tail: Rep -> Rep from Foreign Builtin
+
        qsetrest!: (Rep, Rep) -> Rep
-       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+       qsetrest!(l: Rep, e: Rep): Rep ==
+         %store(%tail l,e)$Foreign(Builtin)
 
        entireRing? := R has EntireRing
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index abc12e16..8204957c 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -2004,8 +2004,10 @@ spadCompileOrSetq(db,form is [nam,[lam,vl,body]]) ==
       registerFunctionReplacement(nam,nam')
       sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
   else if macform := expandableDefinition?(vl,body) then
-           registerFunctionReplacement(nam,macform)
-           sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
+    registerFunctionReplacement(nam,macform)
+    [:vl',.] := vl
+    sayBrightly ['"     ",:bright prefix2String [nam,:vl'],
+                   '"is replaced by",:bright prefix2String body]
 
   form := 
     getFunctionReplacement nam => 
diff --git a/src/interp/format.boot b/src/interp/format.boot
index 0d4f3d4b..41033b90 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -446,7 +446,7 @@ form2String1 u ==
     argl := rest argl
     (null argl) or null (first argl) => [lo, '".."]
     [lo, '"..", form2String1 first argl]
-  isBinaryInfix op => formatAsFortranExpression [op,:argl]
+  binaryInfix? op => formatAsFortranExpression [op,:argl]
   application2String(op,[form2String1 x for x in argl], u1)
 
 formWrapId id == 
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index af86f29e..d734fbc1 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -469,8 +469,17 @@ rbrkSch() == symbolName specialChar 'rbrk
 lbrkSch() == symbolName specialChar 'lbrk
 quadSch() == symbolName specialChar 'quad
 
-isBinaryInfix x ==
-  member(x, '(_= _+ _- _* _/ _*_* _^ "=" "+" "-" "*" "/" "**" "^"))
+++ List of binary operators
+$BinaryOperators ==
+  ["**", "^", "*", "/", "//", "\", "\\", "rem", "quo", "exquo", "+", "-",
+    "/\", "\/", "=", "~=", "<", "<=", ">", ">=", "and", "or", ">>", "<<",
+      "by", "has", "case", "->", "..", "|"]
+  
+
+binaryInfix? x ==
+  ident? x => symbolMember?(x,$BinaryOperators)
+  string? x => symbolMember?(makeSymbol x,$BinaryOperators)
+  false
 
 stringApp([.,u],x,y,d) ==
   appChar(strconc($DoubleQuote,atom2String u,$DoubleQuote),x,y,d)