* boot/utility.boot (objectMember?): Don't rely non tail recursion

	removal. 
	(reverse): Define.
	* boot/tokens.boot: Don't rename reverse anymore.
	* boot/ast.boot: Generate reverse forms instead of REVERSE.

12 files changed, 73 insertions, 46 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 0e35daa0..e848b3e5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
 2011-04-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/utility.boot (objectMember?): Don't rely non tail recursion
+	removal. 
+	(reverse): Define.
+	* boot/tokens.boot: Don't rename reverse anymore.
+	* boot/ast.boot: Generate reverse forms instead of REVERSE.
+
+2011-04-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* boot/tokens.boot: Don't rename nreverse.
 	* boot/utility.boot (reverse!): Define.
 	* boot/parser.boot: Use reverse! instead of NREVERSE.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 8913772f..e58179a2 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -393,7 +393,7 @@ bf0COLLECT(y,itl) ==
  
 bf0APPEND(y,itl)==
   g := bfGenSymbol()
-  body := ['SETQ,g,['APPEND,['REVERSE,y],g]]
+  body := ['SETQ,g,['APPEND,['reverse,y],g]]
   extrait := [[[g],[nil],[],[],[],[['reverse!,g]]]]
   bfLp2(extrait,itl,body)
  
@@ -572,14 +572,14 @@ bfLET2(lhs,rhs) ==
     [:l1,:l2]
   lhs is ['APPEND,var1,var2] =>
     patrev := bfISReverse(var2,var1)
-    rev := ['REVERSE,rhs]
+    rev := ['reverse,rhs]
     g := makeSymbol strconc('"LETTMP#", toString $letGenVarCounter)
     $letGenVarCounter := $letGenVarCounter + 1
     l2 := bfLET2(patrev,g)
     if cons? l2 and atom first l2 then l2 := [l2,:nil]
     var1 = "DOT" => [['L%T,g,rev],:l2]
     last l2 is ['L%T, =var1, val1] =>
-      [['L%T,g,rev],:REVERSE rest REVERSE l2,
+      [['L%T,g,rev],:reverse rest reverse l2,
        bfLetForm(var1,['reverse!,val1])]
     [['L%T,g,rev],:l2,bfLetForm(var1,['reverse!,var1])]
   lhs is ["EQUAL",var1] => ['COND,[bfQ(var1,rhs),var1]]
@@ -602,7 +602,7 @@ bfLET(lhs,rhs) ==
  
 addCARorCDR(acc,expr) ==
   atom expr => [acc,expr]
-  acc = 'CAR and expr is ["REVERSE",:.] =>
+  acc = 'CAR and expr is ["reverse",:.] =>
       ["CAR",["LAST",:rest expr]]
  --   ['last,:rest expr]
   funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
@@ -676,7 +676,7 @@ bfIS1(lhs,rhs) ==
     patrev := bfISReverse(b,a)
     g := makeSymbol strconc('"ISTMP#",toString $isGenVarCounter)
     $isGenVarCounter := $isGenVarCounter + 1
-    rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],'T]]
+    rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['reverse,lhs]],'T]]
     l2 := bfIS1(g,patrev)
     if cons? l2 and atom first l2 then l2 := [l2,:nil]
     a = "DOT" => bfAND [rev,:l2]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 0f94abac..b903d432 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -516,7 +516,7 @@
       (PROGN
         (SETQ |g| (|bfGenSymbol|))
         (SETQ |body|
-              (LIST 'SETQ |g| (LIST 'APPEND (LIST 'REVERSE |y|) |g|)))
+              (LIST 'SETQ |g| (LIST 'APPEND (LIST '|reverse| |y|) |g|)))
         (SETQ |extrait|
               (LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
                           (LIST (LIST '|reverse!| |g|)))))
@@ -846,7 +846,7 @@
                        (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                             (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T))))))
          (SETQ |patrev| (|bfISReverse| |var2| |var1|))
-         (SETQ |rev| (LIST 'REVERSE |rhs|))
+         (SETQ |rev| (LIST '|reverse| |rhs|))
          (SETQ |g|
                (INTERN (CONCAT "LETTMP#"
                                (WRITE-TO-STRING |$letGenVarCounter|))))
@@ -872,7 +872,7 @@
                                    (SETQ |val1| (CAR |ISTMP#3|))
                                    T)))))))
             (CONS (LIST 'L%T |g| |rev|)
-                  (APPEND (REVERSE (CDR (REVERSE |l2|)))
+                  (APPEND (|reverse| (CDR (|reverse| |l2|)))
                           (CONS (|bfLetForm| |var1|
                                     (LIST '|reverse!| |val1|))
                                 NIL))))
@@ -905,7 +905,7 @@
       (COND
         ((ATOM |expr|) (LIST |acc| |expr|))
         ((AND (EQ |acc| 'CAR) (CONSP |expr|)
-              (EQ (CAR |expr|) 'REVERSE))
+              (EQ (CAR |expr|) '|reverse|))
          (LIST 'CAR (CONS 'LAST (CDR |expr|))))
         (T (SETQ |funs|
                  '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
@@ -1066,7 +1066,7 @@
                (|bfAND| (LIST (LIST 'CONSP |lhs|)
                               (LIST 'PROGN
                                     (LIST 'L%T |g|
-                                     (LIST 'REVERSE |lhs|))
+                                     (LIST '|reverse| |lhs|))
                                     'T))))
          (SETQ |l2| (|bfIS1| |g| |patrev|))
          (COND
@@ -1222,7 +1222,7 @@
                         (PROGN (SETQ |c| (CAR |bfVar#97|)) NIL))
                     (RETURN (|reverse!| |bfVar#98|)))
                    (T (SETQ |bfVar#98|
-                            (APPEND (REVERSE (|bfFlatten| 'OR |c|))
+                            (APPEND (|reverse| (|bfFlatten| 'OR |c|))
                                     |bfVar#98|))))
                  (SETQ |bfVar#97| (CDR |bfVar#97|))))))))
 
@@ -1238,7 +1238,7 @@
                         (PROGN (SETQ |c| (CAR |bfVar#99|)) NIL))
                     (RETURN (|reverse!| |bfVar#100|)))
                    (T (SETQ |bfVar#100|
-                            (APPEND (REVERSE (|bfFlatten| 'AND |c|))
+                            (APPEND (|reverse| (|bfFlatten| 'AND |c|))
                                     |bfVar#100|))))
                  (SETQ |bfVar#99| (CDR |bfVar#99|))))))))
 
@@ -1345,7 +1345,7 @@
                          (PROGN (SETQ |d| (CAR |bfVar#107|)) NIL))
                      (RETURN (|reverse!| |bfVar#108|)))
                     (T (SETQ |bfVar#108|
-                             (APPEND (REVERSE
+                             (APPEND (|reverse|
                                       (|shoeComps| (|bfDef1| |d|)))
                                      |bfVar#108|))))
                   (SETQ |bfVar#107| (CDR |bfVar#107|)))))))))
@@ -1425,7 +1425,7 @@
                           (PROGN (SETQ |d| (CAR |bfVar#110|)) NIL))
                       (RETURN (|reverse!| |bfVar#111|)))
                      (T (SETQ |bfVar#111|
-                              (APPEND (REVERSE
+                              (APPEND (|reverse|
                                        (|shoeComps| (|bfDef1| |d|)))
                                       |bfVar#111|))))
                    (SETQ |bfVar#110| (CDR |bfVar#110|))))))))))
@@ -1600,7 +1600,7 @@
     (RETURN
       (COND
         ((NULL |b|) (LIST (LIST 'PROG |v|)))
-        (T (SETQ |LETTMP#1| (REVERSE |b|))
+        (T (SETQ |LETTMP#1| (|reverse| |b|))
            (SETQ |blast| (CAR |LETTMP#1|))
            (SETQ |blist| (|reverse!| (CDR |LETTMP#1|)))
            (LIST (CONS 'PROG
@@ -1810,7 +1810,7 @@
                   (COND
                     ((ATOM |c|) (RETURN (|reverse!| |bfVar#119|)))
                     (T (SETQ |bfVar#119|
-                             (APPEND (REVERSE (|bfFlattenSeq| |c|))
+                             (APPEND (|reverse| (|bfFlattenSeq| |c|))
                                      |bfVar#119|))))
                   (SETQ |c| (CDR |c|)))))
         (COND
@@ -1860,7 +1860,7 @@
               (PROGN
                 (SETQ |ISTMP#1| (CDR |a|))
                 (AND (CONSP |ISTMP#1|)
-                     (PROGN (SETQ |ISTMP#2| (REVERSE |ISTMP#1|)) T)
+                     (PROGN (SETQ |ISTMP#2| (|reverse| |ISTMP#1|)) T)
                      (CONSP |ISTMP#2|)
                      (PROGN
                        (SETQ |ISTMP#3| (CAR |ISTMP#2|))
@@ -2225,7 +2225,8 @@
       (PROGN
         (SETQ |g| (GENSYM))
         (COND
-          ((AND (CONSP |cs|) (PROGN (SETQ |ISTMP#1| (REVERSE |cs|)) T)
+          ((AND (CONSP |cs|)
+                (PROGN (SETQ |ISTMP#1| (|reverse| |cs|)) T)
                 (CONSP |ISTMP#1|)
                 (PROGN
                   (SETQ |f| (CAR |ISTMP#1|))
@@ -2650,7 +2651,7 @@
                          (CONS (|nativeArgumentType| |x|) |argtypes|))
                    (SETQ |args| (CONS (GENSYM) |args|)))))
             (SETQ |bfVar#146| (CDR |bfVar#146|))))
-        (SETQ |args| (REVERSE |args|))
+        (SETQ |args| (|reverse| |args|))
         (SETQ |rettype| (|nativeReturnType| |t|))
         (LIST (LIST 'DEFUN |op| |args|
                     (LIST (|bfColonColon| 'FFI 'C-INLINE) |args|
@@ -3103,7 +3104,7 @@
                                         (T
                                          (SETQ |bfVar#187|
                                           (APPEND
-                                           (REVERSE
+                                           (|reverse|
                                             (LIST |x|
                                              (COND
                                                ((SETQ |p'|
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index c4c075ce..9f1694f6 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -236,9 +236,9 @@
                   (LIST '|readLispFromString| 'READ-FROM-STRING)
                   (LIST '|readOnly?| 'CONSTANTP)
                   (LIST '|removeDuplicates| 'REMDUP)
-                  (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
-                  (LIST '|sameObject?| 'EQ) (LIST '|scalarEq?| 'EQL)
-                  (LIST '|scalarEqual?| 'EQL) (LIST '|second| 'CADR)
+                  (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ)
+                  (LIST '|scalarEq?| 'EQL) (LIST '|scalarEqual?| 'EQL)
+                  (LIST '|second| 'CADR)
                   (LIST '|setDifference| 'SETDIFFERENCE)
                   (LIST '|setIntersection| 'INTERSECTION)
                   (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 60df1f22..9b394a17 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -6,13 +6,15 @@
 (PROVIDE "utility")
 
 (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
-             |scalarMember?| |listMember?| |reverse!|))
+             |scalarMember?| |listMember?| |reverse| |reverse!|))
 
 (DEFUN |objectMember?| (|x| |l|)
-  (COND
-    ((CONSP |l|)
-     (OR (EQ |x| (CAR |l|)) (|objectMember?| |x| (CDR |l|))))
-    (T (EQ |x| |l|))))
+  (LOOP
+    (COND
+      ((NULL |l|) (RETURN NIL))
+      ((CONSP |l|)
+       (COND ((EQ |x| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|)))))
+      (T (RETURN (EQ |x| |l|))))))
 
 (DEFUN |symbolMember?| (|s| |l|)
   (LOOP
@@ -62,6 +64,17 @@
          (T (SETQ |l| (CDR |l|)))))
       (T (RETURN (EQUAL |x| |l|))))))
 
+(DEFUN |reverse| (|l|)
+  (PROG (|r|)
+    (RETURN
+      (PROGN
+        (SETQ |r| NIL)
+        (LOOP
+          (COND
+            ((CONSP |l|) (SETQ |r| (CONS (CAR |l|) |r|))
+             (SETQ |l| (CDR |l|)))
+            (T (RETURN |r|))))))))
+
 (DEFUN |reverse!| (|l|)
   (PROG (|l2| |l1|)
     (RETURN
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index fb94ff87..8f291306 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -296,7 +296,6 @@ for i in [ _
   ["readOnly?","CONSTANTP"], _
   ["removeDuplicates", "REMDUP"]  , _
   ["rest",         "CDR"]  , _
-  ["reverse",  "REVERSE"]  , _
   ["sameObject?",  "EQ" ] , _
   ["scalarEq?",   "EQL" ] , _
   ["scalarEqual?","EQL" ] , _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 0ce3362a..a7545688 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -33,13 +33,18 @@
 import initial_-env
 namespace BOOTTRAN
 module utility (objectMember?, symbolMember?, stringMember?,
-  charMember?, scalarMember?, listMember?, reverse!)
+  charMember?, scalarMember?, listMember?, reverse, reverse!)
 
 --% membership operators
 
 objectMember?(x,l) ==
-  cons? l => sameObject?(x,first l) or objectMember?(x,rest l)
-  sameObject?(x,l)
+  repeat
+    l = nil => return false
+    cons? l =>
+      sameObject?(x,first l) => return true
+      l := rest l
+    return sameObject?(x,l)
+
 
 symbolMember?(s,l) ==
   repeat
@@ -83,6 +88,14 @@ listMember?(x,l) ==
 
 --% list reversal
 
+reverse l ==
+  r := nil
+  repeat
+    cons? l =>
+      r := [first l,:r]
+      l := rest l
+    return r
+
 reverse! l ==
   l1 := nil
   repeat
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index c38f8c8e..71098c9c 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -1014,7 +1014,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
                            (PRIN1 /CALLER CURSTRM)))
                   (MONITOR-PRINARGS
                     (if (SPADSYSNAMEP NAME)
-                        (|reverse!| (REVERSE  (|coerceTraceArgs2E|
+                        (|reverse!| (|reverse|  (|coerceTraceArgs2E|
                                               (INTERN NAME1)
                                               (INTERN NAME)
                                               /ARGS)))
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 0fbb0f33..e5d07fe2 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -562,7 +562,7 @@ for x in [
     ['%lempty?,   :'NULL],
     ['%lfirst,    :'CAR],
     ['%llength,   :'LIST_-LENGTH],
-    ['%lreverse,  :'REVERSE],
+    ['%lreverse,  :'reverse],
     ['%lreverse!, :'reverse!],
     ['%lsecond,   :'CADR],
     ['%lthird,    :'CADDR],
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index 586bca51..1285de92 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -209,7 +209,7 @@
 ;; NCBLOCK is the current comment block
 (DEFUN FINCOMBLOCK (NUM OLDNUMS OLDLOCS NCBLOCK linelist)
   (PUSH
-    (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (REVERSE (CDR NCBLOCK))))
+    (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (|reverse| (CDR NCBLOCK))))
               ;; comment for constructor itself paired with 1st line -1
           ('T
            (COND ($EchoLineStack
@@ -225,7 +225,7 @@
                 (if (and (numberp (car olocs))
                          (<= (car olocs) sloc))
                     (return (car onums))))
-            (REVERSE (CDR NCBLOCK)))))
+            (|reverse| (CDR NCBLOCK)))))
     $COMBLOCKLIST))
  
 (defun PARSEPRINT (L)
@@ -342,7 +342,7 @@
 ;;                    LINE)))))
  
 (defun PREPARSE-ECHO (linelist)
-  (if |$Echo| (REPEAT (IN X (REVERSE $EchoLineStack))
+  (if |$Echo| (REPEAT (IN X (|reverse| $EchoLineStack))
                         (format out-stream "~&;~A~%" X)))
   (setq $EchoLineStack ()))
  
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index cda2479d..33e18eb3 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -977,7 +977,7 @@
 			(LIST 'THETACHECK G (MKQ G)(MKQ OP)))
 		       (G) ))
 	   (COND ((EQ OP 'CONS)
-		  (SETQ EXIT (LIST 'NREVERSE0 EXIT))))
+		  (SETQ EXIT (LIST '|reverse!| EXIT))))
 	   ;; CONSCODE= code which conses a member onto the list
 	   (SETQ VALUE 
 		 (COND ((EQ Y 'NO_THETA_PROPERTY)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 3023a662..b5eeb762 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -216,13 +216,6 @@
 
 (defmacro ne (a b) `(not (equal ,a ,b)))
 
-(defmacro nreverse0 (x)
-  (if (atom x)
-      `(if (atom ,x) ,x (|reverse!| ,x))
-    (let ((xx (gensym)))
-      `(let ((,xx ,x))
-         (if (atom ,xx) ,xx (|reverse!| ,xx))))))
-
 (defmacro nump (n)
  `(numberp ,n))
 
@@ -406,7 +399,7 @@
   `(,(dcqexp pattern '=) ,exp))
 
 (defmacro seq (&rest form)
-  (let* ((body (reverse form))
+  (let* ((body (|reverse| form))
          (val `(return-from seq ,(pop body))))
     (nsubstitute '(progn) nil body) ;don't treat NIL as a label
     `(block seq (tagbody ,@(|reverse!| body) ,val))))