* 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.

11 files changed, 149 insertions, 24 deletions

diff --git a/src/boot/Makefile.in b/src/boot/Makefile.in
index c7557598..c223c0b4 100644
--- a/src/boot/Makefile.in
+++ b/src/boot/Makefile.in
@@ -1,6 +1,6 @@
 ## Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ## All rights reserved.
-## Copyright (C) 2007-2010, Gabriel Dos Reis.
+## Copyright (C) 2007-2011, Gabriel Dos Reis.
 ## All rights reserved.
 ##
 ## Redistribution and use in source and binary forms, with or without
@@ -54,7 +54,7 @@ AXIOM_LOCAL_LISP = ../lisp/lisp$(EXEEXT)
 
 ## FASLs that comprises `bootsys'
 boot_SOURCES = initial-env.lisp $(boot_sources)
-boot_sources = tokens.boot includer.boot scanner.boot \
+boot_sources = utility.boot tokens.boot includer.boot scanner.boot \
 	pile.boot ast.boot parser.boot  translator.boot
 boot_clisp = $(boot_sources:.boot=.clisp)
 boot_objects = initial-env.$(LNKEXT) $(boot_sources:.boot=.$(LNKEXT))
@@ -190,6 +190,9 @@ stage2/%.clisp: %.boot stage1/stamp stage2/.started
 %/initial-env.$(LNKEXT): initial-env.lisp %/.started
 	$(DRIVER) --execpath=$(AXIOM_LOCAL_LISP) --compile --output=$@ $<
 
+%/utility.$(LNKEXT): %/utility.clisp %/initial-env.$(LNKEXT)
+	$(DRIVER) --execpath=$(AXIOM_LOCAL_LISP) --output=$@ --compile --load-directory=$* $<
+
 %/tokens.$(LNKEXT): %/tokens.clisp %/initial-env.$(LNKEXT)
 	$(DRIVER) --execpath=$(AXIOM_LOCAL_LISP) --output=$@ --compile --load-directory=$* $<
 
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index ec973521..e9272af2 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -703,7 +703,7 @@ bfMember(var,seq) ==
   integer? var or var is ["char",.] or sequence?(seq,function integer?) =>
     ["MEMBER",var,seq,KEYWORD::TEST, ["FUNCTION", "EQL"]]
   defQuoteId var or sequence?(seq,function symbol?) =>
-    ["MEMQ",var,seq]
+    ["symbolMember?",var,seq]
   string? var or sequence?(seq,function string?) =>
     ["MEMBER",var,seq,KEYWORD::TEST,["FUNCTION", "STRING="]]
   ["MEMBER",var,seq]
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|))))
+
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index e01e8d6d..95011b4a 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -253,6 +253,7 @@ for i in [ _
   ["charByName", "NAME-CHAR"] , _
   ["charString", "STRING"] , _
   ["char?", "CHARACTERP"]  , _
+  ["charEq?",   "CHAR=" ], _
   ["codePoint", "CHAR-CODE"], _
   ["cons?",      "CONSP"]  , _
   ["copy",        "COPY"]  , _
@@ -295,6 +296,7 @@ for i in [ _
   ["rest",         "CDR"]  , _
   ["reverse",  "REVERSE"]  , _
   ["sameObject?",  "EQ" ] , _
+  ["scalarEq?",   "EQL" ] , _
   ["scalarEqual?","EQL" ] , _
   ["second",      "CADR"] , _
   ["setDifference", "SETDIFFERENCE"]  , _
@@ -304,6 +306,7 @@ for i in [ _
   ["strconc",  "CONCAT"]  , _
   ["stringChar", "SCHAR"] , _
   ["string?",  "STRINGP"]  ,_
+  ["stringEq?","STRING="] , _
   ["subSequence", "SUBSEQ"] , _
   ["substitute",  "SUBST"]  , _
   ["substitute!", "NSUBST"]  , _
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index fb0d750f..ef5cff04 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -405,7 +405,7 @@ translateToplevelExpression expr ==
 
 exportNames ns ==
   ns = nil => nil
-  [["EXPORT",:ns]]
+  [["EXPORT",["QUOTE",ns]]]
 
 translateToplevel(b,export?) ==
   atom b => [b]  -- generally happens in interactive mode.
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
new file mode 100644
index 00000000..39747fd5
--- /dev/null
+++ b/src/boot/utility.boot
@@ -0,0 +1,62 @@
+-- Copyright (C) 2011, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical Algorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+import initial_-env
+namespace BOOTTRAN
+module utility (objectMember?, symbolMember?, stringMember?,
+  charMember?, scalarMember?)
+
+objectMember?(x,l) ==
+  cons? l => sameObject?(x,first l) or objectMember?(x,rest l)
+  sameObject?(x,l)
+
+symbolMember?(x,l) ==
+  l = nil => false
+  cons? l => sameObject?(x,first l) or symbolMember?(x,rest l)
+  sameObject?(x,l)
+
+stringMember?(s,l) ==
+  l = nil => false
+  cons? l => stringEq?(s,first l) or stringMember?(s,rest l)
+  stringEq?(s,l)
+
+charMember?(x,l) ==
+  l = nil => false
+  cons? l => charEq?(x,first l) or charMember?(x,rest l)
+  charEq?(x,l)
+
+scalarMember?(x,l) ==
+  l = nil => false
+  cons? l => scalarEq?(x,first l) or scalarMember?(x,rest l)
+  scalarEq?(x,l)
+
+