more cleanup

5 files changed, 48 insertions, 23 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 961cad8f..719d583d 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -359,15 +359,18 @@ bfReduce(op,y)==
  
 bfReduceCollect(op,y)==
   y is ["COLLECT",:.] => 
-    body := y.1
-    itl := y.2
+    body := second y
+    itl := third y
     a :=
       op is ["QUOTE",:.] => second op
       op
     op := bfReName a
     init := a has SHOETHETA or op has SHOETHETA
     bfOpReduce(op,init,body,itl)
-  bfReduce(op,bfTupleConstruct (y.1))
+  seq :=
+    y = nil => bfTuple nil
+    second y
+  bfReduce(op,bfTupleConstruct seq)
  
 -- delayed collect
  
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index eeb147ac..7bf4bef4 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -691,6 +691,8 @@ bpCompare()==
      and (bpIs() or bpTrap())
 	and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
 	    or true)
+              or bpLeave()
+                or bpThrow()
  
 bpAnd() == 
   bpLeftAssoc('(AND),function bpCompare)
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 4ba335aa..b1e8ab77 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -472,11 +472,11 @@
              (|bfLp| |it| |body|)))))))
 
 (DEFUN |bfReduceCollect| (|op| |y|)
-  (PROG (|init| |a| |itl| |body|)
+  (PROG (|seq| |init| |a| |itl| |body|)
     (RETURN
       (COND
         ((AND (CONSP |y|) (EQ (CAR |y|) 'COLLECT))
-         (SETQ |body| (ELT |y| 1)) (SETQ |itl| (ELT |y| 2))
+         (SETQ |body| (CADR |y|)) (SETQ |itl| (CADDR |y|))
          (SETQ |a|
                (COND
                  ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE))
@@ -485,7 +485,9 @@
          (SETQ |op| (|bfReName| |a|))
          (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
          (|bfOpReduce| |op| |init| |body| |itl|))
-        (T (|bfReduce| |op| (|bfTupleConstruct| (ELT |y| 1))))))))
+        (T (SETQ |seq|
+                 (COND ((NULL |y|) (|bfTuple| NIL)) (T (CADR |y|))))
+           (|bfReduce| |op| (|bfTupleConstruct| |seq|)))))))
 
 (DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|))
 
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index afed4d9f..b3ef4b0e 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -747,13 +747,14 @@
   (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|)))))
 
 (DEFUN |bpCompare| ()
-  (AND (|bpIs|)
-       (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN))
-                (OR (|bpIs|) (|bpTrap|))
-                (|bpPush|
-                    (|bfInfApplication| (|bpPop2|) (|bpPop2|)
-                        (|bpPop1|))))
-           T)))
+  (OR (AND (|bpIs|)
+           (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN))
+                    (OR (|bpIs|) (|bpTrap|))
+                    (|bpPush|
+                        (|bfInfApplication| (|bpPop2|) (|bpPop2|)
+                            (|bpPop1|))))
+               T))
+      (|bpLeave|) (|bpThrow|)))
 
 (DEFUN |bpAnd| () (|bpLeftAssoc| '(AND) #'|bpCompare|))
 
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index e52d92ea..c1799071 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -14,21 +14,38 @@
      (OR (EQ |x| (CAR |l|)) (|objectMember?| |x| (CDR |l|))))
     (T (EQ |x| |l|))))
 
-(DEFUN |genericMember?| (|x| |l| |p|)
+(DEFUN |symbolMember?| (|s| |l|)
   (COND
     ((NULL |l|) NIL)
     ((CONSP |l|)
-     (OR (APPLY |p| |x| (CAR |l|) NIL)
-         (|genericMember?| |x| (CDR |l|) |p|)))
-    (T (APPLY |p| |x| |l| NIL))))
+     (OR (EQ |s| (CAR |l|)) (|symbolMember?| |s| (CDR |l|))))
+    (T (EQ |s| |l|))))
 
-(DEFUN |symbolMember?| (|x| |l|) (|genericMember?| |x| |l| #'EQ))
-
-(DEFUN |stringMember?| (|s| |l|) (|genericMember?| |s| |l| #'STRING=))
+(DEFUN |stringMember?| (|s| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (STRING= |s| (CAR |l|)) (|stringMember?| |s| (CDR |l|))))
+    (T (STRING= |s| |l|))))
 
-(DEFUN |charMember?| (|c| |l|) (|genericMember?| |c| |l| #'CHAR=))
+(DEFUN |charMember?| (|c| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (CHAR= |c| (CAR |l|)) (|charMember?| |c| (CDR |l|))))
+    (T (CHAR= |c| |l|))))
 
-(DEFUN |scalarMember?| (|x| |l|) (|genericMember?| |x| |l| #'EQL))
+(DEFUN |scalarMember?| (|x| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (EQL |x| (CAR |l|)) (|scalarMember?| |x| (CDR |l|))))
+    (T (CHAR= |x| |l|))))
 
-(DEFUN |listMember?| (|x| |l|) (|genericMember?| |x| |l| #'EQUAL))
+(DEFUN |listMember?| (|x| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (EQUAL |x| (CAR |l|)) (|listMember?| |x| (CDR |l|))))
+    (T (EQUAL |x| |l|))))