* interp/sys-utility.boot (substitute): Define.

	(substitute!): Likewise.
	* boot/utility.boot: Do not rely on tail recursion removal.
	* boot/tokens.boot: Don't translate substitute and substitute!.
	* boot/ast.boot (bfLp1): Tidy.

9 files changed, 110 insertions, 52 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index ea46d38b..45d82a45 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2011-04-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/sys-utility.boot (substitute): Define.
+	(substitute!): Likewise.
+	* boot/utility.boot: Do not rely on tail recursion removal.
+	* boot/tokens.boot: Don't translate substitute and substitute!.
+	* boot/ast.boot (bfLp1): Tidy.
+
 2011-04-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/tokens.boot: charUpcase, charDowncase, stringUpcase,
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 719d583d..3e0fdc5d 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -411,7 +411,9 @@ bfLp1(iters,body)==
   value :=
     value = nil => "NIL"
     first value
-  exits := ["COND",[bfOR exits,["RETURN",value]],['T,nbody]]
+  exits :=
+    exits = nil => nbody
+    ["COND",[bfOR exits,["RETURN",value]],['T,nbody]]
   loop := ["LOOP",exits,:sucs]
   if vars then loop := 
     ["LET",[[v, i] for v in vars for i in inits], loop]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index b1e8ab77..95ca0d0d 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -551,9 +551,11 @@
                 (T (|bfAND| (APPEND |filters| (CONS |body| NIL))))))
         (SETQ |value| (COND ((NULL |value|) 'NIL) (T (CAR |value|))))
         (SETQ |exits|
-              (LIST 'COND
-                    (LIST (|bfOR| |exits|) (LIST 'RETURN |value|))
-                    (LIST 'T |nbody|)))
+              (COND
+                ((NULL |exits|) |nbody|)
+                (T (LIST 'COND
+                         (LIST (|bfOR| |exits|) (LIST 'RETURN |value|))
+                         (LIST 'T |nbody|)))))
         (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|)))
         (COND
           (|vars| (SETQ |loop|
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 7a032a5f..7ec5fb63 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -248,9 +248,7 @@
                   (LIST '|string?| 'STRINGP)
                   (LIST '|stringEq?| 'STRING=)
                   (LIST '|stringUpcase| 'STRING-UPCASE)
-                  (LIST '|subSequence| 'SUBSEQ)
-                  (LIST '|substitute| 'SUBST)
-                  (LIST '|substitute!| 'NSUBST) (LIST '|symbolEq?| 'EQ)
+                  (LIST '|subSequence| 'SUBSEQ) (LIST '|symbolEq?| 'EQ)
                   (LIST '|symbolFunction| 'SYMBOL-FUNCTION)
                   (LIST '|symbolName| 'SYMBOL-NAME)
                   (LIST '|symbolValue| 'SYMBOL-VALUE)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index c1799071..dac91a2b 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -15,37 +15,50 @@
     (T (EQ |x| |l|))))
 
 (DEFUN |symbolMember?| (|s| |l|)
-  (COND
-    ((NULL |l|) NIL)
-    ((CONSP |l|)
-     (OR (EQ |s| (CAR |l|)) (|symbolMember?| |s| (CDR |l|))))
-    (T (EQ |s| |l|))))
+  (LOOP
+    (COND
+      ((NULL |l|) (RETURN NIL))
+      ((CONSP |l|)
+       (COND ((EQ |s| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|)))))
+      (T (RETURN (EQ |s| |l|))))))
 
 (DEFUN |stringMember?| (|s| |l|)
-  (COND
-    ((NULL |l|) NIL)
-    ((CONSP |l|)
-     (OR (STRING= |s| (CAR |l|)) (|stringMember?| |s| (CDR |l|))))
-    (T (STRING= |s| |l|))))
+  (LOOP
+    (COND
+      ((NULL |l|) (RETURN NIL))
+      ((CONSP |l|)
+       (COND
+         ((STRING= |s| (CAR |l|)) (RETURN T))
+         (T (SETQ |l| (CDR |l|)))))
+      (T (RETURN (STRING= |s| |l|))))))
 
 (DEFUN |charMember?| (|c| |l|)
-  (COND
-    ((NULL |l|) NIL)
-    ((CONSP |l|)
-     (OR (CHAR= |c| (CAR |l|)) (|charMember?| |c| (CDR |l|))))
-    (T (CHAR= |c| |l|))))
+  (LOOP
+    (COND
+      ((NULL |l|) (RETURN NIL))
+      ((CONSP |l|)
+       (COND
+         ((CHAR= |c| (CAR |l|)) (RETURN T))
+         (T (SETQ |l| (CDR |l|)))))
+      (T (RETURN (CHAR= |c| |l|))))))
 
-(DEFUN |scalarMember?| (|x| |l|)
-  (COND
-    ((NULL |l|) NIL)
-    ((CONSP |l|)
-     (OR (EQL |x| (CAR |l|)) (|scalarMember?| |x| (CDR |l|))))
-    (T (CHAR= |x| |l|))))
+(DEFUN |scalarMember?| (|s| |l|)
+  (LOOP
+    (COND
+      ((NULL |l|) (RETURN NIL))
+      ((CONSP |l|)
+       (COND
+         ((EQL |s| (CAR |l|)) (RETURN T))
+         (T (SETQ |l| (CDR |l|)))))
+      (T (RETURN (EQL |s| |l|))))))
 
 (DEFUN |listMember?| (|x| |l|)
-  (COND
-    ((NULL |l|) NIL)
-    ((CONSP |l|)
-     (OR (EQUAL |x| (CAR |l|)) (|listMember?| |x| (CDR |l|))))
-    (T (EQUAL |x| |l|))))
+  (LOOP
+    (COND
+      ((NULL |l|) (RETURN NIL))
+      ((CONSP |l|)
+       (COND
+         ((EQUAL |x| (CAR |l|)) (RETURN T))
+         (T (SETQ |l| (CDR |l|)))))
+      (T (RETURN (EQUAL |x| |l|))))))
 
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index b12e5991..f87da75f 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -313,8 +313,6 @@ for i in [ _
   ["stringEq?","STRING="] , _
   ["stringUpcase", "STRING-UPCASE"] , _
   ["subSequence", "SUBSEQ"] , _
-  ["substitute",  "SUBST"]  , _
-  ["substitute!", "NSUBST"]  , _
   ["symbolEq?", "EQ"], _
   ["symbolFunction", "SYMBOL-FUNCTION"], _
   ["symbolName", "SYMBOL-NAME"], _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 6ee1e180..78e01a97 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -40,26 +40,41 @@ objectMember?(x,l) ==
   sameObject?(x,l)
 
 symbolMember?(s,l) ==
-  l = nil => false
-  cons? l => symbolEq?(s,first l) or symbolMember?(s,rest l)
-  symbolEq?(s,l)
+  repeat
+    l = nil => return false
+    cons? l =>
+      symbolEq?(s,first l) => return true
+      l := rest l
+    return symbolEq?(s,l)
 
 stringMember?(s,l) ==
-  l = nil => false
-  cons? l => stringEq?(s,first l) or stringMember?(s,rest l)
-  stringEq?(s,l)
+  repeat
+    l = nil => return false
+    cons? l =>
+      stringEq?(s,first l) => return true
+      l := rest l
+    return stringEq?(s,l)
 
 charMember?(c,l) ==
-  l = nil => false
-  cons? l => charEq?(c,first l) or charMember?(c,rest l)
-  charEq?(c,l)
+  repeat
+    l = nil => return false
+    cons? l =>
+      charEq?(c,first l) => return true
+      l := rest l
+    return charEq?(c,l)
 
-scalarMember?(x,l) ==
-  l = nil => false
-  cons? l => scalarEq?(x,first l) or scalarMember?(x,rest l)
-  charEq?(x,l)
+scalarMember?(s,l) ==
+  repeat
+    l = nil => return false
+    cons? l =>
+      scalarEq?(s,first l) => return true
+      l := rest l
+    return scalarEq?(s,l)
 
 listMember?(x,l) ==
-  l = nil => false
-  cons? l => listEq?(x,first l) or listMember?(x,rest l)
-  listEq?(x,l)
+  repeat
+    l = nil => return false
+    cons? l =>
+      listEq?(x,first l) => return true
+      l := rest l
+    return listEq?(x,l)
diff --git a/src/interp/as.boot b/src/interp/as.boot
index 7108d5a4..9bdaaf85 100644
--- a/src/interp/as.boot
+++ b/src/interp/as.boot
@@ -283,7 +283,7 @@ asGetModemaps(opAlist,oform,kind,modemap) ==
   for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat
     for [sig0, pred] in itemlist repeat
       sig := substitute(dc,"$",sig0)
-      pred:= subtitute(dc,"$",pred)
+      pred:= substitute(dc,"$",pred)
       sig := SUBLISLIS(rpvl,KDR oform,sig)
       pred:= SUBLISLIS(rpvl,KDR oform,pred)
       pred := pred or 'T
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index d047296e..6895926e 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -391,3 +391,25 @@ stringAssoc(s,l) ==
 symbolLassoc(s,l) ==
   p := symbolAssoc(s,l) => rest p
   nil
+
+
+--% substitute
+
+substitute(new,old,tree) ==
+  sameObject?(old,tree) => new
+  cons? tree =>
+    h := substitute(new,old,first tree)
+    t := substitute(new,old,rest tree)
+    sameObject?(h,first tree) and sameObject?(t,rest tree) => tree
+    [h,:t]
+  tree
+
+substitute!(new,old,tree) ==
+  sameObject?(old,tree) => new
+  cons? tree =>
+    h := substitute!(new,old,first tree)
+    t := substitute!(new,old,rest tree)
+    tree.first := h
+    tree.rest := t
+  tree
+