* interp/sys-macros.lisp (MKPF1): Tidy.

	* interp/sys-constants.boot ($QueryVariables): New.
	* interp/define.boot ($whreDecls): Remove.
	(checkRepresentation): Take a DB as first parameter.  Adjust Callers.
	(buildConstructorCondition): New
	(deduceImplicitParameters): Likewise
	(compDefineCategory2): Use it.
	(compDefineFunctor1): Likewise.
	(typeDependencyPath): Remove.
	(inferConstructorImplicitParameters): Likewise.
	* interp/compiler.boot (compTopLevel): Do not bind $whereDecls.
	(recordDeclarationInSideCondition): Take additional reference
	parameter to the list of processed decls.  Adjust callers.
	(compWhere): Record any side decls in compilation environment.
	* interp/c-util.boot (makeCompilationData): Initialize implicit data.
	(dbParameters): New.
	(dbImplicitData): New accessor macro.
	(dbImplicitParameters): New.
	(dbImplicitConstraints): Likewise.
	(dbSubstituteFormals): Likewise.
	(dbSubstituteQueries): Likewise.
	* interp/database.boot (fixUpPredicate): Tidy.
	* boot/utility.boot (applySubst): Early exit on identity substitution.
	(applySubst!): Likewise.
	(applySubstNQ): Likewise.
	* boot/ast.boot (bfIS1): Accept pattern matching against Boolean
	constant true.

