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

1 files changed, 30 insertions, 23 deletions

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