* interp/vmlisp.lisp (remove): Remove.

	(REMOVEQ, NREMOVEQ): Likewise.
	* boot/utility.boot (removeSymbol, removeScalar, removeValue)
	(remove):  New.
	* boot/ast.boot (bfMDef): Use applySubst in lieu of SUBLIS.

6 files changed, 128 insertions, 30 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index d0c98595..fa6d0d76 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
 2011-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/vmlisp.lisp (remove): Remove.
+	(REMOVEQ, NREMOVEQ): Likewise.
+	* boot/utility.boot (removeSymbol, removeScalar, removeValue)
+	(remove):  New.
+	* boot/ast.boot (bfMDef): Use applySubst in lieu of SUBLIS.
+
+2011-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* boot/utility.boot (assocSymbol): New.
 	(applySubst): Likewise.  Export.
 	* boot/ast.boot: Use it.  Remove SUBLIS and SUBLISLIS.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index e45047aa..ab87e808 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -787,10 +787,10 @@ bfMDef (op,args,body) ==
     bfTupleP args => rest args
     [args]
   [gargl,sgargl,nargl,largl]:=bfGargl argl
-  sb:=[[i,:j] for i in nargl for j in sgargl]
-  body:= SUBLIS(sb,body)
+  sb := [[i,:j] for i in nargl for j in sgargl]
+  body := applySubst(sb,body)
   sb2 := [["CONS",["QUOTE",i],j] for i in sgargl for j in largl]
