* interp/i-util.boot (flattenCOND): Move from g-boot.boot.

	(extractCONDClauses): Likewise.
	* interp/g-boot.boot: Remove.
	* interp/def.lisp: Likewise.
	* interp/Makefile.pamphlet: Adjust dependencies.

10 files changed, 35 insertions, 1162 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 17a676b1..a48af9e1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
 2010-05-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/i-util.boot (flattenCOND): Move from g-boot.boot.
+	(extractCONDClauses): Likewise.
+	* interp/g-boot.boot: Remove.
+	* interp/def.lisp: Likewise.
+	* interp/Makefile.pamphlet: Adjust dependencies.
+
+2010-05-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/property.lisp: Clean up.
 
 2010-05-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 30962fc2..c839616b 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -45,7 +45,6 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	g-cndata.$(FASLEXT)	database.$(FASLEXT)	\
 	debug.$(FASLEXT)	dq.$(FASLEXT)		\
 	fname.$(FASLEXT)	format.$(FASLEXT)	\
-	def.$(FASLEXT)	        g-boot.$(FASLEXT)	\
 	g-error.$(FASLEXT)	g-opt.$(FASLEXT)	\
 	ggreater.$(FASLEXT)				\
 	hypertex.$(FASLEXT)	\
@@ -115,8 +114,7 @@ BROBJS=	bc-matrix.$(FASLEXT)				\
 autoload_objects += $(BFOBJS)
 
 TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT) \
-	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT) \
-	  ${AUTO}/def.$(FASLEXT)
+	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT)
 
 autoload_objects += $(TRANOBJS)
 
@@ -348,10 +346,9 @@ mark.$(FASLEXT): macros.$(FASLEXT)
 parse.$(FASLEXT): metalex.$(FASLEXT) postpar.$(FASLEXT)
 packtran.$(FASLEXT): sys-macros.$(FASLEXT)
 postpar.$(FASLEXT): macros.$(FASLEXT)
-bootlex.$(FASLEXT): preparse.$(FASLEXT) def.$(FASLEXT) \
+bootlex.$(FASLEXT): preparse.$(FASLEXT) macros.$(FASLEXT) \
 			nlib.$(FASLEXT) sys-globals.$(FASLEXT)
 newaux.$(FASLEXT): macros.$(FASLEXT)
-def.$(FASLEXT): macros.$(FASLEXT)
 comp.$(FASLEXT): macros.$(FASLEXT)
 preparse.$(FASLEXT): fnewmeta.$(FASLEXT)
 fnewmeta.$(FASLEXT): parsing.$(FASLEXT)
@@ -400,10 +397,9 @@ info.$(FASLEXT): g-util.$(FASLEXT)
 slam.$(FASLEXT): g-timer.$(FASLEXT)
 clammed.$(FASLEXT): g-timer.$(FASLEXT)
 clam.$(FASLEXT): g-timer.$(FASLEXT)
-g-opt.$(FASLEXT): def.$(FASLEXT)
+g-opt.$(FASLEXT): macros.$(FASLEXT)
 g-timer.$(FASLEXT): macros.$(FASLEXT) g-util.$(FASLEXT)
 msgdb.$(FASLEXT): g-util.$(FASLEXT)
-g-boot.$(FASLEXT): def.$(FASLEXT) g-util.$(FASLEXT)
 g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT)
 c-util.$(FASLEXT): g-util.$(FASLEXT) g-opt.$(FASLEXT)
 pathname.$(FASLEXT): nlib.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index b07194c3..be5cb024 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -124,7 +124,6 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	g-cndata.$(FASLEXT)	database.$(FASLEXT)	\
 	debug.$(FASLEXT)	dq.$(FASLEXT)		\
 	fname.$(FASLEXT)	format.$(FASLEXT)	\
-	def.$(FASLEXT)	        g-boot.$(FASLEXT)	\
 	g-error.$(FASLEXT)	g-opt.$(FASLEXT)	\
 	ggreater.$(FASLEXT)				\
 	hypertex.$(FASLEXT)	\
@@ -189,16 +188,6 @@ first time they are called. Loading the files overwrites
 the autoload function call and re-calls the function. 
 Any subsequent calls will run the compiled code.
 
-Notice that the object file [[def.$(FASLEXT)]] appears on both the
-[[OBJS]] and [[TRANOBJS]] lists.  In normal situation, parsing 
-precedes translation; consequently the file [[def]] is loaded by the 
-parser, so that it does not need to be reloaded by the translator. 
-However, it may theoretically be that a translation could happen without 
-prior parsing (in case someone types in a parse tree for SPAD code).  
-Consequently, it must be ensured that [[def.]] is still loaded in that
-configuration.  In the long term, the autoload machinery need
-rethinking.
-
 The {\bf OCOBJS} list contains files from the old compiler. Again,
 ``old'' is meaningless. These files should probably be autoloaded.
 <<environment>>=
@@ -247,8 +236,7 @@ many compiler functions by versions contain in this files.
 (which replace compiler functions) {\em must} be autoloaded).
 <<environment>>=
 TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT) \
-	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT) \
-	  ${AUTO}/def.$(FASLEXT)
+	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT)
 
 autoload_objects += $(TRANOBJS)
 
@@ -597,10 +585,9 @@ mark.$(FASLEXT): macros.$(FASLEXT)
 parse.$(FASLEXT): metalex.$(FASLEXT) postpar.$(FASLEXT)
 packtran.$(FASLEXT): sys-macros.$(FASLEXT)
 postpar.$(FASLEXT): macros.$(FASLEXT)
-bootlex.$(FASLEXT): preparse.$(FASLEXT) def.$(FASLEXT) \
+bootlex.$(FASLEXT): preparse.$(FASLEXT) macros.$(FASLEXT) \
 			nlib.$(FASLEXT) sys-globals.$(FASLEXT)
 newaux.$(FASLEXT): macros.$(FASLEXT)
-def.$(FASLEXT): macros.$(FASLEXT)
 comp.$(FASLEXT): macros.$(FASLEXT)
 preparse.$(FASLEXT): fnewmeta.$(FASLEXT)
 fnewmeta.$(FASLEXT): parsing.$(FASLEXT)
@@ -649,10 +636,9 @@ info.$(FASLEXT): g-util.$(FASLEXT)
 slam.$(FASLEXT): g-timer.$(FASLEXT)
 clammed.$(FASLEXT): g-timer.$(FASLEXT)
 clam.$(FASLEXT): g-timer.$(FASLEXT)
-g-opt.$(FASLEXT): def.$(FASLEXT)
+g-opt.$(FASLEXT): macros.$(FASLEXT)
 g-timer.$(FASLEXT): macros.$(FASLEXT) g-util.$(FASLEXT)
 msgdb.$(FASLEXT): g-util.$(FASLEXT)
-g-boot.$(FASLEXT): def.$(FASLEXT) g-util.$(FASLEXT)
 g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT)
 c-util.$(FASLEXT): g-util.$(FASLEXT) g-opt.$(FASLEXT)
 pathname.$(FASLEXT): nlib.$(FASLEXT)
diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index 811657e7..e32e375b 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -45,7 +45,7 @@
 
 (import-module "sys-globals")
 (IMPORT-MODULE "preparse")
-(IMPORT-MODULE "def")
+(IMPORT-MODULE "macros")
 (IMPORT-MODULE "nlib")
 (in-package "BOOT")
 
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index f55cbd31..c59519a8 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -886,7 +886,7 @@ setqMultiple(nameList,val,m,e) ==
     [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
       for x in nameList for [y,:z] in selectorModePairs]
   if assignList="failed" then NIL
