more cleanup

3 files changed, 40 insertions, 20 deletions

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|))))