-  body := ["SUBLIS",["LIST",:sb2],["QUOTE",body]]
+  body := ["applySubst",["LIST",:sb2],["QUOTE",body]]
   lamex:= ["MLAMBDA",gargl,body]
   def:= [op,lamex]
   [shoeComp def,:[:shoeComps bfDef1 d for d in $wheredefs]]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index a6f77349..0f152136 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1362,7 +1362,7 @@
                        (SETQ |bfVar#109| (CDR |bfVar#109|))))
                   (SETQ |bfVar#106| (CDR |bfVar#106|))
                   (SETQ |bfVar#107| (CDR |bfVar#107|)))))
-        (SETQ |body| (SUBLIS |sb| |body|))
+        (SETQ |body| (|applySubst| |sb| |body|))
         (SETQ |sb2|
               (LET ((|bfVar#112| NIL) (|bfVar#113| NIL)
                     (|bfVar#110| |sgargl|) (|i| NIL)
@@ -1384,7 +1384,8 @@
                   (SETQ |bfVar#110| (CDR |bfVar#110|))
                   (SETQ |bfVar#111| (CDR |bfVar#111|)))))
         (SETQ |body|
-              (LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
+              (LIST '|applySubst| (CONS 'LIST |sb2|)
+                    (LIST 'QUOTE |body|)))
         (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
         (SETQ |def| (LIST |op| |lamex|))
         (CONS (|shoeComp| |def|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 97428682..3d5aca1f 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -8,7 +8,7 @@
 (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
              |scalarMember?| |listMember?| |reverse| |reverse!|
              |lastNode| |append!| |copyList| |substitute| |substitute!|
-             |setDifference| |applySubst|))
+             |setDifference| |applySubst| |applySubst!| |remove|))
 
 (DEFUN |objectMember?| (|x| |l|)
   (LOOP
@@ -155,18 +155,27 @@
         (T |s|)))))
 
 (DEFUN |applySubst| (|sl| |t|)
-  (PROG (|tl| |hd| |p|)
+  (PROG (|p| |tl| |hd|)
     (RETURN
       (COND
-        ((SYMBOLP |t|)
-         (COND
-           ((SETQ |p| (|assocSymbol| |t| |sl|)) (CDR |p|))
-           (T |t|)))
         ((CONSP |t|) (SETQ |hd| (|applySubst| |sl| (CAR |t|)))
          (SETQ |tl| (|applySubst| |sl| (CDR |t|)))
          (COND
            ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
            (T (CONS |hd| |tl|))))
+        ((AND (SYMBOLP |t|) (SETQ |p| (|assocSymbol| |t| |sl|)))
+         (CDR |p|))
+        (T |t|)))))
+
+(DEFUN |applySubst!| (|sl| |t|)
+  (PROG (|p| |tl| |hd|)
+    (RETURN
+      (COND
+        ((CONSP |t|) (SETQ |hd| (|applySubst!| |sl| (CAR |t|)))
+         (SETQ |tl| (|applySubst!| |sl| (CDR |t|))) (RPLACA |t| |hd|)
+         (RPLACD |t| |tl|))
+        ((AND (SYMBOLP |t|) (SETQ |p| (|assocSymbol| |t| |sl|)))
+         (CDR |p|))
         (T |t|)))))
 
 (DEFUN |setDifference| (|x| |y|)
@@ -189,3 +198,57 @@
                (SETQ |bfVar#1| (CDR |bfVar#1|))))
            (CDR |l|))))))
 
+(DEFUN |removeSymbol| (|l| |x|)
+  (PROG (|y| |LETTMP#1| |l'| |before|)
+    (RETURN
+      (PROGN
+        (SETQ |before| NIL)
+        (SETQ |l'| |l|)
+        (LOOP
+          (COND
+            ((NOT (CONSP |l'|)) (RETURN |l|))
+            (T (SETQ |LETTMP#1| |l'|) (SETQ |y| (CAR |LETTMP#1|))
+               (SETQ |l'| (CDR |LETTMP#1|))
+               (COND
+                 ((EQ |x| |y|)
+                  (RETURN (|append!| (|reverse!| |before|) |l'|)))
+                 (T (SETQ |before| (CONS |y| |before|)))))))))))
+
+(DEFUN |removeScalar| (|l| |x|)
+  (PROG (|y| |LETTMP#1| |l'| |before|)
+    (RETURN
+      (PROGN
+        (SETQ |before| NIL)
+        (SETQ |l'| |l|)
+        (LOOP
+          (COND
+            ((NOT (CONSP |l'|)) (RETURN |l|))
+            (T (SETQ |LETTMP#1| |l'|) (SETQ |y| (CAR |LETTMP#1|))
+               (SETQ |l'| (CDR |LETTMP#1|))
+               (COND
+                 ((EQL |x| |y|)
+                  (RETURN (|append!| (|reverse!| |before|) |l'|)))
+                 (T (SETQ |before| (CONS |y| |before|)))))))))))
+
+(DEFUN |removeValue| (|l| |x|)
+  (PROG (|y| |LETTMP#1| |l'| |before|)
+    (RETURN
+      (PROGN
+        (SETQ |before| NIL)
+        (SETQ |l'| |l|)
+        (LOOP
+          (COND
+            ((NOT (CONSP |l'|)) (RETURN |l|))
+            (T (SETQ |LETTMP#1| |l'|) (SETQ |y| (CAR |LETTMP#1|))
+               (SETQ |l'| (CDR |LETTMP#1|))
+               (COND
+                 ((EQUAL |x| |y|)
+                  (RETURN (|append!| (|reverse!| |before|) |l'|)))
+                 (T (SETQ |before| (CONS |y| |before|)))))))))))
+
+(DEFUN |remove| (|l| |x|)
+  (COND
+    ((SYMBOLP |x|) (|removeSymbol| |l| |x|))
+    ((OR (CHARACTERP |x|) (INTEGERP |x|)) (|removeScalar| |l| |x|))
+    (T (|removeValue| |l| |x|))))
+
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index e344dc63..16a81067 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -35,7 +35,7 @@ namespace BOOTTRAN
 module utility (objectMember?, symbolMember?, stringMember?,
   charMember?, scalarMember?, listMember?, reverse, reverse!,
   lastNode, append!, copyList, substitute, substitute!, setDifference,
-  applySubst)
+  applySubst, applySubst!,remove)
 
 --% membership operators
 
@@ -164,14 +164,21 @@ substitute(y,x,s) ==
   s
   
 applySubst(sl,t) ==
-  symbol? t =>
-    p := assocSymbol(t,sl) => rest p
-    t
   cons? t =>
     hd := applySubst(sl,first t)
     tl := applySubst(sl,rest t)
     sameObject?(hd,first t) and sameObject?(tl,rest t) => t
     [hd,:tl]
+  symbol? t and (p := assocSymbol(t,sl)) => rest p
+  t
+
+applySubst!(sl,t) ==
+  cons? t =>
+    hd := applySubst!(sl,first t)
+    tl := applySubst!(sl,rest t)
+    t.first := hd
+    t.rest := tl
+  symbol? t and (p := assocSymbol(t,sl)) => rest p
   t
 
 --% set operations
@@ -184,3 +191,37 @@ setDifference(x,y) ==
     p.rest := [a]
     p := rest p
   rest l
+
+--% removal
+
+removeSymbol(l,x) ==
+  before := nil
+  l' := l
+  repeat
+    not cons? l' => return l
+    [y,:l'] := l'
+    symbolEq?(x,y) => return append!(reverse! before,l')
+    before := [y,:before]
+
+removeScalar(l,x) ==
+  before := nil
+  l' := l
+  repeat
+    not cons? l' => return l
+    [y,:l'] := l'
+    scalarEq?(x,y) => return append!(reverse! before,l')
+    before := [y,:before]
+
+removeValue(l,x) ==
+  before := nil
+  l' := l
+  repeat
+    not cons? l' => return l
+    [y,:l'] := l'
+    valueEq?(x,y) => return append!(reverse! before,l')
+    before := [y,:before]
+
+remove(l,x) ==
+  symbol? x => removeSymbol(l,x)
+  char? x or integer? x => removeScalar(l,x)
+  removeValue(l,x)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index b766a79f..590aa4a8 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -739,16 +739,6 @@
          ((and (atom item) (not (arrayp item))) (member item sequence))
          (T (member item sequence :test #'equalp))))
 
-(defun |remove| (list item &optional (count 1))
-  (if (integerp count)
-      (remove item list :count count :test #'equalp)
-      (remove item list :test #'equalp)))
-
-(defun REMOVEQ (list item &optional (count 1))
-  (if (integerp count)
-      (remove item list :count count :test #'eq)
-      (remove item list :test #'eq)))
-
 ; 14.2 Accessing
 
 (defun |last| (x) (car (lastpair x)))
@@ -787,11 +777,6 @@
       (delete item list :count count :test #'equal)
       (delete item list :test #'equal)))
 
-(defun NREMOVEQ (list item &optional (count 1))
-  (if (integerp count)
-      (delete item list :count count )
-      (delete item list )))
-
 (defun EFFACE (item list) (delete item list :count 1 :test #'equal))
 
 ; 14.6 Miscellaneous