-  else [MKPROGN [x,:assignList,g],m',e]
+  else [mkpf([x,:assignList,g],'PROGN),m',e]
 
 setqMultipleExplicit(nameList,valList,m,e) ==
   #nameList~=#valList =>
diff --git a/src/interp/def.lisp b/src/interp/def.lisp
deleted file mode 100644
index d7d629b8..00000000
--- a/src/interp/def.lisp
+++ /dev/null
@@ -1,668 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2008, 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.
-
-
-; NAME:     Def
-; PURPOSE:  Defines BOOT code
-
-(IMPORT-MODULE "macros")
-
-(in-package "BOOT")
-
-(REPEAT (IN X '(
-  (|:| |DEF-:|)
-  (|::| |DEF-::|)
-  (ELT DEF-ELT)
-  (SETELT DEF-SETELT)
-  (%LET DEF-LET)
-  (COLLECT DEF-COLLECT)
-  (LESSP DEF-LESSP)
-  (|<| DEF-LESSP)
-  (REPEAT DEF-REPEAT)
-;;(|TRACE,LET| DEF-TRACE-LET)
-  (CATEGORY DEF-CATEGORY)
-  (EQUAL DEF-EQUAL)
-  (|is| DEF-IS)
-  (SEQ DEF-SEQ)
-  (|isnt| DEF-ISNT)
-  (|where| DEF-WHERE)
-)) (PROGN (MAKEPROP (CAR X) '|DEF-TRAN| (CADR X)) (CADR X)))
-
-
-;;; Common Block
-
-(defparameter deftran nil)
-(defparameter $macroassoc nil)
-(defparameter $ne nil)
-
-(defparameter $op nil
-"$OP is globalized for construction of local function names, e.g.
-foo defined inside of fum gets renamed as fum,foo.")
-
-(defparameter $opassoc nil
-"$OPASSOC is a renaming accumulator to be used with SUBLIS.")
-
-(defparameter $BODY nil)
-
-(defun DEF (FORM SIGNATURE $BODY)
-  (declare (ignore SIGNATURE))
-  (let* ($opassoc
-         ($op (first form))
-         (argl (rest form))
-         ($body (deftran $body))
-         (argl (DEF-INSERT_LET argl))
-         (arglp (DEF-STRINGTOQUOTE argl))
-         ($body (|bootTransform| $body)))
-      (|backendCompile| (SUBLIS $OPASSOC (list (list $OP (list 'LAM arglp $body)))))))
-
-; We are making shallow binding cells for these functions as well
-
-(mapcar #'(lambda (x) (MAKEPROP (FIRST X) 'DEF-TRAN (SECOND X)))
-         '((\: DEF-\:) (\:\: DEF-\:\:) (ELT DEF-ELT)
-           (SETELT DEF-SETELT) (SPADLET DEF-LET)
-           (SEQ DEF-SEQ) (COLLECT DEF-COLLECT)
-           (REPEAT DEF-REPEAT) (TRACE-LET DEF-TRACE-LET)
-           (CATEGORY DEF-CATEGORY) (EQUAL DEF-EQUAL)
-           (|is| DEF-IS) (|isnt| DEF-ISNT) (|where| DEF-WHERE)))
-
-(defun DEF-EQUAL (X)
-  (COND ((NOT (CDR X)) (CONS 'EQUAL X))
-        ((OR (MEMBER '(|One|) X) (MEMBER '(|Zero|) X)
-             (integerp (FIRST X)) (integerp (SECOND X))) (CONS 'EQL X))
-       ; ((AND (EQCAR (FIRST X) 'QUOTE) (IDENTP (CADAR X))) (CONS 'EQ X))
-        ((NOT (FIRST X)) (LIST 'NULL (SECOND X)))
-        ((NOT (SECOND X)) (LIST 'NULL (FIRST X)))
-       ; ((AND (EQCAR (SECOND X) 'QUOTE) (IDENTP (CADADR X))) (CONS 'EQ X))
-        ($BOOT (CONS 'BOOT-EQUAL X))
-        ((CONS 'EQUAL X))))
- 
-(defun DEF-LESSP (x)
-  (cond ((null (cdr x)) (cons '< x))
-        ((eq (cadr x) 0) (list 'minusp (car x)))
-        ((and (smint-able (car x)) (smint-able (cadr x)))
-         (cons 'qslessp x))
-        ('t (list '> (CADR x) (CAR x)))))
-
-(defun smint-able (x)
-  (or (smintp x)
-      (and (pairp x) (memq (car x) '(|One| |Zero| LENGTH \# QCSIZE QVSIZE QLENGTH)))))
-
-(defun DEF-PROCESS (X &aux $MACROASSOC)
-  (COND ((EQCAR X 'DEF) (DEF (SECOND X) (THIRD X) (FIRST (CDDDDR X))))
-        ((EQCAR X 'MDEF) (B-MDEF (SECOND X) (THIRD X) (FIRST (CDDDDR X))))
-        ((AND (EQCAR X 'WHERE) (EQCAR (cadr X) 'DEF))
-         (let* ((u (cadr X)) (Y (cdr U)))
-           (DEF-PROCESS (LIST 'DEF
-                              (car Y)
-                              (car (setq Y (cdr Y)))
-                              (car (setq Y (cdr Y)))
-                              (CONS 'WHERE (cons (car (setq Y (cdr Y))) (cddr X)))))))
-        ((IS-CONSOLE |$OutputStream|)
-         (SAY "  VALUE = " (EVAL (DEFTRAN X))))
-        ((print-full (DEFTRAN X)))))
-
-(defun B-MDEF (FORM SIGNATURE $BODY)
-  (declare (ignore SIGNATURE))
- (let* ($OpAssoc
-        ($op (first form)) (argl (cdr form))
-        (GARGL (MAPCAR #'(LAMBDA (X) (GENSYM)) ARGL))
-        ($BODY (SUBLISLIS GARGL ARGL (|bootTransform| (DEFTRAN $BODY))))
-        ($BODY (LIST 'SUBLISLIS (CONS 'LIST GARGL) (LIST 'QUOTE GARGL)
-                     (LIST 'QUOTE $BODY))))
-   (|backendCompile| (SUBLIS $OPASSOC
-                 (LIST (LIST $OP (LIST 'MLAMBDA (CONS () GARGL) $BODY)))))))
-
-(defun DEF-INNER (FORM SIGNATURE $BODY)
-  "Same as DEF but assumes body has already been DEFTRANned"
- (let ($OpAssoc ($op (first form)) (argl (rest form)))
-   (let* ((ARGL (DEF-INSERT_LET ARGL))
-          (ARGLP (DEF-STRINGTOQUOTE ARGL)))
-    (|backendCompile| (SUBLIS $OPASSOC `((,$OP (LAM ,ARGLP ,$BODY))))))))
-
-(defun DEF-INSERT_LET (X)
-  (if (ATOM X) X
-      (CONS (DEF-INSERT_LET1 (FIRST X)) (DEF-INSERT_LET (CDR X)))))
-
-(defun DEF-INSERT_LET1 (Y)
-  (if (EQCAR Y 'SPADLET)
-      (COND ((IDENTP (SECOND Y))
-             (setq $BODY
-                   (MKPROGN
-                     (LIST (DEF-LET (THIRD Y) (SECOND Y)) $BODY)))
-             (setq Y (SECOND Y)))
-            ((IDENTP (THIRD Y))
-             (setq $BODY
-                   (MKPROGN (LIST (DEFTRAN Y) $BODY))) (setq Y (THIRD Y)))
-            ((ERRHUH)))
-      Y))
-
-(defun MKPROGN (L) (MKPF L 'PROGN))
-
-(defun DEF-STRINGTOQUOTE (X)
-  (COND ((STRINGP X) (LIST 'QUOTE (INTERN X)))
-        ((ATOM X) X)
-        ((CONS (DEF-ADDLET (FIRST X)) (DEF-STRINGTOQUOTE (CDR X))))))
-
-(defun DEF-ADDLET (X)
-  (if (ATOM X)
-      (if (STRINGP X) `(QUOTE ,(intern x))  X)
-      (let ((g (gensym)))
-        (setq $body (mkprogn
-                     (list (def-let (comp\,fluidize x) g)
-                           $body)))
-        g)))
-
-(mapcar #'(lambda (x) (MAKEPROP (CAR X) 'RENAME (CDR X)))
-        '((|true| 'T) (|otherwise| 'T) (|false| NIL)
-          (|and| AND) (|or| OR) (|is| IS)
-          (|list| LIST) (|cons| CONS) (|car| CAR) (|cdr| CDR)
-          (|setDifference| SETDIFFERENCE) (INTERSECTION |intersection|)
-          (|setIntersection| |intersection|) (|setUnion| |union|)
-          (UNION |union|) (REMOVE |remove|) (MEMBER |member|) (ASSOC |assoc|)
-          (READ VMREAD) (READ-LINE |read-line|)
-          (|apply| APPLY) (|lastNode| LASTPAIR) (LAST |last|)
-          (|in| |member|) (|strconc| STRCONC) (|append| APPEND)
-          (|copy| COPY) (DELETE |delete|) (RASSOC |rassoc|)
-          (|size| SIZE) (|nconc| NCONC)
-          (|setPart| SETELT) (|where| WHERE)
-          (|first| CAR) (|rest| CDR) (|substitute| MSUBST)
-          (|removeDuplicates| REMDUP) (|reverse| REVERSE) (|nreverse| NREVERSE)
-          (|drop| DROP) (|take| TAKE) (|croak| CROAK) (|genvar| GENVAR)
-          (|mkpf| MKPF) (^= NEQUAL) (= EQUAL) (- SPADDIFFERENCE)
-          (+ PLUS) (* TIMES) (/ QUOTIENT)
-          (** EXPT) (|return| RETURN) (|exit| EXIT) (\| SUCHTHAT)
-          (^ NULL) (|not| NULL) (NOT NULL) (REDUCE spadReduce) (DO spadDo)
-          (|atom| ATOM) (|nil| NIL) (|null| NULL) (GET GETL)
-          (T T$)))
-
-; This two-level call allows DEF-RENAME to be locally bound to do
-; nothing (see boot2Lisp) yet still allow function call (lisp2BootAndComp)
-
-(defun DEF-RENAME (X) (DEF-RENAME1 X))
-
-(defun DEF-RENAME1 (X)
-  (COND ((symbolp X) (let ((y (get x 'rename))) (if y (first y) x)))
-        ((and (listp X) X)
-         (if (EQCAR X 'QUOTE)
-             X
-             (CONS (DEF-RENAME1 (FIRST X)) (DEF-RENAME1 (CDR X)))))
-        (X)))
-
-(defun DEFTRAN (X)
- (let (op Y)
-   (COND ((STRINGP X) (DEF-STRING X))
-         ((IDENTP X) (COND ((LASSOC X $MACROASSOC)) (X)))
-         ((ATOM X) X)
-         ((EQ (setq OP (FIRST X)) 'WHERE) (DEF-WHERE (CDR X)))
-         ((EQ OP 'REPEAT) (DEF-REPEAT (CDR X)))
-         ((EQ OP 'COLLECT) (DEF-COLLECT (CDR X)))
-         ((EQ OP 'MAKESTRING)
-          (COND ((STRINGP (SECOND X)) X)
-                ((EQCAR (SECOND X) 'QUOTE)
-                 (LIST 'MAKESTRING (STRINGIMAGE (CADADR X))))
-                ((LIST 'MAKESTRING (DEFTRAN (SECOND X)) )) ))
-         ((EQ OP 'QUOTE)
-          (if (STRINGP (setq y (SECOND X))) (LIST 'MAKESTRING y)
-             (if (and (identp y) (char= (elt (pname y) 0) #\.))
-                 `(intern ,(pname y) ,(package-name *package*)) x)))
-         ((EQ OP 'IS) (|defIS| (CADR X) (CADDR X)))
-         ((EQ OP 'SPADLET) (DEF-LET (CADR X) (caddr x)))
-         ((EQ OP 'DCQ) (LIST 'DCQ (SECOND X) (DEFTRAN (THIRD X))))
-         ((EQ OP 'COND) (CONS 'COND (DEF-COND (CDR X))))
-         ((member (FIRST X) '(|sayBrightly| SAY MOAN CROAK) :test #'eq)
-          (DEF-MESSAGE X))
-         ((setq Y (GETL (FIRST X) 'DEF-TRAN))
-          (funcall Y (MAPCAR #'DEFTRAN (CDR X))))
-         ((mapcar #'DEFTRAN X)))))
-
-(defun DEF-SEQ (U) (SEQOPT (CONS 'SEQ U)))
-
-(defun DEF-MESSAGE (U) (CONS (FIRST U) (mapcar #'def-message1 (cdr u))))
-
-(defun DEF-MESSAGE1 (V)
-  (COND ((AND (STRINGP V) (> (SIZE V) 0) (NOT (EQ (ELT V 0) '\%)))
-         (LIST 'MAKESTRING V))
-        ((EQCAR V 'CONS) (LIST 'CONS (DEF-MESSAGE1 (SECOND V))
-                               (DEF-MESSAGE1 (THIRD V))))
-        ((DEFTRAN V))))
-
-(defun |DEF-:| (X &aux Y)
-       (DCQ (x y) x)
-       `(SPADLET ,(if (or (eq y '|fluid|)
-                          (and (identp x) (char= #\$ (ELT (PNAME X) 0))))
-                      `(FLUID ,X) X)
-                 NIL))
-
-(defmacro |DEF-::| (X)
-  (let ((expr (first x)) (type (second x)))
-    (if (EQUAL TYPE '(|Triple|)) EXPR (ERRHUH))))
-
-(defun DEF-COLLECT (L) (DEF-IT 'COLLECT (MAPCAR #'DEFTRAN (HACKFORIS L))))
-
-(defun DEF-REPEAT (L) (DEF-IT 'REPEAT (mapcar #'DEFTRAN (HACKFORIS L))))
-
-(defun HACKFORIS (L) (mapcar #'hackforis1 L))
-
-(defun HACKFORIS1 (X)
-  (if (AND (MEMBER (KAR X) '(IN ON)) (EQCAR (SECOND X) 'IS))
-      (CONS (FIRST X) (CONS (CONS 'SPADLET (CDADR X)) (CDDR X)))
-      X))
-
-(defun DEF-select (L)
-  (cond ((IDENTP (FIRST L)) (DEF-select1 (FIRST L) (SECOND L)))
-        ((LET* ((G (GENSYM))
-                (U (DEF-select1 G (SECOND L))))
-           (LIST 'PROGN (LIST 'SPADLET G (FIRST L)) U)))))
-
-(defun DEF-select1 (X Y)
-  (if (EQCAR Y 'SEQ)
-      (CONS 'COND (DEF-select2 X (CDR Y)))
-      (MOAN (format nil "Unexpected CASE body: ~S" Y))))
-
-(defun DEF-select2 (X Y)
-  (let (u v)
-    (COND ((NOT Y) (MOAN "Unexpected CASE clause termination"))
-          ((EQCAR (setq U (FIRST Y)) 'EXIT)
-           (LIST (LIST ''T (SECOND U))))
-          ((AND (EQCAR U 'COND) (NOT (CDDR U))
-                (EQCAR (SECOND (setq V (SECOND U))) 'EXIT))
-           (CONS (LIST (DEF-IS (LIST X (FIRST V))) (CADADR V))
-                 (DEF-select2 X (CDR Y))))
-          ((MOAN (format nil "Unexpected CASE clause: ~S" (FIRST Y)))))))
-
-(defun DEF-IT (FN L)
-  (setq L (reverse L))
-  (let ((B (first L)))
-    (let ((it (DEF-IN2ON (NREVERSE (rest L)))))
-      (let ((itp
-              (apply #'APPEND
-                     (mapcar
-                       #'(lambda (x &aux OP Y G)
-                           (if (AND (MEMBER (setq OP (FIRST X)) '(IN ON))
-                                    (NOT (ATOM (SECOND X))))
-                               (if (EQCAR (setq Y (SECOND X)) 'SPADLET)
-                                   (if (ATOM (setq G (SECOND Y)))
-                                       (LIST `(,OP ,G
-                                               ,(DEFTRAN (THIRD X)))
-                                             `(RESET
-                                                ,(DEF-LET
-                                                   (DEFTRAN
-                                                     (THIRD Y)) G)))
-                                       (ERRHUH))
-                                   (LIST
-                                     `(,OP ,(setq G (GENSYM))
-                                       ,(DEFTRAN (THIRD X)))
-                                     `(RESET
-                                        ,(DEF-LET (DEFTRAN (SECOND X))
-                                                  G))))
-                               `(,X)))
-                       IT))))
-        (CONS FN (NCONC ITP (LIST B)))))))
-
-(defun DEF-IN2ON (IT)
-  (mapcar #'(lambda (x) (let (u)
-              (COND
-                ((AND (EQCAR X 'IN) (EQCAR (THIRD X) '|tails|))
-                 (LIST 'ON (SECOND X) (SECOND (THIRD X))))
-                ((AND (EQCAR X 'IN) (EQCAR (setq U (THIRD X)) 'SEGMENT))
-                 (COND
-                   ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) 1 (THIRD U)))
-                   ((LIST 'STEP (SECOND X) (SECOND U) 1))  ))
-                ((AND (EQCAR X 'INBY) (EQCAR (setq U (THIRD X)) 'SEGMENT))
-                 (COND
-                   ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) (|last| x) (THIRD U)))
-                   ((LIST 'STEP (SECOND X) (SECOND U) (|last| x)))  ))
-                (X))))
-          IT))
-
-(defun DEF-COND (L)
-  (COND ((NOT L) NIL)
-        ((CONS (MAPCAR #'DEFTRAN (FIRST L)) (DEF-COND (CDR L))))))
-
-(defun DEF-LET (FORM RHS)
-  (setq FORM (if (EQCAR FORM '\:) FORM (macroexpand FORM)))
-  (prog (F1 F2)
-   (COND ((EQCAR FORM '\:)
-          (SPADLET F1 (DEFTRAN FORM))
-          (SPADLET F2 (DEFTRAN (LIST 'SPADLET (CADR FORM) RHS)))
-          (COND ((AND (EQ (CAR F2) 'SPADLET) (EQUAL (CADR F2) (CADR FORM)))
-                  (RETURN (LIST 'SPADLET (CADR F1) (CADDR F2)) ))
-                ('T (RETURN (LIST 'PROGN F1 F2)) )) )
-        ((EQCAR FORM 'ELT) (RETURN
-           (DEFTRAN (LIST 'SETELT (CADR FORM) (CADDR FORM) RHS)) )))
-   (RETURN 
-     (COND (|$useDCQnotLET| (|defLETdcq| FORM (DEFTRAN RHS)))
-           ('T            (|defLET| FORM (DEFTRAN RHS)))))))
-
-(defun |defLETdcq| (FORM RHS &AUX G NAME)
-  ;; see defLET in G-BOOT BOOT
-  (COND
-    ((IDENTP FORM) (LIST 'SPADLET FORM RHS))
-    ((IDENTP RHS)
-       (LIST 'COND (LIST (DEFTRAN (LIST 'IS RHS FORM)) RHS)
-                   (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING
-                                                    (MK_LEFORM FORM)) RHS))))
-    ((AND (EQ (CAR RHS) 'SPADLET) (IDENTP (SETQ NAME (CADR RHS)) ))
-       (SPADLET G (GENSYM))
-       (LIST 'COND (LIST (SUBST RHS G (DEFTRAN (LIST 'IS G FORM))) NAME)
-                   (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING
-                                                    (MK_LEFORM FORM)) NAME))))
-    ('T (SPADLET G (GENSYM))
-       (LIST 'COND (LIST (SUBST (LIST 'SPADLET G RHS) G
-                                (DEFTRAN (LIST 'IS G FORM))) G)
-                    (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING
-                                                  (MK_LEFORM FORM)) G))  ) )))
-
-
-(defun LET_ERROR (FORM VAL)
-  (|systemError| (format nil "~S is not matched by structure ~S~%" FORM VAL)))
-
-(defun DEF-ISNT (X) (DEFTRAN (LIST 'NULL (CONS 'IS X))))
-
-(defparameter $IS-GENSYMLIST nil)
-
-(defparameter Initial-Gensym (list (gensym)))
-
-(defun DEF-IS (X)
-  (let (($IS-GENSYMLIST Initial-Gensym))
-    (DEF-IS2 (first X) (second x))))
-
-(defun IS-GENSYM ()
-  (if (NOT (CDR $IS-GENSYMLIST)) (RPLACD $IS-GENSYMLIST (LIST (GENSYM))))
-  (pop $IS-GENSYMLIST))
-
-(defparameter $IS-EQLIST nil)
-(defparameter $IS-SPILL_LIST nil)
-
-(defun DEF-IS2 (FORM STRUCT)
-  (let ($IS-EQLIST $IS-SPILL_LIST (FORM (DEFTRAN FORM)))
-    (if (EQCAR STRUCT '|%Comma|)
-        (MOAN "you must use square brackets around right arg. to" '%b "is" '%d))
-    (let* ((X (DEF-IS-EQLIST (DEF-IS-REMDUP STRUCT)))
-           (CODE (if (IDENTP X)
-                     (MKPF (SUBST FORM X $IS-EQLIST) 'AND)
-                     (MKPF `((DCQ ,X ,FORM) . ,$IS-EQLIST) 'AND))))
-      (let ((CODE (MKPF `(,CODE . ,$IS-SPILL_LIST) 'AND)))
-        (if $TRACELETFLAG
-            (let ((L (remove-if #'gensymp (listofatoms x))))
-              `(PROG1 ,CODE
-                      ,@(mapcar #'(lambda (y) `(/tracelet-print ,y ,y)) L)))
-            CODE)))))
-
-(defun DEF-STRING (X)
- ;; following patches needed to fix reader bug in Lucid Common Lisp
-  (if (and (> (size x) 0) (or (char= (elt x 0) #\.) (char= (elt x 0) #\Page)))
-      `(INTERN ,X ,(package-name *PACKAGE*))
-      `(QUOTE ,(DEFTRAN (INTERN X)))))
-
-(defun DEF-IS-EQLIST (STR)
-  (let (g e)
-    (COND ((NOT STR) (PUSH `(EQ ,(setq G (IS-GENSYM)) NIL) $IS-EQLIST) G)
-          ((EQ STR '\.) (IS-GENSYM))
-          ((IDENTP STR) STR)
-          ((STRINGP STR)
-           (setq E (DEF-STRING STR))
-           (PUSH (LIST (if (ATOM (SECOND E)) 'EQ 'EQUAL)
-                       (setq G (IS-GENSYM)) E)
-                 $IS-EQLIST)
-           G)
-          ((OR (NUMBERP STR) (MEMBER STR '((|Zero|) (|One|))))
-           (PUSH (LIST 'EQ (setq G (IS-GENSYM)) STR) $IS-EQLIST)
-           G)
-          ((ATOM STR) (ERRHUH))
-          ((EQCAR STR 'SPADLET)
-           (COND ((IDENTP (SECOND STR))
-                  (PUSH (DEF-IS2 (cadr str) (caddr STR)) $IS-SPILL_LIST)
-                  (SECOND STR))
-                 ((IDENTP (THIRD STR))
-                  (PUSH (DEFTRAN STR) $IS-SPILL_LIST) (THIRD STR))
-                 ((ERRHUH)) ))
-          ((EQCAR STR 'QUOTE)
-           (PUSH (LIST (COND ((ATOM (SECOND STR)) 'EQ)
-                             ('EQUAL))
-                       (setq G (IS-GENSYM)) STR) $IS-EQLIST) G)
-          ((EQCAR STR 'LIST) (DEF-IS-EQLIST (LIST2CONS STR)))
-          ((OR (EQCAR STR 'CONS) (EQCAR STR 'VCONS))
-           (CONS (DEF-IS-EQLIST (SECOND STR)) (DEF-IS-EQLIST (THIRD STR))))
-          ((EQCAR STR 'APPEND)
-           (if (NOT (IDENTP (SECOND STR))) (ERROR "CANT!"))
-           (PUSH (DEF-IS2 (LIST 'REVERSE (setq G (IS-GENSYM)))
-                          (DEF-IS-REV (THIRD STR) (SECOND STR)))
-                 $IS-EQLIST)
-           (COND ((EQ (SECOND STR) '\.) ''T)
-                 ((PUSH (SUBST (SECOND STR) 'L '(OR (setq L (NREVERSE L)) T))
-
-                        $IS-SPILL_LIST)))
-           G)
-          ((ERRHUH)))))
-
-(defparameter $vl nil)
-
-(defun def-is-remdup (x) (let ($vl) (def-is-remdup1 x)))
-
-(defun def-is-remdup1 (x)
-  (let (rhs lhs g)
-    (COND ((NOT X) NIL)
-          ((EQ X '\.) X)
-          ((IDENTP X)
-           (COND ((MEMBER X $VL)
-                  (PUSH (LIST 'EQUAL (setq G (IS-GENSYM)) X) $IS-EQLIST) G)
-                 ((PUSH X $VL) X)))
-          ((MEMBER X '((|Zero|) (|One|))) X)
-          ((ATOM X) X)
-          ((EQCAR X 'SPADLET)
-           (setq RHS (DEF-IS-REMDUP1 (THIRD X)))
-           (setq LHS (DEF-IS-REMDUP1 (SECOND X)))
-           (LIST 'SPADLET LHS RHS))
-          ((EQCAR X '%LET)
-           (setq RHS (DEF-IS-REMDUP1 (THIRD X)))
-           (setq LHS (DEF-IS-REMDUP1 (SECOND X)))
-           (LIST '%LET LHS RHS))
-          ((EQCAR X 'QUOTE) X)
-          ((AND (EQCAR X 'EQUAL) (NOT (CDDR X)))
-           (PUSH (LIST 'EQUAL (setq G (IS-GENSYM)) (SECOND X)) $IS-EQLIST) G)
-          ((MEMBER (FIRST X) '(LIST APPEND CONS VCONS))
-           (CONS (COND ((EQ (FIRST X) 'VCONS) 'CONS) ( (FIRST X)))
-                 (mapcar #'def-is-remdup1 (cdr x))))
-          ((ERRHUH)))))
-
-(defun LIST2CONS (X)
-"Produces LISP code for constructing a list, involving only CONS."
- (LIST2CONS-1 (CDR X)))
-
-(defun LIST2CONS-1 (X)
-  (if (NOT X) NIL (LIST 'CONS (FIRST X) (LIST2CONS-1 (CDR X)))))
-
-(defun DEF-IS-REV (X A)
-  (let (y)
-    (if (EQ (FIRST X) 'CONS)
-        (COND ((NOT (THIRD X)) (LIST 'CONS (SECOND X) A))
-              ((setq Y (DEF-IS-REV (THIRD X) NIL))
-               (setf (THIRD Y) (LIST 'CONS (SECOND X) A))
-               Y))
-        (ERRHUH))))
-
-(defparameter $DEFSTACK nil)
-
-(defun DEF-WHERE (args)
-  (let ((x (car args)) (y (cdr args)) $DEFSTACK)
-    (let ((u (DEF-WHERECLAUSELIST Y)))
-      (mapc #'(lambda (X) (DEF-INNER (FIRST X) NIL
-                              (SUBLIS $OPASSOC (SECOND X))))
-              $DEFSTACK)
-      (MKPROGN (NCONC U (LIST (DEFTRAN X)))))))
-
-(defun DEF-WHERECLAUSELIST (L)
-  (if (NOT (CDR L))
-      (DEF-WHERECLAUSE (DEFTRAN (FIRST L)))
-      (REDUCE #'APPEND
-              (mapcar #'(lambda (u) (def-whereclause (deftran u))) L))))
-
-(defun DEF-WHERECLAUSE (X)
-  (COND ((OR (EQCAR X 'SEQ) (EQCAR X 'PROGN))
-         (reduce #'append (mapcar #'def-whereclause (cdr x))))
-        ((EQCAR X 'DEF) (WHDEF (SECOND X) (FIRST (CDDDDR X))) NIL)
-        ((AND (EQCAR X '|exit|) (EQCAR (SECOND X) 'DEF))
-         (WHDEF (CADADR X) (FIRST (CDDDDR (SECOND X)) )) NIL)
-        ((LIST X))))
-
-(defun WHDEF (X Y)
-  "Returns no value -- side effect is to do a compilation or modify a global."
-  (prog ((XP (if (ATOM X) (LIST X) X)) Op)
-    (COND ((NOT (CDR XP))
-           (RETURN (PUSH (CONS (FIRST XP) Y) $MACROASSOC))))
-    (setq OP (INTERNL (PNAME $OP) "\," (FIRST XP)))
-    (SETQ $OPASSOC (PUSH (CONS (FIRST XP) OP) $OPASSOC))
-    (SETQ $DEFSTACK (CONS (LIST (CONS OP (CDR XP)) Y) $DEFSTACK))
-    NIL))
-
-
-(mapcar #'(lambda (x) (MAKEPROP (first X) 'SEL\,FUNCTION (second X)))
-        '((|aTree| 0)           (|aMode| 1)
-          (|aValue| 2)          (|aModeSet| 3)
-          (|aGeneral| 4)        (|expr| CAR)
-          (|mode| CADR)         (|env| CADDR)
-          (|mmDC| CAAR)         (|cacheName| CADR)
-          (|cacheType| CADDR)   (|cacheReset| CADDDR)
-          (|cacheCount| CADDDDR)(|mmSignature| CDAR)
-          (|mmTarget| CADAR)    (|mmCondition| CAADR)
-          (|mmImplementation| CADADR)
-          (|streamName| CADR)   (|streamDef| CADDR)
-          (|streamCode| CADDDR) (|opSig| CADR)
-          (|attributes| CADDR)  (|op| CAR)
-          (|opcode| CADR)       (|sig| CDDR)
-          (|source| CDR)        (|target| CAR)
-          (|first| CAR)         (|rest| CDR)))
-
-(defun DEF-ELT (args)
-  (let ((EXPR (car args)) (SEL (cadr args)))
-    (let (Y)
-      (COND ((and (symbolp sel) (setq Y (GET SEL 'SEL\,FUNCTION)))
-             (COND ((INTEGERP Y) (LIST 'ELT EXPR Y))
-                   ((LIST Y EXPR))))
-            ((LIST 'ELT EXPR SEL))))))
-
-(defun DEF-SETELT (args)
-  (let ((VAR (first args)) (SEL (second args)) (EXPR (third args)))
-    (let ((y (and (symbolp sel) (get sel 'sel\,function))))
-      (COND (y (COND ((INTEGERP Y) (LIST 'SETELT VAR Y EXPR))
-                     ((LIST 'RPLAC (LIST Y VAR) EXPR))))
-            ((LIST 'SETELT VAR SEL EXPR))))))
-
-(defun DEF-CATEGORY (L)
-  (let (siglist atlist)
-    (mapcar #'(lambda (x) (if (EQCAR (KADR X) 'Signature)
-                              (PUSH X SIGLIST)
-                              (PUSH X ATLIST)))
-            L)
-    (LIST 'CATEGORY (MKQ (NREVERSE SIGLIST)) (MKQ (NREVERSE ATLIST)))))
-
-
-(defun LIST2STRING (X)
-"Converts a list to a string which looks like a printed list,
-except that elements are separated by commas."
-  (COND ((ATOM X) (STRINGIMAGE X))
-        ((STRCONC "(" (LIST2STRING (FIRST X)) (LIST2STRING1 (CDR X)) ")"))))
-
-(defun LIST2STRING1 (X)
-  (COND
-    ((NOT X) "")
-    ((STRCONC "\," (LIST2STRING (FIRST X)) (LIST2STRING1 (CDR X))))))
-
-(defvar |$new2OldRenameAssoc|
-        '((\QUAD . \.) (\' . QUOTE) (|nil| . NIL) (|append| . APPEND)
-          (|union| . UNION) (|cons| . CONS)))
-
-(defun |new2OldLisp| (x) (|new2OldTran| (|postTransform| x)))
-
-(defun |new2OldTran| (x)
-  (PROG (G10463 a b G10465 G10466 G10467 G10469 d G10470 c)
-        (RETURN
-          (prog nil
-                (if (atom x)
-                    (RETURN (let ((y (ASSOC x |$new2OldRenameAssoc|)))
-                              (if y (cdr y) x))))
-                (if (AND (dcq (g10463 a b . g10465) x)
-                         (null G10465)
-                         (EQ G10463 '|where|)
-                         (dcq (g10466 . g10467) b)
-                         (dcq ((g10469 d . g10470) . c) (reverse g10467))
-                         (null G10470)
-                         (EQ G10469 '|exit|)
-                         (EQ G10466 'SEQ)
-                         (OR (setq c (NREVERSE c)) 'T))
-                    (RETURN
-                      `(|where| ,(|new2OldTran| a) ,@(|new2OldTran| c)
-                                ,(|new2OldTran| d))))
-                (return
-                  (case (car x)
-                      (QUOTE x)
-                      (DEF (|newDef2Def| x))
-                      (IF (|newIf2Cond| x))
-                      (|construct| (|newConstruct| (|new2OldTran| (cdr x))))
-                      (T `(,(|new2OldTran| (CAR x)) .
-                           ,(|new2OldTran| (CDR x))))))))))
-
-(defun |newDef2Def| (DEF-EXPR)
-  (if (not (AND (= (length def-expr) 5) (eq (car def-expr) 'DEF)))
-      (LET_ERROR "(DEF,form,a,b,c)" DEF-EXPR)
-      (let ((form (second def-expr))
-            (a (third def-expr))
-            (b (fourth def-expr))
-            (c (fifth def-expr)))
-        `(DEF ,(|new2OldDefForm|  form) ,(|new2OldTran| a)
-           ,(|new2OldTran| b) ,(|new2OldTran| c)))))
-
-(defun |new2OldDefForm| (x)
-  (cond ((ATOM x) (|new2OldTran| x))
-        ((and (listp x)
-              (listp (car x))
-              (eq (caar x) '|is|)
-              (= (length (car x)) 3))
-         (let ((a (second (car x))) (b (third (car x))) (y (cdr x)))
-              (|new2OldDefForm| `((SPADLET ,a ,b) ,@y))))
-        ((CONS (|new2OldTran| (CAR x)) (|new2OldDefForm| (CDR x))))))
-
-(defun |newIf2Cond| (COND-EXPR)
-       (if (not (AND (= (length cond-expr) 4) (EQ (car cond-expr) 'IF)))
-           (LET_ERROR "(IF,a,b,c)" COND-EXPR))
-       (let ((a (second COND-EXPR))
-             (b (third COND-EXPR))
-             (c (fourth COND-EXPR)))
-         (setq a (|new2OldTran| a) b (|new2OldTran| b) c (|new2OldTran| c))
-         (cond ((EQ c '|%noBranch|) `(if ,a ,b))
-               (t  `(if ,a ,b ,c)))))
-
-(defun |newConstruct| (l)
-  (if (ATOM l) l
-      `(CONS  ,(CAR l) ,(|newConstruct| (CDR l)))))
diff --git a/src/interp/g-boot.boot b/src/interp/g-boot.boot
deleted file mode 100644
index fe3fe608..00000000
--- a/src/interp/g-boot.boot
+++ /dev/null
@@ -1,466 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007-2010, 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 def
-import g_-util
-namespace BOOT
-
--- @(#)g-boot.boot      2.2      89/11/02  14:44:09
-
---% BOOT to LISP Translation
- 
--- these supplement those in DEF and MACRO LISP
- 
---% Utilities
-
-$inDefLET := false
-$inDefIS := false
-$letGenVarCounter := 1
-$isGenVarCounter := 1 
- 
-$LET := 'SPADLET    -- LET is a standard macro in Common Lisp
- 
-nakedEXIT? c ==
-  atom c => NIL
-  [a,:d] := c
-  IDENTP a =>
-    a = 'EXIT  => true
-    a = 'QUOTE => NIL
-    a in '(SEQ PROG LAMBDA MLAMBDA LAM) => NIL
-    nakedEXIT?(d)
-  nakedEXIT?(a) or nakedEXIT?(d)
- 
-mergeableCOND x ==
-  atom(x) or x isnt ['COND,:cls] => NIL
-  -- to be mergeable, every result must be an EXIT and the last
-  -- predicate must be a pair
-  ok := true
-  while (cls and ok) repeat
-    [[p,:r],:cls] := cls
-    cons? QCDR r => ok := NIL
-    first(r) isnt ['EXIT,.] => ok := NIL
-    null(cls) and atom(p) => ok := NIL
-    null(cls) and (p = ''T) => ok := NIL
-  ok
- 
-mergeCONDsWithEXITs l ==
-  -- combines things like
-  -- (COND (foo (EXIT a)))
-  -- (COND (bar (EXIT b)))
-  -- into one COND
-  null l => NIL
-  atom l => l
-  atom QCDR l => l
-  a := QCAR l
-  if a is ['COND,:.] then a := flattenCOND a
-  am := mergeableCOND a
-  rest(l) is [b,:k] and am and mergeableCOND(b) =>
-    b:= flattenCOND b
-    c := ['COND,:QCDR a,:QCDR b]
-    mergeCONDsWithEXITs [flattenCOND c,:k]
-  rest(l) is [b] and am =>
-    [removeEXITFromCOND flattenCOND ['COND,:QCDR a,[''T,b]]]
-  [a,:mergeCONDsWithEXITs rest l]
- 
-removeEXITFromCOND? c ==
-  -- c is '(COND ...)
-  -- only can do it if every clause simply EXITs
-  ok := true
-  c := rest c
-  while ok and c repeat
-    [[p,:r],:c] := c
-    nakedEXIT? p => ok := NIL
-    [:f,r1] := r
-    nakedEXIT? f => ok := NIL
-    r1 isnt ['EXIT,r2] => ok := NIL
-    nakedEXIT? r2 => ok := NIL
-  ok
- 
-removeEXITFromCOND c ==
-  -- c is '(COND ...)
-  z := NIL
-  for cl in rest c repeat
-    atom cl => z := [cl,:z]
-    cond := QCAR cl
-    length1? cl =>
-      cond is ["EXIT",:.] => z := [QCDR cond,:z]
-      z := [cl,:z]
-    cl' := reverse cl
-    lastSE := QCAR cl'
-    atom lastSE => z := [cl,:z]
-    lastSE is ["EXIT",:.] =>
-      z := [reverse [second lastSE,:rest cl'],:z]
-    z := [cl,:z]
-  ['COND,:nreverse z]
- 
-flattenCOND body ==
-  -- transforms nested COND clauses to flat ones, if possible
-  body isnt ['COND,:.] => body
-  ['COND,:extractCONDClauses body]
- 
-extractCONDClauses clauses ==
-  -- extracts nested COND clauses into a flat structure
-  clauses is ['COND, [pred1,:act1],:restClauses] =>
-    if act1 is [['PROGN,:acts]] then act1 := acts
-    restClauses is [[''T,restCond]] =>
-      [[pred1,:act1],:extractCONDClauses restCond]
-    [[pred1,:act1],:restClauses]
-  [[''T,clauses]]
- 
---% COND and IF
- 
-bootIF c ==
-  -- handles IF expressions by turning them into CONDs
-  c is [.,p,t] => bootCOND ['COND,[p,t]]
-  [.,p,t,e] := c
-  bootCOND ['COND,[p,t],[''T,e]]
- 
-bootCOND c ==
-  -- handles COND expressions: c is ['COND,:.]
-  cls := rest c
-  null cls => NIL
-  cls is [[''T,r],:.] => r
-  [:icls,fcls] := cls
-  ncls := NIL
-  for cl in icls repeat
-    [p,:r] := cl
-    ncls :=
-      r is [['PROGN,:r1]] => [[p,:r1],:ncls]
-      [cl,:ncls]
-  fcls := bootPushEXITintoCONDclause fcls
-  ncls :=
-    fcls is [''T,['COND,:mcls]] =>
-      append(reverse mcls,ncls)
-    fcls is [''T,['PROGN,:mcls]] =>
-      [[''T,:mcls],:ncls]
-    [fcls,:ncls]
-  ['COND,:reverse ncls]
- 
-bootPushEXITintoCONDclause e ==
-  e isnt [''T,['EXIT,['COND,:cls]]] => e
-  ncls := NIL
-  for cl in cls repeat
-    [p,:r] := cl
-    ncls :=
-      r is [['EXIT,:.]] => [cl,:ncls]
-      r is [r1]           => [[p,['EXIT,r1]],:ncls]
-      [[p,['EXIT,bootTran ['PROGN,:r]]],:ncls]
-  [''T,['COND,:nreverse ncls]]
- 
---% SEQ and PROGN
- 
--- following is a more sophisticated def than that in MACRO LISP
--- it is used for boot code
- 
-tryToRemoveSEQ e ==
-  -- returns e if unsuccessful
-  e isnt ['SEQ,cl,:cls] => NIL
-  nakedEXIT? cl =>
-    cl is ['COND,[p,['EXIT,r]],:ccls] =>
-      nakedEXIT? p or nakedEXIT? r => e
-      null ccls =>
-        bootCOND ['COND,[p,r],[''T,bootSEQ ['SEQ,:cls]]]
-      bootCOND ['COND,[p,r],[''T,bootSEQ ['SEQ,['COND,:ccls],:cls]]]
-    e
-  bootPROGN ['PROGN,cl,bootSEQ ['SEQ,:cls]]
- 
-bootAbsorbSEQsAndPROGNs e ==
-  -- assume e is a list from a SEQ or a PROGN
-  atom e => e
-  [:cls,lcl] := e
-  g := [:flatten(f) for f in cls] where
-    flatten x ==
-      null x => NIL
-      IDENTP x =>
-        MEMQ(x,$labelsForGO) => [x]
-        NIL
-      atom x => NIL
-      x is ['PROGN,:pcls,lpcl] =>
-        atom lpcl => pcls
-        rest x
-      -- next usually comes about from if foo then bar := zap
-      x is ['COND,y,[''T,'NIL]] => [['COND,y]]
-      [x]
-  while lcl is ['EXIT,f] repeat
-    lcl := f
-  lcl is ['PROGN,:pcls] => append(g,pcls)
-  lcl is ['COND,[''T,:pcls]] => append(g,pcls)
-  lcl is ['COND,[pred,['EXIT,h]]] =>
-    append(g,[['COND,[pred,h]]])
-  append(g,[lcl])
- 
-bootSEQ e ==
-  e := ['SEQ,:mergeCONDsWithEXITs bootAbsorbSEQsAndPROGNs rest e]
-  if e is [.,:cls,lcl] and IDENTP lcl and not MEMQ(lcl,$labelsForGO) then
-    e := ['SEQ,:cls,['EXIT,lcl]]
-  cls := QCDR e
-  cls is [['SEQ,:.]] => tryToRemoveSEQ QCAR cls
-  cls is [['EXIT,body]] =>
-    nakedEXIT? body => bootTran ['SEQ,body]
-    body
-  not (nakedEXIT?(cls) or "or"/[MEMQ(g,$labelsForGO) for g in cls]) =>
-    bootTran ['PROGN,:cls]
-  e is ['SEQ,['COND,[pred,['EXIT,r1]]],:r2] =>
-    nakedEXIT?(pred) or nakedEXIT?(r1) or nakedEXIT?(r2) =>
-      tryToRemoveSEQ e
-    bootTran ['COND,[pred,r1],[''T,:r2]]
-  tryToRemoveSEQ e
- 
-bootPROGN e ==
-  e := ['PROGN,:bootAbsorbSEQsAndPROGNs rest e]
-  [.,:cls] := e
-  null cls => NIL
-  cls is [body] => body
-  e
- 
---% LET
- 
-defLetForm(lhs,rhs) ==
---if functionp lhs then
---  sayMSG ['"Danger: Reassigning value to LISP function:",:bright lhs]
-  [$LET,lhs,rhs]
- 
-defLET1(lhs,rhs) ==
-  IDENTP lhs         => defLetForm(lhs,rhs)
-  lhs is ['FLUID,id] => defLetForm(lhs,rhs)
-  IDENTP rhs and not CONTAINED(rhs,lhs) =>
-    rhs' := defLET2(lhs,rhs)
-    EQCAR(rhs',$LET) => MKPROGN [rhs',rhs]
-    rhs' is ["PROGN",:.] => append(rhs',[rhs])
-    if IDENTP first rhs' then rhs' := [rhs',:NIL]
-    MKPROGN [:rhs',rhs]
-  rhs is [=$LET,:.] and IDENTP(name := second rhs) =>
-    -- handle things like [a] := x := foo
-    l1 := defLET1(name,third rhs)
-    l2 := defLET1(lhs,name)
-    l2 is ["PROGN",:.] => MKPROGN [l1,:rest l2]
-    if IDENTP first l2 then l2 := [l2,:nil]
-    MKPROGN [l1,:l2,name]
-  g := INTERN strconc('"LETTMP#",STRINGIMAGE $letGenVarCounter)
-  $letGenVarCounter := $letGenVarCounter + 1
-  rhs' := [$LET,g,rhs]
-  let' := defLET1(lhs,g)
-  let' is ["PROGN",:.] => MKPROGN [rhs',:rest let']
-  if IDENTP first let' then let' := [let',:NIL]
-  MKPROGN [rhs',:let',g]
- 
-defLET2(lhs,rhs) ==
-  IDENTP lhs => defLetForm(lhs,rhs)
-  null lhs   => NIL
-  lhs is ['FLUID,id] => defLetForm(lhs,rhs)
-  lhs is [=$LET,a,b] =>
-    a := defLET2(a,rhs)
-    null (b := defLET2(b,rhs)) => a
-    atom b => [a,b]
-    cons? QCAR b => [a,:b]
-    [a,b]
-  lhs is ['CONS,var1,var2] =>
-    var1 = "." or (var1 is ["QUOTE",:.]) =>
-      defLET2(var2,addCARorCDR('CDR,rhs))
-    l1 := defLET2(var1,addCARorCDR('CAR,rhs))
-    var2 in '(NIL _.) => l1
-    if cons? l1 and atom first l1 then l1 := [l1,:nil]
-    IDENTP var2 =>
-      [:l1,defLetForm(var2,addCARorCDR('CDR,rhs))]
-    l2 := defLET2(var2,addCARorCDR('CDR,rhs))
-    if cons? l2 and atom first l2 then l2 := [l2,:nil]
-    append(l1,l2)
-  lhs is ['APPEND,var1,var2] =>
-    patrev := defISReverse(var2,var1)
-    rev := ['REVERSE,rhs]
-    g := INTERN strconc('"LETTMP#",STRINGIMAGE $letGenVarCounter)
-    $letGenVarCounter := $letGenVarCounter + 1
-    l2 := defLET2(patrev,g)
-    if cons? l2 and atom first l2 then l2 := [l2,:nil]
-    var1 = "." => [[$LET,g,rev],:l2]
-    last l2 is [=$LET, =var1, val1] =>
-      [[$LET,g,rev],:reverse rest reverse l2,
-       defLetForm(var1,['NREVERSE,val1])]
-    [[$LET,g,rev],:l2,defLetForm(var1,['NREVERSE,var1])]
-  lhs is ['EQUAL,var1] =>
-    ['COND,[['EQUAL,var1,rhs],var1]]
-  -- let the IS code take over from here
-  isPred :=
-    $inDefIS => defIS1(rhs,lhs)
-    defIS(rhs,lhs)
-  ['COND,[isPred,rhs]]
- 
-defLET(lhs,rhs) ==
-  $letGenVarCounter : local := 1
-  $inDefLET : local := true
-  defLET1(lhs,rhs)
- 
-addCARorCDR(acc,expr) ==
-  atom expr => [acc,expr]
-  acc = 'CAR and expr is ["REVERSE",:.] =>
-    ['last,:QCDR expr]
-  funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
-            CDAAR CDDAR CDADR CDDDR)
-  p := position(QCAR expr,funs)
-  p = -1 => [acc,expr]
-  funsA := '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR CAAADR
-             CAADDR CADAAR CADDAR CADADR CADDDR)
-  funsR := '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR CDAADR
-             CDADDR CDDAAR CDDDAR CDDADR CDDDDR)
-  if acc = 'CAR then [funsA.p,:QCDR expr]
-  else               [funsR.p,:QCDR expr]
- 
- 
---% IS
- 
-defISReverse(x,a) ==
-  -- reverses forms coming from APPENDs in patterns
-  -- pretty much just a translation of DEF-IS-REV
-  x is ['CONS,:.] =>
-    null third x => ['CONS,second x, a]
-    y := defISReverse(third x, NIL)
-    y.rest.rest.first := ['CONS,second x,a]
-    y
-  ERRHUH()
- 
-defIS1(lhs,rhs) ==
-  null rhs =>
-    ['NULL,lhs]
-  string? rhs =>
-    ['EQ,lhs,['QUOTE,INTERN rhs]]
-  NUMBERP rhs =>
-    ['EQUAL,lhs,rhs]
-  atom rhs =>
-    ['PROGN,defLetForm(rhs,lhs),''T]
-  rhs is ['QUOTE,a] =>
-    IDENTP a => ['EQ,lhs,rhs]
-    ['EQUAL,lhs,rhs]
-  rhs is [=$LET,c,d] =>
-    l :=
-      $inDefLET => defLET1(c,lhs)
-      defLET(c,lhs)
-    ['AND,defIS1(lhs,d),MKPROGN [l,''T]]
-  rhs is ['EQUAL,a] =>
-    ['EQUAL,lhs,a]
-  cons? lhs =>
-    g := INTERN strconc('"ISTMP#",STRINGIMAGE $isGenVarCounter)
-    $isGenVarCounter := $isGenVarCounter + 1
-    MKPROGN [[$LET,g,lhs],defIS1(g,rhs)]
-  rhs is ['CONS,a,b] =>
-    a = "." =>
-      null b =>
-        ['AND,['CONSP,lhs],
-              ['EQ,['QCDR,lhs],'NIL]]
-      ['AND,['CONSP,lhs],
-            defIS1(['QCDR,lhs],b)]
-    null b =>
-      ['AND,['CONSP,lhs],
-            ['EQ,['QCDR,lhs],'NIL],_
-            defIS1(['QCAR,lhs],a)]
-    b = "." =>
-      ['AND,['CONSP,lhs],defIS1(['QCAR,lhs],a)]
-    a1 := defIS1(['QCAR,lhs],a)
-    b1 := defIS1(['QCDR,lhs],b)
-    a1 is ['PROGN,c,''T] and b1 is ['PROGN,:cls] =>
-      ['AND,['CONSP,lhs],MKPROGN [c,:cls]]
-    ['AND,['CONSP,lhs],a1,b1]
-  rhs is ['APPEND,a,b] =>
-    patrev := defISReverse(b,a)
-    g := INTERN strconc('"ISTMP#",STRINGIMAGE $isGenVarCounter)
-    $isGenVarCounter := $isGenVarCounter + 1
-    rev := ['AND,['CONSP,lhs],['PROGN,[$LET,g,['REVERSE,lhs]],''T]]
-    l2 := defIS1(g,patrev)
-    if cons? l2 and atom first l2 then l2 := [l2,:nil]
-    a = "." => ['AND,rev,:l2]
-    ['AND,rev,:l2,['PROGN,defLetForm(a,['NREVERSE,a]),''T]]
-  SAY '"WARNING (defIS1): possibly bad IS code being generated"
-  DEF_-IS [lhs,rhs]
- 
-defIS(lhs,rhs) ==
-  $isGenVarCounter : local := 1
-  $inDefIS : local := true
-  defIS1(DEFTRAN lhs,rhs)
- 
---% OR and AND
- 
-bootOR e ==
-  -- flatten any contained ORs.
-  cls := rest e
-  null cls => NIL
-  null rest cls => first cls
-  ncls := [:flatten(c) for c in cls] where
-    flatten x ==
-      x is ['OR,:.] => QCDR x
-      [x]
-  ['OR,:ncls]
- 
-bootAND e ==
-  -- flatten any contained ANDs.
-  cls := rest e
-  null cls => 'T
-  null rest cls => first cls
-  ncls := [:flatten(c) for c in cls] where
-    flatten x ==
-      x is ['AND,:.] => QCDR x
-      [x]
-  ['AND,:ncls]
- 
---% Main Transformation Functions
- 
-bootLabelsForGO e ==
-  atom e => NIL
-  [head,:tail] := e
-  IDENTP head =>
-    head = 'GO => $labelsForGO := [first tail,:$labelsForGO]
-    head = 'QUOTE => NIL
-    bootLabelsForGO tail
-  bootLabelsForGO head
-  bootLabelsForGO tail
- 
-bootTran e ==
-  atom e => e
-  [head,:tail] := e
-  head = 'QUOTE => e
-  tail := [bootTran t for t in tail]
-  e := [head,:tail]
-  IDENTP head =>
-    head = 'IF    => bootIF e
-    head = 'COND  => bootCOND e
-    head = 'PROGN => bootPROGN  e
-    head = 'SEQ   => bootSEQ  e
-    head = 'OR    => bootOR  e
-    head = 'AND   => bootAND  e
-    e
-  [bootTran head,:QCDR e]
- 
-bootTransform e ==
---null $BOOT => e
-  $labelsForGO : local := NIL
-  bootLabelsForGO e
-  bootTran e
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 65368f84..7b85a8e6 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -32,7 +32,7 @@
 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
-import def
+import macros
 namespace BOOT
 
 --% 
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index 2a571c5e..9c602844 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -155,3 +155,20 @@ validateVariableNameOrElse var ==
   not IDENTP var => throwKeyedMsg("S2IS0016",[STRINGIMAGE var])
   var in '(% %%) => throwKeyedMsg("S2IS0050",[var])
   true
+
+--%
+
+flattenCOND body ==
+  -- transforms nested COND clauses to flat ones, if possible
+  body isnt ['COND,:.] => body
+  ['COND,:extractCONDClauses body]
+ 
+extractCONDClauses clauses ==
+  -- extracts nested COND clauses into a flat structure
+  clauses is ['COND, [pred1,:act1],:restClauses] =>
+    if act1 is [['PROGN,:acts]] then act1 := acts
+    restClauses is [[''T,restCond]] =>
+      [[pred1,:act1],:extractCONDClauses restCond]
+    [[pred1,:act1],:restClauses]
+  [[''T,clauses]]
+ 
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index c4ee9412..19a968cc 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -623,7 +623,7 @@ setqMultiple(nameList,val,m,e) ==
     [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
       for x in nameList for [y,:z] in selectorModePairs]
   if assignList="failed" then NIL
-  else [MKPROGN [x,:assignList,g],m',e]
+  else [mkpf([x,:assignList,g],'PROGN),m',e]
 
 setqMultipleExplicit(nameList,valList,m,e) ==
   #nameList ~= #valList =>