* interp/newfort.boot: Likewise.

	* interp/define.boot (orderBySubsumption): Fix thinko.
	* interp/boot-pkg.lisp: Use BOOTTRAN package.  Don't import names
	individually.
	* boot/utility.boot: New.
	* boot/translator.boot (exportNames): Fix thinko.
	* boot/tokens.boot: Add charEq? and scalarEq? builtiin functions.
	* boot/ast.boot (bfMember): Generate call to symbolMember? for
	membership tests for symbols.

6 files changed, 77 insertions, 20 deletions

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 7b10b10b..b2659f15 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -180,7 +180,8 @@
 
 (DEFUN |bfColonColon| (|package| |name|)
   (COND
-    ((AND (|%hasFeature| :CLISP) (MEMQ |package| '(EXT FFI)))
+    ((AND (|%hasFeature| :CLISP)
+          (|symbolMember?| |package| '(EXT FFI)))
      (FIND-SYMBOL (PNAME |name|) |package|))
     (T (INTERN (PNAME |name|) |package|))))
 
@@ -1127,7 +1128,7 @@
              (|sequence?| |seq| #'INTEGERP))
          (LIST 'MEMBER |var| |seq| :TEST (LIST 'FUNCTION 'EQL)))
         ((OR (|defQuoteId| |var|) (|sequence?| |seq| #'SYMBOLP))
-         (LIST 'MEMQ |var| |seq|))
+         (LIST '|symbolMember?| |var| |seq|))
         ((OR (STRINGP |var|) (|sequence?| |seq| #'STRINGP))
          (LIST 'MEMBER |var| |seq| :TEST (LIST 'FUNCTION 'STRING=)))
         (T (LIST 'MEMBER |var| |seq|))))))
@@ -1205,17 +1206,20 @@
 
 (DEFUN |bfChar?| (|x|)
   (OR (CHARACTERP |x|)
-      (AND (CONSP |x|) (MEMQ (CAR |x|) '(|char| CODE-CHAR SCHAR)))))
+      (AND (CONSP |x|)
+           (|symbolMember?| (CAR |x|) '(|char| CODE-CHAR SCHAR)))))
 
 (DEFUN |bfSmintable| (|x|)
   (OR (INTEGERP |x|)
       (AND (CONSP |x|)
-           (MEMQ (CAR |x|) '(SIZE LENGTH CHAR-CODE MAXINDEX + -)))))
+           (|symbolMember?| (CAR |x|)
+               '(SIZE LENGTH CHAR-CODE MAXINDEX + -)))))
 
 (DEFUN |bfString?| (|x|)
   (OR (STRINGP |x|)
       (AND (CONSP |x|)
-           (MEMQ (CAR |x|) '(STRING SYMBOL-NAME |subString|)))))
+           (|symbolMember?| (CAR |x|)
+               '(STRING SYMBOL-NAME |subString|)))))
 
 (DEFUN |bfQ| (|l| |r|)
   (COND
@@ -1533,8 +1537,10 @@
         ((ATOM |body|) NIL)
         (T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|))
            (COND
-             ((MEMQ |op| '(RETURN RETURN-FROM)) T)
-             ((MEMQ |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
+             ((|symbolMember?| |op| '(RETURN RETURN-FROM)) T)
+             ((|symbolMember?| |op|
+                  '(LET PROG LOOP BLOCK DECLARE LAMBDA))
+              NIL)
              ((LET ((|bfVar#115| NIL) (|bfVar#114| |body|) (|t| NIL))
                 (LOOP
                   (COND
@@ -1637,7 +1643,8 @@
                          (T (CONS (CADR |l|) |$fluidVars|))))
                  (RPLACA (CDR |x|) (CADR |l|)))))
              ((EQ U '|%Leave|) (RPLACA |x| 'RETURN))
-             ((MEMQ U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
+             ((|symbolMember?| U '(PROG LAMBDA))
+              (SETQ |newbindings| NIL)
               (LET ((|bfVar#116| (CADR |x|)) (|y| NIL))
                 (LOOP
                   (COND
@@ -2279,7 +2286,7 @@
                (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
                      'BASE-CHAR))
               (T |t'|)))
-           ((MEMQ |t| '(|byte| |uint8|))
+           ((|symbolMember?| |t| '(|byte| |uint8|))
             (COND
               ((|%hasFeature| :SBCL)
                (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 8))
@@ -2383,10 +2390,11 @@
         (T (SETQ |m| (CAR |t|)) (SETQ |c| (CAADR . #0=(|t|)))
            (SETQ |t'| (CADADR . #0#))
            (COND
-             ((NOT (MEMQ |m| '(|readonly| |writeonly| |readwrite|)))
+             ((NOT (|symbolMember?| |m|
+                       '(|readonly| |writeonly| |readwrite|)))
               (|coreError|
                   "missing modifier for argument type for a native function"))
-             ((NOT (MEMQ |c| '(|buffer| |pointer|)))
+             ((NOT (|symbolMember?| |c| '(|buffer| |pointer|)))
               (|coreError|
                   "expected 'buffer' or 'pointer' type instance"))
              ((NOT (MEMBER |t'| |$NativeSimpleDataTypes|))
@@ -2397,7 +2405,7 @@
   (PROG (|m|)
     (RETURN
       (AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) T)
-           (MEMQ |m| '(|readonly| |writeonly| |readwrite|))))))
+           (|symbolMember?| |m| '(|readonly| |writeonly| |readwrite|))))))
 
 (DEFUN |coerceToNativeType| (|a| |t|)
   (PROG (|y| |c|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 89cb3dee..afed4d9f 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -426,8 +426,8 @@
 (DEFUN |bpConstTok| ()
   (DECLARE (SPECIAL |$ttok| |$stok|))
   (COND
-    ((MEMQ (|shoeTokType| |$stok|) '(INTEGER FLOAT)) (|bpPush| |$ttok|)
-     (|bpNext|))
+    ((|symbolMember?| (|shoeTokType| |$stok|) '(INTEGER FLOAT))
+     (|bpPush| |$ttok|) (|bpNext|))
     ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISP))
      (AND (|bpPush| (|%Lisp| |$ttok|)) (|bpNext|)))
     ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISPEXP))
@@ -576,7 +576,8 @@
                (|bpTrap|))
            (|bpPush| (- |$ttok|)) (|bpNext|))
       (|bpSexpKey|)
-      (AND (MEMQ (|shoeTokType| |$stok|) '(ID INTEGER STRING FLOAT))
+      (AND (|symbolMember?| (|shoeTokType| |$stok|)
+               '(ID INTEGER STRING FLOAT))
            (|bpPush| |$ttok|) (|bpNext|))))
 
 (DEFUN |bpSexp| ()
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 4f17e690..a76f3a3f 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -140,7 +140,8 @@
            (T (|shoeAccumulateLines| |$r| |string|))))
         (T (CONS |s| |string|))))))
 
-(DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
+(DEFUN |shoeCloser| (|t|)
+  (|symbolMember?| (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
 
 (DEFUN |shoeToken| ()
   (PROG (|b| |ch| |n| |linepos|)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index ef543a5b..15fdfa25 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -207,7 +207,7 @@
                   (LIST '|canonicalFilename| 'PROBE-FILE)
                   (LIST '|charByName| 'NAME-CHAR)
                   (LIST '|charString| 'STRING)
-                  (LIST '|char?| 'CHARACTERP)
+                  (LIST '|char?| 'CHARACTERP) (LIST '|charEq?| 'CHAR=)
                   (LIST '|codePoint| 'CHAR-CODE) (LIST '|cons?| 'CONSP)
                   (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK)
                   (LIST '|digit?| 'DIGIT-CHAR-P) (LIST '|drop| 'DROP)
@@ -234,13 +234,14 @@
                   (LIST '|readOnly?| 'CONSTANTP)
                   (LIST '|removeDuplicates| 'REMDUP)
                   (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
-                  (LIST '|sameObject?| 'EQ) (LIST '|scalarEqual?| 'EQL)
-                  (LIST '|second| 'CADR)
+                  (LIST '|sameObject?| 'EQ) (LIST '|scalarEq?| 'EQL)
+                  (LIST '|scalarEqual?| 'EQL) (LIST '|second| 'CADR)
                   (LIST '|setDifference| 'SETDIFFERENCE)
                   (LIST '|setIntersection| 'INTERSECTION)
                   (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION)
                   (LIST '|strconc| 'CONCAT) (LIST '|stringChar| 'SCHAR)
                   (LIST '|string?| 'STRINGP)
+                  (LIST '|stringEq?| 'STRING=)
                   (LIST '|subSequence| 'SUBSEQ)
                   (LIST '|substitute| 'SUBST)
                   (LIST '|substitute!| 'NSUBST)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 0a0c8ee2..f7dbcb13 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -582,7 +582,9 @@
           (T (|shoeEVALANDFILEACTQ| |expr'|)))))))
 
 (DEFUN |exportNames| (|ns|)
-  (COND ((NULL |ns|) NIL) (T (LIST (CONS 'EXPORT |ns|)))))
+  (COND
+    ((NULL |ns|) NIL)
+    (T (LIST (LIST 'EXPORT (LIST 'QUOTE |ns|))))))
 
 (DEFUN |translateToplevel| (|b| |export?|)
   (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |xs|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
new file mode 100644
index 00000000..efb7cf0e
--- /dev/null
+++ b/src/boot/strap/utility.clisp
@@ -0,0 +1,44 @@
+(PROCLAIM '(OPTIMIZE SPEED))
+(IMPORT-MODULE "initial-env")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(PROVIDE "utility")
+
+(EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
+             |scalarMember?|))
+
+(DEFUN |objectMember?| (|x| |l|)
+  (COND
+    ((CONSP |l|)
+     (OR (EQ |x| (CAR |l|)) (|objectMember?| |x| (CDR |l|))))
+    (T (EQ |x| |l|))))
+
+(DEFUN |symbolMember?| (|x| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (EQ |x| (CAR |l|)) (|symbolMember?| |x| (CDR |l|))))
+    (T (EQ |x| |l|))))
+
+(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?| (|x| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (CHAR= |x| (CAR |l|)) (|charMember?| |x| (CDR |l|))))
+    (T (CHAR= |x| |l|))))
+
+(DEFUN |scalarMember?| (|x| |l|)
+  (COND
+    ((NULL |l|) NIL)
+    ((CONSP |l|)
+     (OR (EQL |x| (CAR |l|)) (|scalarMember?| |x| (CDR |l|))))
+    (T (EQL |x| |l|))))
+