3 files changed, 50 insertions, 41 deletions

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 2842cf8a..f074ad0b 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1053,6 +1053,7 @@
          |d| |c| |a|)
     (RETURN
      (COND ((NULL |rhs|) (LIST 'NULL |lhs|))
+           ((EQ |rhs| T) (LIST 'EQ |lhs| |rhs|))
            ((|bfString?| |rhs|)
             (|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |rhs|))))
            ((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) (LIST 'EQL |lhs| |rhs|))
@@ -3281,7 +3282,7 @@
                            (CONS |rettype| NIL)))))
       (COND
        ((EQ |t| '|string|)
-        (SETQ |call| (LIST (|bfColonColon| 'CCL 'GET-CSTRING) |call|))))
+        (SETQ |call| (LIST (|bfColonColon| 'CCL '%GET-CSTRING) |call|))))
       (LET ((|bfVar#14| |aryPairs|) (|arg| NIL))
         (LOOP
          (COND
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 4696f676..ea0dabcf 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -182,16 +182,15 @@
              (LIST '|charUpcase| 'CHAR-UPCASE) (LIST '|charString| 'STRING)
              (LIST '|char?| 'CHARACTERP) (LIST '|codePoint| 'CHAR-CODE)
              (LIST '|cons?| 'CONSP) (LIST '|copy| 'COPY)
-             (LIST '|copyString| 'COPY-SEQ)
-             (LIST '|copyVector| 'COPY-SEQ) (LIST '|croak| 'CROAK)
-             (LIST '|digit?| 'DIGIT-CHAR-P) (LIST '|drop| 'DROP)
-             (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) (LIST '|fifth| 'FIFTH)
-             (LIST '|first| 'CAR) (LIST '|float?| 'FLOATP)
-             (LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR)
-             (LIST '|function| 'FUNCTION) (LIST '|function?| 'FUNCTIONP)
-             (LIST '|gensym| 'GENSYM) (LIST '|genvar| 'GENVAR)
-             (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|)
-             (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
+             (LIST '|copyString| 'COPY-SEQ) (LIST '|copyVector| 'COPY-SEQ)
+             (LIST '|croak| 'CROAK) (LIST '|digit?| 'DIGIT-CHAR-P)
+             (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
+             (LIST '|fifth| 'FIFTH) (LIST '|first| 'CAR)
+             (LIST '|float?| 'FLOATP) (LIST '|flushOutput| 'FORCE-OUTPUT)
+             (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION)
+             (LIST '|function?| 'FUNCTIONP) (LIST '|gensym| 'GENSYM)
+             (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP)
+             (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
              (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN)
              (LIST '|maxIndex| 'MAXINDEX) (LIST '|mkpf| 'MKPF)
              (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL)
@@ -244,13 +243,15 @@
              (LIST '|mmCondition| 'CAADR) (LIST '|mmDC| 'CAAR)
              (LIST '|mmImplementation| 'CADADR) (LIST '|mmSignature| 'CDAR)
              (LIST '|mmTarget| 'CADAR) (LIST '|mmSource| 'CDDAR)
-             (LIST '|mapOperation| 'CAAR) (LIST '|mapSignature| 'CADAR)
-             (LIST '|mapTarget| 'CAADAR) (LIST '|mapSource| 'CDADAR)
-             (LIST '|mapKind| 'CAADDR) (LIST '|mode| 'CADR) (LIST '|op| 'CAR)
-             (LIST '|opcode| 'CADR) (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR)
-             (LIST '|sig| 'CDDR) (LIST '|source| 'CDR)
-             (LIST '|streamCode| 'CADDDR) (LIST '|streamDef| 'CADDR)
-             (LIST '|streamName| 'CADR) (LIST '|target| 'CAR)))
+             (LIST '|mapOpsig| 'CAR) (LIST '|mapOperation| 'CAAR)
+             (LIST '|mapSignature| 'CADAR) (LIST '|mapTarget| 'CAADAR)
+             (LIST '|mapSource| 'CDADAR) (LIST '|mapPredicate| 'CADR)
+             (LIST '|mapImpl| 'CADDR) (LIST '|mapKind| 'CAADDR)
+             (LIST '|mode| 'CADR) (LIST '|op| 'CAR) (LIST '|opcode| 'CADR)
+             (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR) (LIST '|sig| 'CDDR)
+             (LIST '|source| 'CDR) (LIST '|streamCode| 'CADDDR)
+             (LIST '|streamDef| 'CADDR) (LIST '|streamName| 'CADR)
+             (LIST '|target| 'CAR)))
       (|i| NIL))
   (LOOP
    (COND
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index db11171f..457ea66e 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -20,7 +20,7 @@
                      |lastNode| |append| |append!| |copyList| |substitute|
                      |substitute!| |setDifference| |setUnion| |setIntersection|
                      |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ|
-                     |objectAssoc| |remove| |removeSymbol| |atomic?|
+                     |objectAssoc| |remove| |removeSymbol| |atomic?| |copyTree|
                      |finishLine|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
@@ -74,6 +74,8 @@
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |atomic?|))
 
+(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |copyTree|))
+
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Void|) |finishLine|))
 
 (DECLAIM
@@ -84,6 +86,10 @@
 
 (DEFUN |atomic?| (|x|) (OR (NOT (CONSP |x|)) (EQ (CAR |x|) 'QUOTE)))
 
+(DEFUN |copyTree| (|t|)
+  (COND ((CONSP |t|) (CONS (|copyTree| (CAR |t|)) (|copyTree| (CDR |t|))))
+        (T |t|)))
+
 (DEFUN |objectMember?| (|x| |l|)
   (LOOP
    (COND ((NULL |l|) (RETURN NIL))
@@ -216,36 +222,37 @@
 (DEFUN |applySubst| (|sl| |t|)
   (PROG (|p| |tl| |hd|)
     (RETURN
-     (COND
-      ((CONSP |t|) (SETQ |hd| (|applySubst| |sl| (CAR |t|)))
-       (SETQ |tl| (|applySubst| |sl| (CDR |t|)))
-       (COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
-             (T (CONS |hd| |tl|))))
-      ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
-      (T |t|)))))
+     (COND ((NULL |sl|) |t|)
+           ((CONSP |t|) (SETQ |hd| (|applySubst| |sl| (CAR |t|)))
+            (SETQ |tl| (|applySubst| |sl| (CDR |t|)))
+            (COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
+                  (T (CONS |hd| |tl|))))
+           ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
+           (T |t|)))))
 
 (DEFUN |applySubst!| (|sl| |t|)
   (PROG (|p| |tl| |hd|)
     (RETURN
-     (COND
-      ((CONSP |t|) (SETQ |hd| (|applySubst!| |sl| (CAR |t|)))
-       (SETQ |tl| (|applySubst!| |sl| (CDR |t|))) (RPLACA |t| |hd|)
-       (RPLACD |t| |tl|))
-      ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
-      (T |t|)))))
+     (COND ((NULL |sl|) |t|)
+           ((CONSP |t|) (SETQ |hd| (|applySubst!| |sl| (CAR |t|)))
+            (SETQ |tl| (|applySubst!| |sl| (CDR |t|))) (RPLACA |t| |hd|)
+            (RPLACD |t| |tl|))
+           ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
+           (T |t|)))))
 
 (DEFUN |applySubstNQ| (|sl| |t|)
   (PROG (|p| |tl| |hd|)
     (RETURN
-     (COND
-      ((AND (CONSP |t|) (PROGN (SETQ |hd| (CAR |t|)) (SETQ |tl| (CDR |t|)) T))
-       (COND ((EQ |hd| 'QUOTE) |t|)
-             (T (SETQ |hd| (|applySubstNQ| |sl| |hd|))
-              (SETQ |tl| (|applySubstNQ| |sl| |tl|))
-              (COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
-                    (T (CONS |hd| |tl|))))))
-      ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
-      (T |t|)))))
+     (COND ((NULL |sl|) |t|)
+           ((AND (CONSP |t|)
+                 (PROGN (SETQ |hd| (CAR |t|)) (SETQ |tl| (CDR |t|)) T))
+            (COND ((EQ |hd| 'QUOTE) |t|)
+                  (T (SETQ |hd| (|applySubstNQ| |sl| |hd|))
+                   (SETQ |tl| (|applySubstNQ| |sl| |tl|))
+                   (COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
+                         (T (CONS |hd| |tl|))))))
+           ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
+           (T |t|)))))
 
 (DEFUN |setDifference| (|x| |y|)
   (PROG (|a| |l| |p|)