diff --git a/changelog b/changelog
index 6a41191..b3dd7a4 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,13 @@
+20090420 tpd src/axiom-website/patches.html 20090420.01.tpd.patch
+20090420 tpd src/interp/Makefile remove parsing autoload
+20090420 tpd src/interp/util.lisp remove parsing autoload
+20090420 tpd src/interp/preparse.lisp removed, moved into parsing.lisp
+20090420 tpd src/interp/postpar.boot removed, moved into parsing.lisp
+20090420 tpd src/interp/parse.boot removed, moved into parsing.lisp
+20090420 tpd src/interp/metalex.lisp removed, moved into parsing.lisp
+20090420 tpd src/interp/def.lisp removed, moved into parsing.lisp
+20090420 tpd src/interp/bootlex.lisp removed, moved into parsing.lisp
+20090420 tpd src/interp/parsing.lisp consolidate parsing
 20090419 tpd src/axiom-website/patches.html 20090419.02.tpd.patch
 20090419 tpd books/bookvol10.3 convert FRAC to +-> notation
 20090419 tpd src/input/Makefile add FRAC regression test
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 8858d1b..756aad5 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -1106,5 +1106,7 @@ bookvol9 move portions of the compiler <br/>
 bookvol9 move portions of the compiler <br/>
 <a href="patches/20090419.02.tpd.patch">20090419.02.tpd.patch</a>
 bookvol10.3 convert FRAC to +-> syntax <br/>
+<a href="patches/20090420.01.tpd.patch">20090420.01.tpd.patch</a>
+parsing.lisp consolidate parsing, remove autoload <br/>
  </body>
 </html>
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index a7c0ab4..69b845e 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -245,7 +245,10 @@ OBJS= ${OUT}/vmlisp.${O}      ${OUT}/hash.${O} \
       ${OUT}/spaderror.${O}    \
       ${OUT}/template.${O}    ${OUT}/termrw.${O} \
       ${OUT}/union.${O}       ${OUT}/daase.${O}   \
-      ${OUT}/fortcall.${O}
+      ${OUT}/fortcall.${O} \
+      ${OUT}/parsing.${O} ${OUT}/fnewmeta.${O} \
+      ${OUT}/postprop.${LISP}	
+
 
 @
 
@@ -276,12 +279,7 @@ generations of ``old'' and all meaning of the term is lost.
 
 <<environment>>=
 # These are autloaded old parser files
-OPOBJS=	${AUTO}/parsing.${O}	${AUTO}/bootlex.${O}	\
-        ${AUTO}/def.${O}	\
-	${AUTO}/fnewmeta.${O}	${AUTO}/metalex.${O}	\
-	${AUTO}/parse.${O}	${AUTO}/postpar.${O}	\
-	${AUTO}/postprop.${LISP}	${AUTO}/preparse.${O}
-
+OPOBJS=	
 @
 
 The {\bf OCOBJS} list contains files from the old compiler. Again,
@@ -318,9 +316,8 @@ to Common Lisp translator and are probably never used by anyone
 but the developers. These files should probably be autoloaded.
 <<environment>>=
 TRANOBJS= ${AUTO}/wi1.${O} ${AUTO}/wi2.${O} ${AUTO}/pspad1.${O} \
-	  ${AUTO}/pspad2.${O} ${AUTO}/mark.${O} ${AUTO}/nspadaux.${O} \
-	  ${AUTO}/def.${O}
-
+	  ${AUTO}/pspad2.${O} ${AUTO}/mark.${O} ${AUTO}/nspadaux.${O} 
+	  
 @
 
 The {\bf NAGBROBJS} list contains files used to access the 
@@ -452,7 +449,7 @@ DOCFILES=${DOC}/alql.boot.dvi \
 	 ${DOC}/bc-matrix.boot.dvi ${DOC}/bc-misc.boot.dvi \
 	 ${DOC}/bc-solve.boot.dvi ${DOC}/bc-util.boot.dvi \
 	 ${DOC}/bits.lisp.dvi ${DOC}/bootfuns.lisp.dvi \
-	 ${DOC}/bootlex.lisp.dvi ${DOC}/br-con.boot.dvi \
+	 ${DOC}/br-con.boot.dvi \
 	 ${DOC}/br-data.boot.dvi ${DOC}/br-op1.boot.dvi \
 	 ${DOC}/br-op2.boot.dvi ${DOC}/br-prof.boot.dvi \
 	 ${DOC}/br-saturn.boot.dvi ${DOC}/br-search.boot.dvi \
@@ -468,7 +465,7 @@ DOCFILES=${DOC}/alql.boot.dvi \
 	 ${DOC}/database.boot.dvi ${DOC}/debug.lisp.dvi \
 	 ${DOC}/define.boot.dvi \
 	 ${DOC}/dq.boot.dvi \
-	 ${DOC}/fname.lisp.dvi ${DOC}/fnewmeta.lisp.dvi \
+	 ${DOC}/fname.lisp.dvi \
 	 ${DOC}/foam_l.lisp.dvi \
 	 ${DOC}/format.boot.dvi ${DOC}/fortcall.boot.dvi \
 	 ${DOC}/functor.boot.dvi ${DOC}/g-boot.boot.dvi \
@@ -494,7 +491,6 @@ DOCFILES=${DOC}/alql.boot.dvi \
 	 ${DOC}/lisplib.boot.dvi ${DOC}/macex.boot.dvi \
 	 ${DOC}/macros.lisp.dvi ${DOC}/Makefile.dvi \
 	 ${DOC}/mark.boot.dvi ${DOC}/match.boot.dvi \
-	 ${DOC}/metalex.lisp.dvi  \
 	 ${DOC}/modemap.boot.dvi ${DOC}/monitor.lisp.dvi \
 	 ${DOC}/msg.boot.dvi ${DOC}/msgdb.boot.dvi \
 	 ${DOC}/nag-c02.boot.dvi ${DOC}/nag-c05.boot.dvi \
@@ -513,12 +509,12 @@ DOCFILES=${DOC}/alql.boot.dvi \
 	 ${DOC}/nruntime.boot.dvi ${DOC}/nspadaux.lisp.dvi \
 	 ${DOC}/obey.lisp.dvi ${DOC}/osyscmd.boot.dvi \
 	 ${DOC}/package.boot.dvi ${DOC}/packtran.boot.dvi \
-	 ${DOC}/parini.boot.dvi ${DOC}/parse.boot.dvi \
-	 ${DOC}/parsing.lisp.dvi ${DOC}/patches.lisp.dvi \
+	 ${DOC}/parini.boot.dvi \
+	 ${DOC}/patches.lisp.dvi \
 	 ${DOC}/pathname.boot.dvi \
 	 ${DOC}/pf2sex.boot.dvi ${DOC}/pile.boot.dvi \
-	 ${DOC}/posit.boot.dvi ${DOC}/postpar.boot.dvi \
-	 ${DOC}/postprop.lisp.dvi ${DOC}/preparse.lisp.dvi \
+	 ${DOC}/posit.boot.dvi \
+	 ${DOC}/postprop.lisp.dvi \
 	 ${DOC}/profile.boot.dvi ${DOC}/property.lisp.dvi \
 	 ${DOC}/pspad1.boot.dvi ${DOC}/pspad2.boot.dvi \
 	 ${DOC}/ptrees.boot.dvi ${DOC}/ptrop.boot.dvi \
@@ -783,12 +779,9 @@ of the form:
 <<depsys>>=
 ${DEPSYS}:	${DEP} ${OUT}/sys-pkg.${LISP} ${OUT}/nocompil.${LISP} \
 	        ${OUT}/bookvol5.${LISP} ${OUT}/util.${LISP} \
-	        ${OUT}/postpar.${LISP} ${OUT}/parse.${LISP} \
-	        ${OUT}/parsing.${LISP} ${OUT}/metalex.${LISP} \
-	        ${OUT}/bootlex.${LISP} ${OUT}/newaux.${LISP} \
-	        ${OUT}/preparse.${LISP} \
-	        ${OUT}/postprop.${LISP} ${OUT}/def.${LISP} \
-	        ${OUT}/fnewmeta.${LISP} \
+	        ${OUT}/parsing.${LISP} ${OUT}/fnewmeta.${LISP} \
+	        ${OUT}/newaux.${LISP} \
+	        ${OUT}/postprop.${LISP} \
 	        ${OUT}/g-boot.${LISP} ${OUT}/c-util.${LISP} \
 	        ${OUT}/g-util.${LISP} \
 	        ${OUT}/clam.${LISP} \
@@ -803,46 +796,22 @@ ${DEPSYS}:	${DEP} ${OUT}/sys-pkg.${LISP} ${OUT}/nocompil.${LISP} \
 	@ echo '(build-depsys (quote ($(patsubst %, "%", ${DEP})))' \
           '"${SPAD}" "${GCLDIR}" "${SRC}" "${INT}" "${OBJ}" "${MNT}"' \
           '"${SYS}")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/postpar.${O}")' \
-          '(compile-file "${OUT}/postpar.${LISP}"' \
-          ':output-file "${OUT}/postpar.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/postpar")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/parse.${O}")' \
-          '(compile-file "${OUT}/parse.${LISP}"' \
-          ':output-file "${OUT}/parse.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/parse")' >> ${OUT}/makedep.lisp
 	@ echo '(unless (probe-file "${OUT}/parsing.${O}")' \
           '(compile-file "${OUT}/parsing.${LISP}"' \
           ':output-file "${OUT}/parsing.${O}"))' >> ${OUT}/makedep.lisp
 	@ echo '(load "${OUT}/parsing")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/metalex.${O}")' \
-          '(compile-file "${OUT}/metalex.${LISP}"' \
-          ':output-file "${OUT}/metalex.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/metalex")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/bootlex.${O}")' \
-          '(compile-file "${OUT}/bootlex.${LISP}"' \
-          ':output-file "${OUT}/bootlex.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/bootlex")' >> ${OUT}/makedep.lisp
+	@ echo '(unless (probe-file "${OUT}/fnewmeta.${O}")' \
+          '(compile-file "${OUT}/fnewmeta.${LISP}"' \
+          ':output-file "${OUT}/fnewmeta.${O}"))' >> ${OUT}/makedep.lisp
+	@ echo '(load "${OUT}/fnewmeta")' >> ${OUT}/makedep.lisp
 	@ echo '(unless (probe-file "${OUT}/newaux.${O}")' \
           '(compile-file "${OUT}/newaux.${LISP}"' \
           ':output-file "${OUT}/newaux.${O}"))' >> ${OUT}/makedep.lisp
 	@ echo '(load "${OUT}/newaux")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/preparse.${O}")' \
-          '(compile-file "${OUT}/preparse.${LISP}"' \
-          ':output-file "${OUT}/preparse.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/preparse")' >> ${OUT}/makedep.lisp
 	@ echo '(unless (probe-file "${OUT}/postprop.${O}")' \
           '(compile-file "${OUT}/postprop.${LISP}"' \
           ':output-file "${OUT}/postprop.${O}"))' >> ${OUT}/makedep.lisp
 	@ echo '(load "${OUT}/postprop")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/def.${O}")' \
-          '(compile-file "${OUT}/def.${LISP}"' \
-          ':output-file "${OUT}/def.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/def")' >> ${OUT}/makedep.lisp
-	@ echo '(unless (probe-file "${OUT}/fnewmeta.${O}")' \
-          '(compile-file "${OUT}/fnewmeta.${LISP}"' \
-          ':output-file "${OUT}/fnewmeta.${O}"))' >> ${OUT}/makedep.lisp
-	@ echo '(load "${OUT}/fnewmeta")' >> ${OUT}/makedep.lisp
 	@ echo '(unless (probe-file "${OUT}/clam.${O}")' \
           '(compile-file "${OUT}/clam.${LISP}"' \
           ':output-file "${OUT}/clam.${O}"))' >> ${OUT}/makedep.lisp
@@ -875,7 +844,7 @@ compiler::*suppress-compiler-notes* to true in order to reduce the noise.
 <<savesys>>=
 ${SAVESYS}:	${DEPSYS} ${OBJS} ${OUT}/bookvol5.${O} ${OUT}/util.${O} \
                 ${OUT}/nocompil.${LISP} ${OUT}/sys-pkg.${LISP} \
-	        ${OUTINTERP} ${OCOBJS} ${OPOBJS} ${BROBJS} ${OUT}/obey.${O} \
+	        ${OUTINTERP} ${OCOBJS} ${BROBJS} ${OUT}/obey.${O} \
 		${OUT}/database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \
 		${NAGBROBJS} ${TRANOBJS} \
 	        ${LOADSYS} \
@@ -908,7 +877,7 @@ ${SAVESYS}:	${DEPSYS} ${OBJS} ${OUT}/bookvol5.${O} ${OUT}/util.${O} \
           '(quote ($(patsubst %, "%", ${OBJS})))'  \
           '(quote ($(patsubst %, "%", ${ASCOMP})))'  \
           '(quote ($(patsubst %, "%", ${INOBJS}))))' \
-          '(quote ($(patsubst %, "%", ${OPOBJS})))'  \
+          nil \
           '(quote ($(patsubst %, "%", ${OCOBJS})))'  \
           '(quote ($(patsubst %, "%", ${BROBJS})))'  \
           '(quote ($(patsubst %, "%", ${TRANOBJS})))'  \
@@ -9189,20 +9158,16 @@ pp
 \bibitem{6} {\bf www.aldor.org}
 \bibitem{7} {\bf \$SPAD/src/interp/apply.boot.pamphlet}
 \bibitem{8} {\bf \$SPAD/src/interp/bits.lisp.pamphlet}
-\bibitem{9} {\bf \$SPAD/src/interp/bootlex.lisp.pamphlet}
 \bibitem{10} {\bf \$SPAD/src/interp/cfuns.lisp.pamphlet}
 \bibitem{11} {\bf \$SPAD/src/interp/comp.lisp.pamphlet}
 \bibitem{12} {\bf \$SPAD/src/interp/construc.lisp.pamphlet}
 \bibitem{13} {\bf \$SPAD/src/interp/daase.lisp.pamphlet}
 \bibitem{14} {\bf \$SPAD/src/interp/debug.lisp.pamphlet}
-\bibitem{15} {\bf \$SPAD/src/interp/def.lisp.pamphlet}
 \bibitem{16} {\bf \$SPAD/src/interp/fortcall.boot.pamphlet}
 \bibitem{17} {\bf \$SPAD/src/interp/fname.lisp.pamphlet}
-\bibitem{18} {\bf \$SPAD/src/interp/fnewmeta.lisp.pamphlet}
 \bibitem{19} {\bf \$SPAD/src/interp/ggreater.lisp.pamphlet}
 \bibitem{20} {\bf \$SPAD/src/interp/hash.lisp.pamphlet}
 \bibitem{21} {\bf \$SPAD/src/interp/macros.lisp.pamphlet}
-\bibitem{22} {\bf \$SPAD/src/interp/metalex.lisp.pamphlet}
 \bibitem{24} {\bf \$SPAD/src/interp/monitor.lisp.pamphlet}
 \bibitem{25} {\bf \$SPAD/src/interp/newaux.lisp.pamphlet}
 \bibitem{26} {\bf \$SPAD/src/interp/nlib.lisp.pamphlet}
@@ -9210,7 +9175,6 @@ pp
 \bibitem{28} {\bf \$SPAD/src/interp/nspadaux.lisp.pamphlet}
 \bibitem{29} {\bf \$SPAD/src/interp/parsing.lisp.pamphlet}
 \bibitem{30} {\bf \$SPAD/src/interp/postprop.lisp.pamphlet}
-\bibitem{31} {\bf \$SPAD/src/interp/preparse.lisp.pamphlet}
 \bibitem{32} {\bf \$SPAD/src/interp/property.lisp.pamphlet}
 \bibitem{33} {\bf \$SPAD/src/interp/sockio.lisp.pamphlet}
 \bibitem{34} {\bf \$SPAD/src/interp/spad.lisp.pamphlet}
diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet
deleted file mode 100644
index c281226..0000000
--- a/src/interp/bootlex.lisp.pamphlet
+++ /dev/null
@@ -1,484 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp bootlex.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; 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.
-
-@
-<<*>>=
-<<license>>
-
-; NAME:		BootLex.lisp
-; PURPOSE:	Parsing support routines for Boot and Spad code
-; CONTENTS:
-;
-;		0. Global parameters
-;		1. BOOT File Handling
-;		2. BOOT Line Handling
-;		3. BOOT Token Handling
-;		4. BOOT Token Parsing Actions
-;		5. BOOT Error Handling
-
-(in-package "BOOT")
-
-; *** 0. Global parameters
-
-(defparameter Boot-Line-Stack nil	"List of lines returned from PREPARSE.")
-
-(defun Next-Lines-Clear () (setq Boot-Line-Stack nil))
-
-(defun Next-Lines-Show ()
-  (and Boot-Line-Stack (format t "Currently preparsed lines are:~%~%"))
-  (mapcar #'(lambda (line)
-	      (format t "~&~5D> ~A~%" (car line) (cdr Line)))
-	  Boot-Line-Stack))
-
-; *** 1. BOOT file handling
-
-(defun init-boot/spad-reader ()
-  (setq $SPAD_ERRORS (VECTOR 0 0 0))
-  (setq SPADERRORSTREAM *standard-output*)
-  (setq XTokenReader 'get-BOOT-token)
-  (setq Line-Handler 'next-BOOT-line)
-  (setq Meta_Error_Handler 'spad_syntax_error)
-  (setq File-Closed nil)
-  (Next-Lines-Clear)
-  (setq Boot-Line-Stack nil)
-  (ioclear))
-
-(defmacro test (x &rest y)
-  `(progn
-     (setq spaderrorstream t)
-     (in-boot)
-     (initialize-preparse *terminal-io*)
-     (,(intern (strconc "PARSE-" x)) . ,y)))
-
-(defun |oldParserAutoloadOnceTrigger| () nil)
-
-(defun print-defun (name body)
-   (let* ((sp (assoc 'vmlisp::compiler-output-stream vmlisp::optionlist))
-	  (st (if sp (cdr sp) *standard-output*)))
-     (if (and (is-console st) (symbolp name) (fboundp name)
-	      (not (compiled-function-p (symbol-function name))))
-	 (compile name))
-     (when (or |$PrettyPrint| (not (is-console st)))
-	   (print-full body st) (force-output st))))
-
-(defun boot-parse-1 (in-stream
-	      &aux
-	     (Echo-Meta nil)
-	     (current-fragment nil)
-	     ($INDEX 0)
-	     ($LineList nil)
-	     ($EchoLineStack nil)
-	     ($preparse-last-line nil)
-	     ($BOOT T)
-	     (*EOF* NIL)
-	     (OPTIONLIST NIL))
-  (declare (special echo-meta *comp370-apply* *EOF* File-Closed
-		    $index $linelist $echolinestack $preparse-last-line))
-  (init-boot/spad-reader)
-  (let* ((Boot-Line-Stack (PREPARSE in-stream))
-	 (parseout (prog2 (|PARSE-Expression|) (pop-stack-1)) ) )
-    ;(setq parseout (|new2OldLisp| parseout))
-    ; (setq parseout (DEF-RENAME parseout))
-    ; (DEF-PROCESS parseout)
-    parseout))
-
-(defun boot (&optional
-	      (*boot-input-file* nil)
-	      (*boot-output-file* nil)
-	     &aux
-	     (Echo-Meta t)
-	     ($BOOT T)
-	     (|$InteractiveMode| NIL)
-	     (XCape #\_)
-	     (File-Closed NIL)
-	     (*EOF* NIL)
-	     (OPTIONLIST NIL)
-	     (*fileactq-apply* (function print-defun))
-	     (*comp370-apply* (function print-defun)))
-  (declare (special echo-meta *comp370-apply* *EOF* File-Closed XCape))
-  (init-boot/spad-reader)
-  (with-open-stream
-    (in-stream (if *boot-input-file* (open *boot-input-file* :direction :input)
-		    *standard-input*))
-    (initialize-preparse in-stream)
-    (with-open-stream
-      (out-stream (if *boot-output-file*
-		      (open *boot-output-file* :direction :output)
-		      #-:cmulisp (make-broadcast-stream *standard-output*)
-		      #+:cmulisp *standard-output*
-		      ))
-      (when *boot-output-file*
-	 (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
-	 (print-package "BOOT"))
-      (loop (if (and (not File-Closed)
-		     (setq Boot-Line-Stack (PREPARSE in-stream)))
-		(progn
-		       (|PARSE-Expression|)
-		       (let ((parseout (pop-stack-1)) )
-			 (setq parseout (|new2OldLisp| parseout))
-			 (setq parseout (DEF-RENAME parseout))
-			 (let ((*standard-output* out-stream))
-			   (DEF-PROCESS parseout))
-			 (format out-stream "~&")
-			 (if (null parseout) (ioclear)) ))
-		(return nil)))
-      (if *boot-input-file*
-	  (format out-stream ";;;Boot translation finished for ~a~%"
-		  (namestring *boot-input-file*)))
-      (IOClear in-stream out-stream)))
-  T)
-
-(defun spad (&optional
-	      (*spad-input-file* nil)
-	      (*spad-output-file* nil)
-	     &aux
-	   (*comp370-apply* (function print-defun))
-	   (*fileactq-apply* (function print-defun))
-	   ($SPAD T)
-	   ($BOOT nil)
-	   (XCape #\_)
-	   (OPTIONLIST nil)
-	   (*EOF* NIL)
-	   (File-Closed NIL)
-	   (/editfile *spad-input-file*)
-	   (|$noSubsumption| |$noSubsumption|)
-	   in-stream out-stream)
-  (declare (special echo-meta /editfile *comp370-apply* *EOF*
-		    File-Closed Xcape |$noSubsumption|))
-  ;; only rebind |$InteractiveFrame| if compiling
-  (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
-	 (if (not |$InteractiveMode|)
-	     (list (|addBinding|
-		    '|$DomainsInScope|
-		    `((FLUID . |true|)
-		      (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
-		    (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
-  (init-boot/spad-reader)
-  (unwind-protect
-    (progn
-      (setq in-stream (if *spad-input-file*
-			 (open *spad-input-file* :direction :input)
-			 *standard-input*))
-      (initialize-preparse in-stream)
-      (setq out-stream (if *spad-output-file*
-			   (open *spad-output-file* :direction :output)
-			 *standard-output*))
-      (when *spad-output-file*
-	 (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
-	 (print-package "BOOT"))
-      (setq curoutstream out-stream)
-      (loop
-       (if (or *eof* file-closed) (return nil))
-       (catch 'SPAD_READER
-	 (if (setq Boot-Line-Stack (PREPARSE in-stream))
-	     (let ((LINE (cdar Boot-Line-Stack)))
-	       (declare (special LINE))
-	       (|PARSE-NewExpr|)
-	       (let ((parseout (pop-stack-1)) )
-		 (when parseout
-		       (let ((*standard-output* out-stream))
-			 (S-PROCESS parseout))
-		       (format out-stream "~&")))
-	       ;(IOClear in-stream out-stream)
-	       )))
-      (IOClear in-stream out-stream)))
-    (if *spad-input-file* (shut in-stream))
-    (if *spad-output-file* (shut out-stream)))
-  T))
-
-(defun READ-BOOT (FN FM TO)
-  (let (($boot t)) (READ-SPAD1 FN 'BOOT FM TO)))
-
-(defun READ-SPAD1 (FN FT FM TO)
-    (LET ((STRM IN-STREAM))
-      (SETQ $MAXLINENUMBER 0)
-      (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
-      (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
-      ($ERASE (LIST FN 'ERROR 'A))
-      (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
-      (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
-      (READ-SPAD-1)
-      (close SPADERRORSTREAM)
-      (SETQ IN-STREAM STRM)
-      (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
-	  (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
-	    '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
-	    '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
-      (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
-
-(defun READBOOT ()
-  (let (form expr ($BOOT 'T))
-    (declare (special $BOOT))
-    (ADVANCE-TOKEN)
-    (|PARSE-Expression|)
-   ;; (|pp| (setq form (|postTransform| (FIRST STACK))))
-    (|pp| (setq form (|postTransform| (pop-STACK-1))))
-    (setq EXPR (DEF-RENAME form))
-    (DEF-PROCESS EXPR)
-    (TERSYSCOMMAND)))
-
-;  *** 2. BOOT Line Handling ***
-
-; See the file PREPARSE.LISP for the hard parts of BOOT line processing.
-
-(defun next-BOOT-line (&optional (in-stream t))
-
-  "Get next line, trimming trailing blanks and trailing comments.
-One trailing blank is added to a non-blank line to ease between-line
-processing for Next Token (i.e., blank takes place of return).	Returns T
-if it gets a non-blank line, and NIL at end of stream."
-
-  (if Boot-Line-Stack
-      (let ((Line-Number (caar Boot-Line-Stack))
-	    (Line-Buffer (suffix #\Space (cdar Boot-Line-Stack))))
-	(pop Boot-Line-Stack)
-	(Line-New-Line Line-Buffer Current-Line Line-Number)
-	(setq |$currentLine| (setq LINE Line-Buffer))
-	Line-Buffer)))
-
-;  *** 3. BOOT Token Handling ***
-
-(defparameter xcape #\_ "Escape character for Boot code.")
-
-(defun get-BOOT-token (token)
-
-  "If you have an _, go to the next line.
-If you have a . followed by an integer, get a floating point number.
-Otherwise, get a .. identifier."
-
-  (if (not (boot-skip-blanks))
-      nil
-      (let ((token-type (boot-token-lookahead-type (current-char))))
-	(case token-type
-	  (eof			(token-install nil '*eof token nonblank))
-	  (escape		(advance-char)
-				(get-boot-identifier-token token t))
-	  (argument-designator	(get-argument-designator-token token))
-	  (id			(get-boot-identifier-token token))
-	  (num			(get-number-token token))
-	  (string		(get-SPADSTRING-token token))
-	  (special-char		(get-special-token token))
-	  (t			(get-gliph-token token token-type))))))
-
-(defun boot-skip-blanks ()
-  (setq nonblank t)
-  (loop (let ((cc (current-char)))
-	  (if (not cc) (return nil))
-	  (if (eq (boot-token-lookahead-type cc) 'white)
-	      (progn (setq nonblank nil) (if (not (advance-char)) (return nil)))
-	      (return t)))))
-
-(defun boot-token-lookahead-type (char)
-  "Predicts the kind of token to follow, based on the given initial character."
-  (cond ((not char)					   'eof)
-	((char= char #\_)				   'escape)
-	((and (char= char #\#) (digitp (next-char)))	   'argument-designator)
-	((digitp char)					   'num)
-	((and (char= char #\$) $boot
-	      (alpha-char-p (next-char)))		   'id)
-	((or (char= char #\%) (char= char #\?)
-	     (char= char #\!) (alpha-char-p char))	   'id)
-	((char= char #\")                                  'string)
-	((member char
-		 '(#\Space #\Tab #\Return)
-		 :test #'char=)				   'white)
-	((get (intern (string char)) 'Gliph))
-	(t						   'special-char)))
-
-(defun get-argument-designator-token (token)
-  (advance-char)
-  (get-number-token token)
-  (token-install (intern (strconc "#" (format nil "~D" (token-symbol token))))
-		 'argument-designator token nonblank))
-
-(defvar Keywords '(|or| |and| |isnt| |is| |otherwise| |when| |where|
-		  |has| |with| |add| |case| |in| |by| |pretend| |mod|
-		  |exquo| |div| |quo| |else| |rem| |then| |suchthat|
-		  |if| |yield| |iterate| |from| |exit| |leave| |return|
-		  |not| |unless| |repeat| |until| |while| |for| |import|)
-
-
-
-"Alphabetic literal strings occurring in the New Meta code constitute
-keywords.   These are recognized specifically by the AnyId production,
-GET-BOOT-IDENTIFIER will recognize keywords but flag them
-as keywords.")
-
-(defun get-boot-identifier-token (token &optional (escaped? nil))
-  "An identifier consists of an escape followed by any character, a %, ?,
-or an alphabetic, followed by any number of escaped characters, digits,
-or the chracters ?, !, ' or %"
-  (prog ((buf (make-adjustable-string 0))
-	 (default-package NIL))
-      (suffix (current-char) buf)
-      (advance-char)
-   id (let ((cur-char (current-char)))
-	 (cond ((char= cur-char XCape)
-		(if (not (advance-char)) (go bye))
-		(suffix (current-char) buf)
-		(setq escaped? t)
-		(if (not (advance-char)) (go bye))
-		(go id))
-	       ((and (null default-package)
-		     (char= cur-char #\'))
-		(setq default-package buf)
-		(setq buf (make-adjustable-string 0))
-		(if (not (advance-char)) (go bye))
-		(go id))
-	       ((or (alpha-char-p cur-char)
-		    (digitp cur-char)
-		    (member cur-char '(#\% #\' #\? #\!) :test #'char=))
-		(suffix (current-char) buf)
-		(if (not (advance-char)) (go bye))
-		(go id))))
-  bye (if (and (stringp default-package)
-	       (or (not (find-package default-package))	 ;; not a package name
-		   (every #'(lambda (x) (eql x #\')) buf))) ;;token ends with ''
-	  (setq buf (concatenate 'string default-package "'" buf)
-		default-package nil))
-      (setq buf (intern buf (or default-package "BOOT")))
-      (return (token-install
-		buf
-		(if (and (not escaped?)
-			 (member buf Keywords :test #'eq))
-		    'keyword 'identifier)
-		token
-		nonblank))))
-
-(defun get-gliph-token (token gliph-list)
-  (prog ((buf (make-adjustable-string 0)))
-	(suffix (current-char) buf)
-	(advance-char)
-   loop (setq gliph-list (assoc (intern (string (current-char))) gliph-list))
-	(if gliph-list
-	    (progn (suffix (current-char) buf)
-		   (pop gliph-list)
-		   (advance-char)
-		   (go loop))
-	    (let ((new-token (intern buf)))
-	      (return (token-install (or (get new-token 'renametok) new-token)
-				     'gliph token nonblank))))))
-
-(defun get-SPADSTRING-token (token)
-   "With TOK=\" and ABC\" on IN-STREAM, extracts and stacks string ABC"
-  (PROG ((BUF (make-adjustable-string 0)))
-	(if (char/= (current-char) #\") (RETURN NIL) (advance-char))
-	(loop
-	 (if (char= (current-char) #\") (return nil))
-	 (SUFFIX (if (char= (current-char) XCape)
-		     (advance-char)
-		   (current-char))
-		 BUF)
-	 (if (null  (advance-char)) ;;end of line
-	     (PROGN (|sayBrightly| "Close quote inserted") (RETURN nil)))
-	 )
-	(advance-char)
-	(return (token-install (copy-seq buf) ;should make a simple string
-			       'spadstring token))))
-
-; **** 4. BOOT token parsing actions
-
-; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
-
-(defun-parse-token SPADSTRING)
-(defun-parse-token KEYWORD)
-(defun-parse-token ARGUMENT-DESIGNATOR)
-
-(defun |boot-LEXPR| () (SETQ $NBOOT T) (New-LEXPR1))
-
-(defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X)
-
-(defun TRANSLABEL1 (X AL)
- "Transforms X according to AL = ((<label> . Sexpr) ..)."
-  (COND ((REFVECP X)
-	 (do ((i 0 (1+ i))
-	      (k (maxindex x)))
-	     ((> i k))
-	   (if (LET ((Y (LASSOC (ELT X I) AL))) (SETELT X I Y))
-	       (TRANSLABEL1 (ELT X I) AL))))
-	((ATOM X) NIL)
-	((LET ((Y (LASSOC (FIRST X) AL)))
-	   (if Y (setf (FIRST X) Y) (TRANSLABEL1 (CDR X) AL))))
-	((TRANSLABEL1 (FIRST X) AL) (TRANSLABEL1 (CDR X) AL))))
-
-; **** 5. BOOT Error Handling
-
-(defun SPAD_SYNTAX_ERROR (&rest byebye)
-  "Print syntax error indication, underline character, scrub line."
-  (BUMPERRORCOUNT '|syntax|)
-  (COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM)))
-	 (SPAD_LONG_ERROR))
-	((SPAD_SHORT_ERROR)))
-  (IOClear)
-  (throw 'spad_reader nil))
-
-(defun SPAD_LONG_ERROR ()
-  (SPAD_ERROR_LOC SPADERRORSTREAM)
-  (iostat)
-  (unless (EQUAL OUT-STREAM SPADERRORSTREAM)
-    (SPAD_ERROR_LOC OUT-STREAM)
-    (TERPRI OUT-STREAM)))
-
-(defun SPAD_SHORT_ERROR () (current-line-show))
-
-(defun SPAD_ERROR_LOC (STR)
-  (format str "******** Boot Syntax Error detected ********"))
-
-(defun BUMPERRORCOUNT (KIND)
-  (unless |$InteractiveMode|
-	  (LET ((INDEX (case KIND
-			 (|syntax| 0)
-			 (|precompilation| 1)
-			 (|semantic| 2)
-			 (T (ERROR "BUMPERRORCOUNT")))))
-	    (SETELT $SPAD_ERRORS INDEX (1+ (ELT $SPAD_ERRORS INDEX))))))
-
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/def.lisp.pamphlet b/src/interp/def.lisp.pamphlet
deleted file mode 100644
index 247268c..0000000
--- a/src/interp/def.lisp.pamphlet
+++ /dev/null
@@ -1,687 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp def.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; 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.
-
-@
-<<*>>=
-<<license>>
-
-; NAME:     Def
-; PURPOSE:  Defines BOOT code
-
-(provide 'Boot)
-
-(in-package "BOOT")
-
-;;; 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)))
-      (COMP (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 *STANDARD-OUTPUT*)
-	 (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))))
-   (COMP (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)))
-    (COMP (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)) ))
-       (LIST 'COND (LIST (SUBST RHS ' (DEFTRAN (LIST 'IS ' 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 MK_LEFORM (U)
-  (COND ((IDENTP U) (PNAME U))
-        ((STRINGP U) U)
-        ((ATOM U) (STRINGIMAGE U))
-        ((MEMBER (FIRST U) '(VCONS CONS) :test #'eq)
-         (STRCONC "(" (MK_LEFORM-CONS U) ")") )
-        ((EQ (FIRST U) 'LIST) (STRCONC "(" (MK_LEFORM (SECOND U)) ")") )
-        ((EQ (FIRST U) 'APPEND) (STRCONC "(" (MK_LEFORM-CONS U) ")") )
-        ((EQ (FIRST U) 'QUOTE) (MK_LEFORM (SECOND U)))
-        ((EQ (FIRST U) 'EQUAL) (STRCONC "=" (MK_LEFORM (SECOND U)) ))
-        ((EQ (FIRST U) 'SPADLET) (MK_LEFORM (THIRD U)))
-        ((ERRHUH))))
-
-(defun MK_LEFORM-CONS (U)
-  (COND ((ATOM U) (STRCONC ":" (MK_LEFORM U)))
-        ((EQ (FIRST U) 'APPEND)
-         (STRCONC ":" (MK_LEFORM (SECOND U)) "\," (MK_LEFORM-CONS (THIRD U)) ))
-        ((EQ (THIRD U) NIL) (MK_LEFORM (SECOND U)))
-        ((STRCONC (MK_LEFORM (SECOND U)) "\," (MK_LEFORM-CONS (THIRD U))))))
-
-(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 '|Tuple|)
-        (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))
-
-(defun ERRHUH () (|systemError| "problem with BOOT to LISP translation"))
-
-(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)))))
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/metalex.lisp.pamphlet b/src/interp/metalex.lisp.pamphlet
deleted file mode 100644
index bd491f9..0000000
--- a/src/interp/metalex.lisp.pamphlet
+++ /dev/null
@@ -1,296 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp metalex.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; 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.
-
-@
-<<*>>=
-<<license>>
-
-; NAME:         MetaLex.lisp
-; PURPOSE:      Parsing support routines for Meta code
-; CONTENTS:
-;
-;               1. META File Handling
-;               2. META Line Handling
-;               3. META Token Handling
-;               4. META Token Parsing Actions
-;               5. META Error Handling
- 
-(in-package "BOOT")
- 
-; *** 2. META Line Handling
- 
-(defun next-META-line (&optional (in-stream t))
- 
-"Get next line, trimming trailing blanks and trailing comments.
-One trailing blank is added to a non-blank line to ease between-line
-processing for Next Token (i.e., blank takes place of return).  Returns T
-if it gets a non-blank line, and NIL at end of stream."
- 
-  (prog (string)
-empty (if File-Closed (return nil))
-      (setq string (kill-trailing-blanks (kill-comments
-					  (get-a-line in-stream))))
-      (if (= (length string) 0) (go empty))
-      (Line-New-Line (suffix #\Space string) Current-Line)
-      (if Echo-Meta (Print-New-Line (Line-Buffer Current-Line) out-stream))
-      (return t)))
- 
-(defparameter Comment-Character #\% "Delimiter of comments in Meta code.")
- 
-(defun kill-comments (string)
-  "Deletes from comment character % to end of STRING."
-  (subseq string 0
-          (let ((mi (maxindex string)))
-            (do ((i 0 (1+ i)))
-                ((> i mi) i)
-              (if (and (char= (elt string i) Comment-Character)
-                       (or (eq i 0) (char/= (elt string (1- i)) #\\)))
-                  (return i))))))
- 
-(defun kill-trailing-blanks (string)
- 
-  "Remove white space from end of STRING."
- 
-  ; Coding note: yes, I know, use string-trim --  but it is broken
-  ; in Symbolics Common Lisp for short strings
- 
-  (let* ((sl (length string))
-         (right (if (= sl 0) -1
-                    (or
-                      (position-if-not
-                        #'(lambda (x)
-                            (member x '(#\Space #\Tab #\Newline) :test #'char=))
-                        string :from-end t)
-                      -1))))
-    (if (>= right 0) (subseq string 0 (1+ right)) (make-string 0))))
- 
-; *** 3. META Token Handling
- 
-; STRING: "'"  { Chars - "'" }* "'"
-; BSTRING: "[" ... "]*"
-; ID: letters, _ and then numbers
-; NUMBER: digits, ., digits, e, +-, digits
- 
-(defun-parse-token STRING)
-(defun-parse-token BSTRING)
-(defun-parse-token IDENTIFIER)
-(defun-parse-token NUMBER)
- 
-; Meta tokens fall into the following categories:
-;
-;               Number
-;               Identifier
-;               Dollar-sign
-;               Special character
-;
-; Special characters are represented as characters, numbers as numbers, and
-; identifiers as strings.  The reason identifiers are represented as strings is
-; that the full print-name of the intern of a string depends on the package you
-; are currently executing in; this can lead to very confusing results!
- 
-(defun get-META-token (token)
-  (prog nil
-   loop (if (not (skip-blanks)) (return nil))
-        (case (token-lookahead-type (current-char))
-          (id           (return (get-identifier-token token)))
-          (num          (return (get-number-token token)))
-          (string       (return (get-string-token token)))
-          (bstring      (return (get-bstring-token token)))
-;         (dollar       (return (get-identifier-token token)))
-          (special-char (return (get-special-token token)))
-          (eof          (return nil)))))
- 
-(defun skip-blanks ()
-  (loop (let ((cc (current-char)))
-          (if (not cc) (return nil))
-          (if (eq (token-lookahead-type cc) 'white)
-              (if (not (advance-char)) (return nil))
-              (return t)))))
- 
-(defparameter Escape-Character #\\ "Superquoting character.")
- 
-(defun token-lookahead-type (char)
-  "Predicts the kind of token to follow, based on the given initial character."
-  (cond ((not char)                                             'eof)
-        ((or (char= char Escape-Character) (alpha-char-p char)) 'id)
-        ((digitp char)                                          'num)
-        ((char= char #\')                                       'string)
-        ((char= char #\[)                                       'bstring)
-;       ((char= char #\$) (advance-char)                        'dollar)
-        ((member char '(#\Space #\Tab #\Return) :test #'char=)  'white)
-        (t                                                      'special-char)))
- 
-(defun make-adjustable-string (n)
-  (make-array (list n) :element-type 'string-char :adjustable t))
-
-(defun get-identifier-token (token)
-  "Take an identifier off the input stream."
-  (prog ((buf (make-adjustable-string 0)))
-   id (let ((cur-char (current-char)))
-         (cond ((equal cur-char Escape-Character)
-                (if (not (advance-char)) (go bye))
-                (suffix (current-char) buf)
-                (if (not (advance-char)) (go bye))
-                (go id))
-               ((or (alpha-char-p cur-char)
-                    (char= cur-char #\-)
-                    (digitp cur-char)
-                    (char= cur-char #\_))
-                (suffix (current-char) buf)
-                (if (not (advance-char)) (go bye))
-                (go id))))
-  bye (return (token-install (intern buf) 'identifier token))))
- 
-(defun get-string-token (token)
-  "With 'ABC' on IN-STREAM, extracts and stacks String 'ABC'."
-  (let ((buf (make-adjustable-string 0)))
-    (if (char= (current-char) #\')
-        (progn (advance-char)
-               (loop (case (current-char)
-                       (#\' (advance-char)
-                        (return (token-install buf 'string token)))
-                       (#\\ (advance-char)
-                        (suffix (current-char) buf)
-                        (advance-char))
-                       (#\Return
-                        (moan "String should fit on one line!")
-                        (advance-char)
-                        (meta-syntax-error)
-                        (return nil))
-                       (t (suffix (current-char) buf)
-                          (advance-char))))))))
- 
-(defun get-bstring-token (token)
-  "With ABC]* on in-stream, extracts and stacks string ABC."
-  (let ((buf (make-adjustable-string 0)))
-    (if (char= (current-char) #\[)
-        (progn (advance-char)
-               (loop (case (current-char)
-                       (#\] (if (char= (next-char) #\*)
-                                (progn (advance-char)
-                                       (advance-char)
-                                       (return (token-install buf 'bstring token)))
-                                (progn (suffix (current-char) buf)
-                                       (advance-char))))
-                       (#\\ (advance-char)
-                        (suffix (current-char) buf)
-                        (advance-char))
-                       (#\Return
-                        (moan "String should fit on one line!")
-                        (advance-char)
-                        (meta-syntax-error)
-                        (return nil))
-                       (t (suffix (current-char) buf)
-                          (advance-char))))))))
- 
-(defun get-special-token (token)
-  "Take a special character off the input stream.  We let the type name of each
-special character be the atom whose print name is the character itself."
-  (let ((symbol (current-char)))
-    (advance-char)
-    (token-install symbol 'special-char token)))
- 
-(defun get-number-token (token)
-  "Take a number off the input stream."
-  (prog ((buf (make-adjustable-string 0)))
-    nu1 (suffix (current-char) buf)                     ; Integer part
-        (let ((next-chr (next-char)))
-          (cond ((digitp next-chr)
-                 (advance-char)
-                 (go nu1))))
-        (advance-char) 
- formint(return (token-install
-		 (read-from-string buf)
-                  'number token
-		  (size buf) ;used to keep track of digit count
-		  ))))
- 
-; *** 4. META Auxiliary Parsing Actions
- 
-(defun make-defun (nametok vars body)
-  (let ((name (INTERN (STRCONC |META_PREFIX| nametok))))
-    (if vars
-        `(DEFUN ,name ,vars (declare (special . ,vars)) ,body)
-        `(DEFUN ,name ,vars ,body))))
- 
-(defun print-fluids (fluids)
-  (terpri out-stream)
-  (mapcar #'(lambda (x) (format out-stream "~&(DEFPARAMETER ~S NIL)~%" x)) fluids)
-  (terpri out-stream))
- 
-(defun print-package (package)
-  (format out-stream "~&~%(IN-PACKAGE ~S )~%~%" package))
- 
-(defparameter Meta_Prefix nil)
- 
-(defun set-prefix (prefix)  (setq META_PREFIX prefix))
- 
-(defun print-rule (x)  (print x out-stream) (format out-stream "~%~%"))
- 
-; *** 5. META Error Handling
- 
-(defun meta-meta-error-handler (&optional (wanted nil) (parsing nil))
-  "Print syntax error indication, underline character, scrub line."
-  (format out-stream "~&% MetaLanguage syntax error: ")
-  (if (Line-Past-End-P Current-Line)
-      (cond ((and wanted parsing)
-             (format out-stream "wanted ~A while parsing ~A.~%"
-                     wanted parsing))
-            (wanted (format out-stream "wanted ~A.~%" wanted))
-            (parsing (format out-stream "while parsing ~A.~%" parsing)))
-      (progn (format out-stream "~:[here~;wanted ~A here~]" wanted wanted)
-             (format out-stream "~:[~; while parsing ~A~]:~%" parsing parsing)
-             (current-line-print)
-             (current-line-clear)
-             (current-token)
-             (incf $num_of_meta_errors)
-             (setq Meta_Errors_Occurred t)))
-   nil)
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/parse.boot.pamphlet b/src/interp/parse.boot.pamphlet
deleted file mode 100644
index 5d9a4be..0000000
--- a/src/interp/parse.boot.pamphlet
+++ /dev/null
@@ -1,1321 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp parse.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-This file contains both the {\bf boot} code and the {\bf Lisp}
-code that is the result of the {\bf boot to lisp} translation.
-We need to keep the translated code around so we can bootstrap
-the system. In other words, we need this boot code translated
-so we can build the boot translator. 
-
-{\bf NOTE WELL: IF YOU CHANGE THIS BOOT CODE YOU MUST TRANSLATE
-THIS CODE TO LISP AND STORE THE RESULTING LISP CODE BACK INTO
-THIS FILE.}
-
-See the {\bf parse.clisp} section below.
-\section{parseTransform}
-This is the top-level function in this file. 
-
-When parsing spad code we walk an source code expression such as
-
-[[P ==> PositiveInteger]]
-
-This gets translated by [[|postTransform|]]\cite{1} into
-
-[[(MDEF P NIL NIL (|PositiveInteger|))]]
-
-[[|parseTranform|]] is called with this expression. The [[%]] symbol,
-which represents the current domain, is replaced with the [[$]] symbol
-internally. This hack was introduced because the Aldor compiler wanted
-to use [[%]] for the [[current domain]]. The Spad compiler used [[$]].
-In order not to have to change this everywhere we do a subsitution here.
-<<parseTransform>>=
-parseTransform x ==
-  $defOp: local:= nil
-  x := substitute('$,'%,x) -- for new compiler compatibility
-  parseTran x
-
-@
-\section{parseTran}
-[[|parseTran|]] sees an expression such as
-
-[[(MDEF P NIL NIL (|PositiveInteger|))]]
-
-It walks the
-expression, which is a list, item by item (note the tail recursive
-call in this function). In general, we are converting certain 
-source-level constructs into internal constructs. Note the subtle
-way that functions get called in this file. The information about
-what function to call is stored on the property list of the symbol.
-
-For example, given the form: [[(|has| S (|OrderedSet|))]]
-the symbol [[|has|]] occurs in the car of the list. [[|parseTran|]]
-assigns [[$op]] to be [[|has|]] and [[argl]] to be the list
-[[(S (|OrderedSet|))]]. Next, a local function [[g]], which checks
-for the compile-time elts, returns [[$op]] unchanged. The variable
-[[u]] is set to [[|has|]].
-
-Since [[|has|]] is an atom we do 
-[[(GET '|has| '|parseTran|)]] which returns [[|parseHas|]]
-because the symbol [[|has|]] contains the association 
-[[|parseTran| |parseHas|]] on it's symbol property list.
-You can see this by calling [[(symbol-plist '|has|)]].
-
-This ends up calling [[(|parseHas| '(S (|OrderedSet|)))]].
-
-The [[|parseTran|]] function walks the entire s-expression
-calling special parsers for various special forms in the input.
-This does things like reverse tests so that [[(if (not x) a b)]]
-becomes [[(if x b a)]], etc.
-
-<<parseTran>>= 
-parseTran x ==
-  $op: local := nil
-  atom x => parseAtom x
-  [$op,:argl]:= x
-  u := g($op) where g op == (op is ['elt,op,x] => g x; op)
-  u='construct =>
-    r:= parseConstruct argl
-    $op is ['elt,:.] => [parseTran $op,:rest r]
-    r
-  atom u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,argl)
-  [parseTran $op,:parseTranList argl]
- 
-@ 
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- 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.
-
-@
-<<*>>=
-<<license>>
-
---% Transformation of Parser Output
- 
-<<parseTransform>>
-<<parseTran>>
-
-parseAtom x ==
- -- next line for compatibility with new compiler
-  x = 'break => parseLeave ['$NoValue]
-  x
- 
-parseTranList l ==
-  atom l => parseTran l
-  [parseTran first l,:parseTranList rest l]
- 
-parseConstruct u ==
-  $insideConstructIfTrue: local:= true
-  l:= parseTranList u
-  ["construct",:l]
- 
-parseUpArrow u ==  parseTran ["**",:u]
- 
-parseLeftArrow u == parseTran ["LET",:u]
- 
-parseIs [a,b] == ['is,parseTran a,transIs parseTran b]
- 
-parseIsnt [a,b] == ['isnt,parseTran a,transIs parseTran b]
- 
-transIs u ==
-  isListConstructor u => ['construct,:transIs1 u]
-  u
- 
-isListConstructor u == u is [op,:.] and op in '(construct append cons)
- 
-transIs1 u ==
-  u is ['construct,:l] => [transIs x for x in l]
-  u is ['append,x,y] =>
-    h:= [":",transIs x]
-    (v:= transIs1 y) is [":",z] => [h,z]
-    v="nil" => first rest h
-    atom v => [h,[":",v]]
-    [h,:v]
-  u is ['cons,x,y] =>
-    h:= transIs x
-    (v:= transIs1 y) is [":",z] => [h,z]
-    v="nil" => [h]
-    atom v => [h,[":",v]]
-    [h,:v]
-  u
- 
-parseLET [x,y] ==
-  p := ['LET,parseTran x,parseTranCheckForRecord(y,opOf x)]
-  opOf x = 'cons => ['LET,transIs p.1,p.2]
-  p
- 
-parseLETD [x,y] == ['LETD,parseTran x,parseTran parseType y]
- 
-parseColon u ==
-  u is [x] => [":",parseTran x]
-  u is [x,typ] =>
-    $InteractiveMode =>
-      $insideConstructIfTrue=true => ['TAG,parseTran x,parseTran typ]
-      [":",parseTran x,parseTran parseType typ]
-    [":",parseTran x,parseTran typ]
- 
-parseBigelt [typ,consForm] ==
-  [['elt,typ,'makeRecord],:transUnCons consForm]
- 
-transUnCons u ==
-  atom u => systemErrorHere '"transUnCons"
-  u is ["APPEND",x,y] =>
-    null y => x
-    systemErrorHere '"transUnCons"
-  u is ["CONS",x,y] =>
-    atom y => [x,:y]
-    [x,:transUnCons y]
- 
-parseCoerce [x,typ] ==
-  $InteractiveMode => ["::",parseTran x,parseTran parseType typ]
-  ["::",parseTran x,parseTran typ]
- 
-parseAtSign [x,typ] ==
-  $InteractiveMode => ["@",parseTran x,parseTran parseType typ]
-  ["@",parseTran x,parseTran typ]
- 
-parsePretend [x,typ] ==
-  $InteractiveMode => ['pretend,parseTran x,parseTran parseType typ]
-  ['pretend,parseTran x,parseTran typ]
- 
-parseType x ==
-  x := substitute($EmptyMode,$quadSymbol,x)
-  x is ['typeOf,val] => ['typeOf,parseTran val]
-  $oldParserExpandAbbrs => parseTypeEvaluate unabbrevAndLoad x
-  x
- 
-parseTypeEvaluate form ==
-  form is [op,:argl] =>
-    newType? op => form
-    $op: local:= op
-    op = 'Mapping =>
-      [op,:[parseTypeEvaluate a for a in argl]]
-    op = 'Union =>
-      isTaggedUnion form =>
-        [op,:[['_:,sel,parseTypeEvaluate type] for
-          ['_:,sel,type] in argl]]
-      [op,:[parseTypeEvaluate a for a in argl]]
-    op = 'Record =>
-      [op,:[['_:,sel,parseTypeEvaluate type] for ['_:,sel,type] in argl]]
-    cmm :=
-      fn := constructor? op =>
-        p := pathname [fn,$spadLibFT,'"*"] =>
-          isExistingFile p => getConstructorModemap(abbreviation? fn)
-          nil
-      nil
-    cmm is [[.,.,:argml],:.] => [op,:parseTypeEvaluateArgs(argl,argml)]
-    throwKeyedMsg("S2IL0015",[op])
-  form
- 
-parseTypeEvaluateArgs(argl,argml) ==
-  [argVal for arg in argl for md in argml for i in 1..] where argVal ==
-      isCategoryForm(md,$CategoryFrame) => parseTypeEvaluate arg
-      arg
- 
- 
-parseTypeError(x,md,i) == throwKeyedMsg("S2IP0003",[i,$op,md])
- 
-specialModeTran form ==
-  form is [op,:argl] =>
-    not ATOM op => form --added 10/5/84 by SCM
-    (s0:= (sop:= PNAME op).0) = "*" =>
-      n:= #sop
-      n=1=> form
-      argKey:= sop.1
-      numArgs:= #argl - (argKey="1" => 1; 0)
-      zeroOrOne:= argKey="0" or argKey="1"
-      isDmp :=
-        numArgs < 10 =>
-          n=6 and ('"DMP"=SUBSTRING(sop,3,3)) and zeroOrOne
-        true =>
-          n=7 and ('"DMP"=SUBSTRING(sop,4,3)) and zeroOrOne
-      isDmp =>
-        if argKey="0" then
-          extraDomain:= $EmptyMode
-          vl:= argl
-         else
-          [:vl,extraDomain] := argl
-        ['DistributedMultivariatePolynomial,['construct,:vl],
-            specialModeTran extraDomain]
-      n=4 and (s3:= sop.3) = "M" and zeroOrOne =>
-        specialModeTran
-          extraDomain:= (argKey="0" => [$EmptyMode]; nil)
-          (n:= PARSE_-INTEGER PNAME sop.2)=1 =>
-            ['SquareMatrix,:argl,:extraDomain]
-          n=2 => ['RectangularMatrix,:argl,:extraDomain]
-          form
-      isUpOrMp :=
-        numArgs < 10 =>
-          n=4 and (s3:= sop.3) = 'P and zeroOrOne or
-            n=5 and (s3:= sop.3)='R and sop.4='F and zeroOrOne
-        true =>
-          n=5 and (s3:= sop.4) = 'P and zeroOrOne or
-            n=6 and (s3:= sop.4)='R and sop.5='F and zeroOrOne
-      isUpOrMp =>
-        polyForm:=
-          domainPart:= (argKey="0" => $EmptyMode; last argl)
-          argPart:= (argKey="0" => argl; drop(-1,argl))
-          numArgs < 10 and (n:= PARSE_-INTEGER PNAME sop.2)=1
-            => ['UP,:argPart,domainPart]
-          ['MP,['construct,:argPart],domainPart]
-        specialModeTran
-          s3 = 'R => [$QuotientField,polyForm]
-          polyForm
-      [first form,:[specialModeTran x for x in rest form]]
-    [first form,:[specialModeTran x for x in rest form]]
-  form
- 
-parseHas [x,y] ==
-  if $InteractiveMode then
-    x:=
-      get(x,'value,$CategoryFrame) is [D,m,.]
-        and m in '((Mode) (Domain) (SubDomain (Domain))) => D
-      parseType x
-  mkand [['has,x,u] for u in fn y] where
-    mkand x ==
-      x is [a] => a
-      ['and,:x]
-    fn y ==
-      if $InteractiveMode then y:= unabbrevAndLoad y
-      y is [":" ,op,['Mapping,:map]] =>
-         op:= (STRINGP op => INTERN op; op)
-         [['SIGNATURE,op,map]]
-      y is ['Join,:u] => "append"/[fn z for z in u]
-      y is ['CATEGORY,:u] => "append"/[fn z for z in u]
-      kk:= GETDATABASE(opOf y,'CONSTRUCTORKIND)
-      kk = 'domain or kk = 'category => [makeNonAtomic y]
-      y is ['ATTRIBUTE,:.] => [y]
-      y is ['SIGNATURE,:.] => [y]
-      $InteractiveMode => parseHasRhs y
-      [['ATTRIBUTE,y]]
- 
-parseHasRhs u ==   --$InteractiveMode = true
-  get(u,'value,$CategoryFrame) is [D,m,.]
-    and m in '((Mode) (Domain) (SubDomain (Domain))) => m
-  y := abbreviation? u =>
-    loadIfNecessary y => [unabbrevAndLoad y]
-    [['ATTRIBUTE,u]]
-  [['ATTRIBUTE,u]]
- 
-parseDEF [$lhs,tList,specialList,body] ==
-  setDefOp $lhs
-  ['DEF,parseLhs $lhs,parseTranList tList,parseTranList specialList,
-    parseTranCheckForRecord(body,opOf $lhs)]
- 
-parseLhs x ==
-  atom x => parseTran x
-  atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]]
-  parseTran x
- 
-parseMDEF [$lhs,tList,specialList,body] ==
-  ['MDEF,parseTran $lhs,parseTranList tList,parseTranList specialList,
-    parseTranCheckForRecord(body,opOf $lhs)]
- 
-parseTranCheckForRecord(x,op) ==
-  (x:= parseTran x) is ['Record,:l] =>
-    or/[y for y in l | y isnt [":",.,.]] =>
-      postError ['"   Constructor",:bright x,'"has missing label"]
-    x
-  x
- 
-parseCases [expr,ifClause] ==
-  casefn(expr,ifClause) where
-    casefn(x,ifExpr) ==
-      ifExpr='noBranch => ['ifClauseError,x]
-      ifExpr is ['IF,a,b,c] => ['IF,parseTran a,parseTran b,casefn(x,c)]
-      postError ['"   CASES format error: cases ",x," of ",ifExpr]
- 
-parseCategory x ==
-  l:= parseTranList parseDropAssertions x
-  key:=
-    CONTAINED("$",l) => "domain"
-    'package
-  ['CATEGORY,key,:l]
- 
-parseDropAssertions x ==
---note: the COPY of this list is necessary-- do not replace by RPLACing version
-  x is [y,:r] =>
-    y is ['IF,'asserted,:.] => parseDropAssertions r
-    [y,:parseDropAssertions r]
-  x
- 
-parseGreaterThan [x,y] ==
-  [substitute("<",">",$op),parseTran y,parseTran x]
- 
-parseGreaterEqual u == parseTran ['not,[substitute("<",">=",$op),:u]]
- 
-parseLessEqual u == parseTran ['not,[substitute(">","<=",$op),:u]]
- 
-parseNotEqual u == parseTran ['not,[substitute("=","^=",$op),:u]]
- 
-parseDollarGreaterThan [x,y] ==
-  [substitute("$<","$>",$op),parseTran y,parseTran x]
- 
-parseDollarGreaterEqual u ==
-  parseTran ['not,[substitute("$<","$>=",$op),:u]]
- 
-parseDollarLessEqual u ==
-  parseTran ['not,[substitute("$>","$<=",$op),:u]]
- 
-parseDollarNotEqual u ==
-  parseTran ['not,[substitute("$=","$^=",$op),:u]]
- 
-parseAnd u ==
-  $InteractiveMode => ['and,:parseTranList u]
-  null u => 'true
-  null rest u => first u
-  parseIf [parseTran first u,parseAnd rest u,"false"]
- 
-parseOr u ==
-  $InteractiveMode => ['or,:parseTranList u]
-  null u => 'false
-  null rest u => first u
-  (x:= parseTran first u) is ['not,y] => parseIf [y,parseOr rest u,'true]
-  true => parseIf [x,'true,parseOr rest u]
- 
-parseNot u ==
-  $InteractiveMode => ['not,parseTran first u]
-  parseTran ['IF,first u,:'(false true)]
- 
-parseEquivalence [a,b] == parseIf [a,b,parseIf [b,:'(false true)]]
- 
-parseImplies [a,b] == parseIf [a,b,'true]
- 
-parseExclusiveOr [a,b] == parseIf [a,parseIf [b,:'(false true)],b]
- 
-parseExit [a,:b] ==
-  --  note: I wanted to convert 1s to 0s here to facilitate indexing in
-  --   comp code; unfortunately, parseTran-ning is sometimes done more
-  --   than once so that the count can be decremented more than once
-  a:= parseTran a
-  b:= parseTran b
-  b =>
-    null INTEGERP a =>
-      (MOAN('"first arg ",a,'" for exit must be integer"); ['exit,1,a])
-    ['exit,a,:b]
-  ['exit,1,a]
- 
-parseLeave [a,:b] ==
-  a:= parseTran a
-  b:= parseTran b
-  b =>
-    null INTEGERP a =>
-      (MOAN('"first arg ",a,'" for 'leave' must be integer"); ['leave,1,a])
-    ['leave,a,:b]
-  ['leave,1,a]
- 
-parseReturn [a,:b] ==
-  a:= parseTran a
-  b:= parseTran b
-  b =>
-    (if a^=1 then MOAN '"multiple-level 'return' not allowed"; ["return",1,:b])
-  ['return,1,a]
- 
-parseJoin l ==
-  ['Join,:fn parseTranList l] where
-    fn l ==
-      null l => nil
-      l is [['Join,:x],:y] => [:x,:fn y]
-      [first l,:fn rest l]
- 
-parseInBy [i,n,inc] ==
-  (u:= parseIn [i,n]) isnt ['STEP,i,a,j,:r] =>
-    postError ["   You cannot use",:bright '"by",
-      '"except for an explicitly indexed sequence."]
-  inc:= parseTran inc
-  ['STEP,i,a,parseTran inc,:r]
- 
-parseSegment p ==
-  p is [a,b] =>
-    b => ['SEGMENT,parseTran a, parseTran b]
-    ['SEGMENT,parseTran a]
-  ['SEGMENT,:p]
- 
-parseIn [i,n] ==
-  i:= parseTran i
-  n:= parseTran n
-  n is ['SEGMENT,a] => ['STEP,i,a,1]
-  n is ['reverse,['SEGMENT,a]] =>
-    postError ['"  You cannot reverse an infinite sequence."]
-  n is ['SEGMENT,a,b] => (b => ['STEP,i,a,1,b]; ['STEP,i,a,1])
-  n is ['reverse,['SEGMENT,a,b]] =>
-    b => ['STEP,i,b,-1,a]
-    postError ['"  You cannot reverse an infinite sequence."]
-  n is ['tails,s] => ['ON,i,s]
-  ['IN,i,n]
- 
-parseIf t ==
-  t isnt [p,a,b] => t
-  ifTran(parseTran p,parseTran a,parseTran b) where
-    ifTran(p,a,b) ==
-      null($InteractiveMode) and p='true  => a
-      null($InteractiveMode) and p='false  => b
-      p is ['not,p'] => ifTran(p',b,a)
-      p is ['IF,p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b))
-      p is ['SEQ,:l,['exit,1,p']] =>
-        ['SEQ,:l,['exit,1,ifTran(p',incExitLevel a,incExitLevel b)]]
-         --this assumes that l has no exits
-      a is ['IF, =p,a',.] => ['IF,p,a',b]
-      b is ['IF, =p,.,b'] => ['IF,p,a,b']
-      makeSimplePredicateOrNil p is ['SEQ,:s,['exit,1,val]] =>
-        parseTran ['SEQ,:s,['exit,1,incExitLevel ['IF,val,a,b]]]
-      ['IF,p,a,b]
- 
-makeSimplePredicateOrNil p ==
-  isSimple p => nil
-  u:= isAlmostSimple p => u
-  true => wrapSEQExit [['LET,g:= GENSYM(),p],g]
- 
-parseWhere l == ['where,:mapInto(l,'parseTran)]
- 
- 
-parseSeq l ==
-  not l is [:.,['exit,:.]] =>
-    postError ['"   Invalid ending to block: ",last l]
-  transSeq mapInto(l,'parseTran)
- 
-transSeq l ==
-  null l => nil
-  null rest l => decExitLevel first l
-  [item,:tail]:= l
-  item is ['SEQ,:l,['exit,1,['IF,p,['exit, =2,q],'noBranch]]] and
-    (and/[x is ['LET,:.] for x in l]) =>
-      ['SEQ,:[decExitLevel x for x in l],['exit,1,['IF,decExitLevel p,
-        decExitLevel q,transSeq tail]]]
-  item is ['IF,a,['exit,1,b],'noBranch] =>
-    ['IF,decExitLevel a,decExitLevel b,transSeq tail]
-  item is ['IF,a,'noBranch,['exit,1,b]] =>
-    ['IF,decExitLevel a,transSeq tail,decExitLevel b]
-  (y:= transSeq tail) is ['SEQ,:s] => ['SEQ,item,:s]
-  ['SEQ,item,['exit,1,incExitLevel y]]
- 
-transCategoryItem x ==
-  x is ['SIGNATURE,lhs,rhs] =>
-    lhs is ['LISTOF,:y] =>
-      "append" /[transCategoryItem ['SIGNATURE,z,rhs] for z in y]
-    atom lhs =>
-      if STRINGP lhs then lhs:= INTERN lhs
-      rhs is ['Mapping,:m] =>
-        m is [.,'constant] => LIST ['SIGNATURE,lhs,[first m],'constant]
-        LIST ['SIGNATURE,lhs,m]
-      $transCategoryAssoc:= [[lhs,:rhs],:$transCategoryAssoc]
-      NIL
-    [op,:argl]:= lhs
-    extra:= nil
-    if rhs is ['Mapping,:m] then
-      if rest m then extra:= rest m
-                 --should only be 'constant' or 'variable'
-      rhs:= first m
-    LIST ['SIGNATURE,op,[rhs,:SUBLIS($transCategoryAssoc,argl)],:extra]
-  LIST x
- 
-superSub(name,x) ==
-  for u in x repeat y:= [:y,:u]
-  code:=
-    x is [[u]] => $quadSymbol
-    STRCONC("_(",scriptTranRow first x,scriptTran rest x,"_)")
-  [INTERNL(PNAME name,"$",code),:y]
- 
-scriptTran x ==
-  null x => ""
-  STRCONC(";",scriptTranRow first x,scriptTran rest x)
- 
-scriptTranRow x ==
-  null x => ""
-  STRCONC($quadSymbol,scriptTranRow1 rest x)
- 
-scriptTranRow1 x ==
-  null x => ""
-  STRCONC(",",$quadSymbol,scriptTranRow1 rest x)
- 
-parseVCONS l == ["VECTOR",:parseTranList l]
-@
-\section{parse.clisp}
-<<parse.clisp>>=
-
-(IN-PACKAGE "BOOT" )
-
-;--% Transformation of Parser Output
-;
-;parseTransform x ==
-;  $defOp: local:= nil
-;  x := substitute('$,'%,x) -- for new compiler compatibility
-;  parseTran x
-
-;;;     ***       |parseTransform| REDEFINED
-
-(DEFUN |parseTransform| (|x|) (PROG (|$defOp|) (DECLARE (SPECIAL |$defOp|)) (RETURN (PROGN (SPADLET |$defOp| NIL) (SPADLET |x| (MSUBST (QUOTE $) (QUOTE %) |x|)) (|parseTran| |x|))))) 
-;
-;parseTran x ==
-;  $op: local
-;  atom x => parseAtom x
-;  [$op,:argl]:= x
-;  u := g($op) where g op == (op is ['elt,op,x] => g x; op)
-;  u='construct =>
-;    r:= parseConstruct argl
-;    $op is ['elt,:.] => [parseTran $op,:rest r]
-;    r
-;  atom u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,argl)
-;  [parseTran $op,:parseTranList argl]
-
-;;;     ***       |parseTran,g| REDEFINED
-
-(DEFUN |parseTran,g| (|op|) (PROG (|ISTMP#1| |ISTMP#2| |x|) (RETURN (SEQ (IF (AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#1| (QCDR |op|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |x| (QCAR |ISTMP#2|)) (QUOTE T))))))) (EXIT (|parseTran,g| |x|))) (EXIT |op|))))) 
-
-;;;     ***       |parseTran| REDEFINED
-
-(DEFUN |parseTran| (|x|) (PROG (|$op| |argl| |u| |r| |fn|) (DECLARE (SPECIAL |$op|)) (RETURN (PROGN (SPADLET |$op| NIL) (COND ((ATOM |x|) (|parseAtom| |x|)) ((QUOTE T) (SPADLET |$op| (CAR |x|)) (SPADLET |argl| (CDR |x|)) (SPADLET |u| (|parseTran,g| |$op|)) (COND ((BOOT-EQUAL |u| (QUOTE |construct|)) (SPADLET |r| (|parseConstruct| |argl|)) (COND ((AND (PAIRP |$op|) (EQ (QCAR |$op|) (QUOTE |elt|))) (CONS (|parseTran| |$op|) (CDR |r|))) ((QUOTE T) |r|))) ((AND (ATOM |u|) (SPADLET |fn| (GETL |u| (QUOTE |parseTran|)))) (FUNCALL |fn| |argl|)) ((QUOTE T) (CONS (|parseTran| |$op|) (|parseTranList| |argl|)))))))))) 
-;
-;parseAtom x ==
-; -- next line for compatibility with new compiler
-;  x = 'break => parseLeave ['$NoValue]
-;  x
-
-;;;     ***       |parseAtom| REDEFINED
-
-(DEFUN |parseAtom| (|x|) (COND ((BOOT-EQUAL |x| (QUOTE |break|)) (|parseLeave| (CONS (QUOTE |$NoValue|) NIL))) ((QUOTE T) |x|))) 
-;
-;parseTranList l ==
-;  atom l => parseTran l
-;  [parseTran first l,:parseTranList rest l]
-
-;;;     ***       |parseTranList| REDEFINED
-
-(DEFUN |parseTranList| (|l|) (COND ((ATOM |l|) (|parseTran| |l|)) ((QUOTE T) (CONS (|parseTran| (CAR |l|)) (|parseTranList| (CDR |l|)))))) 
-;
-;parseConstruct u ==
-;  $insideConstructIfTrue: local:= true
-;  l:= parseTranList u
-;  ["construct",:l]
-
-;;;     ***       |parseConstruct| REDEFINED
-
-(DEFUN |parseConstruct| (|u|) (PROG (|$insideConstructIfTrue| |l|) (DECLARE (SPECIAL |$insideConstructIfTrue|)) (RETURN (PROGN (SPADLET |$insideConstructIfTrue| (QUOTE T)) (SPADLET |l| (|parseTranList| |u|)) (CONS (QUOTE |construct|) |l|))))) 
-;
-;parseUpArrow u ==  parseTran ["**",:u]
-
-;;;     ***       |parseUpArrow| REDEFINED
-
-(DEFUN |parseUpArrow| (|u|) (|parseTran| (CONS (QUOTE **) |u|))) 
-;
-;parseLeftArrow u == parseTran ["LET",:u]
-
-;;;     ***       |parseLeftArrow| REDEFINED
-
-(DEFUN |parseLeftArrow| (|u|) (|parseTran| (CONS (QUOTE LET) |u|))) 
-;
-;parseIs [a,b] == ['is,parseTran a,transIs parseTran b]
-
-;;;     ***       |parseIs| REDEFINED
-
-(DEFUN |parseIs| (#0=#:G2259) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (CONS (QUOTE |is|) (CONS (|parseTran| |a|) (CONS (|transIs| (|parseTran| |b|)) NIL))))))) 
-;
-;parseIsnt [a,b] == ['isnt,parseTran a,transIs parseTran b]
-
-;;;     ***       |parseIsnt| REDEFINED
-
-(DEFUN |parseIsnt| (#0=#:G2273) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (CONS (QUOTE |isnt|) (CONS (|parseTran| |a|) (CONS (|transIs| (|parseTran| |b|)) NIL))))))) 
-;
-;transIs u ==
-;  isListConstructor u => ['construct,:transIs1 u]
-;  u
-
-;;;     ***       |transIs| REDEFINED
-
-(DEFUN |transIs| (|u|) (COND ((|isListConstructor| |u|) (CONS (QUOTE |construct|) (|transIs1| |u|))) ((QUOTE T) |u|))) 
-;
-;isListConstructor u == u is [op,:.] and op in '(construct append cons)
-
-;;;     ***       |isListConstructor| REDEFINED
-
-(DEFUN |isListConstructor| (|u|) (PROG (|op|) (RETURN (AND (PAIRP |u|) (PROGN (SPADLET |op| (QCAR |u|)) (QUOTE T)) (|member| |op| (QUOTE (|construct| |append| |cons|))))))) 
-;
-;transIs1 u ==
-;  u is ['construct,:l] => [transIs x for x in l]
-;  u is ['append,x,y] =>
-;    h:= [":",transIs x]
-;    (v:= transIs1 y) is [":",z] => [h,z]
-;    v="nil" => first rest h
-;    atom v => [h,[":",v]]
-;    [h,:v]
-;  u is ['cons,x,y] =>
-;    h:= transIs x
-;    (v:= transIs1 y) is [":",z] => [h,z]
-;    v="nil" => [h]
-;    atom v => [h,[":",v]]
-;    [h,:v]
-;  u
-
-;;;     ***       |transIs1| REDEFINED
-
-(DEFUN |transIs1| (|u|) (PROG (|l| |x| |y| |h| |v| |ISTMP#1| |ISTMP#2| |z|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |l| (QCDR |u|)) (QUOTE T))) (PROG (#0=#:G2354) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2359 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|transIs| |x|) #0#)))))))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |append|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |h| (CONS (QUOTE |:|) (CONS (|transIs| |x|) NIL))) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |v| (|transIs1| |y|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |z| (QCAR |ISTMP#2|)) (QUOTE T)))))) (CONS |h| (CONS |z| NIL))) ((BOOT-EQUAL |v| (QUOTE |nil|)) (CAR (CDR |h|))) ((ATOM |v|) (CONS |h| (CONS (CONS (QUOTE |:|) (CONS |v| NIL)) NIL))) ((QUOTE T) (CONS |h| |v|)))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |cons|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |h| (|transIs| |x|)) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |v| (|transIs1| |y|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |z| (QCAR |ISTMP#2|)) (QUOTE T)))))) (CONS |h| (CONS |z| NIL))) ((BOOT-EQUAL |v| (QUOTE |nil|)) (CONS |h| NIL)) ((ATOM |v|) (CONS |h| (CONS (CONS (QUOTE |:|) (CONS |v| NIL)) NIL))) ((QUOTE T) (CONS |h| |v|)))) ((QUOTE T) |u|)))))) 
-;
-;parseLET [x,y] ==
-;  p := ['LET,parseTran x,parseTranCheckForRecord(y,opOf x)]
-;  opOf x = 'cons => ['LET,transIs p.1,p.2]
-;  p
-
-;;;     ***       |parseLET| REDEFINED
-
-(DEFUN |parseLET| (#0=#:G2389) (PROG (|x| |y| |p|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (SPADLET |p| (CONS (QUOTE LET) (CONS (|parseTran| |x|) (CONS (|parseTranCheckForRecord| |y| (|opOf| |x|)) NIL)))) (COND ((BOOT-EQUAL (|opOf| |x|) (QUOTE |cons|)) (CONS (QUOTE LET) (CONS (|transIs| (ELT |p| 1)) (CONS (ELT |p| 2) NIL)))) ((QUOTE T) |p|)))))) 
-;
-;parseLETD [x,y] == ['LETD,parseTran x,parseTran parseType y]
-
-;;;     ***       |parseLETD| REDEFINED
-
-(DEFUN |parseLETD| (#0=#:G2404) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (QUOTE LETD) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |y|)) NIL))))))) 
-;
-;parseColon u ==
-;  u is [x] => [":",parseTran x]
-;  u is [x,typ] =>
-;    $InteractiveMode =>
-;      $insideConstructIfTrue=true => ['TAG,parseTran x,parseTran typ]
-;      [":",parseTran x,parseTran parseType typ]
-;    [":",parseTran x,parseTran typ]
-
-;;;     ***       |parseColon| REDEFINED
-
-(DEFUN |parseColon| (|u|) (PROG (|x| |ISTMP#1| |typ|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (PROGN (SPADLET |x| (QCAR |u|)) (QUOTE T))) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) NIL))) ((AND (PAIRP |u|) (PROGN (SPADLET |x| (QCAR |u|)) (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |typ| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND (|$InteractiveMode| (COND ((BOOT-EQUAL |$insideConstructIfTrue| (QUOTE T)) (CONS (QUOTE TAG) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL)))) ((QUOTE T) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))))) ((QUOTE T) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL)))))))))) 
-;
-;parseBigelt [typ,consForm] ==
-;  [['elt,typ,'makeRecord],:transUnCons consForm]
-
-;;;     ***       |parseBigelt| REDEFINED
-
-(DEFUN |parseBigelt| (#0=#:G2437) (PROG (|typ| |consForm|) (RETURN (PROGN (SPADLET |typ| (CAR #0#)) (SPADLET |consForm| (CADR #0#)) (CONS (CONS (QUOTE |elt|) (CONS |typ| (CONS (QUOTE |makeRecord|) NIL))) (|transUnCons| |consForm|)))))) 
-;
-;transUnCons u ==
-;  atom u => systemErrorHere '"transUnCons"
-;  u is ["APPEND",x,y] =>
-;    null y => x
-;    systemErrorHere '"transUnCons"
-;  u is ["CONS",x,y] =>
-;    atom y => [x,:y]
-;    [x,:transUnCons y]
-
-;;;     ***       |transUnCons| REDEFINED
-
-(DEFUN |transUnCons| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((ATOM |u|) (|systemErrorHere| (MAKESTRING "transUnCons"))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE APPEND)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((NULL |y|) |x|) ((QUOTE T) (|systemErrorHere| (MAKESTRING "transUnCons"))))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE CONS)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((ATOM |y|) (CONS |x| |y|)) ((QUOTE T) (CONS |x| (|transUnCons| |y|))))))))) 
-;
-;parseCoerce [x,typ] ==
-;  $InteractiveMode => ["::",parseTran x,parseTran parseType typ]
-;  ["::",parseTran x,parseTran typ]
-
-;;;     ***       |parseCoerce| REDEFINED
-
-(DEFUN |parseCoerce| (#0=#:G2498) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE |::|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE |::|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) 
-;
-;parseAtSign [x,typ] ==
-;  $InteractiveMode => ["@",parseTran x,parseTran parseType typ]
-;  ["@",parseTran x,parseTran typ]
-
-;;;     ***       |parseAtSign| REDEFINED
-
-(DEFUN |parseAtSign| (#0=#:G2513) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE @) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE @) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) 
-;
-;parsePretend [x,typ] ==
-;  $InteractiveMode => ['pretend,parseTran x,parseTran parseType typ]
-;  ['pretend,parseTran x,parseTran typ]
-
-;;;     ***       |parsePretend| REDEFINED
-
-(DEFUN |parsePretend| (#0=#:G2528) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE |pretend|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE |pretend|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) 
-;
-;parseType x ==
-;  x := substitute($EmptyMode,$quadSymbol,x)
-;  x is ['typeOf,val] => ['typeOf,parseTran val]
-;  $oldParserExpandAbbrs => parseTypeEvaluate unabbrevAndLoad x
-;  x
-
-;;;     ***       |parseType| REDEFINED
-
-(DEFUN |parseType| (|x|) (PROG (|ISTMP#1| |val|) (RETURN (PROGN (SPADLET |x| (MSUBST |$EmptyMode| |$quadSymbol| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |typeOf|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE |typeOf|) (CONS (|parseTran| |val|) NIL))) (|$oldParserExpandAbbrs| (|parseTypeEvaluate| (|unabbrevAndLoad| |x|))) ((QUOTE T) |x|)))))) 
-;
-;parseTypeEvaluate form ==
-;  form is [op,:argl] =>
-;    newType? op => form
-;    $op: local:= op
-;    op = 'Mapping =>
-;      [op,:[parseTypeEvaluate a for a in argl]]
-;    op = 'Union =>
-;      isTaggedUnion form =>
-;        [op,:[['_:,sel,parseTypeEvaluate type] for
-;          ['_:,sel,type] in argl]]
-;      [op,:[parseTypeEvaluate a for a in argl]]
-;    op = 'Record =>
-;      [op,:[['_:,sel,parseTypeEvaluate type] for ['_:,sel,type] in argl]]
-;    cmm :=
-;      fn := constructor? op =>
-;        p := pathname [fn,$spadLibFT,'"*"] =>
-;          isExistingFile p => getConstructorModemap(abbreviation? fn)
-;          nil
-;      nil
-;    cmm is [[.,.,:argml],:.] => [op,:parseTypeEvaluateArgs(argl,argml)]
-;    throwKeyedMsg("S2IL0015",[op])
-;  form
-
-;;;     ***       |parseTypeEvaluate| REDEFINED
-
-(DEFUN |parseTypeEvaluate| (|form|) (PROG (|$op| |op| |argl| |sel| |type| |fn| |p| |cmm| |ISTMP#1| |ISTMP#2| |argml|) (DECLARE (SPECIAL |$op|)) (RETURN (SEQ (COND ((AND (PAIRP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((|newType?| |op|) |form|) ((QUOTE T) (SPADLET |$op| |op|) (COND ((BOOT-EQUAL |op| (QUOTE |Mapping|)) (CONS |op| (PROG (#0=#:G2583) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2588 |argl| (CDR #1#)) (|a| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |a| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|parseTypeEvaluate| |a|) #0#))))))))) ((BOOT-EQUAL |op| (QUOTE |Union|)) (COND ((|isTaggedUnion| |form|) (CONS |op| (PROG (#2=#:G2599) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G2605 |argl| (CDR #3#)) (#4=#:G2556 NIL)) ((OR (ATOM #3#) (PROGN (SETQ #4# (CAR #3#)) NIL) (PROGN (PROGN (SPADLET |sel| (CADR #4#)) (SPADLET |type| (CADDR #4#)) #4#) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (CONS (QUOTE |:|) (CONS |sel| (CONS (|parseTypeEvaluate| |type|) NIL))) #2#))))))))) ((QUOTE T) (CONS |op| (PROG (#5=#:G2616) (SPADLET #5# NIL) (RETURN (DO ((#6=#:G2621 |argl| (CDR #6#)) (|a| NIL)) ((OR (ATOM #6#) (PROGN (SETQ |a| (CAR #6#)) NIL)) (NREVERSE0 #5#)) (SEQ (EXIT (SETQ #5# (CONS (|parseTypeEvaluate| |a|) #5#))))))))))) ((BOOT-EQUAL |op| (QUOTE |Record|)) (CONS |op| (PROG (#7=#:G2632) (SPADLET #7# NIL) (RETURN (DO ((#8=#:G2638 |argl| (CDR #8#)) (#9=#:G2561 NIL)) ((OR (ATOM #8#) (PROGN (SETQ #9# (CAR #8#)) NIL) (PROGN (PROGN (SPADLET |sel| (CADR #9#)) (SPADLET |type| (CADDR #9#)) #9#) NIL)) (NREVERSE0 #7#)) (SEQ (EXIT (SETQ #7# (CONS (CONS (QUOTE |:|) (CONS |sel| (CONS (|parseTypeEvaluate| |type|) NIL))) #7#))))))))) ((QUOTE T) (SPADLET |cmm| (SEQ (COND ((SPADLET |fn| (|constructor?| |op|)) (COND ((SPADLET |p| (|pathname| (CONS |fn| (CONS |$spadLibFT| (CONS (MAKESTRING "*") NIL))))) (EXIT (COND ((|isExistingFile| |p|) (|getConstructorModemap| (|abbreviation?| |fn|))) ((QUOTE T) NIL)))))) ((QUOTE T) NIL)))) (COND ((AND (PAIRP |cmm|) (PROGN (SPADLET |ISTMP#1| (QCAR |cmm|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |argml| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS |op| (|parseTypeEvaluateArgs| |argl| |argml|))) ((QUOTE T) (|throwKeyedMsg| (QUOTE S2IL0015) (CONS |op| NIL))))))))) ((QUOTE T) |form|)))))) 
-;
-;parseTypeEvaluateArgs(argl,argml) ==
-;  [argVal for arg in argl for md in argml for i in 1..] where argVal ==
-;      isCategoryForm(md,$CategoryFrame) => parseTypeEvaluate arg
-;      arg
-
-;;;     ***       |parseTypeEvaluateArgs| REDEFINED
-
-(DEFUN |parseTypeEvaluateArgs| (|argl| |argml|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G2675) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2682 |argl| (CDR #1#)) (|arg| NIL) (#2=#:G2683 |argml| (CDR #2#)) (|md| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #1#) (PROGN (SETQ |arg| (CAR #1#)) NIL) (ATOM #2#) (PROGN (SETQ |md| (CAR #2#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((|isCategoryForm| |md| |$CategoryFrame|) (|parseTypeEvaluate| |arg|)) ((QUOTE T) |arg|)) #0#))))))))))) 
-;
-;
-;parseTypeError(x,md,i) == throwKeyedMsg("S2IP0003",[i,$op,md])
-
-;;;     ***       |parseTypeError| REDEFINED
-
-(DEFUN |parseTypeError| (|x| |md| |i|) (|throwKeyedMsg| (QUOTE S2IP0003) (CONS |i| (CONS |$op| (CONS |md| NIL))))) 
-;
-;specialModeTran form ==
-;  form is [op,:argl] =>
-;    not ATOM op => form --added 10/5/84 by SCM
-;    (s0:= (sop:= PNAME op).0) = "*" =>
-;      n:= #sop
-;      n=1=> form
-;      argKey:= sop.1
-;      numArgs:= #argl - (argKey="1" => 1; 0)
-;      zeroOrOne:= argKey="0" or argKey="1"
-;      isDmp :=
-;        numArgs < 10 =>
-;          n=6 and ('"DMP"=SUBSTRING(sop,3,3)) and zeroOrOne
-;        true =>
-;          n=7 and ('"DMP"=SUBSTRING(sop,4,3)) and zeroOrOne
-;      isDmp =>
-;        if argKey="0" then
-;          extraDomain:= $EmptyMode
-;          vl:= argl
-;         else
-;          [:vl,extraDomain] := argl
-;        ['DistributedMultivariatePolynomial,['construct,:vl],
-;            specialModeTran extraDomain]
-;      n=4 and (s3:= sop.3) = "M" and zeroOrOne =>
-;        specialModeTran
-;          extraDomain:= (argKey="0" => [$EmptyMode]; nil)
-;          (n:= PARSE_-INTEGER PNAME sop.2)=1 =>
-;            ['SquareMatrix,:argl,:extraDomain]
-;          n=2 => ['RectangularMatrix,:argl,:extraDomain]
-;          form
-;      isUpOrMp :=
-;        numArgs < 10 =>
-;          n=4 and (s3:= sop.3) = 'P and zeroOrOne or
-;            n=5 and (s3:= sop.3)='R and sop.4='F and zeroOrOne
-;        true =>
-;          n=5 and (s3:= sop.4) = 'P and zeroOrOne or
-;            n=6 and (s3:= sop.4)='R and sop.5='F and zeroOrOne
-;      isUpOrMp =>
-;        polyForm:=
-;          domainPart:= (argKey="0" => $EmptyMode; last argl)
-;          argPart:= (argKey="0" => argl; drop(-1,argl))
-;          numArgs < 10 and (n:= PARSE_-INTEGER PNAME sop.2)=1
-;            => ['UP,:argPart,domainPart]
-;          ['MP,['construct,:argPart],domainPart]
-;        specialModeTran
-;          s3 = 'R => [$QuotientField,polyForm]
-;          polyForm
-;      [first form,:[specialModeTran x for x in rest form]]
-;    [first form,:[specialModeTran x for x in rest form]]
-;  form
-
-;;;     ***       |specialModeTran| REDEFINED
-
-(DEFUN |specialModeTran| (|form|) (PROG (|op| |argl| |sop| |s0| |argKey| |numArgs| |zeroOrOne| |isDmp| |LETTMP#1| |vl| |extraDomain| |s3| |isUpOrMp| |domainPart| |argPart| |n| |polyForm|) (RETURN (SEQ (COND ((AND (PAIRP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((NULL (ATOM |op|)) |form|) ((BOOT-EQUAL (SPADLET |s0| (ELT (SPADLET |sop| (PNAME |op|)) 0)) (QUOTE *)) (SPADLET |n| (|#| |sop|)) (COND ((EQL |n| 1) |form|) ((QUOTE T) (SPADLET |argKey| (ELT |sop| 1)) (SPADLET |numArgs| (SPADDIFFERENCE (|#| |argl|) (COND ((BOOT-EQUAL |argKey| (QUOTE |1|)) 1) ((QUOTE T) 0)))) (SPADLET |zeroOrOne| (OR (BOOT-EQUAL |argKey| (QUOTE |0|)) (BOOT-EQUAL |argKey| (QUOTE |1|)))) (SPADLET |isDmp| (COND ((> 10 |numArgs|) (AND (EQL |n| 6) (BOOT-EQUAL (MAKESTRING "DMP") (SUBSTRING |sop| 3 3)) |zeroOrOne|)) ((QUOTE T) (AND (EQL |n| 7) (BOOT-EQUAL (MAKESTRING "DMP") (SUBSTRING |sop| 4 3)) |zeroOrOne|)))) (COND (|isDmp| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (SPADLET |extraDomain| |$EmptyMode|) (SPADLET |vl| |argl|)) ((QUOTE T) (SPADLET |LETTMP#1| (REVERSE |argl|)) (SPADLET |extraDomain| (CAR |LETTMP#1|)) (SPADLET |vl| (NREVERSE (CDR |LETTMP#1|))) |argl|)) (CONS (QUOTE |DistributedMultivariatePolynomial|) (CONS (CONS (QUOTE |construct|) |vl|) (CONS (|specialModeTran| |extraDomain|) NIL)))) ((AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE M)) |zeroOrOne|) (|specialModeTran| (PROGN (SPADLET |extraDomain| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (CONS |$EmptyMode| NIL)) ((QUOTE T) NIL))) (COND ((EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1) (CONS (QUOTE |SquareMatrix|) (APPEND |argl| |extraDomain|))) ((EQL |n| 2) (CONS (QUOTE |RectangularMatrix|) (APPEND |argl| |extraDomain|))) ((QUOTE T) |form|))))) ((QUOTE T) (SPADLET |isUpOrMp| (COND ((> 10 |numArgs|) (OR (AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 4) (QUOTE F)) |zeroOrOne|))) ((QUOTE T) (OR (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 6) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 5) (QUOTE F)) |zeroOrOne|))))) (COND (|isUpOrMp| (SPADLET |polyForm| (PROGN (SPADLET |domainPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |$EmptyMode|) ((QUOTE T) (|last| |argl|)))) (SPADLET |argPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |argl|) ((QUOTE T) (DROP (SPADDIFFERENCE 1) |argl|)))) (COND ((AND (> 10 |numArgs|) (EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1)) (CONS (QUOTE UP) (APPEND |argPart| (CONS |domainPart| NIL)))) ((QUOTE T) (CONS (QUOTE MP) (CONS (CONS (QUOTE |construct|) |argPart|) (CONS |domainPart| NIL))))))) (|specialModeTran| (COND ((BOOT-EQUAL |s3| (QUOTE R)) (CONS |$QuotientField| (CONS |polyForm| NIL))) ((QUOTE T) |polyForm|)))) ((QUOTE T) (CONS (CAR |form|) (PROG (#0=#:G2725) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2730 (CDR |form|) (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|specialModeTran| |x|) #0#))))))))))))))) ((QUOTE T) (CONS (CAR |form|) (PROG (#2=#:G2740) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G2745 (CDR |form|) (CDR #3#)) (|x| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (|specialModeTran| |x|) #2#))))))))))) ((QUOTE T) |form|)))))) 
-;
-;parseHas [x,y] ==
-;  if $InteractiveMode then
-;    x:=
-;      get(x,'value,$CategoryFrame) is [D,m,.]
-;        and m in '((Mode) (Domain) (SubDomain (Domain))) => D
-;      parseType x
-;  mkand [['has,x,u] for u in fn y] where
-;    mkand x ==
-;      x is [a] => a
-;      ['and,:x]
-;    fn y ==
-;      if $InteractiveMode then y:= unabbrevAndLoad y
-;      y is [":" ,op,['Mapping,:map]] =>
-;         op:= (STRINGP op => INTERN op; op)
-;         [['SIGNATURE,op,map]]
-;      y is ['Join,:u] => "append"/[fn z for z in u]
-;      y is ['CATEGORY,:u] => "append"/[fn z for z in u]
-;      kk:= GETDATABASE(opOf y,'CONSTRUCTORKIND)
-;      kk = 'domain or kk = 'category => [makeNonAtomic y]
-;      y is ['ATTRIBUTE,:.] => [y]
-;      y is ['SIGNATURE,:.] => [y]
-;      $InteractiveMode => parseHasRhs y
-;      [['ATTRIBUTE,y]]
-
-;;;     ***       |parseHas,fn| REDEFINED
-
-(DEFUN |parseHas,fn| (|y|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |map| |op| |u| |kk|) (RETURN (SEQ (IF |$InteractiveMode| (SPADLET |y| (|unabbrevAndLoad| |y|)) NIL) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |Mapping|)) (PROGN (SPADLET |map| (QCDR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (SEQ (SPADLET |op| (SEQ (IF (STRINGP |op|) (EXIT (INTERN |op|))) (EXIT |op|))) (EXIT (CONS (CONS (QUOTE SIGNATURE) (CONS |op| (CONS |map| NIL))) NIL))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |Join|)) (PROGN (SPADLET |u| (QCDR |y|)) (QUOTE T))) (EXIT (PROG (#0=#:G2837) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2842 |u| (CDR #1#)) (|z| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |z| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|parseHas,fn| |z|)))))))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE CATEGORY)) (PROGN (SPADLET |u| (QCDR |y|)) (QUOTE T))) (EXIT (PROG (#2=#:G2848) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G2853 |u| (CDR #3#)) (|z| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |z| (CAR #3#)) NIL)) #2#) (SEQ (EXIT (SETQ #2# (APPEND #2# (|parseHas,fn| |z|)))))))))) (SPADLET |kk| (GETDATABASE (|opOf| |y|) (QUOTE CONSTRUCTORKIND))) (IF (OR (BOOT-EQUAL |kk| (QUOTE |domain|)) (BOOT-EQUAL |kk| (QUOTE |category|))) (EXIT (CONS (|makeNonAtomic| |y|) NIL))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE ATTRIBUTE))) (EXIT (CONS |y| NIL))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE SIGNATURE))) (EXIT (CONS |y| NIL))) (IF |$InteractiveMode| (EXIT (|parseHasRhs| |y|))) (EXIT (CONS (CONS (QUOTE ATTRIBUTE) (CONS |y| NIL)) NIL)))))) 
-
-;;;     ***       |parseHas,mkand| REDEFINED
-
-(DEFUN |parseHas,mkand| (|x|) (PROG (|a|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCDR |x|) NIL) (PROGN (SPADLET |a| (QCAR |x|)) (QUOTE T))) (EXIT |a|)) (EXIT (CONS (QUOTE |and|) |x|)))))) 
-
-;;;     ***       |parseHas| REDEFINED
-
-(DEFUN |parseHas| (#0=#:G2880) (PROG (|y| |ISTMP#1| D |ISTMP#2| |m| |ISTMP#3| |x|) (RETURN (SEQ (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (COND (|$InteractiveMode| (SPADLET |x| (COND ((AND (PROGN (SPADLET |ISTMP#1| (|get| |x| (QUOTE |value|) |$CategoryFrame|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET D (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |m| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) (|member| |m| (QUOTE ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))) D) ((QUOTE T) (|parseType| |x|)))))) (|parseHas,mkand| (PROG (#1=#:G2901) (SPADLET #1# NIL) (RETURN (DO ((#2=#:G2906 (|parseHas,fn| |y|) (CDR #2#)) (|u| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |u| (CAR #2#)) NIL)) (NREVERSE0 #1#)) (SEQ (EXIT (SETQ #1# (CONS (CONS (QUOTE |has|) (CONS |x| (CONS |u| NIL))) #1#))))))))))))) 
-;
-;parseHasRhs u ==   --$InteractiveMode = true
-;  get(u,'value,$CategoryFrame) is [D,m,.]
-;    and m in '((Mode) (Domain) (SubDomain (Domain))) => m
-;  y := abbreviation? u =>
-;    loadIfNecessary y => [unabbrevAndLoad y]
-;    [['ATTRIBUTE,u]]
-;  [['ATTRIBUTE,u]]
-
-;;;     ***       |parseHasRhs| REDEFINED
-
-(DEFUN |parseHasRhs| (|u|) (PROG (|ISTMP#1| D |ISTMP#2| |m| |ISTMP#3| |y|) (RETURN (COND ((AND (PROGN (SPADLET |ISTMP#1| (|get| |u| (QUOTE |value|) |$CategoryFrame|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET D (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |m| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) (|member| |m| (QUOTE ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))) |m|) ((SPADLET |y| (|abbreviation?| |u|)) (COND ((|loadIfNecessary| |y|) (CONS (|unabbrevAndLoad| |y|) NIL)) ((QUOTE T) (CONS (CONS (QUOTE ATTRIBUTE) (CONS |u| NIL)) NIL)))) ((QUOTE T) (CONS (CONS (QUOTE ATTRIBUTE) (CONS |u| NIL)) NIL)))))) 
-;
-;parseDEF [$lhs,tList,specialList,body] ==
-;  setDefOp $lhs
-;  ['DEF,parseLhs $lhs,parseTranList tList,parseTranList specialList,
-;    parseTranCheckForRecord(body,opOf $lhs)]
-
-;;;     ***       |parseDEF| REDEFINED
-
-(DEFUN |parseDEF| (#0=#:G2960) (PROG (|$lhs| |tList| |specialList| |body|) (DECLARE (SPECIAL |$lhs|)) (RETURN (PROGN (SPADLET |$lhs| (CAR #0#)) (SPADLET |tList| (CADR #0#)) (SPADLET |specialList| (CADDR #0#)) (SPADLET |body| (CADDDR #0#)) (|setDefOp| |$lhs|) (CONS (QUOTE DEF) (CONS (|parseLhs| |$lhs|) (CONS (|parseTranList| |tList|) (CONS (|parseTranList| |specialList|) (CONS (|parseTranCheckForRecord| |body| (|opOf| |$lhs|)) NIL))))))))) 
-;
-;parseLhs x ==
-;  atom x => parseTran x
-;  atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]]
-;  parseTran x
-
-;;;     ***       |parseLhs| REDEFINED
-
-(DEFUN |parseLhs| (|x|) (PROG NIL (RETURN (SEQ (COND ((ATOM |x|) (|parseTran| |x|)) ((ATOM (CAR |x|)) (CONS (|parseTran| (CAR |x|)) (PROG (#0=#:G2987) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2992 (CDR |x|) (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|transIs| (|parseTran| |y|)) #0#))))))))) ((QUOTE T) (|parseTran| |x|))))))) 
-;
-;parseMDEF [$lhs,tList,specialList,body] ==
-;  ['MDEF,parseTran $lhs,parseTranList tList,parseTranList specialList,
-;    parseTranCheckForRecord(body,opOf $lhs)]
-
-;;;     ***       |parseMDEF| REDEFINED
-
-(DEFUN |parseMDEF| (#0=#:G3002) (PROG (|$lhs| |tList| |specialList| |body|) (DECLARE (SPECIAL |$lhs|)) (RETURN (PROGN (SPADLET |$lhs| (CAR #0#)) (SPADLET |tList| (CADR #0#)) (SPADLET |specialList| (CADDR #0#)) (SPADLET |body| (CADDDR #0#)) (CONS (QUOTE MDEF) (CONS (|parseTran| |$lhs|) (CONS (|parseTranList| |tList|) (CONS (|parseTranList| |specialList|) (CONS (|parseTranCheckForRecord| |body| (|opOf| |$lhs|)) NIL))))))))) 
-;
-;parseTranCheckForRecord(x,op) ==
-;  (x:= parseTran x) is ['Record,:l] =>
-;    or/[y for y in l | y isnt [":",.,.]] =>
-;      postError ['"   Constructor",:bright x,'"has missing label"]
-;    x
-;  x
-
-;;;     ***       |parseTranCheckForRecord| REDEFINED
-
-(DEFUN |parseTranCheckForRecord| (|x| |op|) (PROG (|l| |ISTMP#1| |ISTMP#2|) (RETURN (SEQ (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |x| (|parseTran| |x|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Record|)) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T)))) (COND ((PROG (#0=#:G3036) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3043 NIL #0#) (#2=#:G3044 |l| (CDR #2#)) (|y| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |y| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (COND ((NULL (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL))))))) (SETQ #0# (OR #0# |y|))))))))) (|postError| (CONS (MAKESTRING "   Constructor") (APPEND (|bright| |x|) (CONS (MAKESTRING "has missing label") NIL))))) ((QUOTE T) |x|))) ((QUOTE T) |x|)))))) 
-;
-;parseCases [expr,ifClause] ==
-;  casefn(expr,ifClause) where
-;    casefn(x,ifExpr) ==
-;      ifExpr='noBranch => ['ifClauseError,x]
-;      ifExpr is ['IF,a,b,c] => ['IF,parseTran a,parseTran b,casefn(x,c)]
-;      postError ['"   CASES format error: cases ",x," of ",ifExpr]
-
-;;;     ***       |parseCases,casefn| REDEFINED
-
-(DEFUN |parseCases,casefn| (|x| |ifExpr|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |ISTMP#3| |c|) (RETURN (SEQ (IF (BOOT-EQUAL |ifExpr| (QUOTE |noBranch|)) (EXIT (CONS (QUOTE |ifClauseError|) (CONS |x| NIL)))) (IF (AND (PAIRP |ifExpr|) (EQ (QCAR |ifExpr|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |ifExpr|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |c| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (CONS (QUOTE IF) (CONS (|parseTran| |a|) (CONS (|parseTran| |b|) (CONS (|parseCases,casefn| |x| |c|) NIL)))))) (EXIT (|postError| (CONS (MAKESTRING "   CASES format error: cases ") (CONS |x| (CONS (QUOTE | of |) (CONS |ifExpr| NIL)))))))))) 
-
-;;;     ***       |parseCases| REDEFINED
-
-(DEFUN |parseCases| (#0=#:G3105) (PROG (|expr| |ifClause|) (RETURN (PROGN (SPADLET |expr| (CAR #0#)) (SPADLET |ifClause| (CADR #0#)) (|parseCases,casefn| |expr| |ifClause|))))) 
-;
-;parseCategory x ==
-;  l:= parseTranList parseDropAssertions x
-;  key:=
-;    CONTAINED("$",l) => "domain"
-;    'package
-;  ['CATEGORY,key,:l]
-
-;;;     ***       |parseCategory| REDEFINED
-
-(DEFUN |parseCategory| (|x|) (PROG (|l| |key|) (RETURN (PROGN (SPADLET |l| (|parseTranList| (|parseDropAssertions| |x|))) (SPADLET |key| (COND ((CONTAINED (QUOTE $) |l|) (QUOTE |domain|)) ((QUOTE T) (QUOTE |package|)))) (CONS (QUOTE CATEGORY) (CONS |key| |l|)))))) 
-;
-;parseDropAssertions x ==
-;--note: the COPY of this list is necessary-- do not replace by RPLACing version
-;  x is [y,:r] =>
-;    y is ['IF,'asserted,:.] => parseDropAssertions r
-;    [y,:parseDropAssertions r]
-;  x
-
-;;;     ***       |parseDropAssertions| REDEFINED
-
-(DEFUN |parseDropAssertions| (|x|) (PROG (|y| |r| |ISTMP#1|) (RETURN (COND ((AND (PAIRP |x|) (PROGN (SPADLET |y| (QCAR |x|)) (SPADLET |r| (QCDR |x|)) (QUOTE T))) (COND ((AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |asserted|))))) (|parseDropAssertions| |r|)) ((QUOTE T) (CONS |y| (|parseDropAssertions| |r|))))) ((QUOTE T) |x|))))) 
-;
-;parseGreaterThan [x,y] ==
-;  [substitute("<",">",$op),parseTran y,parseTran x]
-
-;;;     ***       |parseGreaterThan| REDEFINED
-
-(DEFUN |parseGreaterThan| (#0=#:G3139) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (MSUBST (QUOTE <) (QUOTE >) |$op|) (CONS (|parseTran| |y|) (CONS (|parseTran| |x|) NIL))))))) 
-;
-;parseGreaterEqual u == parseTran ['not,[substitute("<",">=",$op),:u]]
-
-;;;     ***       |parseGreaterEqual| REDEFINED
-
-(DEFUN |parseGreaterEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE <) (QUOTE >=) |$op|) |u|) NIL)))) 
-;
-;parseLessEqual u == parseTran ['not,[substitute(">","<=",$op),:u]]
-
-;;;     ***       |parseLessEqual| REDEFINED
-
-(DEFUN |parseLessEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE >) (QUOTE <=) |$op|) |u|) NIL)))) 
-;
-;parseNotEqual u == parseTran ['not,[substitute("=","^=",$op),:u]]
-
-;;;     ***       |parseNotEqual| REDEFINED
-
-(DEFUN |parseNotEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE =) (QUOTE ^=) |$op|) |u|) NIL)))) 
-;
-;parseDollarGreaterThan [x,y] ==
-;  [substitute("$<","$>",$op),parseTran y,parseTran x]
-
-;;;     ***       |parseDollarGreaterThan| REDEFINED
-
-(DEFUN |parseDollarGreaterThan| (#0=#:G3162) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (MSUBST (QUOTE $<) (QUOTE $>) |$op|) (CONS (|parseTran| |y|) (CONS (|parseTran| |x|) NIL))))))) 
-;
-;parseDollarGreaterEqual u ==
-;  parseTran ['not,[substitute("$<","$>=",$op),:u]]
-
-;;;     ***       |parseDollarGreaterEqual| REDEFINED
-
-(DEFUN |parseDollarGreaterEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $<) (QUOTE $>=) |$op|) |u|) NIL)))) 
-;
-;parseDollarLessEqual u ==
-;  parseTran ['not,[substitute("$>","$<=",$op),:u]]
-
-;;;     ***       |parseDollarLessEqual| REDEFINED
-
-(DEFUN |parseDollarLessEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $>) (QUOTE $<=) |$op|) |u|) NIL)))) 
-;
-;parseDollarNotEqual u ==
-;  parseTran ['not,[substitute("$=","$^=",$op),:u]]
-
-;;;     ***       |parseDollarNotEqual| REDEFINED
-
-(DEFUN |parseDollarNotEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $=) (QUOTE $^=) |$op|) |u|) NIL)))) 
-;
-;parseAnd u ==
-;  $InteractiveMode => ['and,:parseTranList u]
-;  null u => 'true
-;  null rest u => first u
-;  parseIf [parseTran first u,parseAnd rest u,"false"]
-
-;;;     ***       |parseAnd| REDEFINED
-
-(DEFUN |parseAnd| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |and|) (|parseTranList| |u|))) ((NULL |u|) (QUOTE |true|)) ((NULL (CDR |u|)) (CAR |u|)) ((QUOTE T) (|parseIf| (CONS (|parseTran| (CAR |u|)) (CONS (|parseAnd| (CDR |u|)) (CONS (QUOTE |false|) NIL))))))) 
-;
-;parseOr u ==
-;  $InteractiveMode => ['or,:parseTranList u]
-;  null u => 'false
-;  null rest u => first u
-;  (x:= parseTran first u) is ['not,y] => parseIf [y,parseOr rest u,'true]
-;  true => parseIf [x,'true,parseOr rest u]
-
-;;;     ***       |parseOr| REDEFINED
-
-(DEFUN |parseOr| (|u|) (PROG (|x| |ISTMP#1| |ISTMP#2| |y|) (RETURN (COND (|$InteractiveMode| (CONS (QUOTE |or|) (|parseTranList| |u|))) ((NULL |u|) (QUOTE |false|)) ((NULL (CDR |u|)) (CAR |u|)) ((PROGN (SPADLET |ISTMP#1| (SPADLET |x| (|parseTran| (CAR |u|)))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |not|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T)))))) (|parseIf| (CONS |y| (CONS (|parseOr| (CDR |u|)) (CONS (QUOTE |true|) NIL))))) ((QUOTE T) (|parseIf| (CONS |x| (CONS (QUOTE |true|) (CONS (|parseOr| (CDR |u|)) NIL))))))))) 
-;
-;parseNot u ==
-;  $InteractiveMode => ['not,parseTran first u]
-;  parseTran ['IF,first u,:'(false true)]
-
-;;;     ***       |parseNot| REDEFINED
-
-(DEFUN |parseNot| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |not|) (CONS (|parseTran| (CAR |u|)) NIL))) ((QUOTE T) (|parseTran| (CONS (QUOTE IF) (CONS (CAR |u|) (QUOTE (|false| |true|)))))))) 
-;
-;parseEquivalence [a,b] == parseIf [a,b,parseIf [b,:'(false true)]]
-
-;;;     ***       |parseEquivalence| REDEFINED
-
-(DEFUN |parseEquivalence| (#0=#:G3211) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS |b| (CONS (|parseIf| (CONS |b| (QUOTE (|false| |true|)))) NIL)))))))) 
-;
-;parseImplies [a,b] == parseIf [a,b,'true]
-
-;;;     ***       |parseImplies| REDEFINED
-
-(DEFUN |parseImplies| (#0=#:G3225) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS |b| (CONS (QUOTE |true|) NIL)))))))) 
-;
-;parseExclusiveOr [a,b] == parseIf [a,parseIf [b,:'(false true)],b]
-
-;;;     ***       |parseExclusiveOr| REDEFINED
-
-(DEFUN |parseExclusiveOr| (#0=#:G3239) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS (|parseIf| (CONS |b| (QUOTE (|false| |true|)))) (CONS |b| NIL)))))))) 
-;
-;parseExit [a,:b] ==
-;  --  note: I wanted to convert 1s to 0s here to facilitate indexing in
-;  --   comp code; unfortunately, parseTran-ning is sometimes done more
-;  --   than once so that the count can be decremented more than once
-;  a:= parseTran a
-;  b:= parseTran b
-;  b =>
-;    null INTEGERP a =>
-;      (MOAN('"first arg ",a,'" for exit must be integer"); ['exit,1,a])
-;    ['exit,a,:b]
-;  ['exit,1,a]
-
-;;;     ***       |parseExit| REDEFINED
-
-(DEFUN |parseExit| (#0=#:G3256) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (INTEGERP |a|)) (MOAN (MAKESTRING "first arg ") |a| (MAKESTRING " for exit must be integer")) (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL))))))))) 
-;
-;parseLeave [a,:b] ==
-;  a:= parseTran a
-;  b:= parseTran b
-;  b =>
-;    null INTEGERP a =>
-;      (MOAN('"first arg ",a,'" for 'leave' must be integer"); ['leave,1,a])
-;    ['leave,a,:b]
-;  ['leave,1,a]
-
-;;;     ***       |parseLeave| REDEFINED
-
-(DEFUN |parseLeave| (#0=#:G3275) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (INTEGERP |a|)) (MOAN (MAKESTRING "first arg ") |a| (MAKESTRING " for 'leave' must be integer")) (CONS (QUOTE |leave|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |leave|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |leave|) (CONS 1 (CONS |a| NIL))))))))) 
-;
-;parseReturn [a,:b] ==
-;  a:= parseTran a
-;  b:= parseTran b
-;  b =>
-;    (if a^=1 then MOAN '"multiple-level 'return' not allowed"; ["return",1,:b])
-;  ['return,1,a]
-
-;;;     ***       |parseReturn| REDEFINED
-
-(DEFUN |parseReturn| (#0=#:G3293) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NEQUAL |a| 1) (MOAN (MAKESTRING "multiple-level 'return' not allowed")))) (CONS (QUOTE |return|) (CONS 1 |b|))) ((QUOTE T) (CONS (QUOTE |return|) (CONS 1 (CONS |a| NIL))))))))) 
-;
-;parseJoin l ==
-;  ['Join,:fn parseTranList l] where
-;    fn l ==
-;      null l => nil
-;      l is [['Join,:x],:y] => [:x,:fn y]
-;      [first l,:fn rest l]
-
-;;;     ***       |parseJoin,fn| REDEFINED
-
-(DEFUN |parseJoin,fn| (|l|) (PROG (|ISTMP#1| |x| |y|) (RETURN (SEQ (IF (NULL |l|) (EXIT NIL)) (IF (AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (QCAR |l|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Join|)) (PROGN (SPADLET |x| (QCDR |ISTMP#1|)) (QUOTE T)))) (PROGN (SPADLET |y| (QCDR |l|)) (QUOTE T))) (EXIT (APPEND |x| (|parseJoin,fn| |y|)))) (EXIT (CONS (CAR |l|) (|parseJoin,fn| (CDR |l|)))))))) 
-
-;;;     ***       |parseJoin| REDEFINED
-
-(DEFUN |parseJoin| (|l|) (CONS (QUOTE |Join|) (|parseJoin,fn| (|parseTranList| |l|)))) 
-;
-;parseInBy [i,n,inc] ==
-;  (u:= parseIn [i,n]) isnt ['STEP,i,a,j,:r] =>
-;    postError ["   You cannot use",:bright '"by",
-;      '"except for an explicitly indexed sequence."]
-;  inc:= parseTran inc
-;  ['STEP,i,a,parseTran inc,:r]
-
-;;;     ***       |parseInBy| REDEFINED
-
-(DEFUN |parseInBy| (#0=#:G3380) (PROG (|n| |u| |ISTMP#1| |ISTMP#2| |i| |ISTMP#3| |a| |ISTMP#4| |j| |r| |inc|) (RETURN (PROGN (SPADLET |i| (CAR #0#)) (SPADLET |n| (CADR #0#)) (SPADLET |inc| (CADDR #0#)) (COND ((NULL (PROGN (SPADLET |ISTMP#1| (SPADLET |u| (|parseIn| (CONS |i| (CONS |n| NIL))))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE STEP)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |i| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |j| (QCAR |ISTMP#4|)) (SPADLET |r| (QCDR |ISTMP#4|)) (QUOTE T))))))))))) (|postError| (CONS (QUOTE |   You cannot use|) (APPEND (|bright| (MAKESTRING "by")) (CONS (MAKESTRING "except for an explicitly indexed sequence.") NIL))))) ((QUOTE T) (SPADLET |inc| (|parseTran| |inc|)) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS (|parseTran| |inc|) |r|)))))))))) 
-;
-;parseSegment p ==
-;  p is [a,b] =>
-;    b => ['SEGMENT,parseTran a, parseTran b]
-;    ['SEGMENT,parseTran a]
-;  ['SEGMENT,:p]
-
-;;;     ***       |parseSegment| REDEFINED
-
-(DEFUN |parseSegment| (|p|) (PROG (|a| |ISTMP#1| |b|) (RETURN (COND ((AND (PAIRP |p|) (PROGN (SPADLET |a| (QCAR |p|)) (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND (|b| (CONS (QUOTE SEGMENT) (CONS (|parseTran| |a|) (CONS (|parseTran| |b|) NIL)))) ((QUOTE T) (CONS (QUOTE SEGMENT) (CONS (|parseTran| |a|) NIL))))) ((QUOTE T) (CONS (QUOTE SEGMENT) |p|)))))) 
-;
-;parseIn [i,n] ==
-;  i:= parseTran i
-;  n:= parseTran n
-;  n is ['SEGMENT,a] => ['STEP,i,a,1]
-;  n is ['reverse,['SEGMENT,a]] =>
-;    postError ['"  You cannot reverse an infinite sequence."]
-;  n is ['SEGMENT,a,b] => (b => ['STEP,i,a,1,b]; ['STEP,i,a,1])
-;  n is ['reverse,['SEGMENT,a,b]] =>
-;    b => ['STEP,i,b,-1,a]
-;    postError ['"  You cannot reverse an infinite sequence."]
-;  n is ['tails,s] => ['ON,i,s]
-;  ['IN,i,n]
-
-;;;     ***       |parseIn| REDEFINED
-
-(DEFUN |parseIn| (#0=#:G3518) (PROG (|i| |n| |ISTMP#2| |ISTMP#3| |a| |ISTMP#4| |b| |ISTMP#1| |s|) (RETURN (PROGN (SPADLET |i| (CAR #0#)) (SPADLET |n| (CADR #0#)) (SPADLET |i| (|parseTran| |i|)) (SPADLET |n| (|parseTran| |n|)) (COND ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 NIL))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |reverse|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (|postError| (CONS (MAKESTRING "  You cannot reverse an infinite sequence.") NIL))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND (|b| (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 (CONS |b| NIL)))))) ((QUOTE T) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 NIL))))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |reverse|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCDR |ISTMP#4|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#4|)) (QUOTE T))))))))))) (COND (|b| (CONS (QUOTE STEP) (CONS |i| (CONS |b| (CONS (SPADDIFFERENCE 1) (CONS |a| NIL)))))) ((QUOTE T) (|postError| (CONS (MAKESTRING "  You cannot reverse an infinite sequence.") NIL))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |tails|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |s| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE ON) (CONS |i| (CONS |s| NIL)))) ((QUOTE T) (CONS (QUOTE IN) (CONS |i| (CONS |n| NIL))))))))) 
-;
-;parseIf t ==
-;  t isnt [p,a,b] => t
-;  ifTran(parseTran p,parseTran a,parseTran b) where
-;    ifTran(p,a,b) ==
-;      null($InteractiveMode) and p='true  => a
-;      null($InteractiveMode) and p='false  => b
-;      p is ['not,p'] => ifTran(p',b,a)
-;      p is ['IF,p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b))
-;      p is ['SEQ,:l,['exit,1,p']] =>
-;        ['SEQ,:l,['exit,1,ifTran(p',incExitLevel a,incExitLevel b)]]
-;         --this assumes that l has no exits
-;      a is ['IF, =p,a',.] => ['IF,p,a',b]
-;      b is ['IF, =p,.,b'] => ['IF,p,a,b']
-;      makeSimplePredicateOrNil p is ['SEQ,:s,['exit,1,val]] =>
-;        parseTran ['SEQ,:s,['exit,1,incExitLevel ['IF,val,a,b]]]
-;      ['IF,p,a,b]
-
-;;;     ***       |parseIf,ifTran| REDEFINED
-
-(DEFUN |parseIf,ifTran| (|p| |a| |b|) (PROG (|p'| |l| |a'| |b'| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |ISTMP#6| |val| |s|) (RETURN (SEQ (IF (AND (NULL |$InteractiveMode|) (BOOT-EQUAL |p| (QUOTE |true|))) (EXIT |a|)) (IF (AND (NULL |$InteractiveMode|) (BOOT-EQUAL |p| (QUOTE |false|))) (EXIT |b|)) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE |not|)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |p'| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (|parseIf,ifTran| |p'| |b| |a|))) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p'| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |a'| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |b'| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (|parseIf,ifTran| |p'| (|parseIf,ifTran| |a'| (COPY |a|) (COPY |b|)) (|parseIf,ifTran| |b'| |a| |b|)))) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T))) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |p'| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T))) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (EXIT (CONS (QUOTE SEQ) (APPEND |l| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|parseIf,ifTran| |p'| (|incExitLevel| |a|) (|incExitLevel| |b|)) NIL))) NIL))))) (IF (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |p|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |a'| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL)))))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a'| (CONS |b| NIL)))))) (IF (AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |b|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |p|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |b'| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a| (CONS |b'| NIL)))))) (IF (PROGN (SPADLET |ISTMP#1| (|makeSimplePredicateOrNil| |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (REVERSE |ISTMP#2|)) (QUOTE T))) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCAR |ISTMP#4|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQUAL (QCAR |ISTMP#5|) 1) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (PROGN (SPADLET |val| (QCAR |ISTMP#6|)) (QUOTE T)))))))) (PROGN (SPADLET |s| (QCDR |ISTMP#3|)) (QUOTE T))) (PROGN (SPADLET |s| (NREVERSE |s|)) (QUOTE T)))))) (EXIT (|parseTran| (CONS (QUOTE SEQ) (APPEND |s| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|incExitLevel| (CONS (QUOTE IF) (CONS |val| (CONS |a| (CONS |b| NIL))))) NIL))) NIL)))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a| (CONS |b| NIL))))))))) 
-
-;;;     ***       |parseIf| REDEFINED
-
-(DEFUN |parseIf| (|t|) (PROG (|p| |ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((NULL (AND (PAIRP |t|) (PROGN (SPADLET |p| (QCAR |t|)) (SPADLET |ISTMP#1| (QCDR |t|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T)))))))) |t|) ((QUOTE T) (|parseIf,ifTran| (|parseTran| |p|) (|parseTran| |a|) (|parseTran| |b|))))))) 
-;
-;makeSimplePredicateOrNil p ==
-;  isSimple p => nil
-;  u:= isAlmostSimple p => u
-;  true => wrapSEQExit [['LET,g:= GENSYM(),p],g]
-
-;;;     ***       |makeSimplePredicateOrNil| REDEFINED
-
-(DEFUN |makeSimplePredicateOrNil| (|p|) (PROG (|u| |g|) (RETURN (COND ((|isSimple| |p|) NIL) ((SPADLET |u| (|isAlmostSimple| |p|)) |u|) ((QUOTE T) (|wrapSEQExit| (CONS (CONS (QUOTE LET) (CONS (SPADLET |g| (GENSYM)) (CONS |p| NIL))) (CONS |g| NIL)))))))) 
-;
-;parseWhere l == ['where,:mapInto(l,'parseTran)]
-
-;;;     ***       |parseWhere| REDEFINED
-
-(DEFUN |parseWhere| (|l|) (CONS (QUOTE |where|) (|mapInto| |l| (QUOTE |parseTran|)))) 
-;
-;
-;parseSeq l ==
-;  not l is [:.,['exit,:.]] =>
-;    postError ['"   Invalid ending to block: ",last l]
-;  transSeq mapInto(l,'parseTran)
-
-;;;     ***       |parseSeq| REDEFINED
-
-(DEFUN |parseSeq| (|l|) (PROG (|ISTMP#1| |ISTMP#2|) (RETURN (COND ((NULL (AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (REVERSE |l|)) (QUOTE T)) (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |exit|)))))) (|postError| (CONS (MAKESTRING "   Invalid ending to block: ") (CONS (|last| |l|) NIL)))) ((QUOTE T) (|transSeq| (|mapInto| |l| (QUOTE |parseTran|)))))))) 
-;
-;transSeq l ==
-;  null l => nil
-;  null rest l => decExitLevel first l
-;  [item,:tail]:= l
-;  item is ['SEQ,:l,['exit,1,['IF,p,['exit, =2,q],'noBranch]]] and
-;    (and/[x is ['LET,:.] for x in l]) =>
-;      ['SEQ,:[decExitLevel x for x in l],['exit,1,['IF,decExitLevel p,
-;        decExitLevel q,transSeq tail]]]
-;  item is ['IF,a,['exit,1,b],'noBranch] =>
-;    ['IF,decExitLevel a,decExitLevel b,transSeq tail]
-;  item is ['IF,a,'noBranch,['exit,1,b]] =>
-;    ['IF,decExitLevel a,transSeq tail,decExitLevel b]
-;  (y:= transSeq tail) is ['SEQ,:s] => ['SEQ,item,:s]
-;  ['SEQ,item,['exit,1,incExitLevel y]]
-
-;;;     ***       |transSeq| REDEFINED
-
-(DEFUN |transSeq| (|l|) (PROG (|item| |tail| |ISTMP#7| |p| |ISTMP#8| |ISTMP#9| |ISTMP#10| |ISTMP#11| |q| |ISTMP#12| |a| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |ISTMP#6| |b| |y| |ISTMP#1| |s|) (RETURN (SEQ (COND ((NULL |l|) NIL) ((NULL (CDR |l|)) (|decExitLevel| (CAR |l|))) ((QUOTE T) (SPADLET |item| (CAR |l|)) (SPADLET |tail| (CDR |l|)) (COND ((AND (PAIRP |item|) (EQ (QCAR |item|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |ISTMP#6| (QCAR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCAR |ISTMP#6|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#7| (QCDR |ISTMP#6|)) (AND (PAIRP |ISTMP#7|) (PROGN (SPADLET |p| (QCAR |ISTMP#7|)) (SPADLET |ISTMP#8| (QCDR |ISTMP#7|)) (AND (PAIRP |ISTMP#8|) (PROGN (SPADLET |ISTMP#9| (QCAR |ISTMP#8|)) (AND (PAIRP |ISTMP#9|) (EQ (QCAR |ISTMP#9|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#10| (QCDR |ISTMP#9|)) (AND (PAIRP |ISTMP#10|) (EQUAL (QCAR |ISTMP#10|) 2) (PROGN (SPADLET |ISTMP#11| (QCDR |ISTMP#10|)) (AND (PAIRP |ISTMP#11|) (EQ (QCDR |ISTMP#11|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#11|)) (QUOTE T)))))))) (PROGN (SPADLET |ISTMP#12| (QCDR |ISTMP#8|)) (AND (PAIRP |ISTMP#12|) (EQ (QCDR |ISTMP#12|) NIL) (EQ (QCAR |ISTMP#12|) (QUOTE |noBranch|)))))))))))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G4140) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G4146 NIL (NULL #0#)) (#2=#:G4147 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE LET))))))))))) (CONS (QUOTE SEQ) (APPEND (PROG (#3=#:G4158) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G4163 |l| (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (|decExitLevel| |x|) #3#))))))) (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (CONS (QUOTE IF) (CONS (|decExitLevel| |p|) (CONS (|decExitLevel| |q|) (CONS (|transSeq| |tail|) NIL)))) NIL))) NIL)))) ((AND (PAIRP |item|) (EQ (QCAR |item|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (EQ (QCAR |ISTMP#6|) (QUOTE |noBranch|))))))))) (CONS (QUOTE IF) (CONS (|decExitLevel| |a|) (CONS (|decExitLevel| |b|) (CONS (|transSeq| |tail|) NIL))))) ((AND (PAIRP |item|) (EQ (QCAR |item|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |noBranch|)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCAR |ISTMP#4|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQUAL (QCAR |ISTMP#5|) 1) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#6|)) (QUOTE T))))))))))))))) (CONS (QUOTE IF) (CONS (|decExitLevel| |a|) (CONS (|transSeq| |tail|) (CONS (|decExitLevel| |b|) NIL))))) ((PROGN (SPADLET |ISTMP#1| (SPADLET |y| (|transSeq| |tail|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ)) (PROGN (SPADLET |s| (QCDR |ISTMP#1|)) (QUOTE T)))) (CONS (QUOTE SEQ) (CONS |item| |s|))) ((QUOTE T) (CONS (QUOTE SEQ) (CONS |item| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|incExitLevel| |y|) NIL))) NIL))))))))))) 
-;
-;transCategoryItem x ==
-;  x is ['SIGNATURE,lhs,rhs] =>
-;    lhs is ['LISTOF,:y] =>
-;      "append" /[transCategoryItem ['SIGNATURE,z,rhs] for z in y]
-;    atom lhs =>
-;      if STRINGP lhs then lhs:= INTERN lhs
-;      rhs is ['Mapping,:m] =>
-;        m is [.,'constant] => LIST ['SIGNATURE,lhs,[first m],'constant]
-;        LIST ['SIGNATURE,lhs,m]
-;      $transCategoryAssoc:= [[lhs,:rhs],:$transCategoryAssoc]
-;      NIL
-;    [op,:argl]:= lhs
-;    extra:= nil
-;    if rhs is ['Mapping,:m] then
-;      if rest m then extra:= rest m
-;                 --should only be 'constant' or 'variable'
-;      rhs:= first m
-;    LIST ['SIGNATURE,op,[rhs,:SUBLIS($transCategoryAssoc,argl)],:extra]
-;  LIST x
-
-;;;     ***       |transCategoryItem| REDEFINED
-
-(DEFUN |transCategoryItem| (|x|) (PROG (|ISTMP#2| |y| |lhs| |ISTMP#1| |op| |argl| |m| |extra| |rhs|) (RETURN (SEQ (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SIGNATURE)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |lhs| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |rhs| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE LISTOF)) (PROGN (SPADLET |y| (QCDR |lhs|)) (QUOTE T))) (PROG (#0=#:G4237) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G4242 |y| (CDR #1#)) (|z| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |z| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|transCategoryItem| (CONS (QUOTE SIGNATURE) (CONS |z| (CONS |rhs| NIL)))))))))))) ((ATOM |lhs|) (COND ((STRINGP |lhs|) (SPADLET |lhs| (INTERN |lhs|)))) (COND ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) (QUOTE |Mapping|)) (PROGN (SPADLET |m| (QCDR |rhs|)) (QUOTE T))) (COND ((AND (PAIRP |m|) (PROGN (SPADLET |ISTMP#1| (QCDR |m|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (EQ (QCAR |ISTMP#1|) (QUOTE |constant|))))) (LIST (CONS (QUOTE SIGNATURE) (CONS |lhs| (CONS (CONS (CAR |m|) NIL) (CONS (QUOTE |constant|) NIL)))))) ((QUOTE T) (LIST (CONS (QUOTE SIGNATURE) (CONS |lhs| (CONS |m| NIL))))))) ((QUOTE T) (SPADLET |$transCategoryAssoc| (CONS (CONS |lhs| |rhs|) |$transCategoryAssoc|)) NIL))) ((QUOTE T) (SPADLET |op| (CAR |lhs|)) (SPADLET |argl| (CDR |lhs|)) (SPADLET |extra| NIL) (COND ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) (QUOTE |Mapping|)) (PROGN (SPADLET |m| (QCDR |rhs|)) (QUOTE T))) (COND ((CDR |m|) (SPADLET |extra| (CDR |m|)))) (SPADLET |rhs| (CAR |m|)))) (LIST (CONS (QUOTE SIGNATURE) (CONS |op| (CONS (CONS |rhs| (SUBLIS |$transCategoryAssoc| |argl|)) |extra|))))))) ((QUOTE T) (LIST |x|))))))) 
-;
-;superSub(name,x) ==
-;  for u in x repeat y:= [:y,:u]
-;  code:=
-;    x is [[u]] => $quadSymbol
-;    STRCONC("_(",scriptTranRow first x,scriptTran rest x,"_)")
-;  [INTERNL(PNAME name,"$",code),:y]
-
-;;;     ***       |superSub| REDEFINED
-
-(DEFUN |superSub| (|name| |x|) (PROG (|y| |ISTMP#1| |u| |code|) (RETURN (SEQ (PROGN (DO ((#0=#:G4276 |x| (CDR #0#)) (|u| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (SPADLET |y| (APPEND |y| |u|))))) (SPADLET |code| (COND ((AND (PAIRP |x|) (EQ (QCDR |x|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T))))) |$quadSymbol|) ((QUOTE T) (STRCONC (QUOTE |(|) (|scriptTranRow| (CAR |x|)) (|scriptTran| (CDR |x|)) (QUOTE |)|))))) (CONS (INTERNL (PNAME |name|) (QUOTE $) |code|) |y|)))))) 
-;
-;scriptTran x ==
-;  null x => ""
-;  STRCONC(";",scriptTranRow first x,scriptTran rest x)
-
-;;;     ***       |scriptTran| REDEFINED
-
-(DEFUN |scriptTran| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC (QUOTE |;|) (|scriptTranRow| (CAR |x|)) (|scriptTran| (CDR |x|)))))) 
-;
-;scriptTranRow x ==
-;  null x => ""
-;  STRCONC($quadSymbol,scriptTranRow1 rest x)
-
-;;;     ***       |scriptTranRow| REDEFINED
-
-(DEFUN |scriptTranRow| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) 
-;
-;scriptTranRow1 x ==
-;  null x => ""
-;  STRCONC(",",$quadSymbol,scriptTranRow1 rest x)
-
-;;;     ***       |scriptTranRow1| REDEFINED
-
-(DEFUN |scriptTranRow1| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC (QUOTE |,|) |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) 
-;
-;parseVCONS l == ["VECTOR",:parseTranList l]
-
-;;;     ***       |parseVCONS| REDEFINED
-
-(DEFUN |parseVCONS| (|l|) (CONS (QUOTE VECTOR) (|parseTranList| |l|))) 
-;;;Boot translation finished for parse.boot
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet
index 8dbb420..c324a87 100644
--- a/src/interp/parsing.lisp.pamphlet
+++ b/src/interp/parsing.lisp.pamphlet
@@ -10,41 +10,7 @@
 \tableofcontents
 \eject
 \section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; 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.
-
-@
 <<*>>=
-<<license>>
 
 ; NAME:    META/LISP Parser Generator and Lexical Analysis Utilities (Parsing)
 ;
@@ -1068,6 +1034,4154 @@ Symbolics read-line returns embedded newlines in a c-m-Y.")
              (cons (list eltWord dom (car rand)) (cdr rand))
              (list eltWord dom rand))))
 @
+bootlex
+<<*>>=
+(defparameter Boot-Line-Stack nil	"List of lines returned from PREPARSE.")
+
+(defun Next-Lines-Clear () (setq Boot-Line-Stack nil))
+
+(defun Next-Lines-Show ()
+  (and Boot-Line-Stack (format t "Currently preparsed lines are:~%~%"))
+  (mapcar #'(lambda (line)
+	      (format t "~&~5D> ~A~%" (car line) (cdr Line)))
+	  Boot-Line-Stack))
+
+; *** 1. BOOT file handling
+
+(defun init-boot/spad-reader ()
+  (setq $SPAD_ERRORS (VECTOR 0 0 0))
+  (setq SPADERRORSTREAM *standard-output*)
+  (setq XTokenReader 'get-BOOT-token)
+  (setq Line-Handler 'next-BOOT-line)
+  (setq Meta_Error_Handler 'spad_syntax_error)
+  (setq File-Closed nil)
+  (Next-Lines-Clear)
+  (setq Boot-Line-Stack nil)
+  (ioclear))
+
+(defmacro test (x &rest y)
+  `(progn
+     (setq spaderrorstream t)
+     (in-boot)
+     (initialize-preparse *terminal-io*)
+     (,(intern (strconc "PARSE-" x)) . ,y)))
+
+(defun |oldParserAutoloadOnceTrigger| () nil)
+
+(defun print-defun (name body)
+   (let* ((sp (assoc 'vmlisp::compiler-output-stream vmlisp::optionlist))
+	  (st (if sp (cdr sp) *standard-output*)))
+     (if (and (is-console st) (symbolp name) (fboundp name)
+	      (not (compiled-function-p (symbol-function name))))
+	 (compile name))
+     (when (or |$PrettyPrint| (not (is-console st)))
+	   (print-full body st) (force-output st))))
+
+(defun boot-parse-1 (in-stream
+	      &aux
+	     (Echo-Meta nil)
+	     (current-fragment nil)
+	     ($INDEX 0)
+	     ($LineList nil)
+	     ($EchoLineStack nil)
+	     ($preparse-last-line nil)
+	     ($BOOT T)
+	     (*EOF* NIL)
+	     (OPTIONLIST NIL))
+  (declare (special echo-meta *comp370-apply* *EOF* File-Closed
+		    $index $linelist $echolinestack $preparse-last-line))
+  (init-boot/spad-reader)
+  (let* ((Boot-Line-Stack (PREPARSE in-stream))
+	 (parseout (prog2 (|PARSE-Expression|) (pop-stack-1)) ) )
+    ;(setq parseout (|new2OldLisp| parseout))
+    ; (setq parseout (DEF-RENAME parseout))
+    ; (DEF-PROCESS parseout)
+    parseout))
+
+(defun boot (&optional
+	      (*boot-input-file* nil)
+	      (*boot-output-file* nil)
+	     &aux
+	     (Echo-Meta t)
+	     ($BOOT T)
+	     (|$InteractiveMode| NIL)
+	     (XCape #\_)
+	     (File-Closed NIL)
+	     (*EOF* NIL)
+	     (OPTIONLIST NIL)
+	     (*fileactq-apply* (function print-defun))
+	     (*comp370-apply* (function print-defun)))
+  (declare (special echo-meta *comp370-apply* *EOF* File-Closed XCape))
+  (init-boot/spad-reader)
+  (with-open-stream
+    (in-stream (if *boot-input-file* (open *boot-input-file* :direction :input)
+		    *standard-input*))
+    (initialize-preparse in-stream)
+    (with-open-stream
+      (out-stream (if *boot-output-file*
+		      (open *boot-output-file* :direction :output)
+		      #-:cmulisp (make-broadcast-stream *standard-output*)
+		      #+:cmulisp *standard-output*
+		      ))
+      (when *boot-output-file*
+	 (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
+	 (print-package "BOOT"))
+      (loop (if (and (not File-Closed)
+		     (setq Boot-Line-Stack (PREPARSE in-stream)))
+		(progn
+		       (|PARSE-Expression|)
+		       (let ((parseout (pop-stack-1)) )
+			 (setq parseout (|new2OldLisp| parseout))
+			 (setq parseout (DEF-RENAME parseout))
+			 (let ((*standard-output* out-stream))
+			   (DEF-PROCESS parseout))
+			 (format out-stream "~&")
+			 (if (null parseout) (ioclear)) ))
+		(return nil)))
+      (if *boot-input-file*
+	  (format out-stream ";;;Boot translation finished for ~a~%"
+		  (namestring *boot-input-file*)))
+      (IOClear in-stream out-stream)))
+  T)
+
+(defun spad (&optional
+	      (*spad-input-file* nil)
+	      (*spad-output-file* nil)
+	     &aux
+	   (*comp370-apply* (function print-defun))
+	   (*fileactq-apply* (function print-defun))
+	   ($SPAD T)
+	   ($BOOT nil)
+	   (XCape #\_)
+	   (OPTIONLIST nil)
+	   (*EOF* NIL)
+	   (File-Closed NIL)
+	   (/editfile *spad-input-file*)
+	   (|$noSubsumption| |$noSubsumption|)
+	   in-stream out-stream)
+  (declare (special echo-meta /editfile *comp370-apply* *EOF*
+		    File-Closed Xcape |$noSubsumption|))
+  ;; only rebind |$InteractiveFrame| if compiling
+  (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
+	 (if (not |$InteractiveMode|)
+	     (list (|addBinding|
+		    '|$DomainsInScope|
+		    `((FLUID . |true|)
+		      (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
+		    (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
+  (init-boot/spad-reader)
+  (unwind-protect
+    (progn
+      (setq in-stream (if *spad-input-file*
+			 (open *spad-input-file* :direction :input)
+			 *standard-input*))
+      (initialize-preparse in-stream)
+      (setq out-stream (if *spad-output-file*
+			   (open *spad-output-file* :direction :output)
+			 *standard-output*))
+      (when *spad-output-file*
+	 (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
+	 (print-package "BOOT"))
+      (setq curoutstream out-stream)
+      (loop
+       (if (or *eof* file-closed) (return nil))
+       (catch 'SPAD_READER
+	 (if (setq Boot-Line-Stack (PREPARSE in-stream))
+	     (let ((LINE (cdar Boot-Line-Stack)))
+	       (declare (special LINE))
+	       (|PARSE-NewExpr|)
+	       (let ((parseout (pop-stack-1)) )
+		 (when parseout
+		       (let ((*standard-output* out-stream))
+			 (S-PROCESS parseout))
+		       (format out-stream "~&")))
+	       ;(IOClear in-stream out-stream)
+	       )))
+      (IOClear in-stream out-stream)))
+    (if *spad-input-file* (shut in-stream))
+    (if *spad-output-file* (shut out-stream)))
+  T))
+
+(defun READ-BOOT (FN FM TO)
+  (let (($boot t)) (READ-SPAD1 FN 'BOOT FM TO)))
+
+(defun READ-SPAD1 (FN FT FM TO)
+    (LET ((STRM IN-STREAM))
+      (SETQ $MAXLINENUMBER 0)
+      (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
+      (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
+      ($ERASE (LIST FN 'ERROR 'A))
+      (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
+      (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
+      (READ-SPAD-1)
+      (close SPADERRORSTREAM)
+      (SETQ IN-STREAM STRM)
+      (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
+	  (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
+	    '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
+	    '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
+      (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
+
+(defun READBOOT ()
+  (let (form expr ($BOOT 'T))
+    (declare (special $BOOT))
+    (ADVANCE-TOKEN)
+    (|PARSE-Expression|)
+   ;; (|pp| (setq form (|postTransform| (FIRST STACK))))
+    (|pp| (setq form (|postTransform| (pop-STACK-1))))
+    (setq EXPR (DEF-RENAME form))
+    (DEF-PROCESS EXPR)
+    (TERSYSCOMMAND)))
+
+;  *** 2. BOOT Line Handling ***
+
+; See the file PREPARSE.LISP for the hard parts of BOOT line processing.
+
+(defun next-BOOT-line (&optional (in-stream t))
+
+  "Get next line, trimming trailing blanks and trailing comments.
+One trailing blank is added to a non-blank line to ease between-line
+processing for Next Token (i.e., blank takes place of return).	Returns T
+if it gets a non-blank line, and NIL at end of stream."
+
+  (if Boot-Line-Stack
+      (let ((Line-Number (caar Boot-Line-Stack))
+	    (Line-Buffer (suffix #\Space (cdar Boot-Line-Stack))))
+	(pop Boot-Line-Stack)
+	(Line-New-Line Line-Buffer Current-Line Line-Number)
+	(setq |$currentLine| (setq LINE Line-Buffer))
+	Line-Buffer)))
+
+;  *** 3. BOOT Token Handling ***
+
+(defparameter xcape #\_ "Escape character for Boot code.")
+
+(defun get-BOOT-token (token)
+
+  "If you have an _, go to the next line.
+If you have a . followed by an integer, get a floating point number.
+Otherwise, get a .. identifier."
+
+  (if (not (boot-skip-blanks))
+      nil
+      (let ((token-type (boot-token-lookahead-type (current-char))))
+	(case token-type
+	  (eof			(token-install nil '*eof token nonblank))
+	  (escape		(advance-char)
+				(get-boot-identifier-token token t))
+	  (argument-designator	(get-argument-designator-token token))
+	  (id			(get-boot-identifier-token token))
+	  (num			(get-number-token token))
+	  (string		(get-SPADSTRING-token token))
+	  (special-char		(get-special-token token))
+	  (t			(get-gliph-token token token-type))))))
+
+(defun boot-skip-blanks ()
+  (setq nonblank t)
+  (loop (let ((cc (current-char)))
+	  (if (not cc) (return nil))
+	  (if (eq (boot-token-lookahead-type cc) 'white)
+	      (progn (setq nonblank nil) (if (not (advance-char)) (return nil)))
+	      (return t)))))
+
+(defun boot-token-lookahead-type (char)
+  "Predicts the kind of token to follow, based on the given initial character."
+  (cond ((not char)					   'eof)
+	((char= char #\_)				   'escape)
+	((and (char= char #\#) (digitp (next-char)))	   'argument-designator)
+	((digitp char)					   'num)
+	((and (char= char #\$) $boot
+	      (alpha-char-p (next-char)))		   'id)
+	((or (char= char #\%) (char= char #\?)
+	     (char= char #\!) (alpha-char-p char))	   'id)
+	((char= char #\")                                  'string)
+	((member char
+		 '(#\Space #\Tab #\Return)
+		 :test #'char=)				   'white)
+	((get (intern (string char)) 'Gliph))
+	(t						   'special-char)))
+
+(defun get-argument-designator-token (token)
+  (advance-char)
+  (get-number-token token)
+  (token-install (intern (strconc "#" (format nil "~D" (token-symbol token))))
+		 'argument-designator token nonblank))
+
+(defvar Keywords '(|or| |and| |isnt| |is| |otherwise| |when| |where|
+		  |has| |with| |add| |case| |in| |by| |pretend| |mod|
+		  |exquo| |div| |quo| |else| |rem| |then| |suchthat|
+		  |if| |yield| |iterate| |from| |exit| |leave| |return|
+		  |not| |unless| |repeat| |until| |while| |for| |import|)
+
+
+
+"Alphabetic literal strings occurring in the New Meta code constitute
+keywords.   These are recognized specifically by the AnyId production,
+GET-BOOT-IDENTIFIER will recognize keywords but flag them
+as keywords.")
+
+(defun get-boot-identifier-token (token &optional (escaped? nil))
+  "An identifier consists of an escape followed by any character, a %, ?,
+or an alphabetic, followed by any number of escaped characters, digits,
+or the chracters ?, !, ' or %"
+  (prog ((buf (make-adjustable-string 0))
+	 (default-package NIL))
+      (suffix (current-char) buf)
+      (advance-char)
+   id (let ((cur-char (current-char)))
+	 (cond ((char= cur-char XCape)
+		(if (not (advance-char)) (go bye))
+		(suffix (current-char) buf)
+		(setq escaped? t)
+		(if (not (advance-char)) (go bye))
+		(go id))
+	       ((and (null default-package)
+		     (char= cur-char #\'))
+		(setq default-package buf)
+		(setq buf (make-adjustable-string 0))
+		(if (not (advance-char)) (go bye))
+		(go id))
+	       ((or (alpha-char-p cur-char)
+		    (digitp cur-char)
+		    (member cur-char '(#\% #\' #\? #\!) :test #'char=))
+		(suffix (current-char) buf)
+		(if (not (advance-char)) (go bye))
+		(go id))))
+  bye (if (and (stringp default-package)
+	       (or (not (find-package default-package))	 ;; not a package name
+		   (every #'(lambda (x) (eql x #\')) buf))) ;;token ends with ''
+	  (setq buf (concatenate 'string default-package "'" buf)
+		default-package nil))
+      (setq buf (intern buf (or default-package "BOOT")))
+      (return (token-install
+		buf
+		(if (and (not escaped?)
+			 (member buf Keywords :test #'eq))
+		    'keyword 'identifier)
+		token
+		nonblank))))
+
+(defun get-gliph-token (token gliph-list)
+  (prog ((buf (make-adjustable-string 0)))
+	(suffix (current-char) buf)
+	(advance-char)
+   loop (setq gliph-list (assoc (intern (string (current-char))) gliph-list))
+	(if gliph-list
+	    (progn (suffix (current-char) buf)
+		   (pop gliph-list)
+		   (advance-char)
+		   (go loop))
+	    (let ((new-token (intern buf)))
+	      (return (token-install (or (get new-token 'renametok) new-token)
+				     'gliph token nonblank))))))
+
+(defun get-SPADSTRING-token (token)
+   "With TOK=\" and ABC\" on IN-STREAM, extracts and stacks string ABC"
+  (PROG ((BUF (make-adjustable-string 0)))
+	(if (char/= (current-char) #\") (RETURN NIL) (advance-char))
+	(loop
+	 (if (char= (current-char) #\") (return nil))
+	 (SUFFIX (if (char= (current-char) XCape)
+		     (advance-char)
+		   (current-char))
+		 BUF)
+	 (if (null  (advance-char)) ;;end of line
+	     (PROGN (|sayBrightly| "Close quote inserted") (RETURN nil)))
+	 )
+	(advance-char)
+	(return (token-install (copy-seq buf) ;should make a simple string
+			       'spadstring token))))
+
+; **** 4. BOOT token parsing actions
+
+; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
+
+(defmacro defun-parse-token (token)
+  `(defun ,(intern (concatenate 'string "PARSE-" (string token))) ()
+     (let* ((tok (match-current-token ',token))
+            (symbol (if tok (token-symbol tok))))
+       (if tok (progn (push-reduction
+                        ',(intern (concatenate 'string (string token)
+                                               "-TOKEN"))
+                        (copy-tree symbol))
+                      (advance-token)
+                      t)))))
+
+(defun-parse-token SPADSTRING)
+(defun-parse-token KEYWORD)
+(defun-parse-token ARGUMENT-DESIGNATOR)
+
+(defun |boot-LEXPR| () (SETQ $NBOOT T) (New-LEXPR1))
+
+(defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X)
+
+(defun TRANSLABEL1 (X AL)
+ "Transforms X according to AL = ((<label> . Sexpr) ..)."
+  (COND ((REFVECP X)
+	 (do ((i 0 (1+ i))
+	      (k (maxindex x)))
+	     ((> i k))
+	   (if (LET ((Y (LASSOC (ELT X I) AL))) (SETELT X I Y))
+	       (TRANSLABEL1 (ELT X I) AL))))
+	((ATOM X) NIL)
+	((LET ((Y (LASSOC (FIRST X) AL)))
+	   (if Y (setf (FIRST X) Y) (TRANSLABEL1 (CDR X) AL))))
+	((TRANSLABEL1 (FIRST X) AL) (TRANSLABEL1 (CDR X) AL))))
+
+; **** 5. BOOT Error Handling
+
+(defun SPAD_SYNTAX_ERROR (&rest byebye)
+  "Print syntax error indication, underline character, scrub line."
+  (BUMPERRORCOUNT '|syntax|)
+  (COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM)))
+	 (SPAD_LONG_ERROR))
+	((SPAD_SHORT_ERROR)))
+  (IOClear)
+  (throw 'spad_reader nil))
+
+(defun SPAD_LONG_ERROR ()
+  (SPAD_ERROR_LOC SPADERRORSTREAM)
+  (iostat)
+  (unless (EQUAL OUT-STREAM SPADERRORSTREAM)
+    (SPAD_ERROR_LOC OUT-STREAM)
+    (TERPRI OUT-STREAM)))
+
+(defun SPAD_SHORT_ERROR () (current-line-show))
+
+(defun SPAD_ERROR_LOC (STR)
+  (format str "******** Boot Syntax Error detected ********"))
+
+(defun BUMPERRORCOUNT (KIND)
+  (unless |$InteractiveMode|
+	  (LET ((INDEX (case KIND
+			 (|syntax| 0)
+			 (|precompilation| 1)
+			 (|semantic| 2)
+			 (T (ERROR "BUMPERRORCOUNT")))))
+	    (SETELT $SPAD_ERRORS INDEX (1+ (ELT $SPAD_ERRORS INDEX))))))
+
+
+@
+<<*>>=
+
+; NAME:     Def
+; PURPOSE:  Defines BOOT code
+
+
+;;; 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)))
+      (COMP (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 *STANDARD-OUTPUT*)
+	 (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))))
+   (COMP (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)))
+    (COMP (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)) ))
+       (LIST 'COND (LIST (SUBST RHS ' (DEFTRAN (LIST 'IS ' 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 MK_LEFORM (U)
+  (COND ((IDENTP U) (PNAME U))
+        ((STRINGP U) U)
+        ((ATOM U) (STRINGIMAGE U))
+        ((MEMBER (FIRST U) '(VCONS CONS) :test #'eq)
+         (STRCONC "(" (MK_LEFORM-CONS U) ")") )
+        ((EQ (FIRST U) 'LIST) (STRCONC "(" (MK_LEFORM (SECOND U)) ")") )
+        ((EQ (FIRST U) 'APPEND) (STRCONC "(" (MK_LEFORM-CONS U) ")") )
+        ((EQ (FIRST U) 'QUOTE) (MK_LEFORM (SECOND U)))
+        ((EQ (FIRST U) 'EQUAL) (STRCONC "=" (MK_LEFORM (SECOND U)) ))
+        ((EQ (FIRST U) 'SPADLET) (MK_LEFORM (THIRD U)))
+        ((ERRHUH))))
+
+(defun MK_LEFORM-CONS (U)
+  (COND ((ATOM U) (STRCONC ":" (MK_LEFORM U)))
+        ((EQ (FIRST U) 'APPEND)
+         (STRCONC ":" (MK_LEFORM (SECOND U)) "\," (MK_LEFORM-CONS (THIRD U)) ))
+        ((EQ (THIRD U) NIL) (MK_LEFORM (SECOND U)))
+        ((STRCONC (MK_LEFORM (SECOND U)) "\," (MK_LEFORM-CONS (THIRD U))))))
+
+(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 '|Tuple|)
+        (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))
+
+(defun ERRHUH () (|systemError| "problem with BOOT to LISP translation"))
+
+(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)))))
+@
+<<fnew.meta>>=
+%       Scratchpad II Boot Language Grammar, Common Lisp Version
+%       IBM Thomas J. Watson Research Center
+%       Summer, 1986
+%
+%       NOTE: Substantially different from VM/LISP version, due to
+%             different parser and attempt to render more within META proper.
+
+.META(New NewExpr Process)
+.PACKAGE 'BOOT'
+.DECLARE(tmptok TOK ParseMode DEFINITION_NAME LABLASOC)
+.PREFIX 'PARSE-'
+
+NewExpr:        =')' .(processSynonyms) Command
+              / .(SETQ DEFINITION_NAME (CURRENT-SYMBOL)) Statement ;
+
+Command:        ')' SpecialKeyWord SpecialCommand +() ;
+
+SpecialKeyWord: =(MATCH-CURRENT-TOKEN "IDENTIFIER)
+                .(SETF (TOKEN-SYMBOL (CURRENT-TOKEN)) (unAbbreviateKeyword (CURRENT-SYMBOL))) ;
+
+SpecialCommand: 'show' <'?' / Expression>! +(show #1) CommandTail
+              / ?(MEMBER (CURRENT-SYMBOL) \$noParseCommands)
+                 .(FUNCALL (CURRENT-SYMBOL))
+              / ?(MEMBER (CURRENT-SYMBOL) \$tokenCommands) TokenList
+                  TokenCommandTail
+              / PrimaryOrQM* CommandTail ;
+
+TokenList:      (^?(isTokenDelimiter) +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN))* ;
+
+TokenCommandTail:
+                <TokenOption*>! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ;
+
+TokenOption:    ')' TokenList ;
+
+CommandTail:    <Option*>! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ;
+
+PrimaryOrQM:    '?' +\? / Primary ;
+
+Option:         ')' PrimaryOrQM* ;
+
+Statement:      Expr{0} <(',' Expr{0})* +(Series #2 -#1)>;
+
+InfixWith:      With +(Join #2 #1) ;
+
+With:           'with' Category +(with #1) ;
+
+Category:      'if' Expression 'then' Category <'else' Category>! +(if #3 #2 #1)
+              / '(' Category <(';' Category)*>! ')' +(CATEGORY #2 -#1)
+              / .(SETQ $1 (LINE-NUMBER CURRENT-LINE)) Application 
+                   ( ':' Expression +(Signature #2 #1)
+                             .(recordSignatureDocumentation ##1 $1)
+                           / +(Attribute #1)
+                             .(recordAttributeDocumentation ##1 $1));
+
+Expression:   Expr{(PARSE-rightBindingPowerOf (MAKE-SYMBOL-OF PRIOR-TOKEN) ParseMode)}
+                +#1 ;
+
+Import:         'import' Expr{1000} <(',' Expr{1000})*>! +(import #2 -#1) ;
+
+Infix:          =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail>
+                Expression +(#2 #2 #1) ;
+
+Prefix:         =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail>
+                Expression +(#2 #1) ;
+
+Suffix:         +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail> +(#1 #1) ;
+
+TokTail:        ?(AND (NULL \$BOOT) (EQ (CURRENT-SYMBOL) "\$)
+                      (OR (ALPHA-CHAR-P (CURRENT-CHAR))
+                          (CHAR-EQ (CURRENT-CHAR) '$')
+                          (CHAR-EQ (CURRENT-CHAR) '\%')
+                          (CHAR-EQ (CURRENT-CHAR) '(')))
+                .(SETQ $1 (COPY-TOKEN PRIOR-TOKEN)) Qualification
+                .(SETQ PRIOR-TOKEN $1) ;
+
+Qualification:  '$' Primary1 +=(dollarTran #1 #1) ;
+
+SemiColon:      ';' (Expr{82} / + \/throwAway) +(\; #2 #1) ;
+
+Return:         'return' Expression +(return #1) ;
+
+Exit:           'exit' (Expression / +\$NoValue) +(exit #1) ;
+
+Leave:          'leave' ( Expression / +\$NoValue )
+                ('from' Label +(leaveFrom #1 #1) / +(leave #1)) ;
+
+Seg:            GliphTok{"\.\.} <Expression>! +(SEGMENT #2 #1) ;
+
+Conditional:    'if' Expression 'then' Expression <'else' ElseClause>!
+                   +(if #3 #2 #1) ;
+
+ElseClause:     ?(EQ (CURRENT-SYMBOL) "if) Conditional / Expression ;
+
+Loop:           Iterator* 'repeat' Expr{110} +(REPEAT -#2 #1)
+              / 'repeat' Expr{110} +(REPEAT #1) ;
+
+Iterator:       'for' Primary 'in' Expression
+                ( 'by' Expr{200} +(INBY #3 #2 #1) / +(IN #2 #1) )
+                < '\|' Expr{111} +(\| #1) >
+              / 'while' Expr{190} +(WHILE #1)
+              / 'until' Expr{190} +(UNTIL #1) ;
+
+Expr{RBP}:      NudPart{RBP} <LedPart{RBP}>* +#1;
+
+LabelExpr:      Label Expr{120} +(LABEL #2 #1) ;
+
+Label:          '<<' Name '>>' ;
+
+LedPart{RBP}:   Operation{"Led RBP} +#1;
+
+NudPart{RBP}:   (Operation{"Nud RBP} / Reduction / Form) +#1 ;
+
+Operation{ParseMode RBP}:
+        ^?(MATCH-CURRENT-TOKEN "IDENTIFIER)
+        ?(GETL (SETQ tmptok (CURRENT-SYMBOL)) ParseMode)
+        ?(LT RBP (PARSE-leftBindingPowerOf tmptok ParseMode))
+        .(SETQ RBP (PARSE-rightBindingPowerOf tmptok ParseMode))
+        getSemanticForm{tmptok ParseMode (ELEMN (GETL tmptok ParseMode) 5 NIL)} ;
+
+% Binding powers stored under the Led and Red properties of an operator
+% are set up by the file BOTTOMUP.LISP.  The format for a Led property
+% is <Operator Left-Power Right-Power>, and the same for a Nud, except that
+% it may also have a fourth component <Special-Handler>. ELEMN attempts to
+% get the Nth indicator, counting from 1.
+
+leftBindingPowerOf{X IND}: =(LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0)) ;
+
+rightBindingPowerOf{X IND}: =(LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105)) ;
+
+getSemanticForm{X IND Y}:
+                ?(AND Y (EVAL Y)) / ?(EQ IND "Nud) Prefix / ?(EQ IND "Led) Infix ;
+
+
+Reduction:      ReductionOp Expr{1000} +(Reduce #2 #1) ;
+
+ReductionOp:    ?(AND (GETL (CURRENT-SYMBOL) "Led)
+                      (MATCH-NEXT-TOKEN "SPECIAL-CHAR (CODE-CHAR 47))) % Forgive me!
+                +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) .(ADVANCE-TOKEN) ;
+
+Form:           'iterate' < 'from' Label +(#1) >! +(iterate -#1)
+              / 'yield' Application +(yield #1)
+              / Application ;
+
+Application: Primary <Selector>* <Application +(#2 #1)>;
+
+Selector: ?NONBLANK ?(EQ (CURRENT-SYMBOL) "\.) ?(CHAR-NE (CURRENT-CHAR) "\ )
+                 '.' PrimaryNoFloat (=\$BOOT +(ELT #2 #1)/ +(#2 #1))
+          / (Float /'.' Primary) (=\$BOOT +(ELT #2 #1)/ +(#2 #1));
+
+PrimaryNoFloat: Primary1 <TokTail> ;
+
+Primary: Float /PrimaryNoFloat ;
+
+Primary1: VarForm <=(AND NONBLANK (EQ (CURRENT-SYMBOL) "\()) Primary1 +(#2 #1)>
+        /Quad
+        /String
+        /IntegerTok
+        /FormalParameter
+        /='\'' (?\$BOOT Data / '\'' Expr{999} +(QUOTE #1))
+        /Sequence
+        /Enclosure ;
+
+Float: FloatBase (?NONBLANK FloatExponent / +0) +=(MAKE-FLOAT #4 #2 #2 #1) ;
+
+FloatBase: ?(FIXP (CURRENT-SYMBOL)) ?(CHAR-EQ (CURRENT-CHAR) '.')
+           ?(CHAR-NE (NEXT-CHAR) '.')
+              IntegerTok FloatBasePart
+          /?(FIXP (CURRENT-SYMBOL)) ?(CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) "E)
+              IntegerTok +0 +0
+         /?(DIGITP (CURRENT-CHAR)) ?(EQ (CURRENT-SYMBOL) "\.)
+              +0 FloatBasePart ;
+
+FloatBasePart: '.'
+  (?(DIGITP (CURRENT-CHAR)) +=(TOKEN-NONBLANK (CURRENT-TOKEN)) IntegerTok
+  / +0 +0);
+
+
+FloatExponent: =(AND (MEMBER (CURRENT-SYMBOL) "(E e))
+                     (FIND (CURRENT-CHAR) '+-'))
+                 .(ADVANCE-TOKEN)
+        (IntegerTok/'+' IntegerTok/'-' IntegerTok +=(MINUS #1)/+0)
+       /?(IDENTP (CURRENT-SYMBOL)) =(SETQ $1 (FLOATEXPID (CURRENT-SYMBOL)))
+       .(ADVANCE-TOKEN) +=$1 ;
+
+Enclosure:      '(' ( Expr{6} ')' / ')' +(Tuple) )
+              / '{' ( Expr{6} '}' +(brace (construct #1)) / '}' +(brace)) ;
+
+IntegerTok:     NUMBER ;
+
+FloatTok:       NUMBER +=(IF \$BOOT #1 (BFP- #1)) ;
+
+FormalParameter: FormalParameterTok ;
+
+FormalParameterTok: ARGUMENT-DESIGNATOR ;
+
+Quad:           '$' +\$ / ?\$BOOT GliphTok{"\.} +\. ;
+
+String:         SPADSTRING ;
+
+VarForm:        Name <Scripts +(Scripts #2 #1) > +#1 ;
+
+Scripts:        ?NONBLANK '[' ScriptItem ']' ;
+
+ScriptItem:     Expr{90} <(';' ScriptItem)* +(\; #2 -#1)>
+              / ';' ScriptItem +(PrefixSC #1) ;
+
+Name:           IDENTIFIER +#1 ;
+
+Data:           .(SETQ LABLASOC NIL) Sexpr +(QUOTE =(TRANSLABEL #1 LABLASOC)) ;
+
+Sexpr:          .(ADVANCE-TOKEN) Sexpr1 ;
+
+Sexpr1:       AnyId
+              < NBGliphTok{"\=} Sexpr1
+                 .(SETQ LABLASOC (CONS (CONS #2 ##1) LABLASOC))>
+              / '\'' Sexpr1 +(QUOTE #1)
+              / IntegerTok
+              / '-' IntegerTok +=(MINUS #1)
+              / String
+              / '<' <Sexpr1*>! '>' +=(LIST2VEC #1)
+              / '(' <Sexpr1* <GliphTok{"\.} Sexpr1 +=(NCONC #2 #1)>>! ')' ;
+
+NBGliphTok{tok}:   ?(AND (MATCH-CURRENT-TOKEN "GLIPH tok) NONBLANK)
+                    .(ADVANCE-TOKEN) ;
+
+GliphTok{tok}:     ?(MATCH-CURRENT-TOKEN "GLIPH tok) .(ADVANCE-TOKEN) ;
+
+AnyId:          IDENTIFIER
+              / (='$' +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) / KEYWORD) ;
+
+Sequence:       OpenBracket Sequence1 ']'
+              / OpenBrace Sequence1 '}' +(brace #1) ;
+
+Sequence1:     (Expression +(#2 #1) / +(#1)) <IteratorTail +(COLLECT -#1 #1)>  ;
+
+OpenBracket:    =(EQ (getToken (SETQ $1 (CURRENT-SYMBOL))) "\[ )
+                      (=(EQCAR $1 "elt) +(elt =(CADR $1) construct)
+                        / +construct) .(ADVANCE-TOKEN) ;
+
+OpenBrace:      =(EQ (getToken (SETQ $1 (CURRENT-SYMBOL))) "\{ )
+                      (=(EQCAR $1 "elt) +(elt =(CADR $1) brace)
+                        / +construct) .(ADVANCE-TOKEN) ;
+
+IteratorTail:   ('repeat' <Iterator*>! / Iterator*) ;
+
+.FIN ;
+
+
+@
+fnewmeta
+<<trace>>=
+
+(DEFPARAMETER |tmptok| NIL)
+(DEFPARAMETER TOK NIL)
+(DEFPARAMETER |ParseMode| NIL)
+(DEFPARAMETER DEFINITION_NAME NIL)
+(DEFPARAMETER LABLASOC NIL)
+
+
+(DEFUN |PARSE-NewExpr| ()
+  (OR (AND (MATCH-STRING ")") (ACTION (|processSynonyms|))
+           (MUST (|PARSE-Command|)))
+      (AND (ACTION (SETQ DEFINITION_NAME (CURRENT-SYMBOL)))
+           (|PARSE-Statement|))))
+(trace |PARSE-NewExpr|) 
+
+
+(DEFUN |PARSE-Command| ()
+  (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-SpecialKeyWord|))
+       (MUST (|PARSE-SpecialCommand|))
+       (PUSH-REDUCTION '|PARSE-Command| NIL)))
+(trace |PARSE-Command|) 
+
+
+(DEFUN |PARSE-SpecialKeyWord| ()
+  (AND (MATCH-CURRENT-TOKEN 'IDENTIFIER)
+       (ACTION (SETF (TOKEN-SYMBOL (CURRENT-TOKEN))
+                     (|unAbbreviateKeyword| (CURRENT-SYMBOL))))))
+(trace |PARSE-SpecialKeyWord|) 
+
+
+(DEFUN |PARSE-SpecialCommand| ()
+  (OR (AND (MATCH-ADVANCE-STRING "show")
+           (BANG FIL_TEST
+                 (OPTIONAL
+                     (OR (MATCH-ADVANCE-STRING "?")
+                         (|PARSE-Expression|))))
+           (PUSH-REDUCTION '|PARSE-SpecialCommand|
+               (CONS '|show| (CONS (POP-STACK-1) NIL)))
+           (MUST (|PARSE-CommandTail|)))
+      (AND (MEMBER (CURRENT-SYMBOL) |$noParseCommands|)
+           (ACTION (FUNCALL (CURRENT-SYMBOL))))
+      (AND (MEMBER (CURRENT-SYMBOL) |$tokenCommands|)
+           (|PARSE-TokenList|) (MUST (|PARSE-TokenCommandTail|)))
+      (AND (STAR REPEATOR (|PARSE-PrimaryOrQM|))
+           (MUST (|PARSE-CommandTail|)))))
+(trace |PARSE-SpecialCommand|) 
+
+
+(DEFUN |PARSE-TokenList| ()
+  (STAR REPEATOR
+        (AND (NOT (|isTokenDelimiter|))
+             (PUSH-REDUCTION '|PARSE-TokenList| (CURRENT-SYMBOL))
+             (ACTION (ADVANCE-TOKEN)))))
+(trace |PARSE-TokenList|) 
+
+
+(DEFUN |PARSE-TokenCommandTail| ()
+  (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-TokenOption|))))
+       (|atEndOfLine|)
+       (PUSH-REDUCTION '|PARSE-TokenCommandTail|
+           (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))
+       (ACTION (|systemCommand| (POP-STACK-1)))))
+(trace |PARSE-TokenCommandTail|) 
+
+
+(DEFUN |PARSE-TokenOption| ()
+  (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-TokenList|))))
+(trace |PARSE-TokenOption|) 
+
+
+(DEFUN |PARSE-CommandTail| ()
+  (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|))))
+       (|atEndOfLine|)
+       (PUSH-REDUCTION '|PARSE-CommandTail|
+           (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))
+       (ACTION (|systemCommand| (POP-STACK-1)))))
+(trace |PARSE-CommandTail|) 
+
+
+(DEFUN |PARSE-PrimaryOrQM| ()
+  (OR (AND (MATCH-ADVANCE-STRING "?")
+           (PUSH-REDUCTION '|PARSE-PrimaryOrQM| '?))
+      (|PARSE-Primary|)))
+(trace |PARSE-PrimaryOrQM|) 
+
+
+(DEFUN |PARSE-Option| ()
+  (AND (MATCH-ADVANCE-STRING ")")
+       (MUST (STAR REPEATOR (|PARSE-PrimaryOrQM|)))))
+(trace |PARSE-Option|) 
+
+
+(DEFUN |PARSE-Statement| ()
+  (AND (|PARSE-Expr| 0)
+       (OPTIONAL
+           (AND (STAR REPEATOR
+                      (AND (MATCH-ADVANCE-STRING ",")
+                           (MUST (|PARSE-Expr| 0))))
+                (PUSH-REDUCTION '|PARSE-Statement|
+                    (CONS '|Series|
+                          (CONS (POP-STACK-2)
+                                (APPEND (POP-STACK-1) NIL))))))))
+(trace |PARSE-Statement|) 
+
+
+(DEFUN |PARSE-InfixWith| ()
+  (AND (|PARSE-With|)
+       (PUSH-REDUCTION '|PARSE-InfixWith|
+           (CONS '|Join| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-InfixWith|) 
+
+
+(DEFUN |PARSE-With| ()
+  (AND (MATCH-ADVANCE-STRING "with") (MUST (|PARSE-Category|))
+       (PUSH-REDUCTION '|PARSE-With|
+           (CONS '|with| (CONS (POP-STACK-1) NIL)))))
+(trace |PARSE-With|) 
+
+
+(DEFUN |PARSE-Category| ()
+  (PROG (G1)
+    (RETURN
+      (OR (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|))
+               (MUST (MATCH-ADVANCE-STRING "then"))
+               (MUST (|PARSE-Category|))
+               (BANG FIL_TEST
+                     (OPTIONAL
+                         (AND (MATCH-ADVANCE-STRING "else")
+                              (MUST (|PARSE-Category|)))))
+               (PUSH-REDUCTION '|PARSE-Category|
+                   (CONS '|if|
+                         (CONS (POP-STACK-3)
+                               (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL))))))
+          (AND (MATCH-ADVANCE-STRING "(") (MUST (|PARSE-Category|))
+               (BANG FIL_TEST
+                     (OPTIONAL
+                         (STAR REPEATOR
+                               (AND (MATCH-ADVANCE-STRING ";")
+                                    (MUST (|PARSE-Category|))))))
+               (MUST (MATCH-ADVANCE-STRING ")"))
+               (PUSH-REDUCTION '|PARSE-Category|
+                   (CONS 'CATEGORY
+                         (CONS (POP-STACK-2)
+                               (APPEND (POP-STACK-1) NIL)))))
+          (AND (ACTION (SETQ G1 (LINE-NUMBER CURRENT-LINE)))
+               (|PARSE-Application|)
+               (MUST (OR (AND (MATCH-ADVANCE-STRING ":")
+                              (MUST (|PARSE-Expression|))
+                              (PUSH-REDUCTION '|PARSE-Category|
+                                  (CONS '|Signature|
+                                        (CONS (POP-STACK-2)
+                                         (CONS (POP-STACK-1) NIL))))
+                              (ACTION (|recordSignatureDocumentation|
+                                       (NTH-STACK 1) G1)))
+                         (AND (PUSH-REDUCTION '|PARSE-Category|
+                                  (CONS '|Attribute|
+                                        (CONS (POP-STACK-1) NIL)))
+                              (ACTION (|recordAttributeDocumentation|
+                                       (NTH-STACK 1) G1))))))))))
+(trace |PARSE-Category|) 
+
+
+(DEFUN |PARSE-Expression| ()
+  (AND (|PARSE-Expr|
+           (|PARSE-rightBindingPowerOf| (MAKE-SYMBOL-OF PRIOR-TOKEN)
+               |ParseMode|))
+       (PUSH-REDUCTION '|PARSE-Expression| (POP-STACK-1))))
+(trace |PARSE-Expression|) 
+
+
+(DEFUN |PARSE-Import| ()
+  (AND (MATCH-ADVANCE-STRING "import") (MUST (|PARSE-Expr| 1000))
+       (BANG FIL_TEST
+             (OPTIONAL
+                 (STAR REPEATOR
+                       (AND (MATCH-ADVANCE-STRING ",")
+                            (MUST (|PARSE-Expr| 1000))))))
+       (PUSH-REDUCTION '|PARSE-Import|
+           (CONS '|import|
+                 (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL))))))
+(trace |PARSE-Import|) 
+
+
+(DEFUN |PARSE-Infix| ()
+  (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
+       (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Infix|
+           (CONS (POP-STACK-2)
+                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-Infix|) 
+
+
+(DEFUN |PARSE-Prefix| ()
+  (AND (PUSH-REDUCTION '|PARSE-Prefix| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
+       (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Prefix|
+           (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
+(trace |PARSE-Prefix|) 
+
+
+(DEFUN |PARSE-Suffix| ()
+  (AND (PUSH-REDUCTION '|PARSE-Suffix| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|))
+       (PUSH-REDUCTION '|PARSE-Suffix|
+           (CONS (POP-STACK-1) (CONS (POP-STACK-1) NIL)))))
+(trace |PARSE-Suffix|) 
+
+
+(DEFUN |PARSE-TokTail| ()
+  (PROG (G1)
+    (RETURN
+      (AND (NULL $BOOT) (EQ (CURRENT-SYMBOL) '$)
+           (OR (ALPHA-CHAR-P (CURRENT-CHAR))
+               (CHAR-EQ (CURRENT-CHAR) "$")
+               (CHAR-EQ (CURRENT-CHAR) "%")
+               (CHAR-EQ (CURRENT-CHAR) "("))
+           (ACTION (SETQ G1 (COPY-TOKEN PRIOR-TOKEN)))
+           (|PARSE-Qualification|) (ACTION (SETQ PRIOR-TOKEN G1))))))
+(trace |PARSE-TokTail|) 
+
+
+(DEFUN |PARSE-Qualification| ()
+  (AND (MATCH-ADVANCE-STRING "$") (MUST (|PARSE-Primary1|))
+       (PUSH-REDUCTION '|PARSE-Qualification|
+           (|dollarTran| (POP-STACK-1) (POP-STACK-1)))))
+(trace |PARSE-Qualification|) 
+
+
+(DEFUN |PARSE-SemiColon| ()
+  (AND (MATCH-ADVANCE-STRING ";")
+       (MUST (OR (|PARSE-Expr| 82)
+                 (PUSH-REDUCTION '|PARSE-SemiColon| '|/throwAway|)))
+       (PUSH-REDUCTION '|PARSE-SemiColon|
+           (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-SemiColon|) 
+
+
+(DEFUN |PARSE-Return| ()
+  (AND (MATCH-ADVANCE-STRING "return") (MUST (|PARSE-Expression|))
+       (PUSH-REDUCTION '|PARSE-Return|
+           (CONS '|return| (CONS (POP-STACK-1) NIL)))))
+(trace |PARSE-Return|) 
+
+
+(DEFUN |PARSE-Exit| ()
+  (AND (MATCH-ADVANCE-STRING "exit")
+       (MUST (OR (|PARSE-Expression|)
+                 (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|)))
+       (PUSH-REDUCTION '|PARSE-Exit|
+           (CONS '|exit| (CONS (POP-STACK-1) NIL)))))
+(trace |PARSE-Exit|) 
+
+
+(DEFUN |PARSE-Leave| ()
+  (AND (MATCH-ADVANCE-STRING "leave")
+       (MUST (OR (|PARSE-Expression|)
+                 (PUSH-REDUCTION '|PARSE-Leave| '|$NoValue|)))
+       (MUST (OR (AND (MATCH-ADVANCE-STRING "from")
+                      (MUST (|PARSE-Label|))
+                      (PUSH-REDUCTION '|PARSE-Leave|
+                          (CONS '|leaveFrom|
+                                (CONS (POP-STACK-1)
+                                      (CONS (POP-STACK-1) NIL)))))
+                 (PUSH-REDUCTION '|PARSE-Leave|
+                     (CONS '|leave| (CONS (POP-STACK-1) NIL)))))))
+(trace |PARSE-Leave|) 
+
+
+(DEFUN |PARSE-Seg| ()
+  (AND (|PARSE-GliphTok| '|..|)
+       (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|)))
+       (PUSH-REDUCTION '|PARSE-Seg|
+           (CONS 'SEGMENT
+                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-Seg|) 
+
+
+(DEFUN |PARSE-Conditional| ()
+  (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|))
+       (MUST (MATCH-ADVANCE-STRING "then")) (MUST (|PARSE-Expression|))
+       (BANG FIL_TEST
+             (OPTIONAL
+                 (AND (MATCH-ADVANCE-STRING "else")
+                      (MUST (|PARSE-ElseClause|)))))
+       (PUSH-REDUCTION '|PARSE-Conditional|
+           (CONS '|if|
+                 (CONS (POP-STACK-3)
+                       (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))))
+(trace |PARSE-Conditional|) 
+
+
+(DEFUN |PARSE-ElseClause| ()
+  (OR (AND (EQ (CURRENT-SYMBOL) '|if|) (|PARSE-Conditional|))
+      (|PARSE-Expression|)))
+(trace |PARSE-ElseClause|) 
+
+
+(DEFUN |PARSE-Loop| ()
+  (OR (AND (STAR REPEATOR (|PARSE-Iterator|))
+           (MUST (MATCH-ADVANCE-STRING "repeat"))
+           (MUST (|PARSE-Expr| 110))
+           (PUSH-REDUCTION '|PARSE-Loop|
+               (CONS 'REPEAT
+                     (APPEND (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
+      (AND (MATCH-ADVANCE-STRING "repeat") (MUST (|PARSE-Expr| 110))
+           (PUSH-REDUCTION '|PARSE-Loop|
+               (CONS 'REPEAT (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-Loop|) 
+
+
+(DEFUN |PARSE-Iterator| ()
+  (OR (AND (MATCH-ADVANCE-STRING "for") (MUST (|PARSE-Primary|))
+           (MUST (MATCH-ADVANCE-STRING "in"))
+           (MUST (|PARSE-Expression|))
+           (MUST (OR (AND (MATCH-ADVANCE-STRING "by")
+                          (MUST (|PARSE-Expr| 200))
+                          (PUSH-REDUCTION '|PARSE-Iterator|
+                              (CONS 'INBY
+                                    (CONS (POP-STACK-3)
+                                     (CONS (POP-STACK-2)
+                                      (CONS (POP-STACK-1) NIL))))))
+                     (PUSH-REDUCTION '|PARSE-Iterator|
+                         (CONS 'IN
+                               (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL))))))
+           (OPTIONAL
+               (AND (MATCH-ADVANCE-STRING "|")
+                    (MUST (|PARSE-Expr| 111))
+                    (PUSH-REDUCTION '|PARSE-Iterator|
+                        (CONS '|\|| (CONS (POP-STACK-1) NIL))))))
+      (AND (MATCH-ADVANCE-STRING "while") (MUST (|PARSE-Expr| 190))
+           (PUSH-REDUCTION '|PARSE-Iterator|
+               (CONS 'WHILE (CONS (POP-STACK-1) NIL))))
+      (AND (MATCH-ADVANCE-STRING "until") (MUST (|PARSE-Expr| 190))
+           (PUSH-REDUCTION '|PARSE-Iterator|
+               (CONS 'UNTIL (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-Iterator|) 
+
+
+(DEFUN |PARSE-Expr| (RBP)
+  (DECLARE (SPECIAL RBP))
+  (AND (|PARSE-NudPart| RBP)
+       (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP)))
+       (PUSH-REDUCTION '|PARSE-Expr| (POP-STACK-1))))
+(trace |PARSE-Expr|) 
+
+
+(DEFUN |PARSE-LabelExpr| ()
+  (AND (|PARSE-Label|) (MUST (|PARSE-Expr| 120))
+       (PUSH-REDUCTION '|PARSE-LabelExpr|
+           (CONS 'LABEL (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-LabelExpr|) 
+
+
+(DEFUN |PARSE-Label| ()
+  (AND (MATCH-ADVANCE-STRING "<<") (MUST (|PARSE-Name|))
+       (MUST (MATCH-ADVANCE-STRING ">>"))))
+(trace |PARSE-Label|) 
+
+
+(DEFUN |PARSE-LedPart| (RBP)
+  (DECLARE (SPECIAL RBP))
+  (AND (|PARSE-Operation| '|Led| RBP)
+       (PUSH-REDUCTION '|PARSE-LedPart| (POP-STACK-1))))
+(trace |PARSE-LedPart|) 
+
+
+(DEFUN |PARSE-NudPart| (RBP)
+  (DECLARE (SPECIAL RBP))
+  (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|)
+           (|PARSE-Form|))
+       (PUSH-REDUCTION '|PARSE-NudPart| (POP-STACK-1))))
+(trace |PARSE-NudPart|) 
+
+
+(DEFUN |PARSE-Operation| (|ParseMode| RBP)
+  (DECLARE (SPECIAL |ParseMode| RBP))
+  (AND (NOT (MATCH-CURRENT-TOKEN 'IDENTIFIER))
+       (GETL (SETQ |tmptok| (CURRENT-SYMBOL)) |ParseMode|)
+       (LT RBP (|PARSE-leftBindingPowerOf| |tmptok| |ParseMode|))
+       (ACTION (SETQ RBP
+                     (|PARSE-rightBindingPowerOf| |tmptok| |ParseMode|)))
+       (|PARSE-getSemanticForm| |tmptok| |ParseMode|
+           (ELEMN (GETL |tmptok| |ParseMode|) 5 NIL))))
+(trace |PARSE-Operation|) 
+
+
+(DEFUN |PARSE-leftBindingPowerOf| (X IND)
+  (DECLARE (SPECIAL X IND))
+  (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0)))
+(trace |PARSE-leftBindingPowerOf|) 
+
+
+(DEFUN |PARSE-rightBindingPowerOf| (X IND)
+  (DECLARE (SPECIAL X IND))
+  (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105)))
+(trace |PARSE-rightBindingPowerOf|) 
+
+
+(DEFUN |PARSE-getSemanticForm| (X IND Y)
+  (DECLARE (SPECIAL X IND Y))
+  (OR (AND Y (EVAL Y)) (AND (EQ IND '|Nud|) (|PARSE-Prefix|))
+      (AND (EQ IND '|Led|) (|PARSE-Infix|))))
+(trace |PARSE-getSemanticForm|) 
+
+
+(DEFUN |PARSE-Reduction| ()
+  (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000))
+       (PUSH-REDUCTION '|PARSE-Reduction|
+           (CONS '|Reduce|
+                 (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-Reduction|) 
+
+
+(DEFUN |PARSE-ReductionOp| ()
+  (AND (GETL (CURRENT-SYMBOL) '|Led|)
+       (MATCH-NEXT-TOKEN 'SPECIAL-CHAR (CODE-CHAR 47))
+       (PUSH-REDUCTION '|PARSE-ReductionOp| (CURRENT-SYMBOL))
+       (ACTION (ADVANCE-TOKEN)) (ACTION (ADVANCE-TOKEN))))
+(trace |PARSE-ReductionOp|) 
+
+
+(DEFUN |PARSE-Form| ()
+  (OR (AND (MATCH-ADVANCE-STRING "iterate")
+           (BANG FIL_TEST
+                 (OPTIONAL
+                     (AND (MATCH-ADVANCE-STRING "from")
+                          (MUST (|PARSE-Label|))
+                          (PUSH-REDUCTION '|PARSE-Form|
+                              (CONS (POP-STACK-1) NIL)))))
+           (PUSH-REDUCTION '|PARSE-Form|
+               (CONS '|iterate| (APPEND (POP-STACK-1) NIL))))
+      (AND (MATCH-ADVANCE-STRING "yield") (MUST (|PARSE-Application|))
+           (PUSH-REDUCTION '|PARSE-Form|
+               (CONS '|yield| (CONS (POP-STACK-1) NIL))))
+      (|PARSE-Application|)))
+(trace |PARSE-Form|) 
+
+
+(DEFUN |PARSE-Application| ()
+  (AND (|PARSE-Primary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|)))
+       (OPTIONAL
+           (AND (|PARSE-Application|)
+                (PUSH-REDUCTION '|PARSE-Application|
+                    (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))))
+(trace |PARSE-Application|) 
+
+
+(DEFUN |PARSE-Selector| ()
+  (OR (AND NONBLANK (EQ (CURRENT-SYMBOL) '|.|)
+           (CHAR-NE (CURRENT-CHAR) '| |) (MATCH-ADVANCE-STRING ".")
+           (MUST (|PARSE-PrimaryNoFloat|))
+           (MUST (OR (AND $BOOT
+                          (PUSH-REDUCTION '|PARSE-Selector|
+                              (CONS 'ELT
+                                    (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL)))))
+                     (PUSH-REDUCTION '|PARSE-Selector|
+                         (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+      (AND (OR (|PARSE-Float|)
+               (AND (MATCH-ADVANCE-STRING ".")
+                    (MUST (|PARSE-Primary|))))
+           (MUST (OR (AND $BOOT
+                          (PUSH-REDUCTION '|PARSE-Selector|
+                              (CONS 'ELT
+                                    (CONS (POP-STACK-2)
+                                     (CONS (POP-STACK-1) NIL)))))
+                     (PUSH-REDUCTION '|PARSE-Selector|
+                         (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))))
+(trace |PARSE-Selector|) 
+
+
+(DEFUN |PARSE-PrimaryNoFloat| ()
+  (AND (|PARSE-Primary1|) (OPTIONAL (|PARSE-TokTail|))))
+(trace |PARSE-PrimaryNoFloat|) 
+
+
+(DEFUN |PARSE-Primary| ()
+  (OR (|PARSE-Float|) (|PARSE-PrimaryNoFloat|)))
+(trace |PARSE-Primary|) 
+
+
+(DEFUN |PARSE-Primary1| ()
+  (OR (AND (|PARSE-VarForm|)
+           (OPTIONAL
+               (AND NONBLANK (EQ (CURRENT-SYMBOL) '|(|)
+                    (MUST (|PARSE-Primary1|))
+                    (PUSH-REDUCTION '|PARSE-Primary1|
+                        (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+      (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|)
+      (|PARSE-FormalParameter|)
+      (AND (MATCH-STRING "'")
+           (MUST (OR (AND $BOOT (|PARSE-Data|))
+                     (AND (MATCH-ADVANCE-STRING "'")
+                          (MUST (|PARSE-Expr| 999))
+                          (PUSH-REDUCTION '|PARSE-Primary1|
+                              (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))))))
+      (|PARSE-Sequence|) (|PARSE-Enclosure|))) 
+(trace |PARSE-Primary1|)
+
+(DEFUN |PARSE-Float| ()
+  (AND (|PARSE-FloatBase|)
+       (MUST (OR (AND NONBLANK (|PARSE-FloatExponent|))
+                 (PUSH-REDUCTION '|PARSE-Float| 0)))
+       (PUSH-REDUCTION '|PARSE-Float|
+           (MAKE-FLOAT (POP-STACK-4) (POP-STACK-2) (POP-STACK-2)
+               (POP-STACK-1)))))
+(trace |PARSE-Float|) 
+
+
+(DEFUN |PARSE-FloatBase| ()
+  (OR (AND (FIXP (CURRENT-SYMBOL)) (CHAR-EQ (CURRENT-CHAR) ".")
+           (CHAR-NE (NEXT-CHAR) ".") (|PARSE-IntegerTok|)
+           (MUST (|PARSE-FloatBasePart|)))
+      (AND (FIXP (CURRENT-SYMBOL))
+           (CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) 'E)
+           (|PARSE-IntegerTok|) (PUSH-REDUCTION '|PARSE-FloatBase| 0)
+           (PUSH-REDUCTION '|PARSE-FloatBase| 0))
+      (AND (DIGITP (CURRENT-CHAR)) (EQ (CURRENT-SYMBOL) '|.|)
+           (PUSH-REDUCTION '|PARSE-FloatBase| 0)
+           (|PARSE-FloatBasePart|))))
+(trace |PARSE-FloatBase|) 
+
+
+(DEFUN |PARSE-FloatBasePart| ()
+  (AND (MATCH-ADVANCE-STRING ".")
+       (MUST (OR (AND (DIGITP (CURRENT-CHAR))
+                      (PUSH-REDUCTION '|PARSE-FloatBasePart|
+                          (TOKEN-NONBLANK (CURRENT-TOKEN)))
+                      (|PARSE-IntegerTok|))
+                 (AND (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)
+                      (PUSH-REDUCTION '|PARSE-FloatBasePart| 0))))))
+(trace |PARSE-FloatBasePart|) 
+
+
+(DEFUN |PARSE-FloatExponent| ()
+  (PROG (G1)
+    (RETURN
+      (OR (AND (MEMBER (CURRENT-SYMBOL) '(E |e|))
+               (FIND (CURRENT-CHAR) "+-") (ACTION (ADVANCE-TOKEN))
+               (MUST (OR (|PARSE-IntegerTok|)
+                         (AND (MATCH-ADVANCE-STRING "+")
+                              (MUST (|PARSE-IntegerTok|)))
+                         (AND (MATCH-ADVANCE-STRING "-")
+                              (MUST (|PARSE-IntegerTok|))
+                              (PUSH-REDUCTION '|PARSE-FloatExponent|
+                                  (MINUS (POP-STACK-1))))
+                         (PUSH-REDUCTION '|PARSE-FloatExponent| 0))))
+          (AND (IDENTP (CURRENT-SYMBOL))
+               (SETQ G1 (FLOATEXPID (CURRENT-SYMBOL)))
+               (ACTION (ADVANCE-TOKEN))
+               (PUSH-REDUCTION '|PARSE-FloatExponent| G1))))))
+(trace |PARSE-FloatExponent|) 
+
+
+(DEFUN |PARSE-Enclosure| ()
+  (OR (AND (MATCH-ADVANCE-STRING "(")
+           (MUST (OR (AND (|PARSE-Expr| 6)
+                          (MUST (MATCH-ADVANCE-STRING ")")))
+                     (AND (MATCH-ADVANCE-STRING ")")
+                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                              (CONS '|Tuple| NIL))))))
+      (AND (MATCH-ADVANCE-STRING "{")
+           (MUST (OR (AND (|PARSE-Expr| 6)
+                          (MUST (MATCH-ADVANCE-STRING "}"))
+                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                              (CONS '|brace|
+                                    (CONS
+                                     (CONS '|construct|
+                                      (CONS (POP-STACK-1) NIL))
+                                     NIL))))
+                     (AND (MATCH-ADVANCE-STRING "}")
+                          (PUSH-REDUCTION '|PARSE-Enclosure|
+                              (CONS '|brace| NIL))))))))
+(trace |PARSE-Enclosure|) 
+
+
+(DEFUN |PARSE-IntegerTok| () (PARSE-NUMBER))
+(trace |PARSE-IntegerTok|) 
+
+
+(DEFUN |PARSE-FloatTok| ()
+  (AND (PARSE-NUMBER)
+       (PUSH-REDUCTION '|PARSE-FloatTok|
+           (IF $BOOT (POP-STACK-1) (BFP- (POP-STACK-1))))))
+(trace |PARSE-FloatTok|) 
+
+
+(DEFUN |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|))
+(trace |PARSE-FormalParameter|) 
+
+
+(DEFUN |PARSE-FormalParameterTok| () (PARSE-ARGUMENT-DESIGNATOR))
+(trace |PARSE-FormalParameterTok|) 
+
+
+(DEFUN |PARSE-Quad| ()
+  (OR (AND (MATCH-ADVANCE-STRING "$")
+           (PUSH-REDUCTION '|PARSE-Quad| '$))
+      (AND $BOOT (|PARSE-GliphTok| '|.|)
+           (PUSH-REDUCTION '|PARSE-Quad| '|.|))))
+(trace |PARSE-Quad|) 
+
+
+(DEFUN |PARSE-String| () (PARSE-SPADSTRING))
+(trace |PARSE-String|) 
+
+
+(DEFUN |PARSE-VarForm| ()
+  (AND (|PARSE-Name|)
+       (OPTIONAL
+           (AND (|PARSE-Scripts|)
+                (PUSH-REDUCTION '|PARSE-VarForm|
+                    (CONS '|Scripts|
+                          (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
+       (PUSH-REDUCTION '|PARSE-VarForm| (POP-STACK-1))))
+(trace |PARSE-VarForm|) 
+
+
+(DEFUN |PARSE-Scripts| ()
+  (AND NONBLANK (MATCH-ADVANCE-STRING "[") (MUST (|PARSE-ScriptItem|))
+       (MUST (MATCH-ADVANCE-STRING "]"))))
+(trace |PARSE-Scripts|) 
+
+
+(DEFUN |PARSE-ScriptItem| ()
+  (OR (AND (|PARSE-Expr| 90)
+           (OPTIONAL
+               (AND (STAR REPEATOR
+                          (AND (MATCH-ADVANCE-STRING ";")
+                               (MUST (|PARSE-ScriptItem|))))
+                    (PUSH-REDUCTION '|PARSE-ScriptItem|
+                        (CONS '|;|
+                              (CONS (POP-STACK-2)
+                                    (APPEND (POP-STACK-1) NIL)))))))
+      (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|))
+           (PUSH-REDUCTION '|PARSE-ScriptItem|
+               (CONS '|PrefixSC| (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-ScriptItem|) 
+
+
+(DEFUN |PARSE-Name| ()
+  (AND (PARSE-IDENTIFIER) (PUSH-REDUCTION '|PARSE-Name| (POP-STACK-1))))
+(trace |PARSE-Name|) 
+
+
+(DEFUN |PARSE-Data| ()
+  (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|)
+       (PUSH-REDUCTION '|PARSE-Data|
+           (CONS 'QUOTE (CONS (TRANSLABEL (POP-STACK-1) LABLASOC) NIL)))))
+(trace |PARSE-Data|) 
+
+
+(DEFUN |PARSE-Sexpr| ()
+  (AND (ACTION (ADVANCE-TOKEN)) (|PARSE-Sexpr1|)))
+(trace |PARSE-Sexpr|) 
+
+
+(DEFUN |PARSE-Sexpr1| ()
+  (OR (AND (|PARSE-AnyId|)
+           (OPTIONAL
+               (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|))
+                    (ACTION (SETQ LABLASOC
+                                  (CONS (CONS (POP-STACK-2)
+                                         (NTH-STACK 1))
+                                        LABLASOC))))))
+      (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|))
+           (PUSH-REDUCTION '|PARSE-Sexpr1|
+               (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
+      (|PARSE-IntegerTok|)
+      (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|))
+           (PUSH-REDUCTION '|PARSE-Sexpr1| (MINUS (POP-STACK-1))))
+      (|PARSE-String|)
+      (AND (MATCH-ADVANCE-STRING "<")
+           (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|))))
+           (MUST (MATCH-ADVANCE-STRING ">"))
+           (PUSH-REDUCTION '|PARSE-Sexpr1| (LIST2VEC (POP-STACK-1))))
+      (AND (MATCH-ADVANCE-STRING "(")
+           (BANG FIL_TEST
+                 (OPTIONAL
+                     (AND (STAR REPEATOR (|PARSE-Sexpr1|))
+                          (OPTIONAL
+                              (AND (|PARSE-GliphTok| '|.|)
+                                   (MUST (|PARSE-Sexpr1|))
+                                   (PUSH-REDUCTION '|PARSE-Sexpr1|
+                                    (NCONC (POP-STACK-2) (POP-STACK-1))))))))
+           (MUST (MATCH-ADVANCE-STRING ")")))))
+(trace |PARSE-Sexpr1|) 
+
+
+(DEFUN |PARSE-NBGliphTok| (|tok|)
+  (DECLARE (SPECIAL |tok|))
+  (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) NONBLANK
+       (ACTION (ADVANCE-TOKEN))))
+(trace |PARSE-NBGliphTok|) 
+
+
+(DEFUN |PARSE-GliphTok| (|tok|)
+  (DECLARE (SPECIAL |tok|))
+  (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) (ACTION (ADVANCE-TOKEN))))
+(trace |PARSE-GliphTok|) 
+
+
+(DEFUN |PARSE-AnyId| ()
+  (OR (PARSE-IDENTIFIER)
+      (OR (AND (MATCH-STRING "$")
+               (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL))
+               (ACTION (ADVANCE-TOKEN)))
+          (PARSE-KEYWORD))))
+(trace |PARSE-AnyId|) 
+
+
+(DEFUN |PARSE-Sequence| ()
+  (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|))
+           (MUST (MATCH-ADVANCE-STRING "]")))
+      (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|))
+           (MUST (MATCH-ADVANCE-STRING "}"))
+           (PUSH-REDUCTION '|PARSE-Sequence|
+               (CONS '|brace| (CONS (POP-STACK-1) NIL))))))
+(trace |PARSE-Sequence|) 
+
+
+(DEFUN |PARSE-Sequence1| ()
+  (AND (OR (AND (|PARSE-Expression|)
+                (PUSH-REDUCTION '|PARSE-Sequence1|
+                    (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))
+           (PUSH-REDUCTION '|PARSE-Sequence1| (CONS (POP-STACK-1) NIL)))
+       (OPTIONAL
+           (AND (|PARSE-IteratorTail|)
+                (PUSH-REDUCTION '|PARSE-Sequence1|
+                    (CONS 'COLLECT
+                          (APPEND (POP-STACK-1)
+                                  (CONS (POP-STACK-1) NIL))))))))
+(trace |PARSE-Sequence1|) 
+
+
+(DEFUN |PARSE-OpenBracket| ()
+  (PROG (G1)
+    (RETURN
+      (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '[)
+           (MUST (OR (AND (EQCAR G1 '|elt|)
+                          (PUSH-REDUCTION '|PARSE-OpenBracket|
+                              (CONS '|elt|
+                                    (CONS (CADR G1)
+                                     (CONS '|construct| NIL)))))
+                     (PUSH-REDUCTION '|PARSE-OpenBracket| '|construct|)))
+           (ACTION (ADVANCE-TOKEN)))))) 
+(trace |PARSE-OpenBracket|)
+
+(DEFUN |PARSE-OpenBrace| ()
+  (PROG (G1)
+    (RETURN
+      (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '{)
+           (MUST (OR (AND (EQCAR G1 '|elt|)
+                          (PUSH-REDUCTION '|PARSE-OpenBrace|
+                              (CONS '|elt|
+                                    (CONS (CADR G1)
+                                     (CONS '|brace| NIL)))))
+                     (PUSH-REDUCTION '|PARSE-OpenBrace| '|construct|)))
+           (ACTION (ADVANCE-TOKEN)))))) 
+(trace |PARSE-OpenBrace|)
+
+(DEFUN |PARSE-IteratorTail| ()
+  (OR (AND (MATCH-ADVANCE-STRING "repeat")
+           (BANG FIL_TEST
+                 (OPTIONAL (STAR REPEATOR (|PARSE-Iterator|)))))
+      (STAR REPEATOR (|PARSE-Iterator|))))
+(trace |PARSE-IteratorTail|) 
+
+@
+metalex
+<<*>>=
+
+; NAME:         MetaLex.lisp
+; PURPOSE:      Parsing support routines for Meta code
+; CONTENTS:
+;
+;               1. META File Handling
+;               2. META Line Handling
+;               3. META Token Handling
+;               4. META Token Parsing Actions
+;               5. META Error Handling
+ 
+(in-package "BOOT")
+ 
+; *** 2. META Line Handling
+ 
+(defun next-META-line (&optional (in-stream t))
+ 
+"Get next line, trimming trailing blanks and trailing comments.
+One trailing blank is added to a non-blank line to ease between-line
+processing for Next Token (i.e., blank takes place of return).  Returns T
+if it gets a non-blank line, and NIL at end of stream."
+ 
+  (prog (string)
+empty (if File-Closed (return nil))
+      (setq string (kill-trailing-blanks (kill-comments
+					  (get-a-line in-stream))))
+      (if (= (length string) 0) (go empty))
+      (Line-New-Line (suffix #\Space string) Current-Line)
+      (if Echo-Meta (Print-New-Line (Line-Buffer Current-Line) out-stream))
+      (return t)))
+ 
+(defparameter Comment-Character #\% "Delimiter of comments in Meta code.")
+ 
+(defun kill-comments (string)
+  "Deletes from comment character % to end of STRING."
+  (subseq string 0
+          (let ((mi (maxindex string)))
+            (do ((i 0 (1+ i)))
+                ((> i mi) i)
+              (if (and (char= (elt string i) Comment-Character)
+                       (or (eq i 0) (char/= (elt string (1- i)) #\\)))
+                  (return i))))))
+ 
+(defun kill-trailing-blanks (string)
+ 
+  "Remove white space from end of STRING."
+ 
+  ; Coding note: yes, I know, use string-trim --  but it is broken
+  ; in Symbolics Common Lisp for short strings
+ 
+  (let* ((sl (length string))
+         (right (if (= sl 0) -1
+                    (or
+                      (position-if-not
+                        #'(lambda (x)
+                            (member x '(#\Space #\Tab #\Newline) :test #'char=))
+                        string :from-end t)
+                      -1))))
+    (if (>= right 0) (subseq string 0 (1+ right)) (make-string 0))))
+ 
+; *** 3. META Token Handling
+ 
+; STRING: "'"  { Chars - "'" }* "'"
+; BSTRING: "[" ... "]*"
+; ID: letters, _ and then numbers
+; NUMBER: digits, ., digits, e, +-, digits
+ 
+(defun-parse-token STRING)
+(defun-parse-token BSTRING)
+(defun-parse-token IDENTIFIER)
+(defun-parse-token NUMBER)
+ 
+; Meta tokens fall into the following categories:
+;
+;               Number
+;               Identifier
+;               Dollar-sign
+;               Special character
+;
+; Special characters are represented as characters, numbers as numbers, and
+; identifiers as strings.  The reason identifiers are represented as strings is
+; that the full print-name of the intern of a string depends on the package you
+; are currently executing in; this can lead to very confusing results!
+ 
+(defun get-META-token (token)
+  (prog nil
+   loop (if (not (skip-blanks)) (return nil))
+        (case (token-lookahead-type (current-char))
+          (id           (return (get-identifier-token token)))
+          (num          (return (get-number-token token)))
+          (string       (return (get-string-token token)))
+          (bstring      (return (get-bstring-token token)))
+;         (dollar       (return (get-identifier-token token)))
+          (special-char (return (get-special-token token)))
+          (eof          (return nil)))))
+ 
+(defun skip-blanks ()
+  (loop (let ((cc (current-char)))
+          (if (not cc) (return nil))
+          (if (eq (token-lookahead-type cc) 'white)
+              (if (not (advance-char)) (return nil))
+              (return t)))))
+ 
+(defparameter Escape-Character #\\ "Superquoting character.")
+ 
+(defun token-lookahead-type (char)
+  "Predicts the kind of token to follow, based on the given initial character."
+  (cond ((not char)                                             'eof)
+        ((or (char= char Escape-Character) (alpha-char-p char)) 'id)
+        ((digitp char)                                          'num)
+        ((char= char #\')                                       'string)
+        ((char= char #\[)                                       'bstring)
+;       ((char= char #\$) (advance-char)                        'dollar)
+        ((member char '(#\Space #\Tab #\Return) :test #'char=)  'white)
+        (t                                                      'special-char)))
+ 
+(defun make-adjustable-string (n)
+  (make-array (list n) :element-type 'string-char :adjustable t))
+
+(defun get-identifier-token (token)
+  "Take an identifier off the input stream."
+  (prog ((buf (make-adjustable-string 0)))
+   id (let ((cur-char (current-char)))
+         (cond ((equal cur-char Escape-Character)
+                (if (not (advance-char)) (go bye))
+                (suffix (current-char) buf)
+                (if (not (advance-char)) (go bye))
+                (go id))
+               ((or (alpha-char-p cur-char)
+                    (char= cur-char #\-)
+                    (digitp cur-char)
+                    (char= cur-char #\_))
+                (suffix (current-char) buf)
+                (if (not (advance-char)) (go bye))
+                (go id))))
+  bye (return (token-install (intern buf) 'identifier token))))
+ 
+(defun get-string-token (token)
+  "With 'ABC' on IN-STREAM, extracts and stacks String 'ABC'."
+  (let ((buf (make-adjustable-string 0)))
+    (if (char= (current-char) #\')
+        (progn (advance-char)
+               (loop (case (current-char)
+                       (#\' (advance-char)
+                        (return (token-install buf 'string token)))
+                       (#\\ (advance-char)
+                        (suffix (current-char) buf)
+                        (advance-char))
+                       (#\Return
+                        (moan "String should fit on one line!")
+                        (advance-char)
+                        (meta-syntax-error)
+                        (return nil))
+                       (t (suffix (current-char) buf)
+                          (advance-char))))))))
+ 
+(defun get-bstring-token (token)
+  "With ABC]* on in-stream, extracts and stacks string ABC."
+  (let ((buf (make-adjustable-string 0)))
+    (if (char= (current-char) #\[)
+        (progn (advance-char)
+               (loop (case (current-char)
+                       (#\] (if (char= (next-char) #\*)
+                                (progn (advance-char)
+                                       (advance-char)
+                                       (return (token-install buf 'bstring token)))
+                                (progn (suffix (current-char) buf)
+                                       (advance-char))))
+                       (#\\ (advance-char)
+                        (suffix (current-char) buf)
+                        (advance-char))
+                       (#\Return
+                        (moan "String should fit on one line!")
+                        (advance-char)
+                        (meta-syntax-error)
+                        (return nil))
+                       (t (suffix (current-char) buf)
+                          (advance-char))))))))
+ 
+(defun get-special-token (token)
+  "Take a special character off the input stream.  We let the type name of each
+special character be the atom whose print name is the character itself."
+  (let ((symbol (current-char)))
+    (advance-char)
+    (token-install symbol 'special-char token)))
+ 
+(defun get-number-token (token)
+  "Take a number off the input stream."
+  (prog ((buf (make-adjustable-string 0)))
+    nu1 (suffix (current-char) buf)                     ; Integer part
+        (let ((next-chr (next-char)))
+          (cond ((digitp next-chr)
+                 (advance-char)
+                 (go nu1))))
+        (advance-char) 
+ formint(return (token-install
+		 (read-from-string buf)
+                  'number token
+		  (size buf) ;used to keep track of digit count
+		  ))))
+ 
+; *** 4. META Auxiliary Parsing Actions
+ 
+(defun make-defun (nametok vars body)
+  (let ((name (INTERN (STRCONC |META_PREFIX| nametok))))
+    (if vars
+        `(DEFUN ,name ,vars (declare (special . ,vars)) ,body)
+        `(DEFUN ,name ,vars ,body))))
+ 
+(defun print-fluids (fluids)
+  (terpri out-stream)
+  (mapcar #'(lambda (x) (format out-stream "~&(DEFPARAMETER ~S NIL)~%" x)) fluids)
+  (terpri out-stream))
+ 
+(defun print-package (package)
+  (format out-stream "~&~%(IN-PACKAGE ~S )~%~%" package))
+ 
+(defparameter Meta_Prefix nil)
+ 
+(defun set-prefix (prefix)  (setq META_PREFIX prefix))
+ 
+(defun print-rule (x)  (print x out-stream) (format out-stream "~%~%"))
+ 
+; *** 5. META Error Handling
+ 
+(defun meta-meta-error-handler (&optional (wanted nil) (parsing nil))
+  "Print syntax error indication, underline character, scrub line."
+  (format out-stream "~&% MetaLanguage syntax error: ")
+  (if (Line-Past-End-P Current-Line)
+      (cond ((and wanted parsing)
+             (format out-stream "wanted ~A while parsing ~A.~%"
+                     wanted parsing))
+            (wanted (format out-stream "wanted ~A.~%" wanted))
+            (parsing (format out-stream "while parsing ~A.~%" parsing)))
+      (progn (format out-stream "~:[here~;wanted ~A here~]" wanted wanted)
+             (format out-stream "~:[~; while parsing ~A~]:~%" parsing parsing)
+             (current-line-print)
+             (current-line-clear)
+             (current-token)
+             (incf $num_of_meta_errors)
+             (setq Meta_Errors_Occurred t)))
+   nil)
+
+@
+preparse
+<<*>>=
+; Global storage
+ 
+(defparameter $INDEX 0                          "File line number of most recently read line.")
+(defparameter $preparse-last-line ()            "Most recently read line.")
+(defparameter $preparseReportIfTrue NIL         "Should we print listings?")
+(defparameter $LineList nil                     "Stack of preparsed lines.")
+(defparameter $EchoLineStack nil                "Stack of lines to list.")
+(defparameter $IOIndex 0                        "Number of latest terminal input line.")
+ 
+(defun Initialize-Preparse (strm)
+  (setq $INDEX 0 $LineList nil $EchoLineStack nil)
+  (setq $preparse-last-line (get-a-line strm)))
+ 
+(defmacro pptest () `(/rp ">scratchpad>test.boot"))
+ 
+(defun /RP (&optional (*boot-input-file* nil) (*boot-output-file* nil)
+                      ($preparseReportIfTrue t))
+  (with-open-stream
+    (in-stream (or (and *boot-input-file* (open *boot-input-file* :direction :input))
+                   *terminal-io*))
+    (declare (special in-stream))
+    (with-open-stream
+      (out-stream (if *boot-output-file*
+                      (open *boot-output-file* :direction :output)
+                      *terminal-io*))
+      (declare (special out-stream))
+      (initialize-preparse in-stream)
+      (do ((lines (PREPARSE in-stream) (PREPARSE in-stream))) ((null lines)))))
+  T)
+ 
+(defun PREPARSE (Strm &aux (stack ()))
+  (SETQ $COMBLOCKLIST NIL $skipme NIL)
+  (when $preparse-last-line
+	(if (pairp $preparse-last-line)
+	    (setq stack $preparse-last-line)
+	  (push $preparse-last-line stack))
+        (setq $INDEX (- $INDEX (length stack))))
+  (let ((U (PREPARSE1 stack)))
+    (if $skipme (preparse strm)
+      (progn
+	(if $preparseReportIfTrue (PARSEPRINT U))
+	(setq |$headerDocumentation| NIL)
+	(SETQ |$docList| NIL)
+	(SETQ |$maxSignatureLineNumber| 0)
+	(SETQ |$constructorLineNumber| (IFCAR (IFCAR U)))
+	U))))
+ 
+(defun PREPARSE1 (LineList)
+ (PROG (($LINELIST LineList) $EchoLineStack NUM A I L PSLOC
+        INSTRING PCOUNT COMSYM STRSYM OPARSYM CPARSYM N NCOMSYM
+        (SLOC -1) (CONTINUE NIL)  (PARENLEV 0) (NCOMBLOCK ())
+        (LINES ()) (LOCS ()) (NUMS ()) functor  )
+ READLOOP (DCQ (NUM . A) (preparseReadLine LineList))
+         (cond ((atEndOfUnit A)
+                (PREPARSE-ECHO LineList)
+                (COND ((NULL LINES) (RETURN NIL))
+                      (NCOMBLOCK
+                       (FINCOMBLOCK NIL NUMS LOCS NCOMBLOCK NIL)))
+                (RETURN (PAIR (NREVERSE NUMS)
+                              (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES))))))
+         (cond ((and (NULL LINES) (> (LENGTH A) 0) (EQ (CHAR A 0) #\) ))
+                ; this is a command line, don't parse it
+                (PREPARSE-ECHO LineList)
+                (setq $preparse-last-line nil) ;don't reread this line
+                (SETQ LINE a)
+		(CATCH 'SPAD_READER (|doSystemCommand| (subseq LINE 1)))
+		(GO READLOOP)))
+         (setq L (LENGTH A))
+         (if (EQ L 0) (GO READLOOP))
+         (setq PSLOC SLOC)
+         (setq I 0 INSTRING () PCOUNT 0)
+ STRLOOP (setq STRSYM (OR (position #\" A :start I ) L))
+         (setq COMSYM (OR (search "--" A :start2 I ) L))
+         (setq NCOMSYM (OR (search "++" A :start2 I ) L))
+         (setq OPARSYM (OR (position #\( A :start I ) L))
+         (setq CPARSYM (OR (position #\) A :start I ) L))
+         (setq N (MIN STRSYM COMSYM NCOMSYM OPARSYM CPARSYM))
+         (cond ((= N L) (GO NOCOMS))
+               ((ESCAPED A N))
+               ((= N STRSYM) (setq INSTRING (NOT INSTRING)))
+               (INSTRING)
+               ((= N COMSYM) (setq A (subseq A 0 N)) (GO NOCOMS)) ; discard trailing comment
+               ((= N NCOMSYM)
+                (setq SLOC (INDENT-POS A))
+                (COND
+                  ((= SLOC N)
+                   (COND ((AND NCOMBLOCK (NOT (= N (CAR NCOMBLOCK))))
+                          (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist)
+                          (SETQ NCOMBLOCK NIL)))
+                   (SETQ NCOMBLOCK (CONS N (CONS A (IFCDR NCOMBLOCK))))
+                   (SETQ A ""))
+                  ('T (PUSH (STRCONC (GETFULLSTR N " ")
+                                  (SUBSTRING A N ())) $LINELIST)
+                      (SETQ $INDEX (SUB1 $INDEX))
+                      (SETQ A (SUBSEQ A 0 N))))
+         (GO NOCOMS))
+               ((= N OPARSYM) (setq PCOUNT (1+ PCOUNT)))
+               ((= N CPARSYM) (setq PCOUNT (1- PCOUNT))))
+         (setq I (1+ N))
+         (GO STRLOOP)
+ NOCOMS  (setq SLOC (INDENT-POS A))
+         (setq A (DROPTRAILINGBLANKS A))
+         (cond ((NULL SLOC) (setq SLOC PSLOC) (GO READLOOP)))
+         (cond ((EQ (ELT A (MAXINDEX A)) XCAPE)
+                (setq CONTINUE T a (subseq A (MAXINDEX A))))
+               ((setq CONTINUE NIL)))
+         (if (and (null LINES) (= SLOC 0)) ;;test for skipping constructors
+             (if (and |$byConstructors|
+                      (null (search "==>" a))
+                      (not (member (setq functor (intern
+                                    (substring a 0 (STRPOSL ": (=" A 0 NIL))))
+                                   |$byConstructors|)))
+                 (setq $skipme 't)
+               (progn (push functor |$constructorsSeen|) (setq $skipme nil))))
+         (when (and LINES (EQL SLOC 0))
+             (IF (AND NCOMBLOCK (NOT (ZEROP (CAR NCOMBLOCK))))
+               (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist))
+	     (IF (NOT (IS-CONSOLE in-stream))
+		 (setq $preparse-last-line
+		       (nreverse $echolinestack)))
+             (RETURN (PAIR (NREVERSE NUMS)
+                        (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES)))))
+         (cond ((> PARENLEV 0) (PUSH NIL LOCS) (setq SLOC PSLOC) (GO REREAD)))
+         (COND (NCOMBLOCK
+                (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist)
+                (setq NCOMBLOCK ())))
+         (PUSH SLOC LOCS)
+ REREAD  (PREPARSE-ECHO LineList)
+         (PUSH A LINES)
+         (PUSH NUM NUMS)
+         (setq PARENLEV (+ PARENLEV PCOUNT))
+         (when (and (is-console in-stream) (not continue))
+            (setq $preparse-last-line nil)
+             (RETURN (PAIR (NREVERSE NUMS)
+                           (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES)))))
+ 
+         (GO READLOOP)))
+ 
+;; NUM is the line number of the current line
+;; OLDNUMS is the list of line numbers of previous lines
+;; OLDLOCS is the list of previous indentation locations
+;; NCBLOCK is the current comment block
+(DEFUN FINCOMBLOCK (NUM OLDNUMS OLDLOCS NCBLOCK linelist)
+  (PUSH
+    (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (REVERSE (CDR NCBLOCK))))
+	      ;; comment for constructor itself paired with 1st line -1
+          ('T
+           (COND ($EchoLineStack
+                  (setq NUM (POP $EchoLineStack))
+                  (PREPARSE-ECHO linelist)
+                  (SETQ $EchoLineStack (LIST NUM))))
+	   (cons
+            ;; scan backwards for line to left of current
+	    (DO ((onums oldnums (cdr onums))
+		 (olocs oldlocs (cdr olocs))
+		 (sloc (car ncblock)))
+		((null onums) nil)
+		(if (and (numberp (car olocs))
+			 (<= (car olocs) sloc))
+		    (return (car onums))))
+	    (REVERSE (CDR NCBLOCK)))))
+    $COMBLOCKLIST))
+ 
+(defun PARSEPRINT (L)
+  (if L
+      (progn (format t "~&~%       ***       PREPARSE      ***~%~%")
+             (dolist (X L) (format t "~5d. ~a~%" (car x) (cdr x)))
+             (format t "~%"))))
+ 
+(DEFUN STOREBLANKS (LINE N)
+   (DO ((I 0 (ADD1 I))) ((= I N) LINE) (SETF (CHAR LINE I) #\ )))
+ 
+(DEFUN INITIAL-SUBSTRING (PATTERN LINE)
+   (let ((ind (mismatch PATTERN LINE)))
+     (OR (NULL IND) (EQL IND (SIZE PATTERN)))))
+ 
+(DEFUN SKIP-IFBLOCK (X)
+   (PROG (LINE IND)
+     (DCQ (IND . LINE) (preparseReadLine1 X))
+      (IF (NOT (STRINGP LINE))  (RETURN (CONS IND LINE)))
+      (IF (ZEROP (SIZE LINE)) (RETURN (SKIP-IFBLOCK X)))
+      (COND ((CHAR= (ELT LINE 0) #\) )
+          (COND
+            ((INITIAL-SUBSTRING ")if" LINE)
+                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 3)))
+                       (RETURN (preparseReadLine X)))
+                      ('T (RETURN (SKIP-IFBLOCK X)))))
+            ((INITIAL-SUBSTRING ")elseif" LINE)
+                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 7)))
+                       (RETURN (preparseReadLine X)))
+                      ('T (RETURN (SKIP-IFBLOCK X)))))
+            ((INITIAL-SUBSTRING ")else" LINE)
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING ")endif" LINE)
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING ")fin" LINE)
+	     (RETURN (CONS IND NIL))))))
+      (RETURN (SKIP-IFBLOCK X)) ) )
+ 
+(DEFUN SKIP-TO-ENDIF (X)
+   (PROG (LINE IND)
+     (DCQ (IND . LINE) (preparseReadLine1 X))
+      (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE)))
+            ((INITIAL-SUBSTRING LINE ")endif")
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING LINE ")fin") (RETURN (CONS IND NIL)))
+            ('T (RETURN (SKIP-TO-ENDIF X))))))
+ 
+(DEFUN preparseReadLine (X)
+    (PROG (LINE IND)
+      (DCQ (IND . LINE) (preparseReadLine1 X))
+      (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE))))
+      (COND ((ZEROP (SIZE LINE))
+             (RETURN (CONS IND LINE))))
+      (COND ((CHAR= (ELT LINE 0) #\) )
+          (COND
+            ((INITIAL-SUBSTRING ")if" LINE)
+                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 3)))
+                       (RETURN (preparseReadLine X)))
+                      ('T (RETURN (SKIP-IFBLOCK X)))))
+            ((INITIAL-SUBSTRING ")elseif" LINE)
+             (RETURN (SKIP-TO-ENDIF X)))
+            ((INITIAL-SUBSTRING ")else" LINE)
+             (RETURN (SKIP-TO-ENDIF X)))
+            ((INITIAL-SUBSTRING ")endif" LINE)
+             (RETURN (preparseReadLine X)))
+            ((INITIAL-SUBSTRING ")fin" LINE)
+	     (SETQ *EOF* T)
+	     (RETURN (CONS IND NIL)) ) )))
+      (RETURN (CONS IND LINE)) ))
+ 
+(DEFUN preparseReadLine1 (X)
+    (PROG (LINE IND)
+      (SETQ LINE (if $LINELIST
+                     (pop $LINELIST)
+              (expand-tabs (get-a-line in-stream))))
+      (setq $preparse-last-line LINE)
+      (and (stringp line) (incf $INDEX))
+      (COND
+        ( (NOT (STRINGP LINE))
+          (RETURN (CONS $INDEX LINE)) ) )
+      (SETQ LINE (DROPTRAILINGBLANKS LINE))
+      (PUSH (COPY-SEQ LINE) $EchoLineStack)
+    ;; next line must evaluate $INDEX before recursive call
+      (RETURN
+        (CONS
+          $INDEX
+          (COND
+            ( (AND (> (SETQ IND (MAXINDEX LINE)) -1) (char= (ELT LINE IND) #\_))
+              (setq $preparse-last-line
+                    (STRCONC (SUBSTRING LINE 0 IND) (CDR (preparseReadLine1 X))) ))
+            ( 'T
+              LINE ) ))) ) )
+ 
+;;(defun preparseReadLine (X)
+;;  (declare (special $LINELIST $echoLineStack))
+;;  (PROG (LINE IND)
+;;        (setq LINE
+;;              (if $LINELIST
+;;                  (pop $LINELIST)
+;;                  (get-a-line in-stream)))
+;;        (setq $preparse-last-line LINE)
+;;        (and (stringp line) (incf $INDEX))
+;;        (if (NOT (STRINGP LINE)) (RETURN (CONS $INDEX LINE)))
+;;        (setq LINE (DROPTRAILINGBLANKS LINE))
+;;        (if Echo-Meta (PUSH (COPY-SEQ LINE) $EchoLineStack))
+;;        ; next line must evaluate $INDEX before recursive call
+;;        (RETURN
+;;          (CONS $INDEX
+;;                (if (and (> (setq IND (MAXINDEX LINE)) -1)
+;;                       (EQ (ELT LINE IND) #\_))
+;;                    (setq $preparse-last-line
+;;                        (STRCONC (SUBSEQ LINE 0 IND)
+;;                                 (CDR (preparseReadLine X))))
+;;                    LINE)))))
+ 
+(defun PREPARSE-ECHO (linelist)
+  (if Echo-Meta (REPEAT (IN X (REVERSE $EchoLineStack))
+                        (format out-stream "~&;~A~%" X)))
+  (setq $EchoLineStack ()))
+ 
+(defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) XCAPE)))
+ 
+(defun atEndOfUnit (X) (NULL (STRINGP X)) )
+ 
+(defun PARSEPILES (LOCS LINES)
+  "Add parens and semis to lines to aid parsing."
+  (mapl #'add-parens-and-semis-to-line (NCONC LINES '(" ")) (nconc locs '(nil)))
+  LINES)
+ 
+(defun add-parens-and-semis-to-line (slines slocs)
+ 
+  "The line to be worked on is (CAR SLINES).  It's indentation is (CAR SLOCS).  There
+is a notion of current indentation. Then:
+ 
+A. Add open paren to beginning of following line if following line's indentation
+   is greater than current, and add close paren to end of last succeeding line
+   with following line's indentation.
+B. Add semicolon to end of line if following line's indentation is the same.
+C. If the entire line consists of the single keyword then or else, leave it alone."
+ 
+  (let ((start-column (car slocs)))
+    (if (and start-column (> start-column 0))
+        (let ((count 0) (i 0))
+          (seq
+           (mapl #'(lambda (next-lines nlocs)
+                     (let ((next-line (car next-lines)) (next-column (car nlocs)))
+                       (incf i)
+                       (if next-column
+                           (progn (setq next-column (abs next-column))
+                                  (if (< next-column start-column) (exit nil))
+                                  (cond ((and (eq next-column start-column)
+                                              (rplaca nlocs (- (car nlocs)))
+                                              (not (infixtok next-line)))
+                                         (setq next-lines (drop (1- i) slines))
+                                         (rplaca next-lines (addclose (car next-lines) #\;))
+                                         (setq count (1+ count))))))))
+                 (cdr slines) (cdr slocs)))
+          (if (> count 0)
+              (progn (setf (char (car slines) (1- (nonblankloc (car slines))))
+                           #\( )
+                     (setq slines (drop (1- i) slines))
+                     (rplaca slines (addclose (car slines) #\) ))))))))
+ 
+(defun INFIXTOK (S) (MEMBER (STRING2ID-N S 1) '(|then| |else|) :test #'eq))
+ 
+ 
+(defun ADDCLOSE (LINE CHAR)
+  (cond ((char= (FETCHCHAR LINE (MAXINDEX LINE)) #\; )
+         (SETELT LINE (MAXINDEX LINE) CHAR)
+         (if (char= CHAR #\;) LINE (suffix #\; LINE)))
+        ((suffix char LINE))))
+@
+parse
+<<*>>=
+;--% Transformation of Parser Output
+;
+;parseTransform x ==
+;  $defOp: local:= nil
+;  x := substitute('$,'%,x) -- for new compiler compatibility
+;  parseTran x
+
+;;;     ***       |parseTransform| REDEFINED
+
+(DEFUN |parseTransform| (|x|) (PROG (|$defOp|) (DECLARE (SPECIAL |$defOp|)) (RETURN (PROGN (SPADLET |$defOp| NIL) (SPADLET |x| (MSUBST (QUOTE $) (QUOTE %) |x|)) (|parseTran| |x|))))) 
+;parseTran x ==
+;  $op: local := nil
+;  atom x => parseAtom x
+;  [$op,:argl]:= x
+;  u := g($op) where g op == (op is ['elt,op,x] => g x; op)
+;  u='construct =>
+;    r:= parseConstruct argl
+;    $op is ['elt,:.] => [parseTran $op,:rest r]
+;    r
+;  atom u and (fn:= GET(u,'parseTran)) => FUNCALL(fn,argl)
+;  [parseTran $op,:parseTranList argl]
+
+;;;     ***       |parseTran,g| REDEFINED
+
+(DEFUN |parseTran,g| (|op|) (PROG (|ISTMP#1| |ISTMP#2| |x|) (RETURN (SEQ (IF (AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#1| (QCDR |op|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |x| (QCAR |ISTMP#2|)) (QUOTE T))))))) (EXIT (|parseTran,g| |x|))) (EXIT |op|))))) 
+
+;;;     ***       |parseTran| REDEFINED
+
+(DEFUN |parseTran| (|x|) (PROG (|$op| |argl| |u| |r| |fn|) (DECLARE (SPECIAL |$op|)) (RETURN (PROGN (SPADLET |$op| NIL) (COND ((ATOM |x|) (|parseAtom| |x|)) ((QUOTE T) (SPADLET |$op| (CAR |x|)) (SPADLET |argl| (CDR |x|)) (SPADLET |u| (|parseTran,g| |$op|)) (COND ((BOOT-EQUAL |u| (QUOTE |construct|)) (SPADLET |r| (|parseConstruct| |argl|)) (COND ((AND (PAIRP |$op|) (EQ (QCAR |$op|) (QUOTE |elt|))) (CONS (|parseTran| |$op|) (CDR |r|))) ((QUOTE T) |r|))) ((AND (ATOM |u|) (SPADLET |fn| (GETL |u| (QUOTE |parseTran|)))) (FUNCALL |fn| |argl|)) ((QUOTE T) (CONS (|parseTran| |$op|) (|parseTranList| |argl|)))))))))) 
+;
+;parseAtom x ==
+; -- next line for compatibility with new compiler
+;  x = 'break => parseLeave ['$NoValue]
+;  x
+
+;;;     ***       |parseAtom| REDEFINED
+
+(DEFUN |parseAtom| (|x|) (COND ((BOOT-EQUAL |x| (QUOTE |break|)) (|parseLeave| (CONS (QUOTE |$NoValue|) NIL))) ((QUOTE T) |x|))) 
+;
+;parseTranList l ==
+;  atom l => parseTran l
+;  [parseTran first l,:parseTranList rest l]
+
+;;;     ***       |parseTranList| REDEFINED
+
+(DEFUN |parseTranList| (|l|) (COND ((ATOM |l|) (|parseTran| |l|)) ((QUOTE T) (CONS (|parseTran| (CAR |l|)) (|parseTranList| (CDR |l|)))))) 
+;
+;parseConstruct u ==
+;  $insideConstructIfTrue: local:= true
+;  l:= parseTranList u
+;  ["construct",:l]
+
+;;;     ***       |parseConstruct| REDEFINED
+
+(DEFUN |parseConstruct| (|u|) (PROG (|$insideConstructIfTrue| |l|) (DECLARE (SPECIAL |$insideConstructIfTrue|)) (RETURN (PROGN (SPADLET |$insideConstructIfTrue| (QUOTE T)) (SPADLET |l| (|parseTranList| |u|)) (CONS (QUOTE |construct|) |l|))))) 
+;
+;parseUpArrow u ==  parseTran ["**",:u]
+
+;;;     ***       |parseUpArrow| REDEFINED
+
+(DEFUN |parseUpArrow| (|u|) (|parseTran| (CONS (QUOTE **) |u|))) 
+;
+;parseLeftArrow u == parseTran ["LET",:u]
+
+;;;     ***       |parseLeftArrow| REDEFINED
+
+(DEFUN |parseLeftArrow| (|u|) (|parseTran| (CONS (QUOTE LET) |u|))) 
+;
+;parseIs [a,b] == ['is,parseTran a,transIs parseTran b]
+
+;;;     ***       |parseIs| REDEFINED
+
+(DEFUN |parseIs| (#0=#:G166160) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (CONS (QUOTE |is|) (CONS (|parseTran| |a|) (CONS (|transIs| (|parseTran| |b|)) NIL))))))) 
+;
+;parseIsnt [a,b] == ['isnt,parseTran a,transIs parseTran b]
+
+;;;     ***       |parseIsnt| REDEFINED
+
+(DEFUN |parseIsnt| (#0=#:G166174) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (CONS (QUOTE |isnt|) (CONS (|parseTran| |a|) (CONS (|transIs| (|parseTran| |b|)) NIL))))))) 
+;
+;transIs u ==
+;  isListConstructor u => ['construct,:transIs1 u]
+;  u
+
+;;;     ***       |transIs| REDEFINED
+
+(DEFUN |transIs| (|u|) (COND ((|isListConstructor| |u|) (CONS (QUOTE |construct|) (|transIs1| |u|))) ((QUOTE T) |u|))) 
+;
+;isListConstructor u == u is [op,:.] and op in '(construct append cons)
+
+;;;     ***       |isListConstructor| REDEFINED
+
+(DEFUN |isListConstructor| (|u|) (PROG (|op|) (RETURN (AND (PAIRP |u|) (PROGN (SPADLET |op| (QCAR |u|)) (QUOTE T)) (|member| |op| (QUOTE (|construct| |append| |cons|))))))) 
+;
+;transIs1 u ==
+;  u is ['construct,:l] => [transIs x for x in l]
+;  u is ['append,x,y] =>
+;    h:= [":",transIs x]
+;    (v:= transIs1 y) is [":",z] => [h,z]
+;    v="nil" => first rest h
+;    atom v => [h,[":",v]]
+;    [h,:v]
+;  u is ['cons,x,y] =>
+;    h:= transIs x
+;    (v:= transIs1 y) is [":",z] => [h,z]
+;    v="nil" => [h]
+;    atom v => [h,[":",v]]
+;    [h,:v]
+;  u
+
+;;;     ***       |transIs1| REDEFINED
+
+(DEFUN |transIs1| (|u|) (PROG (|l| |x| |y| |h| |v| |ISTMP#1| |ISTMP#2| |z|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |l| (QCDR |u|)) (QUOTE T))) (PROG (#0=#:G166255) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166260 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|transIs| |x|) #0#)))))))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |append|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |h| (CONS (QUOTE |:|) (CONS (|transIs| |x|) NIL))) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |v| (|transIs1| |y|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |z| (QCAR |ISTMP#2|)) (QUOTE T)))))) (CONS |h| (CONS |z| NIL))) ((BOOT-EQUAL |v| (QUOTE |nil|)) (CAR (CDR |h|))) ((ATOM |v|) (CONS |h| (CONS (CONS (QUOTE |:|) (CONS |v| NIL)) NIL))) ((QUOTE T) (CONS |h| |v|)))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |cons|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |h| (|transIs| |x|)) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |v| (|transIs1| |y|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |z| (QCAR |ISTMP#2|)) (QUOTE T)))))) (CONS |h| (CONS |z| NIL))) ((BOOT-EQUAL |v| (QUOTE |nil|)) (CONS |h| NIL)) ((ATOM |v|) (CONS |h| (CONS (CONS (QUOTE |:|) (CONS |v| NIL)) NIL))) ((QUOTE T) (CONS |h| |v|)))) ((QUOTE T) |u|)))))) 
+;
+;parseLET [x,y] ==
+;  p := ['LET,parseTran x,parseTranCheckForRecord(y,opOf x)]
+;  opOf x = 'cons => ['LET,transIs p.1,p.2]
+;  p
+
+;;;     ***       |parseLET| REDEFINED
+
+(DEFUN |parseLET| (#0=#:G166290) (PROG (|x| |y| |p|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (SPADLET |p| (CONS (QUOTE LET) (CONS (|parseTran| |x|) (CONS (|parseTranCheckForRecord| |y| (|opOf| |x|)) NIL)))) (COND ((BOOT-EQUAL (|opOf| |x|) (QUOTE |cons|)) (CONS (QUOTE LET) (CONS (|transIs| (ELT |p| 1)) (CONS (ELT |p| 2) NIL)))) ((QUOTE T) |p|)))))) 
+;
+;parseLETD [x,y] == ['LETD,parseTran x,parseTran parseType y]
+
+;;;     ***       |parseLETD| REDEFINED
+
+(DEFUN |parseLETD| (#0=#:G166305) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (QUOTE LETD) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |y|)) NIL))))))) 
+;
+;parseColon u ==
+;  u is [x] => [":",parseTran x]
+;  u is [x,typ] =>
+;    $InteractiveMode =>
+;      $insideConstructIfTrue=true => ['TAG,parseTran x,parseTran typ]
+;      [":",parseTran x,parseTran parseType typ]
+;    [":",parseTran x,parseTran typ]
+
+;;;     ***       |parseColon| REDEFINED
+
+(DEFUN |parseColon| (|u|) (PROG (|x| |ISTMP#1| |typ|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (PROGN (SPADLET |x| (QCAR |u|)) (QUOTE T))) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) NIL))) ((AND (PAIRP |u|) (PROGN (SPADLET |x| (QCAR |u|)) (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |typ| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND (|$InteractiveMode| (COND ((BOOT-EQUAL |$insideConstructIfTrue| (QUOTE T)) (CONS (QUOTE TAG) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL)))) ((QUOTE T) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))))) ((QUOTE T) (CONS (QUOTE |:|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL)))))))))) 
+;
+;parseBigelt [typ,consForm] ==
+;  [['elt,typ,'makeRecord],:transUnCons consForm]
+
+;;;     ***       |parseBigelt| REDEFINED
+
+(DEFUN |parseBigelt| (#0=#:G166338) (PROG (|typ| |consForm|) (RETURN (PROGN (SPADLET |typ| (CAR #0#)) (SPADLET |consForm| (CADR #0#)) (CONS (CONS (QUOTE |elt|) (CONS |typ| (CONS (QUOTE |makeRecord|) NIL))) (|transUnCons| |consForm|)))))) 
+;
+;transUnCons u ==
+;  atom u => systemErrorHere '"transUnCons"
+;  u is ["APPEND",x,y] =>
+;    null y => x
+;    systemErrorHere '"transUnCons"
+;  u is ["CONS",x,y] =>
+;    atom y => [x,:y]
+;    [x,:transUnCons y]
+
+;;;     ***       |transUnCons| REDEFINED
+
+(DEFUN |transUnCons| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((ATOM |u|) (|systemErrorHere| (MAKESTRING "transUnCons"))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE APPEND)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((NULL |y|) |x|) ((QUOTE T) (|systemErrorHere| (MAKESTRING "transUnCons"))))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE CONS)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((ATOM |y|) (CONS |x| |y|)) ((QUOTE T) (CONS |x| (|transUnCons| |y|))))))))) 
+;
+;parseCoerce [x,typ] ==
+;  $InteractiveMode => ["::",parseTran x,parseTran parseType typ]
+;  ["::",parseTran x,parseTran typ]
+
+;;;     ***       |parseCoerce| REDEFINED
+
+(DEFUN |parseCoerce| (#0=#:G166399) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE |::|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE |::|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) 
+;
+;parseAtSign [x,typ] ==
+;  $InteractiveMode => ["@",parseTran x,parseTran parseType typ]
+;  ["@",parseTran x,parseTran typ]
+
+;;;     ***       |parseAtSign| REDEFINED
+
+(DEFUN |parseAtSign| (#0=#:G166414) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE @) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE @) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) 
+;
+;parsePretend [x,typ] ==
+;  $InteractiveMode => ['pretend,parseTran x,parseTran parseType typ]
+;  ['pretend,parseTran x,parseTran typ]
+
+;;;     ***       |parsePretend| REDEFINED
+
+(DEFUN |parsePretend| (#0=#:G166429) (PROG (|x| |typ|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |typ| (CADR #0#)) (COND (|$InteractiveMode| (CONS (QUOTE |pretend|) (CONS (|parseTran| |x|) (CONS (|parseTran| (|parseType| |typ|)) NIL)))) ((QUOTE T) (CONS (QUOTE |pretend|) (CONS (|parseTran| |x|) (CONS (|parseTran| |typ|) NIL))))))))) 
+;
+;parseType x ==
+;  x := substitute($EmptyMode,$quadSymbol,x)
+;  x is ['typeOf,val] => ['typeOf,parseTran val]
+;  $oldParserExpandAbbrs => parseTypeEvaluate unabbrevAndLoad x
+;  x
+
+;;;     ***       |parseType| REDEFINED
+
+(DEFUN |parseType| (|x|) (PROG (|ISTMP#1| |val|) (RETURN (PROGN (SPADLET |x| (MSUBST |$EmptyMode| |$quadSymbol| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |typeOf|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE |typeOf|) (CONS (|parseTran| |val|) NIL))) (|$oldParserExpandAbbrs| (|parseTypeEvaluate| (|unabbrevAndLoad| |x|))) ((QUOTE T) |x|)))))) 
+;
+;parseTypeEvaluate form ==
+;  form is [op,:argl] =>
+;    newType? op => form
+;    $op: local:= op
+;    op = 'Mapping =>
+;      [op,:[parseTypeEvaluate a for a in argl]]
+;    op = 'Union =>
+;      isTaggedUnion form =>
+;        [op,:[['_:,sel,parseTypeEvaluate type] for
+;          ['_:,sel,type] in argl]]
+;      [op,:[parseTypeEvaluate a for a in argl]]
+;    op = 'Record =>
+;      [op,:[['_:,sel,parseTypeEvaluate type] for ['_:,sel,type] in argl]]
+;    cmm :=
+;      fn := constructor? op =>
+;        p := pathname [fn,$spadLibFT,'"*"] =>
+;          isExistingFile p => getConstructorModemap(abbreviation? fn)
+;          nil
+;      nil
+;    cmm is [[.,.,:argml],:.] => [op,:parseTypeEvaluateArgs(argl,argml)]
+;    throwKeyedMsg("S2IL0015",[op])
+;  form
+
+;;;     ***       |parseTypeEvaluate| REDEFINED
+
+(DEFUN |parseTypeEvaluate| (|form|) (PROG (|$op| |op| |argl| |sel| |type| |fn| |p| |cmm| |ISTMP#1| |ISTMP#2| |argml|) (DECLARE (SPECIAL |$op|)) (RETURN (SEQ (COND ((AND (PAIRP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((|newType?| |op|) |form|) ((QUOTE T) (SPADLET |$op| |op|) (COND ((BOOT-EQUAL |op| (QUOTE |Mapping|)) (CONS |op| (PROG (#0=#:G166484) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166489 |argl| (CDR #1#)) (|a| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |a| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|parseTypeEvaluate| |a|) #0#))))))))) ((BOOT-EQUAL |op| (QUOTE |Union|)) (COND ((|isTaggedUnion| |form|) (CONS |op| (PROG (#2=#:G166500) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166506 |argl| (CDR #3#)) (#4=#:G166457 NIL)) ((OR (ATOM #3#) (PROGN (SETQ #4# (CAR #3#)) NIL) (PROGN (PROGN (SPADLET |sel| (CADR #4#)) (SPADLET |type| (CADDR #4#)) #4#) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (CONS (QUOTE |:|) (CONS |sel| (CONS (|parseTypeEvaluate| |type|) NIL))) #2#))))))))) ((QUOTE T) (CONS |op| (PROG (#5=#:G166517) (SPADLET #5# NIL) (RETURN (DO ((#6=#:G166522 |argl| (CDR #6#)) (|a| NIL)) ((OR (ATOM #6#) (PROGN (SETQ |a| (CAR #6#)) NIL)) (NREVERSE0 #5#)) (SEQ (EXIT (SETQ #5# (CONS (|parseTypeEvaluate| |a|) #5#))))))))))) ((BOOT-EQUAL |op| (QUOTE |Record|)) (CONS |op| (PROG (#7=#:G166533) (SPADLET #7# NIL) (RETURN (DO ((#8=#:G166539 |argl| (CDR #8#)) (#9=#:G166462 NIL)) ((OR (ATOM #8#) (PROGN (SETQ #9# (CAR #8#)) NIL) (PROGN (PROGN (SPADLET |sel| (CADR #9#)) (SPADLET |type| (CADDR #9#)) #9#) NIL)) (NREVERSE0 #7#)) (SEQ (EXIT (SETQ #7# (CONS (CONS (QUOTE |:|) (CONS |sel| (CONS (|parseTypeEvaluate| |type|) NIL))) #7#))))))))) ((QUOTE T) (SPADLET |cmm| (SEQ (COND ((SPADLET |fn| (|constructor?| |op|)) (COND ((SPADLET |p| (|pathname| (CONS |fn| (CONS |$spadLibFT| (CONS (MAKESTRING "*") NIL))))) (EXIT (COND ((|isExistingFile| |p|) (|getConstructorModemap| (|abbreviation?| |fn|))) ((QUOTE T) NIL)))))) ((QUOTE T) NIL)))) (COND ((AND (PAIRP |cmm|) (PROGN (SPADLET |ISTMP#1| (QCAR |cmm|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |argml| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS |op| (|parseTypeEvaluateArgs| |argl| |argml|))) ((QUOTE T) (|throwKeyedMsg| (QUOTE S2IL0015) (CONS |op| NIL))))))))) ((QUOTE T) |form|)))))) 
+;
+;parseTypeEvaluateArgs(argl,argml) ==
+;  [argVal for arg in argl for md in argml for i in 1..] where argVal ==
+;      isCategoryForm(md,$CategoryFrame) => parseTypeEvaluate arg
+;      arg
+
+;;;     ***       |parseTypeEvaluateArgs| REDEFINED
+
+(DEFUN |parseTypeEvaluateArgs| (|argl| |argml|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G166576) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166583 |argl| (CDR #1#)) (|arg| NIL) (#2=#:G166584 |argml| (CDR #2#)) (|md| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #1#) (PROGN (SETQ |arg| (CAR #1#)) NIL) (ATOM #2#) (PROGN (SETQ |md| (CAR #2#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((|isCategoryForm| |md| |$CategoryFrame|) (|parseTypeEvaluate| |arg|)) ((QUOTE T) |arg|)) #0#))))))))))) 
+;
+;
+;parseTypeError(x,md,i) == throwKeyedMsg("S2IP0003",[i,$op,md])
+
+;;;     ***       |parseTypeError| REDEFINED
+
+(DEFUN |parseTypeError| (|x| |md| |i|) (|throwKeyedMsg| (QUOTE S2IP0003) (CONS |i| (CONS |$op| (CONS |md| NIL))))) 
+;
+;specialModeTran form ==
+;  form is [op,:argl] =>
+;    not ATOM op => form --added 10/5/84 by SCM
+;    (s0:= (sop:= PNAME op).0) = "*" =>
+;      n:= #sop
+;      n=1=> form
+;      argKey:= sop.1
+;      numArgs:= #argl - (argKey="1" => 1; 0)
+;      zeroOrOne:= argKey="0" or argKey="1"
+;      isDmp :=
+;        numArgs < 10 =>
+;          n=6 and ('"DMP"=SUBSTRING(sop,3,3)) and zeroOrOne
+;        true =>
+;          n=7 and ('"DMP"=SUBSTRING(sop,4,3)) and zeroOrOne
+;      isDmp =>
+;        if argKey="0" then
+;          extraDomain:= $EmptyMode
+;          vl:= argl
+;         else
+;          [:vl,extraDomain] := argl
+;        ['DistributedMultivariatePolynomial,['construct,:vl],
+;            specialModeTran extraDomain]
+;      n=4 and (s3:= sop.3) = "M" and zeroOrOne =>
+;        specialModeTran
+;          extraDomain:= (argKey="0" => [$EmptyMode]; nil)
+;          (n:= PARSE_-INTEGER PNAME sop.2)=1 =>
+;            ['SquareMatrix,:argl,:extraDomain]
+;          n=2 => ['RectangularMatrix,:argl,:extraDomain]
+;          form
+;      isUpOrMp :=
+;        numArgs < 10 =>
+;          n=4 and (s3:= sop.3) = 'P and zeroOrOne or
+;            n=5 and (s3:= sop.3)='R and sop.4='F and zeroOrOne
+;        true =>
+;          n=5 and (s3:= sop.4) = 'P and zeroOrOne or
+;            n=6 and (s3:= sop.4)='R and sop.5='F and zeroOrOne
+;      isUpOrMp =>
+;        polyForm:=
+;          domainPart:= (argKey="0" => $EmptyMode; last argl)
+;          argPart:= (argKey="0" => argl; drop(-1,argl))
+;          numArgs < 10 and (n:= PARSE_-INTEGER PNAME sop.2)=1
+;            => ['UP,:argPart,domainPart]
+;          ['MP,['construct,:argPart],domainPart]
+;        specialModeTran
+;          s3 = 'R => [$QuotientField,polyForm]
+;          polyForm
+;      [first form,:[specialModeTran x for x in rest form]]
+;    [first form,:[specialModeTran x for x in rest form]]
+;  form
+
+;;;     ***       |specialModeTran| REDEFINED
+
+(DEFUN |specialModeTran| (|form|) (PROG (|op| |argl| |sop| |s0| |argKey| |numArgs| |zeroOrOne| |isDmp| |LETTMP#1| |vl| |extraDomain| |s3| |isUpOrMp| |domainPart| |argPart| |n| |polyForm|) (RETURN (SEQ (COND ((AND (PAIRP |form|) (PROGN (SPADLET |op| (QCAR |form|)) (SPADLET |argl| (QCDR |form|)) (QUOTE T))) (COND ((NULL (ATOM |op|)) |form|) ((BOOT-EQUAL (SPADLET |s0| (ELT (SPADLET |sop| (PNAME |op|)) 0)) (QUOTE *)) (SPADLET |n| (|#| |sop|)) (COND ((EQL |n| 1) |form|) ((QUOTE T) (SPADLET |argKey| (ELT |sop| 1)) (SPADLET |numArgs| (SPADDIFFERENCE (|#| |argl|) (COND ((BOOT-EQUAL |argKey| (QUOTE |1|)) 1) ((QUOTE T) 0)))) (SPADLET |zeroOrOne| (OR (BOOT-EQUAL |argKey| (QUOTE |0|)) (BOOT-EQUAL |argKey| (QUOTE |1|)))) (SPADLET |isDmp| (COND ((> 10 |numArgs|) (AND (EQL |n| 6) (BOOT-EQUAL (MAKESTRING "DMP") (SUBSTRING |sop| 3 3)) |zeroOrOne|)) ((QUOTE T) (AND (EQL |n| 7) (BOOT-EQUAL (MAKESTRING "DMP") (SUBSTRING |sop| 4 3)) |zeroOrOne|)))) (COND (|isDmp| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (SPADLET |extraDomain| |$EmptyMode|) (SPADLET |vl| |argl|)) ((QUOTE T) (SPADLET |LETTMP#1| (REVERSE |argl|)) (SPADLET |extraDomain| (CAR |LETTMP#1|)) (SPADLET |vl| (NREVERSE (CDR |LETTMP#1|))) |argl|)) (CONS (QUOTE |DistributedMultivariatePolynomial|) (CONS (CONS (QUOTE |construct|) |vl|) (CONS (|specialModeTran| |extraDomain|) NIL)))) ((AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE M)) |zeroOrOne|) (|specialModeTran| (PROGN (SPADLET |extraDomain| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) (CONS |$EmptyMode| NIL)) ((QUOTE T) NIL))) (COND ((EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1) (CONS (QUOTE |SquareMatrix|) (APPEND |argl| |extraDomain|))) ((EQL |n| 2) (CONS (QUOTE |RectangularMatrix|) (APPEND |argl| |extraDomain|))) ((QUOTE T) |form|))))) ((QUOTE T) (SPADLET |isUpOrMp| (COND ((> 10 |numArgs|) (OR (AND (EQL |n| 4) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 3)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 4) (QUOTE F)) |zeroOrOne|))) ((QUOTE T) (OR (AND (EQL |n| 5) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE P)) |zeroOrOne|) (AND (EQL |n| 6) (BOOT-EQUAL (SPADLET |s3| (ELT |sop| 4)) (QUOTE R)) (BOOT-EQUAL (ELT |sop| 5) (QUOTE F)) |zeroOrOne|))))) (COND (|isUpOrMp| (SPADLET |polyForm| (PROGN (SPADLET |domainPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |$EmptyMode|) ((QUOTE T) (|last| |argl|)))) (SPADLET |argPart| (COND ((BOOT-EQUAL |argKey| (QUOTE |0|)) |argl|) ((QUOTE T) (DROP (SPADDIFFERENCE 1) |argl|)))) (COND ((AND (> 10 |numArgs|) (EQL (SPADLET |n| (PARSE-INTEGER (PNAME (ELT |sop| 2)))) 1)) (CONS (QUOTE UP) (APPEND |argPart| (CONS |domainPart| NIL)))) ((QUOTE T) (CONS (QUOTE MP) (CONS (CONS (QUOTE |construct|) |argPart|) (CONS |domainPart| NIL))))))) (|specialModeTran| (COND ((BOOT-EQUAL |s3| (QUOTE R)) (CONS |$QuotientField| (CONS |polyForm| NIL))) ((QUOTE T) |polyForm|)))) ((QUOTE T) (CONS (CAR |form|) (PROG (#0=#:G166626) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166631 (CDR |form|) (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|specialModeTran| |x|) #0#))))))))))))))) ((QUOTE T) (CONS (CAR |form|) (PROG (#2=#:G166641) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166646 (CDR |form|) (CDR #3#)) (|x| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (|specialModeTran| |x|) #2#))))))))))) ((QUOTE T) |form|)))))) 
+;
+;parseHas [x,y] ==
+;  if $InteractiveMode then
+;    x:=
+;      get(x,'value,$CategoryFrame) is [D,m,.]
+;        and m in '((Mode) (Domain) (SubDomain (Domain))) => D
+;      parseType x
+;  mkand [['has,x,u] for u in fn y] where
+;    mkand x ==
+;      x is [a] => a
+;      ['and,:x]
+;    fn y ==
+;      if $InteractiveMode then y:= unabbrevAndLoad y
+;      y is [":" ,op,['Mapping,:map]] =>
+;         op:= (STRINGP op => INTERN op; op)
+;         [['SIGNATURE,op,map]]
+;      y is ['Join,:u] => "append"/[fn z for z in u]
+;      y is ['CATEGORY,:u] => "append"/[fn z for z in u]
+;      kk:= GETDATABASE(opOf y,'CONSTRUCTORKIND)
+;      kk = 'domain or kk = 'category => [makeNonAtomic y]
+;      y is ['ATTRIBUTE,:.] => [y]
+;      y is ['SIGNATURE,:.] => [y]
+;      $InteractiveMode => parseHasRhs y
+;      [['ATTRIBUTE,y]]
+
+;;;     ***       |parseHas,fn| REDEFINED
+
+(DEFUN |parseHas,fn| (|y|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |map| |op| |u| |kk|) (RETURN (SEQ (IF |$InteractiveMode| (SPADLET |y| (|unabbrevAndLoad| |y|)) NIL) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |op| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |Mapping|)) (PROGN (SPADLET |map| (QCDR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (SEQ (SPADLET |op| (SEQ (IF (STRINGP |op|) (EXIT (INTERN |op|))) (EXIT |op|))) (EXIT (CONS (CONS (QUOTE SIGNATURE) (CONS |op| (CONS |map| NIL))) NIL))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |Join|)) (PROGN (SPADLET |u| (QCDR |y|)) (QUOTE T))) (EXIT (PROG (#0=#:G166738) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166743 |u| (CDR #1#)) (|z| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |z| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|parseHas,fn| |z|)))))))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE CATEGORY)) (PROGN (SPADLET |u| (QCDR |y|)) (QUOTE T))) (EXIT (PROG (#2=#:G166749) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166754 |u| (CDR #3#)) (|z| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |z| (CAR #3#)) NIL)) #2#) (SEQ (EXIT (SETQ #2# (APPEND #2# (|parseHas,fn| |z|)))))))))) (SPADLET |kk| (GETDATABASE (|opOf| |y|) (QUOTE CONSTRUCTORKIND))) (IF (OR (BOOT-EQUAL |kk| (QUOTE |domain|)) (BOOT-EQUAL |kk| (QUOTE |category|))) (EXIT (CONS (|makeNonAtomic| |y|) NIL))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE ATTRIBUTE))) (EXIT (CONS |y| NIL))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE SIGNATURE))) (EXIT (CONS |y| NIL))) (IF |$InteractiveMode| (EXIT (|parseHasRhs| |y|))) (EXIT (CONS (CONS (QUOTE ATTRIBUTE) (CONS |y| NIL)) NIL)))))) 
+
+;;;     ***       |parseHas,mkand| REDEFINED
+
+(DEFUN |parseHas,mkand| (|x|) (PROG (|a|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCDR |x|) NIL) (PROGN (SPADLET |a| (QCAR |x|)) (QUOTE T))) (EXIT |a|)) (EXIT (CONS (QUOTE |and|) |x|)))))) 
+
+;;;     ***       |parseHas| REDEFINED
+
+(DEFUN |parseHas| (#0=#:G166781) (PROG (|y| |ISTMP#1| D |ISTMP#2| |m| |ISTMP#3| |x|) (RETURN (SEQ (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (COND (|$InteractiveMode| (SPADLET |x| (COND ((AND (PROGN (SPADLET |ISTMP#1| (|get| |x| (QUOTE |value|) |$CategoryFrame|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET D (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |m| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) (|member| |m| (QUOTE ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))) D) ((QUOTE T) (|parseType| |x|)))))) (|parseHas,mkand| (PROG (#1=#:G166802) (SPADLET #1# NIL) (RETURN (DO ((#2=#:G166807 (|parseHas,fn| |y|) (CDR #2#)) (|u| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |u| (CAR #2#)) NIL)) (NREVERSE0 #1#)) (SEQ (EXIT (SETQ #1# (CONS (CONS (QUOTE |has|) (CONS |x| (CONS |u| NIL))) #1#))))))))))))) 
+;
+;parseHasRhs u ==   --$InteractiveMode = true
+;  get(u,'value,$CategoryFrame) is [D,m,.]
+;    and m in '((Mode) (Domain) (SubDomain (Domain))) => m
+;  y := abbreviation? u =>
+;    loadIfNecessary y => [unabbrevAndLoad y]
+;    [['ATTRIBUTE,u]]
+;  [['ATTRIBUTE,u]]
+
+;;;     ***       |parseHasRhs| REDEFINED
+
+(DEFUN |parseHasRhs| (|u|) (PROG (|ISTMP#1| D |ISTMP#2| |m| |ISTMP#3| |y|) (RETURN (COND ((AND (PROGN (SPADLET |ISTMP#1| (|get| |u| (QUOTE |value|) |$CategoryFrame|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET D (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |m| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) (|member| |m| (QUOTE ((|Mode|) (|Domain|) (|SubDomain| (|Domain|)))))) |m|) ((SPADLET |y| (|abbreviation?| |u|)) (COND ((|loadIfNecessary| |y|) (CONS (|unabbrevAndLoad| |y|) NIL)) ((QUOTE T) (CONS (CONS (QUOTE ATTRIBUTE) (CONS |u| NIL)) NIL)))) ((QUOTE T) (CONS (CONS (QUOTE ATTRIBUTE) (CONS |u| NIL)) NIL)))))) 
+;
+;parseDEF [$lhs,tList,specialList,body] ==
+;  setDefOp $lhs
+;  ['DEF,parseLhs $lhs,parseTranList tList,parseTranList specialList,
+;    parseTranCheckForRecord(body,opOf $lhs)]
+
+;;;     ***       |parseDEF| REDEFINED
+
+(DEFUN |parseDEF| (#0=#:G166861) (PROG (|$lhs| |tList| |specialList| |body|) (DECLARE (SPECIAL |$lhs|)) (RETURN (PROGN (SPADLET |$lhs| (CAR #0#)) (SPADLET |tList| (CADR #0#)) (SPADLET |specialList| (CADDR #0#)) (SPADLET |body| (CADDDR #0#)) (|setDefOp| |$lhs|) (CONS (QUOTE DEF) (CONS (|parseLhs| |$lhs|) (CONS (|parseTranList| |tList|) (CONS (|parseTranList| |specialList|) (CONS (|parseTranCheckForRecord| |body| (|opOf| |$lhs|)) NIL))))))))) 
+;
+;parseLhs x ==
+;  atom x => parseTran x
+;  atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]]
+;  parseTran x
+
+;;;     ***       |parseLhs| REDEFINED
+
+(DEFUN |parseLhs| (|x|) (PROG NIL (RETURN (SEQ (COND ((ATOM |x|) (|parseTran| |x|)) ((ATOM (CAR |x|)) (CONS (|parseTran| (CAR |x|)) (PROG (#0=#:G166888) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166893 (CDR |x|) (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|transIs| (|parseTran| |y|)) #0#))))))))) ((QUOTE T) (|parseTran| |x|))))))) 
+;
+;parseMDEF [$lhs,tList,specialList,body] ==
+;  ['MDEF,parseTran $lhs,parseTranList tList,parseTranList specialList,
+;    parseTranCheckForRecord(body,opOf $lhs)]
+
+;;;     ***       |parseMDEF| REDEFINED
+
+(DEFUN |parseMDEF| (#0=#:G166903) (PROG (|$lhs| |tList| |specialList| |body|) (DECLARE (SPECIAL |$lhs|)) (RETURN (PROGN (SPADLET |$lhs| (CAR #0#)) (SPADLET |tList| (CADR #0#)) (SPADLET |specialList| (CADDR #0#)) (SPADLET |body| (CADDDR #0#)) (CONS (QUOTE MDEF) (CONS (|parseTran| |$lhs|) (CONS (|parseTranList| |tList|) (CONS (|parseTranList| |specialList|) (CONS (|parseTranCheckForRecord| |body| (|opOf| |$lhs|)) NIL))))))))) 
+;
+;parseTranCheckForRecord(x,op) ==
+;  (x:= parseTran x) is ['Record,:l] =>
+;    or/[y for y in l | y isnt [":",.,.]] =>
+;      postError ['"   Constructor",:bright x,'"has missing label"]
+;    x
+;  x
+
+;;;     ***       |parseTranCheckForRecord| REDEFINED
+
+(DEFUN |parseTranCheckForRecord| (|x| |op|) (PROG (|l| |ISTMP#1| |ISTMP#2|) (RETURN (SEQ (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |x| (|parseTran| |x|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Record|)) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T)))) (COND ((PROG (#0=#:G166937) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166944 NIL #0#) (#2=#:G166945 |l| (CDR #2#)) (|y| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |y| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (COND ((NULL (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL))))))) (SETQ #0# (OR #0# |y|))))))))) (|postError| (CONS (MAKESTRING "   Constructor") (APPEND (|bright| |x|) (CONS (MAKESTRING "has missing label") NIL))))) ((QUOTE T) |x|))) ((QUOTE T) |x|)))))) 
+;
+;parseCases [expr,ifClause] ==
+;  casefn(expr,ifClause) where
+;    casefn(x,ifExpr) ==
+;      ifExpr='noBranch => ['ifClauseError,x]
+;      ifExpr is ['IF,a,b,c] => ['IF,parseTran a,parseTran b,casefn(x,c)]
+;      postError ['"   CASES format error: cases ",x," of ",ifExpr]
+
+;;;     ***       |parseCases,casefn| REDEFINED
+
+(DEFUN |parseCases,casefn| (|x| |ifExpr|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |ISTMP#3| |c|) (RETURN (SEQ (IF (BOOT-EQUAL |ifExpr| (QUOTE |noBranch|)) (EXIT (CONS (QUOTE |ifClauseError|) (CONS |x| NIL)))) (IF (AND (PAIRP |ifExpr|) (EQ (QCAR |ifExpr|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |ifExpr|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |c| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (CONS (QUOTE IF) (CONS (|parseTran| |a|) (CONS (|parseTran| |b|) (CONS (|parseCases,casefn| |x| |c|) NIL)))))) (EXIT (|postError| (CONS (MAKESTRING "   CASES format error: cases ") (CONS |x| (CONS (QUOTE | of |) (CONS |ifExpr| NIL)))))))))) 
+
+;;;     ***       |parseCases| REDEFINED
+
+(DEFUN |parseCases| (#0=#:G167006) (PROG (|expr| |ifClause|) (RETURN (PROGN (SPADLET |expr| (CAR #0#)) (SPADLET |ifClause| (CADR #0#)) (|parseCases,casefn| |expr| |ifClause|))))) 
+;
+;parseCategory x ==
+;  l:= parseTranList parseDropAssertions x
+;  key:=
+;    CONTAINED("$",l) => "domain"
+;    'package
+;  ['CATEGORY,key,:l]
+
+;;;     ***       |parseCategory| REDEFINED
+
+(DEFUN |parseCategory| (|x|) (PROG (|l| |key|) (RETURN (PROGN (SPADLET |l| (|parseTranList| (|parseDropAssertions| |x|))) (SPADLET |key| (COND ((CONTAINED (QUOTE $) |l|) (QUOTE |domain|)) ((QUOTE T) (QUOTE |package|)))) (CONS (QUOTE CATEGORY) (CONS |key| |l|)))))) 
+;
+;parseDropAssertions x ==
+;--note: the COPY of this list is necessary-- do not replace by RPLACing version
+;  x is [y,:r] =>
+;    y is ['IF,'asserted,:.] => parseDropAssertions r
+;    [y,:parseDropAssertions r]
+;  x
+
+;;;     ***       |parseDropAssertions| REDEFINED
+
+(DEFUN |parseDropAssertions| (|x|) (PROG (|y| |r| |ISTMP#1|) (RETURN (COND ((AND (PAIRP |x|) (PROGN (SPADLET |y| (QCAR |x|)) (SPADLET |r| (QCDR |x|)) (QUOTE T))) (COND ((AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |asserted|))))) (|parseDropAssertions| |r|)) ((QUOTE T) (CONS |y| (|parseDropAssertions| |r|))))) ((QUOTE T) |x|))))) 
+;
+;parseGreaterThan [x,y] ==
+;  [substitute("<",">",$op),parseTran y,parseTran x]
+
+;;;     ***       |parseGreaterThan| REDEFINED
+
+(DEFUN |parseGreaterThan| (#0=#:G167040) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (MSUBST (QUOTE <) (QUOTE >) |$op|) (CONS (|parseTran| |y|) (CONS (|parseTran| |x|) NIL))))))) 
+;
+;parseGreaterEqual u == parseTran ['not,[substitute("<",">=",$op),:u]]
+
+;;;     ***       |parseGreaterEqual| REDEFINED
+
+(DEFUN |parseGreaterEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE <) (QUOTE >=) |$op|) |u|) NIL)))) 
+;
+;parseLessEqual u == parseTran ['not,[substitute(">","<=",$op),:u]]
+
+;;;     ***       |parseLessEqual| REDEFINED
+
+(DEFUN |parseLessEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE >) (QUOTE <=) |$op|) |u|) NIL)))) 
+;
+;parseNotEqual u == parseTran ['not,[substitute("=","^=",$op),:u]]
+
+;;;     ***       |parseNotEqual| REDEFINED
+
+(DEFUN |parseNotEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE =) (QUOTE ^=) |$op|) |u|) NIL)))) 
+;
+;parseDollarGreaterThan [x,y] ==
+;  [substitute("$<","$>",$op),parseTran y,parseTran x]
+
+;;;     ***       |parseDollarGreaterThan| REDEFINED
+
+(DEFUN |parseDollarGreaterThan| (#0=#:G167063) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CAR #0#)) (SPADLET |y| (CADR #0#)) (CONS (MSUBST (QUOTE $<) (QUOTE $>) |$op|) (CONS (|parseTran| |y|) (CONS (|parseTran| |x|) NIL))))))) 
+;
+;parseDollarGreaterEqual u ==
+;  parseTran ['not,[substitute("$<","$>=",$op),:u]]
+
+;;;     ***       |parseDollarGreaterEqual| REDEFINED
+
+(DEFUN |parseDollarGreaterEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $<) (QUOTE $>=) |$op|) |u|) NIL)))) 
+;
+;parseDollarLessEqual u ==
+;  parseTran ['not,[substitute("$>","$<=",$op),:u]]
+
+;;;     ***       |parseDollarLessEqual| REDEFINED
+
+(DEFUN |parseDollarLessEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $>) (QUOTE $<=) |$op|) |u|) NIL)))) 
+;
+;parseDollarNotEqual u ==
+;  parseTran ['not,[substitute("$=","$^=",$op),:u]]
+
+;;;     ***       |parseDollarNotEqual| REDEFINED
+
+(DEFUN |parseDollarNotEqual| (|u|) (|parseTran| (CONS (QUOTE |not|) (CONS (CONS (MSUBST (QUOTE $=) (QUOTE $^=) |$op|) |u|) NIL)))) 
+;
+;parseAnd u ==
+;  $InteractiveMode => ['and,:parseTranList u]
+;  null u => 'true
+;  null rest u => first u
+;  parseIf [parseTran first u,parseAnd rest u,"false"]
+
+;;;     ***       |parseAnd| REDEFINED
+
+(DEFUN |parseAnd| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |and|) (|parseTranList| |u|))) ((NULL |u|) (QUOTE |true|)) ((NULL (CDR |u|)) (CAR |u|)) ((QUOTE T) (|parseIf| (CONS (|parseTran| (CAR |u|)) (CONS (|parseAnd| (CDR |u|)) (CONS (QUOTE |false|) NIL))))))) 
+;
+;parseOr u ==
+;  $InteractiveMode => ['or,:parseTranList u]
+;  null u => 'false
+;  null rest u => first u
+;  (x:= parseTran first u) is ['not,y] => parseIf [y,parseOr rest u,'true]
+;  true => parseIf [x,'true,parseOr rest u]
+
+;;;     ***       |parseOr| REDEFINED
+
+(DEFUN |parseOr| (|u|) (PROG (|x| |ISTMP#1| |ISTMP#2| |y|) (RETURN (COND (|$InteractiveMode| (CONS (QUOTE |or|) (|parseTranList| |u|))) ((NULL |u|) (QUOTE |false|)) ((NULL (CDR |u|)) (CAR |u|)) ((PROGN (SPADLET |ISTMP#1| (SPADLET |x| (|parseTran| (CAR |u|)))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |not|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T)))))) (|parseIf| (CONS |y| (CONS (|parseOr| (CDR |u|)) (CONS (QUOTE |true|) NIL))))) ((QUOTE T) (|parseIf| (CONS |x| (CONS (QUOTE |true|) (CONS (|parseOr| (CDR |u|)) NIL))))))))) 
+;
+;parseNot u ==
+;  $InteractiveMode => ['not,parseTran first u]
+;  parseTran ['IF,first u,:'(false true)]
+
+;;;     ***       |parseNot| REDEFINED
+
+(DEFUN |parseNot| (|u|) (COND (|$InteractiveMode| (CONS (QUOTE |not|) (CONS (|parseTran| (CAR |u|)) NIL))) ((QUOTE T) (|parseTran| (CONS (QUOTE IF) (CONS (CAR |u|) (QUOTE (|false| |true|)))))))) 
+;
+;parseEquivalence [a,b] == parseIf [a,b,parseIf [b,:'(false true)]]
+
+;;;     ***       |parseEquivalence| REDEFINED
+
+(DEFUN |parseEquivalence| (#0=#:G167112) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS |b| (CONS (|parseIf| (CONS |b| (QUOTE (|false| |true|)))) NIL)))))))) 
+;
+;parseImplies [a,b] == parseIf [a,b,'true]
+
+;;;     ***       |parseImplies| REDEFINED
+
+(DEFUN |parseImplies| (#0=#:G167126) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS |b| (CONS (QUOTE |true|) NIL)))))))) 
+;
+;parseExclusiveOr [a,b] == parseIf [a,parseIf [b,:'(false true)],b]
+
+;;;     ***       |parseExclusiveOr| REDEFINED
+
+(DEFUN |parseExclusiveOr| (#0=#:G167140) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CADR #0#)) (|parseIf| (CONS |a| (CONS (|parseIf| (CONS |b| (QUOTE (|false| |true|)))) (CONS |b| NIL)))))))) 
+;
+;parseExit [a,:b] ==
+;  --  note: I wanted to convert 1s to 0s here to facilitate indexing in
+;  --   comp code; unfortunately, parseTran-ning is sometimes done more
+;  --   than once so that the count can be decremented more than once
+;  a:= parseTran a
+;  b:= parseTran b
+;  b =>
+;    null INTEGERP a =>
+;      (MOAN('"first arg ",a,'" for exit must be integer"); ['exit,1,a])
+;    ['exit,a,:b]
+;  ['exit,1,a]
+
+;;;     ***       |parseExit| REDEFINED
+
+(DEFUN |parseExit| (#0=#:G167157) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (INTEGERP |a|)) (MOAN (MAKESTRING "first arg ") |a| (MAKESTRING " for exit must be integer")) (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |exit|) (CONS 1 (CONS |a| NIL))))))))) 
+;
+;parseLeave [a,:b] ==
+;  a:= parseTran a
+;  b:= parseTran b
+;  b =>
+;    null INTEGERP a =>
+;      (MOAN('"first arg ",a,'" for 'leave' must be integer"); ['leave,1,a])
+;    ['leave,a,:b]
+;  ['leave,1,a]
+
+;;;     ***       |parseLeave| REDEFINED
+
+(DEFUN |parseLeave| (#0=#:G167176) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NULL (INTEGERP |a|)) (MOAN (MAKESTRING "first arg ") |a| (MAKESTRING " for 'leave' must be integer")) (CONS (QUOTE |leave|) (CONS 1 (CONS |a| NIL)))) ((QUOTE T) (CONS (QUOTE |leave|) (CONS |a| |b|))))) ((QUOTE T) (CONS (QUOTE |leave|) (CONS 1 (CONS |a| NIL))))))))) 
+;
+;parseReturn [a,:b] ==
+;  a:= parseTran a
+;  b:= parseTran b
+;  b =>
+;    (if a^=1 then MOAN '"multiple-level 'return' not allowed"; ["return",1,:b])
+;  ['return,1,a]
+
+;;;     ***       |parseReturn| REDEFINED
+
+(DEFUN |parseReturn| (#0=#:G167194) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CAR #0#)) (SPADLET |b| (CDR #0#)) (SPADLET |a| (|parseTran| |a|)) (SPADLET |b| (|parseTran| |b|)) (COND (|b| (COND ((NEQUAL |a| 1) (MOAN (MAKESTRING "multiple-level 'return' not allowed")))) (CONS (QUOTE |return|) (CONS 1 |b|))) ((QUOTE T) (CONS (QUOTE |return|) (CONS 1 (CONS |a| NIL))))))))) 
+;
+;parseJoin l ==
+;  ['Join,:fn parseTranList l] where
+;    fn l ==
+;      null l => nil
+;      l is [['Join,:x],:y] => [:x,:fn y]
+;      [first l,:fn rest l]
+
+;;;     ***       |parseJoin,fn| REDEFINED
+
+(DEFUN |parseJoin,fn| (|l|) (PROG (|ISTMP#1| |x| |y|) (RETURN (SEQ (IF (NULL |l|) (EXIT NIL)) (IF (AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (QCAR |l|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Join|)) (PROGN (SPADLET |x| (QCDR |ISTMP#1|)) (QUOTE T)))) (PROGN (SPADLET |y| (QCDR |l|)) (QUOTE T))) (EXIT (APPEND |x| (|parseJoin,fn| |y|)))) (EXIT (CONS (CAR |l|) (|parseJoin,fn| (CDR |l|)))))))) 
+
+;;;     ***       |parseJoin| REDEFINED
+
+(DEFUN |parseJoin| (|l|) (CONS (QUOTE |Join|) (|parseJoin,fn| (|parseTranList| |l|)))) 
+;
+;parseInBy [i,n,inc] ==
+;  (u:= parseIn [i,n]) isnt ['STEP,i,a,j,:r] =>
+;    postError ["   You cannot use",:bright '"by",
+;      '"except for an explicitly indexed sequence."]
+;  inc:= parseTran inc
+;  ['STEP,i,a,parseTran inc,:r]
+
+;;;     ***       |parseInBy| REDEFINED
+
+(DEFUN |parseInBy| (#0=#:G167281) (PROG (|n| |u| |ISTMP#1| |ISTMP#2| |i| |ISTMP#3| |a| |ISTMP#4| |j| |r| |inc|) (RETURN (PROGN (SPADLET |i| (CAR #0#)) (SPADLET |n| (CADR #0#)) (SPADLET |inc| (CADDR #0#)) (COND ((NULL (PROGN (SPADLET |ISTMP#1| (SPADLET |u| (|parseIn| (CONS |i| (CONS |n| NIL))))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE STEP)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |i| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |j| (QCAR |ISTMP#4|)) (SPADLET |r| (QCDR |ISTMP#4|)) (QUOTE T))))))))))) (|postError| (CONS (QUOTE |   You cannot use|) (APPEND (|bright| (MAKESTRING "by")) (CONS (MAKESTRING "except for an explicitly indexed sequence.") NIL))))) ((QUOTE T) (SPADLET |inc| (|parseTran| |inc|)) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS (|parseTran| |inc|) |r|)))))))))) 
+;
+;parseSegment p ==
+;  p is [a,b] =>
+;    b => ['SEGMENT,parseTran a, parseTran b]
+;    ['SEGMENT,parseTran a]
+;  ['SEGMENT,:p]
+
+;;;     ***       |parseSegment| REDEFINED
+
+(DEFUN |parseSegment| (|p|) (PROG (|a| |ISTMP#1| |b|) (RETURN (COND ((AND (PAIRP |p|) (PROGN (SPADLET |a| (QCAR |p|)) (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND (|b| (CONS (QUOTE SEGMENT) (CONS (|parseTran| |a|) (CONS (|parseTran| |b|) NIL)))) ((QUOTE T) (CONS (QUOTE SEGMENT) (CONS (|parseTran| |a|) NIL))))) ((QUOTE T) (CONS (QUOTE SEGMENT) |p|)))))) 
+;
+;parseIn [i,n] ==
+;  i:= parseTran i
+;  n:= parseTran n
+;  n is ['SEGMENT,a] => ['STEP,i,a,1]
+;  n is ['reverse,['SEGMENT,a]] =>
+;    postError ['"  You cannot reverse an infinite sequence."]
+;  n is ['SEGMENT,a,b] => (b => ['STEP,i,a,1,b]; ['STEP,i,a,1])
+;  n is ['reverse,['SEGMENT,a,b]] =>
+;    b => ['STEP,i,b,-1,a]
+;    postError ['"  You cannot reverse an infinite sequence."]
+;  n is ['tails,s] => ['ON,i,s]
+;  ['IN,i,n]
+
+;;;     ***       |parseIn| REDEFINED
+
+(DEFUN |parseIn| (#0=#:G167419) (PROG (|i| |n| |ISTMP#2| |ISTMP#3| |a| |ISTMP#4| |b| |ISTMP#1| |s|) (RETURN (PROGN (SPADLET |i| (CAR #0#)) (SPADLET |n| (CADR #0#)) (SPADLET |i| (|parseTran| |i|)) (SPADLET |n| (|parseTran| |n|)) (COND ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 NIL))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |reverse|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (|postError| (CONS (MAKESTRING "  You cannot reverse an infinite sequence.") NIL))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND (|b| (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 (CONS |b| NIL)))))) ((QUOTE T) (CONS (QUOTE STEP) (CONS |i| (CONS |a| (CONS 1 NIL))))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |reverse|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCDR |ISTMP#4|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#4|)) (QUOTE T))))))))))) (COND (|b| (CONS (QUOTE STEP) (CONS |i| (CONS |b| (CONS (SPADDIFFERENCE 1) (CONS |a| NIL)))))) ((QUOTE T) (|postError| (CONS (MAKESTRING "  You cannot reverse an infinite sequence.") NIL))))) ((AND (PAIRP |n|) (EQ (QCAR |n|) (QUOTE |tails|)) (PROGN (SPADLET |ISTMP#1| (QCDR |n|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |s| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE ON) (CONS |i| (CONS |s| NIL)))) ((QUOTE T) (CONS (QUOTE IN) (CONS |i| (CONS |n| NIL))))))))) 
+;
+;parseIf t ==
+;  t isnt [p,a,b] => t
+;  ifTran(parseTran p,parseTran a,parseTran b) where
+;    ifTran(p,a,b) ==
+;      null($InteractiveMode) and p='true  => a
+;      null($InteractiveMode) and p='false  => b
+;      p is ['not,p'] => ifTran(p',b,a)
+;      p is ['IF,p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b))
+;      p is ['SEQ,:l,['exit,1,p']] =>
+;        ['SEQ,:l,['exit,1,ifTran(p',incExitLevel a,incExitLevel b)]]
+;         --this assumes that l has no exits
+;      a is ['IF, =p,a',.] => ['IF,p,a',b]
+;      b is ['IF, =p,.,b'] => ['IF,p,a,b']
+;      makeSimplePredicateOrNil p is ['SEQ,:s,['exit,1,val]] =>
+;        parseTran ['SEQ,:s,['exit,1,incExitLevel ['IF,val,a,b]]]
+;      ['IF,p,a,b]
+
+;;;     ***       |parseIf,ifTran| REDEFINED
+
+(DEFUN |parseIf,ifTran| (|p| |a| |b|) (PROG (|p'| |l| |a'| |b'| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |ISTMP#6| |val| |s|) (RETURN (SEQ (IF (AND (NULL |$InteractiveMode|) (BOOT-EQUAL |p| (QUOTE |true|))) (EXIT |a|)) (IF (AND (NULL |$InteractiveMode|) (BOOT-EQUAL |p| (QUOTE |false|))) (EXIT |b|)) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE |not|)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |p'| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (|parseIf,ifTran| |p'| |b| |a|))) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p'| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |a'| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |b'| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (|parseIf,ifTran| |p'| (|parseIf,ifTran| |a'| (COPY |a|) (COPY |b|)) (|parseIf,ifTran| |b'| |a| |b|)))) (IF (AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#1| (QCDR |p|)) (AND (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T))) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |p'| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T))) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (EXIT (CONS (QUOTE SEQ) (APPEND |l| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|parseIf,ifTran| |p'| (|incExitLevel| |a|) (|incExitLevel| |b|)) NIL))) NIL))))) (IF (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |p|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |a'| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL)))))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a'| (CONS |b| NIL)))))) (IF (AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |b|)) (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |p|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |b'| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a| (CONS |b'| NIL)))))) (IF (PROGN (SPADLET |ISTMP#1| (|makeSimplePredicateOrNil| |p|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (REVERSE |ISTMP#2|)) (QUOTE T))) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCAR |ISTMP#4|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQUAL (QCAR |ISTMP#5|) 1) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (PROGN (SPADLET |val| (QCAR |ISTMP#6|)) (QUOTE T)))))))) (PROGN (SPADLET |s| (QCDR |ISTMP#3|)) (QUOTE T))) (PROGN (SPADLET |s| (NREVERSE |s|)) (QUOTE T)))))) (EXIT (|parseTran| (CONS (QUOTE SEQ) (APPEND |s| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|incExitLevel| (CONS (QUOTE IF) (CONS |val| (CONS |a| (CONS |b| NIL))))) NIL))) NIL)))))) (EXIT (CONS (QUOTE IF) (CONS |p| (CONS |a| (CONS |b| NIL))))))))) 
+
+;;;     ***       |parseIf| REDEFINED
+
+(DEFUN |parseIf| (|t|) (PROG (|p| |ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((NULL (AND (PAIRP |t|) (PROGN (SPADLET |p| (QCAR |t|)) (SPADLET |ISTMP#1| (QCDR |t|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T)))))))) |t|) ((QUOTE T) (|parseIf,ifTran| (|parseTran| |p|) (|parseTran| |a|) (|parseTran| |b|))))))) 
+;
+;makeSimplePredicateOrNil p ==
+;  isSimple p => nil
+;  u:= isAlmostSimple p => u
+;  true => wrapSEQExit [['LET,g:= GENSYM(),p],g]
+
+;;;     ***       |makeSimplePredicateOrNil| REDEFINED
+
+(DEFUN |makeSimplePredicateOrNil| (|p|) (PROG (|u| |g|) (RETURN (COND ((|isSimple| |p|) NIL) ((SPADLET |u| (|isAlmostSimple| |p|)) |u|) ((QUOTE T) (|wrapSEQExit| (CONS (CONS (QUOTE LET) (CONS (SPADLET |g| (GENSYM)) (CONS |p| NIL))) (CONS |g| NIL)))))))) 
+;
+;parseWhere l == ['where,:mapInto(l,'parseTran)]
+
+;;;     ***       |parseWhere| REDEFINED
+
+(DEFUN |parseWhere| (|l|) (CONS (QUOTE |where|) (|mapInto| |l| (QUOTE |parseTran|)))) 
+;
+;
+;parseSeq l ==
+;  not l is [:.,['exit,:.]] =>
+;    postError ['"   Invalid ending to block: ",last l]
+;  transSeq mapInto(l,'parseTran)
+
+;;;     ***       |parseSeq| REDEFINED
+
+(DEFUN |parseSeq| (|l|) (PROG (|ISTMP#1| |ISTMP#2|) (RETURN (COND ((NULL (AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (REVERSE |l|)) (QUOTE T)) (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |exit|)))))) (|postError| (CONS (MAKESTRING "   Invalid ending to block: ") (CONS (|last| |l|) NIL)))) ((QUOTE T) (|transSeq| (|mapInto| |l| (QUOTE |parseTran|)))))))) 
+;
+;transSeq l ==
+;  null l => nil
+;  null rest l => decExitLevel first l
+;  [item,:tail]:= l
+;  item is ['SEQ,:l,['exit,1,['IF,p,['exit, =2,q],'noBranch]]] and
+;    (and/[x is ['LET,:.] for x in l]) =>
+;      ['SEQ,:[decExitLevel x for x in l],['exit,1,['IF,decExitLevel p,
+;        decExitLevel q,transSeq tail]]]
+;  item is ['IF,a,['exit,1,b],'noBranch] =>
+;    ['IF,decExitLevel a,decExitLevel b,transSeq tail]
+;  item is ['IF,a,'noBranch,['exit,1,b]] =>
+;    ['IF,decExitLevel a,transSeq tail,decExitLevel b]
+;  (y:= transSeq tail) is ['SEQ,:s] => ['SEQ,item,:s]
+;  ['SEQ,item,['exit,1,incExitLevel y]]
+
+;;;     ***       |transSeq| REDEFINED
+
+(DEFUN |transSeq| (|l|) (PROG (|item| |tail| |ISTMP#7| |p| |ISTMP#8| |ISTMP#9| |ISTMP#10| |ISTMP#11| |q| |ISTMP#12| |a| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |ISTMP#6| |b| |y| |ISTMP#1| |s|) (RETURN (SEQ (COND ((NULL |l|) NIL) ((NULL (CDR |l|)) (|decExitLevel| (CAR |l|))) ((QUOTE T) (SPADLET |item| (CAR |l|)) (SPADLET |tail| (CDR |l|)) (COND ((AND (PAIRP |item|) (EQ (QCAR |item|) (QUOTE SEQ)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |ISTMP#6| (QCAR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCAR |ISTMP#6|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#7| (QCDR |ISTMP#6|)) (AND (PAIRP |ISTMP#7|) (PROGN (SPADLET |p| (QCAR |ISTMP#7|)) (SPADLET |ISTMP#8| (QCDR |ISTMP#7|)) (AND (PAIRP |ISTMP#8|) (PROGN (SPADLET |ISTMP#9| (QCAR |ISTMP#8|)) (AND (PAIRP |ISTMP#9|) (EQ (QCAR |ISTMP#9|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#10| (QCDR |ISTMP#9|)) (AND (PAIRP |ISTMP#10|) (EQUAL (QCAR |ISTMP#10|) 2) (PROGN (SPADLET |ISTMP#11| (QCDR |ISTMP#10|)) (AND (PAIRP |ISTMP#11|) (EQ (QCDR |ISTMP#11|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#11|)) (QUOTE T)))))))) (PROGN (SPADLET |ISTMP#12| (QCDR |ISTMP#8|)) (AND (PAIRP |ISTMP#12|) (EQ (QCDR |ISTMP#12|) NIL) (EQ (QCAR |ISTMP#12|) (QUOTE |noBranch|)))))))))))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G168041) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G168047 NIL (NULL #0#)) (#2=#:G168048 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE LET))))))))))) (CONS (QUOTE SEQ) (APPEND (PROG (#3=#:G168059) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G168064 |l| (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (|decExitLevel| |x|) #3#))))))) (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (CONS (QUOTE IF) (CONS (|decExitLevel| |p|) (CONS (|decExitLevel| |q|) (CONS (|transSeq| |tail|) NIL)))) NIL))) NIL)))) ((AND (PAIRP |item|) (EQ (QCAR |item|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQUAL (QCAR |ISTMP#4|) 1) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (EQ (QCAR |ISTMP#6|) (QUOTE |noBranch|))))))))) (CONS (QUOTE IF) (CONS (|decExitLevel| |a|) (CONS (|decExitLevel| |b|) (CONS (|transSeq| |tail|) NIL))))) ((AND (PAIRP |item|) (EQ (QCAR |item|) (QUOTE IF)) (PROGN (SPADLET |ISTMP#1| (QCDR |item|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |noBranch|)) (PROGN (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (EQ (QCAR |ISTMP#4|) (QUOTE |exit|)) (PROGN (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQUAL (QCAR |ISTMP#5|) 1) (PROGN (SPADLET |ISTMP#6| (QCDR |ISTMP#5|)) (AND (PAIRP |ISTMP#6|) (EQ (QCDR |ISTMP#6|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#6|)) (QUOTE T))))))))))))))) (CONS (QUOTE IF) (CONS (|decExitLevel| |a|) (CONS (|transSeq| |tail|) (CONS (|decExitLevel| |b|) NIL))))) ((PROGN (SPADLET |ISTMP#1| (SPADLET |y| (|transSeq| |tail|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ)) (PROGN (SPADLET |s| (QCDR |ISTMP#1|)) (QUOTE T)))) (CONS (QUOTE SEQ) (CONS |item| |s|))) ((QUOTE T) (CONS (QUOTE SEQ) (CONS |item| (CONS (CONS (QUOTE |exit|) (CONS 1 (CONS (|incExitLevel| |y|) NIL))) NIL))))))))))) 
+;
+;transCategoryItem x ==
+;  x is ['SIGNATURE,lhs,rhs] =>
+;    lhs is ['LISTOF,:y] =>
+;      "append" /[transCategoryItem ['SIGNATURE,z,rhs] for z in y]
+;    atom lhs =>
+;      if STRINGP lhs then lhs:= INTERN lhs
+;      rhs is ['Mapping,:m] =>
+;        m is [.,'constant] => LIST ['SIGNATURE,lhs,[first m],'constant]
+;        LIST ['SIGNATURE,lhs,m]
+;      $transCategoryAssoc:= [[lhs,:rhs],:$transCategoryAssoc]
+;      NIL
+;    [op,:argl]:= lhs
+;    extra:= nil
+;    if rhs is ['Mapping,:m] then
+;      if rest m then extra:= rest m
+;                 --should only be 'constant' or 'variable'
+;      rhs:= first m
+;    LIST ['SIGNATURE,op,[rhs,:SUBLIS($transCategoryAssoc,argl)],:extra]
+;  LIST x
+
+;;;     ***       |transCategoryItem| REDEFINED
+
+(DEFUN |transCategoryItem| (|x|) (PROG (|ISTMP#2| |y| |lhs| |ISTMP#1| |op| |argl| |m| |extra| |rhs|) (RETURN (SEQ (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SIGNATURE)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |lhs| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |rhs| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE LISTOF)) (PROGN (SPADLET |y| (QCDR |lhs|)) (QUOTE T))) (PROG (#0=#:G168138) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G168143 |y| (CDR #1#)) (|z| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |z| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|transCategoryItem| (CONS (QUOTE SIGNATURE) (CONS |z| (CONS |rhs| NIL)))))))))))) ((ATOM |lhs|) (COND ((STRINGP |lhs|) (SPADLET |lhs| (INTERN |lhs|)))) (COND ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) (QUOTE |Mapping|)) (PROGN (SPADLET |m| (QCDR |rhs|)) (QUOTE T))) (COND ((AND (PAIRP |m|) (PROGN (SPADLET |ISTMP#1| (QCDR |m|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (EQ (QCAR |ISTMP#1|) (QUOTE |constant|))))) (LIST (CONS (QUOTE SIGNATURE) (CONS |lhs| (CONS (CONS (CAR |m|) NIL) (CONS (QUOTE |constant|) NIL)))))) ((QUOTE T) (LIST (CONS (QUOTE SIGNATURE) (CONS |lhs| (CONS |m| NIL))))))) ((QUOTE T) (SPADLET |$transCategoryAssoc| (CONS (CONS |lhs| |rhs|) |$transCategoryAssoc|)) NIL))) ((QUOTE T) (SPADLET |op| (CAR |lhs|)) (SPADLET |argl| (CDR |lhs|)) (SPADLET |extra| NIL) (COND ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) (QUOTE |Mapping|)) (PROGN (SPADLET |m| (QCDR |rhs|)) (QUOTE T))) (COND ((CDR |m|) (SPADLET |extra| (CDR |m|)))) (SPADLET |rhs| (CAR |m|)))) (LIST (CONS (QUOTE SIGNATURE) (CONS |op| (CONS (CONS |rhs| (SUBLIS |$transCategoryAssoc| |argl|)) |extra|))))))) ((QUOTE T) (LIST |x|))))))) 
+;
+;superSub(name,x) ==
+;  for u in x repeat y:= [:y,:u]
+;  code:=
+;    x is [[u]] => $quadSymbol
+;    STRCONC("_(",scriptTranRow first x,scriptTran rest x,"_)")
+;  [INTERNL(PNAME name,"$",code),:y]
+
+;;;     ***       |superSub| REDEFINED
+
+(DEFUN |superSub| (|name| |x|) (PROG (|y| |ISTMP#1| |u| |code|) (RETURN (SEQ (PROGN (DO ((#0=#:G168177 |x| (CDR #0#)) (|u| NIL)) ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (SPADLET |y| (APPEND |y| |u|))))) (SPADLET |code| (COND ((AND (PAIRP |x|) (EQ (QCDR |x|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T))))) |$quadSymbol|) ((QUOTE T) (STRCONC (QUOTE |(|) (|scriptTranRow| (CAR |x|)) (|scriptTran| (CDR |x|)) (QUOTE |)|))))) (CONS (INTERNL (PNAME |name|) (QUOTE $) |code|) |y|)))))) 
+;
+;scriptTran x ==
+;  null x => ""
+;  STRCONC(";",scriptTranRow first x,scriptTran rest x)
+
+;;;     ***       |scriptTran| REDEFINED
+
+(DEFUN |scriptTran| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC (QUOTE |;|) (|scriptTranRow| (CAR |x|)) (|scriptTran| (CDR |x|)))))) 
+;
+;scriptTranRow x ==
+;  null x => ""
+;  STRCONC($quadSymbol,scriptTranRow1 rest x)
+
+;;;     ***       |scriptTranRow| REDEFINED
+
+(DEFUN |scriptTranRow| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) 
+;
+;scriptTranRow1 x ==
+;  null x => ""
+;  STRCONC(",",$quadSymbol,scriptTranRow1 rest x)
+
+;;;     ***       |scriptTranRow1| REDEFINED
+
+(DEFUN |scriptTranRow1| (|x|) (COND ((NULL |x|) (QUOTE ||)) ((QUOTE T) (STRCONC (QUOTE |,|) |$quadSymbol| (|scriptTranRow1| (CDR |x|)))))) 
+;
+;parseVCONS l == ["VECTOR",:parseTranList l]
+
+;;;     ***       |parseVCONS| REDEFINED
+
+(DEFUN |parseVCONS| (|l|) (CONS (QUOTE VECTOR) (|parseTranList| |l|))) 
+;;;Boot translation finished for parse.boot
+@
+postpar
+<<*>>=
+;--% Yet Another Parser Transformation File
+;--These functions are used by for BOOT and SPAD code
+;--(see new2OldLisp, e.g.)
+;postTransform y ==
+;  x:= y
+;  u:= postTran x
+;  if u is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:=
+;    [":",['LISTOF,:l,y],t]
+;  postTransformCheck u
+;  aplTran u
+
+;;;     ***       |postTransform| REDEFINED
+
+(DEFUN |postTransform| (|y|) (PROG (|x| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |t| |l| |u|) (RETURN (SEQ (PROGN (SPADLET |x| |y|) (SPADLET |u| (|postTran| |x|)) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166116) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166122 NIL (NULL #0#)) (#2=#:G166123 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (SPADLET |u| (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))))) (|postTransformCheck| |u|) (|aplTran| |u|)))))) 
+;displayPreCompilationErrors() ==
+;  n:= #($postStack:= REMDUP NREVERSE $postStack)
+;  n=0 => nil
+;  errors:=
+;    1<n => '"errors"
+;    '"error"
+;  if $InteractiveMode
+;    then sayBrightly ['"   Semantic ",errors,'" detected: "]
+;    else
+;      heading:=
+;        $topOp ^= '$topOp => ['"   ",$topOp,'" has"]
+;        ['"   You have"]
+;      sayBrightly [:heading,'%b,n,'%d,'"precompilation ",errors,'":"]
+;  if 1<n then
+;    (for x in $postStack for i in 1.. repeat sayMath ['"   ",i,'"_) ",:x])
+;    else sayMath ['"    ",:first $postStack]
+;  TERPRI()
+
+;;;     ***       |displayPreCompilationErrors| REDEFINED
+
+(DEFUN |displayPreCompilationErrors| NIL (PROG (|n| |errors| |heading|) (RETURN (SEQ (PROGN (SPADLET |n| (|#| (SPADLET |$postStack| (REMDUP (NREVERSE |$postStack|))))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (SPADLET |errors| (COND ((> |n| 1) (MAKESTRING "errors")) ((QUOTE T) (MAKESTRING "error")))) (COND (|$InteractiveMode| (|sayBrightly| (CONS (MAKESTRING "   Semantic ") (CONS |errors| (CONS (MAKESTRING " detected: ") NIL))))) ((QUOTE T) (SPADLET |heading| (COND ((NEQUAL |$topOp| (QUOTE |$topOp|)) (CONS (MAKESTRING "   ") (CONS |$topOp| (CONS (MAKESTRING " has") NIL)))) ((QUOTE T) (CONS (MAKESTRING "   You have") NIL)))) (|sayBrightly| (APPEND |heading| (CONS (QUOTE |%b|) (CONS |n| (CONS (QUOTE |%d|) (CONS (MAKESTRING "precompilation ") (CONS |errors| (CONS (MAKESTRING ":") NIL)))))))))) (COND ((> |n| 1) (DO ((#0=#:G166154 |$postStack| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayMath| (CONS (MAKESTRING "   ") (CONS |i| (CONS (MAKESTRING ") ") |x|)))))))) ((QUOTE T) (|sayMath| (CONS (MAKESTRING "    ") (CAR |$postStack|))))) (TERPRI)))))))) 
+;postTran x ==
+;  atom x =>
+;    postAtom x
+;  op := first x
+;  atom op and (f:= GET(op,'postTran)) => FUNCALL(f,x)
+;  op is ['elt,a,b] =>
+;    u:= postTran [b,:rest x]
+;    [postTran op,:rest u]
+;  op is ['Scripts,:.] =>
+;    postScriptsForm(op,"append"/[unTuple postTran y for y in rest x])
+;  op^=(y:= postOp op) => [y,:postTranList rest x]
+;  postForm x
+
+;;;     ***       |postTran| REDEFINED
+
+(DEFUN |postTran| (|x|) (PROG (|op| |f| |ISTMP#1| |a| |ISTMP#2| |b| |u| |y|) (RETURN (SEQ (COND ((ATOM |x|) (|postAtom| |x|)) ((QUOTE T) (SPADLET |op| (CAR |x|)) (COND ((AND (ATOM |op|) (SPADLET |f| (GETL |op| (QUOTE |postTran|)))) (FUNCALL |f| |x|)) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#1| (QCDR |op|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |u| (|postTran| (CONS |b| (CDR |x|)))) (CONS (|postTran| |op|) (CDR |u|))) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |Scripts|))) (|postScriptsForm| |op| (PROG (#0=#:G166185) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166190 (CDR |x|) (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|unTuple| (|postTran| |y|))))))))))) ((NEQUAL |op| (SPADLET |y| (|postOp| |op|))) (CONS |y| (|postTranList| (CDR |x|)))) ((QUOTE T) (|postForm| |x|))))))))) 
+;postTranList x == [postTran y for y in x]
+
+;;;     ***       |postTranList| REDEFINED
+
+(DEFUN |postTranList| (|x|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G166212) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166217 |x| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postTran| |y|) #0#))))))))))) 
+;postBigFloat x ==
+;  [.,mant,:expon] := x
+;  $BOOT => INT2RNUM(mant) * INT2RNUM(10) ** expon
+;  eltword := if $InteractiveMode then "$elt" else 'elt
+;  postTran [[eltword,'(Float),'float],[",",[",",mant,expon],10]]
+
+;;;     ***       |postBigFloat| REDEFINED
+
+(DEFUN |postBigFloat| (|x|) (PROG (|mant| |expon| |eltword|) (RETURN (PROGN (SPADLET |mant| (CADR |x|)) (SPADLET |expon| (CDDR |x|)) (COND ($BOOT (TIMES (INT2RNUM |mant|) (EXPT (INT2RNUM 10) |expon|))) ((QUOTE T) (SPADLET |eltword| (COND (|$InteractiveMode| (QUOTE |$elt|)) ((QUOTE T) (QUOTE |elt|)))) (|postTran| (CONS (CONS |eltword| (CONS (QUOTE (|Float|)) (CONS (QUOTE |float|) NIL))) (CONS (CONS (QUOTE |,|) (CONS (CONS (QUOTE |,|) (CONS |mant| (CONS |expon| NIL))) (CONS 10 NIL))) NIL))))))))) 
+;postAdd ['add,a,:b] ==
+;  null b => postCapsule a
+;  ['add,postTran a,postCapsule first b]
+
+;;;     ***       |postAdd| REDEFINED
+
+(DEFUN |postAdd| (#0=#:G166238) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CDDR #0#)) (COND ((NULL |b|) (|postCapsule| |a|)) ((QUOTE T) (CONS (QUOTE |add|) (CONS (|postTran| |a|) (CONS (|postCapsule| (CAR |b|)) NIL))))))))) 
+;checkWarning msg == postError concat('"Parsing error: ",msg)
+
+;;;     ***       |checkWarning| REDEFINED
+
+(DEFUN |checkWarning| (|msg|) (|postError| (|concat| (MAKESTRING "Parsing error: ") |msg|))) 
+;
+;checkWarningIndentation() ==
+;  checkWarning ['"Apparent indentation error following",:bright "add"]
+
+;;;     ***       |checkWarningIndentation| REDEFINED
+
+(DEFUN |checkWarningIndentation| NIL (|checkWarning| (CONS (MAKESTRING "Apparent indentation error following") (|bright| (QUOTE |add|))))) 
+;postCapsule x ==
+;  x isnt [op,:.] => checkWarningIndentation()
+;  INTEGERP op or op = "==" => ['CAPSULE,postBlockItem x]
+;  op = ";" => ['CAPSULE,:postBlockItemList postFlatten(x,";")]
+;  op = "if" => ['CAPSULE,postBlockItem x]
+;  checkWarningIndentation()
+
+;;;     ***       |postCapsule| REDEFINED
+
+(DEFUN |postCapsule| (|x|) (PROG (|op|) (RETURN (COND ((NULL (AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T)))) (|checkWarningIndentation|)) ((OR (INTEGERP |op|) (BOOT-EQUAL |op| (QUOTE ==))) (CONS (QUOTE CAPSULE) (CONS (|postBlockItem| |x|) NIL))) ((BOOT-EQUAL |op| (QUOTE |;|)) (CONS (QUOTE CAPSULE) (|postBlockItemList| (|postFlatten| |x| (QUOTE |;|))))) ((BOOT-EQUAL |op| (QUOTE |if|)) (CONS (QUOTE CAPSULE) (CONS (|postBlockItem| |x|) NIL))) ((QUOTE T) (|checkWarningIndentation|)))))) 
+;postQUOTE x == x
+
+;;;     ***       |postQUOTE| REDEFINED
+
+(DEFUN |postQUOTE| (|x|) |x|) 
+;postColon u ==
+;  u is [":",x] => [":",postTran x]
+;  u is [":",x,y] => [":",postTran x,:postType y]
+
+;;;     ***       |postColon| REDEFINED
+
+(DEFUN |postColon| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE |:|) (CONS (|postTran| |x|) NIL))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |:|) (CONS (|postTran| |x|) (|postType| |y|)))))))) 
+;postColonColon u ==
+;  -- for Lisp package calling
+;  -- boot syntax is package::fun but probably need to parenthesize it
+;  $BOOT and u is ["::",package,fun] =>
+;    INTERN(STRINGIMAGE fun, package)
+;  postForm u
+
+;;;     ***       |postColonColon| REDEFINED
+
+(DEFUN |postColonColon| (|u|) (PROG (|ISTMP#1| |package| |ISTMP#2| |fun|) (RETURN (COND ((AND $BOOT (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |::|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |package| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |fun| (QCAR |ISTMP#2|)) (QUOTE T))))))) (INTERN (STRINGIMAGE |fun|) |package|)) ((QUOTE T) (|postForm| |u|)))))) 
+;postAtSign ["@",x,y] == ["@",postTran x,:postType y]
+
+;;;     ***       |postAtSign| REDEFINED
+
+(DEFUN |postAtSign| (#0=#:G166320) (PROG (|x| |y|) (RETURN (PROGN (COND ((EQ (CAR #0#) (QUOTE @)) (CAR #0#))) (SPADLET |x| (CADR #0#)) (SPADLET |y| (CADDR #0#)) (CONS (QUOTE @) (CONS (|postTran| |x|) (|postType| |y|))))))) 
+;postPretend ['pretend,x,y] == ['pretend,postTran x,:postType y]
+
+;;;     ***       |postPretend| REDEFINED
+
+(DEFUN |postPretend| (#0=#:G166336) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CADR #0#)) (SPADLET |y| (CADDR #0#)) (CONS (QUOTE |pretend|) (CONS (|postTran| |x|) (|postType| |y|))))))) 
+;postConstruct u ==
+;  u is ['construct,b] =>
+;    a:= (b is [",",:.] => comma2Tuple b; b)
+;    a is ['SEGMENT,p,q] => ['construct,postTranSegment(p,q)]
+;    a is ['Tuple,:l] =>
+;      or/[x is [":",y] for x in l] => postMakeCons l
+;      or/[x is ['SEGMENT,:.] for x in l] => tuple2List l
+;      ['construct,:postTranList l]
+;    ['construct,postTran a]
+;  u
+
+;;;     ***       |postConstruct| REDEFINED
+
+(DEFUN |postConstruct| (|u|) (PROG (|b| |a| |p| |ISTMP#2| |q| |l| |ISTMP#1| |y|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |a| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |,|))) (|comma2Tuple| |b|)) ((QUOTE T) |b|))) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |a|)) (QUOTE T))) (COND ((PROG (#0=#:G166378) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166388 NIL #0#) (#2=#:G166389 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (|postMakeCons| |l|)) ((PROG (#3=#:G166396) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G166402 NIL #3#) (#5=#:G166403 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (|tuple2List| |l|)) ((QUOTE T) (CONS (QUOTE |construct|) (|postTranList| |l|))))) ((QUOTE T) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))))) ((QUOTE T) |u|)))))) 
+;postError msg ==
+;  BUMPERRORCOUNT 'precompilation
+;  xmsg:=
+;    $defOp ^= '$defOp and not InteractiveMode => [$defOp,'": ",:msg]
+;    msg
+;  $postStack:= [xmsg,:$postStack]
+;  nil
+
+;;;     ***       |postError| REDEFINED
+
+(DEFUN |postError| (|msg|) (PROG (|xmsg|) (RETURN (PROGN (BUMPERRORCOUNT (QUOTE |precompilation|)) (SPADLET |xmsg| (COND ((AND (NEQUAL |$defOp| (QUOTE |$defOp|)) (NULL |InteractiveMode|)) (CONS |$defOp| (CONS (MAKESTRING ": ") |msg|))) ((QUOTE T) |msg|))) (SPADLET |$postStack| (CONS |xmsg| |$postStack|)) NIL)))) 
+;postMakeCons l ==
+;  null l => 'nil
+;  l is [[":",a],:l'] =>
+;    l' => ['append,postTran a,postMakeCons l']
+;    postTran a
+;  ['cons,postTran first l,postMakeCons rest l]
+
+;;;     ***       |postMakeCons| REDEFINED
+
+(DEFUN |postMakeCons| (|l|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l'|) (RETURN (COND ((NULL |l|) (QUOTE |nil|)) ((AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (QCAR |l|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (QUOTE T)))))) (PROGN (SPADLET |l'| (QCDR |l|)) (QUOTE T))) (COND (|l'| (CONS (QUOTE |append|) (CONS (|postTran| |a|) (CONS (|postMakeCons| |l'|) NIL)))) ((QUOTE T) (|postTran| |a|)))) ((QUOTE T) (CONS (QUOTE |cons|) (CONS (|postTran| (CAR |l|)) (CONS (|postMakeCons| (CDR |l|)) NIL)))))))) 
+;postAtom x ==
+;  $BOOT => x
+;  x=0 => '(Zero)
+;  x=1 => '(One)
+;  EQ(x,'T) => 'T_$ -- rename T in spad code to T$
+;  IDENTP x and GETDATABASE(x,'NILADIC) => LIST x
+;  x
+
+;;;     ***       |postAtom| REDEFINED
+
+(DEFUN |postAtom| (|x|) (COND ($BOOT |x|) ((EQL |x| 0) (QUOTE (|Zero|))) ((EQL |x| 1) (QUOTE (|One|))) ((EQ |x| (QUOTE T)) (QUOTE T$)) ((AND (IDENTP |x|) (GETDATABASE |x| (QUOTE NILADIC))) (LIST |x|)) ((QUOTE T) |x|))) 
+;postBlock ['Block,:l,x] ==
+;  ['SEQ,:postBlockItemList l,['exit,postTran x]]
+
+;;;     ***       |postBlock| REDEFINED
+
+(DEFUN |postBlock| (#0=#:G166455) (PROG (|LETTMP#1| |x| |l|) (RETURN (PROGN (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |l| (NREVERSE (CDR |LETTMP#1|))) (CONS (QUOTE SEQ) (APPEND (|postBlockItemList| |l|) (CONS (CONS (QUOTE |exit|) (CONS (|postTran| |x|) NIL)) NIL))))))) 
+;postBlockItemList l == [postBlockItem x for x in l]
+
+;;;     ***       |postBlockItemList| REDEFINED
+
+(DEFUN |postBlockItemList| (|l|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G166476) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166481 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postBlockItem| |x|) #0#))))))))))) 
+;postBlockItem x ==
+;  x:= postTran x
+;  x is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>
+;    [":",['LISTOF,:l,y],t]
+;  x
+
+;;;     ***       |postBlockItem| REDEFINED
+
+(DEFUN |postBlockItem| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |y| |ISTMP#5| |t| |l|) (RETURN (SEQ (PROGN (SPADLET |x| (|postTran| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G166534) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G166540 NIL (NULL #0#)) (#2=#:G166541 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))) ((QUOTE T) |x|))))))) 
+;postCategory (u is ['CATEGORY,:l]) ==
+;  --RDJ: ugh_ please -- someone take away need for PROGN as soon as possible
+;  null l => u
+;  op :=
+;    $insidePostCategoryIfTrue = true => 'PROGN
+;    'CATEGORY
+;  [op,:[fn x for x in l]] where fn x ==
+;    $insidePostCategoryIfTrue: local := true
+;    postTran x
+
+;;;     ***       |postCategory,fn| REDEFINED
+
+(DEFUN |postCategory,fn| (|x|) (PROG (|$insidePostCategoryIfTrue|) (DECLARE (SPECIAL |$insidePostCategoryIfTrue|)) (RETURN (SEQ (SPADLET |$insidePostCategoryIfTrue| (QUOTE T)) (EXIT (|postTran| |x|)))))) 
+
+;;;     ***       |postCategory| REDEFINED
+
+(DEFUN |postCategory| (|u|) (PROG (|l| |op|) (RETURN (SEQ (PROGN (SPADLET |l| (CDR |u|)) (COND ((NULL |l|) |u|) ((QUOTE T) (SPADLET |op| (COND ((BOOT-EQUAL |$insidePostCategoryIfTrue| (QUOTE T)) (QUOTE PROGN)) ((QUOTE T) (QUOTE CATEGORY)))) (CONS |op| (PROG (#0=#:G166582) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166587 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postCategory,fn| |x|) #0#))))))))))))))) 
+;postComma u == postTuple comma2Tuple u
+
+;;;     ***       |postComma| REDEFINED
+
+(DEFUN |postComma| (|u|) (|postTuple| (|comma2Tuple| |u|))) 
+;comma2Tuple u == ['Tuple,:postFlatten(u,",")]
+
+;;;     ***       |comma2Tuple| REDEFINED
+
+(DEFUN |comma2Tuple| (|u|) (CONS (QUOTE |Tuple|) (|postFlatten| |u| (QUOTE |,|)))) 
+;postDef [defOp,lhs,rhs] ==
+;--+
+;  lhs is ["macro",name] => postMDef ["==>",name,rhs]
+;  if not($BOOT) then recordHeaderDocumentation nil
+;  if $maxSignatureLineNumber ^= 0 then
+;    $docList := [['constructor,:$headerDocumentation],:$docList]
+;    $maxSignatureLineNumber := 0
+;    --reset this for next constructor; see recordDocumentation
+;  lhs:= postTran lhs
+;  [form,targetType]:=
+;    lhs is [":",:.] => rest lhs
+;    [lhs,nil]
+;  if null $InteractiveMode and atom form then form := LIST form
+;  newLhs:=
+;    atom form => form
+;    [op,:argl]:= [(x is [":",a,.] => a; x) for x in form]
+;    [op,:postDefArgs argl]
+;  argTypeList:=
+;    atom form => nil
+;    [(x is [":",.,t] => t; nil) for x in rest form]
+;  typeList:= [targetType,:argTypeList]
+;  if atom form then form := [form]
+;  specialCaseForm := [nil for x in form]
+;  ['DEF,newLhs,typeList,specialCaseForm,postTran rhs]
+
+;;;     ***       |postDef| REDEFINED
+
+(DEFUN |postDef| (#0=#:G166655) (PROG (|defOp| |rhs| |name| |lhs| |targetType| |a| |LETTMP#1| |op| |argl| |newLhs| |ISTMP#1| |ISTMP#2| |t| |argTypeList| |typeList| |form| |specialCaseForm|) (RETURN (SEQ (PROGN (SPADLET |defOp| (CAR #0#)) (SPADLET |lhs| (CADR #0#)) (SPADLET |rhs| (CADDR #0#)) (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE |macro|)) (PROGN (SPADLET |ISTMP#1| (QCDR |lhs|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |name| (QCAR |ISTMP#1|)) (QUOTE T))))) (|postMDef| (CONS (QUOTE ==>) (CONS |name| (CONS |rhs| NIL))))) ((QUOTE T) (COND ((NULL $BOOT) (|recordHeaderDocumentation| NIL))) (COND ((NEQUAL |$maxSignatureLineNumber| 0) (SPADLET |$docList| (CONS (CONS (QUOTE |constructor|) |$headerDocumentation|) |$docList|)) (SPADLET |$maxSignatureLineNumber| 0))) (SPADLET |lhs| (|postTran| |lhs|)) (SPADLET |LETTMP#1| (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE |:|))) (CDR |lhs|)) ((QUOTE T) (CONS |lhs| (CONS NIL NIL))))) (SPADLET |form| (CAR |LETTMP#1|)) (SPADLET |targetType| (CADR |LETTMP#1|)) (COND ((AND (NULL |$InteractiveMode|) (ATOM |form|)) (SPADLET |form| (LIST |form|)))) (SPADLET |newLhs| (COND ((ATOM |form|) |form|) ((QUOTE T) (SPADLET |LETTMP#1| (PROG (#1=#:G166698) (SPADLET #1# NIL) (RETURN (DO ((#2=#:G166708 |form| (CDR #2#)) (|x| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) (NREVERSE0 #1#)) (SEQ (EXIT (SETQ #1# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL)))))) |a|) ((QUOTE T) |x|)) #1#)))))))) (SPADLET |op| (CAR |LETTMP#1|)) (SPADLET |argl| (CDR |LETTMP#1|)) (CONS |op| (|postDefArgs| |argl|))))) (SPADLET |argTypeList| (COND ((ATOM |form|) NIL) ((QUOTE T) (PROG (#3=#:G166724) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G166735 (CDR |form|) (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#2|)) (QUOTE T))))))) |t|) ((QUOTE T) NIL)) #3#)))))))))) (SPADLET |typeList| (CONS |targetType| |argTypeList|)) (COND ((ATOM |form|) (SPADLET |form| (CONS |form| NIL)))) (SPADLET |specialCaseForm| (PROG (#5=#:G166745) (SPADLET #5# NIL) (RETURN (DO ((#6=#:G166750 |form| (CDR #6#)) (|x| NIL)) ((OR (ATOM #6#) (PROGN (SETQ |x| (CAR #6#)) NIL)) (NREVERSE0 #5#)) (SEQ (EXIT (SETQ #5# (CONS NIL #5#)))))))) (CONS (QUOTE DEF) (CONS |newLhs| (CONS |typeList| (CONS |specialCaseForm| (CONS (|postTran| |rhs|) NIL)))))))))))) 
+;postDefArgs argl ==
+;  null argl => argl
+;  argl is [[":",a],:b] =>
+;    b => postError
+;      ['"   Argument",:bright a,'"of indefinite length must be last"]
+;    atom a or a is ['QUOTE,:.] => a
+;    postError
+;      ['"   Argument",:bright a,'"of indefinite length must be a name"]
+;  [first argl,:postDefArgs rest argl]
+
+;;;     ***       |postDefArgs| REDEFINED
+
+(DEFUN |postDefArgs| (|argl|) (PROG (|ISTMP#1| |ISTMP#2| |a| |b|) (RETURN (COND ((NULL |argl|) |argl|) ((AND (PAIRP |argl|) (PROGN (SPADLET |ISTMP#1| (QCAR |argl|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (QUOTE T)))))) (PROGN (SPADLET |b| (QCDR |argl|)) (QUOTE T))) (COND (|b| (|postError| (CONS (MAKESTRING "   Argument") (APPEND (|bright| |a|) (CONS (MAKESTRING "of indefinite length must be last") NIL))))) ((OR (ATOM |a|) (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE QUOTE)))) |a|) ((QUOTE T) (|postError| (CONS (MAKESTRING "   Argument") (APPEND (|bright| |a|) (CONS (MAKESTRING "of indefinite length must be a name") NIL))))))) ((QUOTE T) (CONS (CAR |argl|) (|postDefArgs| (CDR |argl|)))))))) 
+;postMDef(t) ==
+;  [.,lhs,rhs] := t
+;  $InteractiveMode and not $BOOT =>
+;    lhs := postTran lhs
+;    null IDENTP lhs => throwKeyedMsg("S2IP0001",NIL)
+;    ['MDEF,lhs,NIL,NIL,postTran rhs]
+;  lhs:= postTran lhs
+;  [form,targetType]:=
+;    lhs is [":",:.] => rest lhs
+;    [lhs,nil]
+;  form:=
+;    atom form => LIST form
+;    form
+;  newLhs:= [(x is [":",a,:.] => a; x) for x in form]
+;  typeList:= [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]]
+;  ['MDEF,newLhs,typeList,[nil for x in form],postTran rhs]
+
+;;;     ***       |postMDef| REDEFINED
+
+(DEFUN |postMDef| (|t|) (PROG (|rhs| |lhs| |LETTMP#1| |targetType| |form| |a| |newLhs| |ISTMP#1| |ISTMP#2| |typeList|) (RETURN (SEQ (PROGN (SPADLET |lhs| (CADR |t|)) (SPADLET |rhs| (CADDR |t|)) (COND ((AND |$InteractiveMode| (NULL $BOOT)) (SPADLET |lhs| (|postTran| |lhs|)) (COND ((NULL (IDENTP |lhs|)) (|throwKeyedMsg| (QUOTE S2IP0001) NIL)) ((QUOTE T) (CONS (QUOTE MDEF) (CONS |lhs| (CONS NIL (CONS NIL (CONS (|postTran| |rhs|) NIL)))))))) ((QUOTE T) (SPADLET |lhs| (|postTran| |lhs|)) (SPADLET |LETTMP#1| (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE |:|))) (CDR |lhs|)) ((QUOTE T) (CONS |lhs| (CONS NIL NIL))))) (SPADLET |form| (CAR |LETTMP#1|)) (SPADLET |targetType| (CADR |LETTMP#1|)) (SPADLET |form| (COND ((ATOM |form|) (LIST |form|)) ((QUOTE T) |form|))) (SPADLET |newLhs| (PROG (#0=#:G166845) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166854 |form| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) |a|) ((QUOTE T) |x|)) #0#)))))))) (SPADLET |typeList| (CONS |targetType| (PROG (#2=#:G166870) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G166881 (CDR |form|) (CDR #3#)) (|x| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#2|)) (QUOTE T))))))) |t|) ((QUOTE T) NIL)) #2#))))))))) (CONS (QUOTE MDEF) (CONS |newLhs| (CONS |typeList| (CONS (PROG (#4=#:G166891) (SPADLET #4# NIL) (RETURN (DO ((#5=#:G166896 |form| (CDR #5#)) (|x| NIL)) ((OR (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) (NREVERSE0 #4#)) (SEQ (EXIT (SETQ #4# (CONS NIL #4#))))))) (CONS (|postTran| |rhs|) NIL)))))))))))) 
+;postElt (u is [.,a,b]) ==
+;  a:= postTran a
+;  b is ['Sequence,:.] => [['elt,a,'makeRecord],:postTranList rest b]
+;  ['elt,a,postTran b]
+
+;;;     ***       |postElt| REDEFINED
+
+(DEFUN |postElt| (|u|) (PROG (|b| |a|) (RETURN (PROGN (SPADLET |a| (CADR |u|)) (SPADLET |b| (CADDR |u|)) (SPADLET |a| (|postTran| |a|)) (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |Sequence|))) (CONS (CONS (QUOTE |elt|) (CONS |a| (CONS (QUOTE |makeRecord|) NIL))) (|postTranList| (CDR |b|)))) ((QUOTE T) (CONS (QUOTE |elt|) (CONS |a| (CONS (|postTran| |b|) NIL))))))))) 
+;postExit ["=>",a,b] == ['IF,postTran a,['exit,postTran b],'noBranch]
+
+;;;     ***       |postExit| REDEFINED
+
+(DEFUN |postExit| (#0=#:G166938) (PROG (|a| |b|) (RETURN (PROGN (COND ((EQ (CAR #0#) (QUOTE =>)) (CAR #0#))) (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (CONS (QUOTE IF) (CONS (|postTran| |a|) (CONS (CONS (QUOTE |exit|) (CONS (|postTran| |b|) NIL)) (CONS (QUOTE |noBranch|) NIL)))))))) 
+;postFlatten(x,op) ==
+;  x is [ =op,a,b] => [:postFlatten(a,op),:postFlatten(b,op)]
+;  LIST x
+
+;;;     ***       |postFlatten| REDEFINED
+
+(DEFUN |postFlatten| (|x| |op|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (EQUAL (QCAR |x|) |op|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (APPEND (|postFlatten| |a| |op|) (|postFlatten| |b| |op|))) ((QUOTE T) (LIST |x|)))))) 
+;postForm (u is [op,:argl]) ==
+;  x:=
+;    atom op =>
+;      argl':= postTranList argl
+;      op':=
+;        true=> op
+;        $BOOT => op
+;        GET(op,'Led) or GET(op,'Nud) or op = 'IN => op
+;        numOfArgs:= (argl' is [['Tuple,:l]] => #l; 1)
+;        INTERNL("*",STRINGIMAGE numOfArgs,PNAME op)
+;      [op',:argl']
+;    op is ['Scripts,:.] => [:postTran op,:postTranList argl]
+;    u:= postTranList u
+;    if u is [['Tuple,:.],:.] then
+;      postError ['"  ",:bright u,
+;        '"is illegal because tuples cannot be applied!",'%l,
+;          '"   Did you misuse infix dot?"]
+;    u
+;  x is [.,['Tuple,:y]] => [first x,:y]
+;  x
+
+;;;     ***       |postForm| REDEFINED
+
+(DEFUN |postForm| (|u|) (PROG (|op| |argl| |argl'| |l| |numOfArgs| |op'| |x| |ISTMP#1| |ISTMP#2| |y|) (RETURN (SEQ (PROGN (SPADLET |op| (CAR |u|)) (SPADLET |argl| (CDR |u|)) (SPADLET |x| (COND ((ATOM |op|) (SPADLET |argl'| (|postTranList| |argl|)) (SPADLET |op'| (SEQ (EXIT |op|) (COND ($BOOT (EXIT |op|))) (COND ((OR (GETL |op| (QUOTE |Led|)) (GETL |op| (QUOTE |Nud|)) (BOOT-EQUAL |op| (QUOTE IN))) (EXIT |op|))) (SPADLET |numOfArgs| (COND ((AND (PAIRP |argl'|) (EQ (QCDR |argl'|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |argl'|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) (|#| |l|)) ((QUOTE T) 1))) (INTERNL (QUOTE *) (STRINGIMAGE |numOfArgs|) (PNAME |op|)))) (CONS |op'| |argl'|)) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |Scripts|))) (APPEND (|postTran| |op|) (|postTranList| |argl|))) ((QUOTE T) (SPADLET |u| (|postTranList| |u|)) (COND ((AND (PAIRP |u|) (PROGN (SPADLET |ISTMP#1| (QCAR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Tuple|))))) (|postError| (CONS (MAKESTRING "  ") (APPEND (|bright| |u|) (CONS (MAKESTRING "is illegal because tuples cannot be applied!") (CONS (QUOTE |%l|) (CONS (MAKESTRING "   Did you misuse infix dot?") NIL)))))))) |u|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS (CAR |x|) |y|)) ((QUOTE T) |x|))))))) 
+;postQuote [.,a] == ['QUOTE,a]
+
+;;;     ***       |postQuote| REDEFINED
+
+(DEFUN |postQuote| (#0=#:G167035) (PROG (|a|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (CONS (QUOTE QUOTE) (CONS |a| NIL)))))) 
+;postScriptsForm(['Scripts,op,a],argl) ==
+;  [getScriptName(op,a,#argl),:postTranScripts a,:argl]
+
+;;;     ***       |postScriptsForm| REDEFINED
+
+(DEFUN |postScriptsForm| (#0=#:G167046 |argl|) (PROG (|op| |a|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |a| (CADDR #0#)) (CONS (|getScriptName| |op| |a| (|#| |argl|)) (APPEND (|postTranScripts| |a|) |argl|)))))) 
+;postScripts ['Scripts,op,a] ==
+;  [getScriptName(op,a,0),:postTranScripts a]
+
+;;;     ***       |postScripts| REDEFINED
+
+(DEFUN |postScripts| (#0=#:G167060) (PROG (|op| |a|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |a| (CADDR #0#)) (CONS (|getScriptName| |op| |a| 0) (|postTranScripts| |a|)))))) 
+;getScriptName(op,a,numberOfFunctionalArgs) ==
+;  if null IDENTP op then
+;    postError ['"   ",op,'" cannot have scripts"]
+;  INTERNL("*",STRINGIMAGE numberOfFunctionalArgs,
+;    decodeScripts a,PNAME op)
+
+;;;     ***       |getScriptName| REDEFINED
+
+(DEFUN |getScriptName| (|op| |a| |numberOfFunctionalArgs|) (PROGN (COND ((NULL (IDENTP |op|)) (|postError| (CONS (MAKESTRING "   ") (CONS |op| (CONS (MAKESTRING " cannot have scripts") NIL)))))) (INTERNL (QUOTE *) (STRINGIMAGE |numberOfFunctionalArgs|) (|decodeScripts| |a|) (PNAME |op|)))) 
+;postTranScripts a ==
+;  a is ['PrefixSC,b] => postTranScripts b
+;  a is [";",:b] => "append"/[postTranScripts y for y in b]
+;  a is [",",:b] =>
+;    ("append"/[fn postTran y for y in b]) where
+;      fn x ==
+;        x is ['Tuple,:y] => y
+;        LIST x
+;  LIST postTran a
+
+;;;     ***       |postTranScripts,fn| REDEFINED
+
+(DEFUN |postTranScripts,fn| (|x|) (PROG (|y|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (EXIT |y|)) (EXIT (LIST |x|)))))) 
+
+;;;     ***       |postTranScripts| REDEFINED
+
+(DEFUN |postTranScripts| (|a|) (PROG (|ISTMP#1| |b|) (RETURN (SEQ (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |PrefixSC|)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (|postTranScripts| |b|)) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |;|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (PROG (#0=#:G167089) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167094 |b| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|postTranScripts| |y|))))))))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (PROG (#2=#:G167100) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G167105 |b| (CDR #3#)) (|y| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |y| (CAR #3#)) NIL)) #2#) (SEQ (EXIT (SETQ #2# (APPEND #2# (|postTranScripts,fn| (|postTran| |y|)))))))))) ((QUOTE T) (LIST (|postTran| |a|)))))))) 
+;decodeScripts a ==
+;  a is ['PrefixSC,b] => STRCONC(STRINGIMAGE 0,decodeScripts b)
+;  a is [";",:b] => APPLX('STRCONC,[decodeScripts x for x in b])
+;  a is [",",:b] =>
+;    STRINGIMAGE fn a where fn a == (a is [",",:b] => +/[fn x for x in b]; 1)
+;  STRINGIMAGE 1
+
+;;;     ***       |decodeScripts,fn| REDEFINED
+
+(DEFUN |decodeScripts,fn| (|a|) (PROG (|b|) (RETURN (SEQ (IF (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (EXIT (PROG (#0=#:G167125) (SPADLET #0# 0) (RETURN (DO ((#1=#:G167130 |b| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (PLUS #0# (|decodeScripts,fn| |x|)))))))))) (EXIT 1))))) 
+
+;;;     ***       |decodeScripts| REDEFINED
+
+(DEFUN |decodeScripts| (|a|) (PROG (|ISTMP#1| |b|) (RETURN (SEQ (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |PrefixSC|)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (STRCONC (STRINGIMAGE 0) (|decodeScripts| |b|))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |;|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (APPLX (QUOTE STRCONC) (PROG (#0=#:G167147) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167152 |b| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|decodeScripts| |x|) #0#))))))))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (STRINGIMAGE (|decodeScripts,fn| |a|))) ((QUOTE T) (STRINGIMAGE 1))))))) 
+;postIf t ==
+;  t isnt ['if,:l] => t
+;  ['IF,:[(null (x:= postTran x) and null $BOOT => 'noBranch; x)
+;    for x in l]]
+
+;;;     ***       |postIf| REDEFINED
+
+(DEFUN |postIf| (|t|) (PROG (|l| |x|) (RETURN (SEQ (COND ((NULL (AND (PAIRP |t|) (EQ (QCAR |t|) (QUOTE |if|)) (PROGN (SPADLET |l| (QCDR |t|)) (QUOTE T)))) |t|) ((QUOTE T) (CONS (QUOTE IF) (PROG (#0=#:G167172) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167177 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((AND (NULL (SPADLET |x| (|postTran| |x|))) (NULL $BOOT)) (QUOTE |noBranch|)) ((QUOTE T) |x|)) #0#)))))))))))))) 
+;postJoin ['Join,a,:l] ==
+;  a:= postTran a
+;  l:= postTranList l
+;  if l is [b] and b is [name,:.] and MEMQ(name,'(ATTRIBUTE SIGNATURE)) then l
+;    := LIST ['CATEGORY,b]
+;  al:=
+;    a is ['Tuple,:c] => c
+;    LIST a
+;  ['Join,:al,:l]
+
+;;;     ***       |postJoin| REDEFINED
+
+(DEFUN |postJoin| (#0=#:G167191) (PROG (|a| |b| |name| |l| |c| |al|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |l| (CDDR #0#)) (SPADLET |a| (|postTran| |a|)) (SPADLET |l| (|postTranList| |l|)) (COND ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) (PROGN (SPADLET |b| (QCAR |l|)) (QUOTE T)) (PAIRP |b|) (PROGN (SPADLET |name| (QCAR |b|)) (QUOTE T)) (MEMQ |name| (QUOTE (ATTRIBUTE SIGNATURE)))) (SPADLET |l| (LIST (CONS (QUOTE CATEGORY) (CONS |b| NIL)))))) (SPADLET |al| (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |Tuple|)) (PROGN (SPADLET |c| (QCDR |a|)) (QUOTE T))) |c|) ((QUOTE T) (LIST |a|)))) (CONS (QUOTE |Join|) (APPEND |al| |l|)))))) 
+;postMapping u  ==
+;  u isnt ["->",source,target] => u
+;  ['Mapping,postTran target,:unTuple postTran source]
+
+;;;     ***       |postMapping| REDEFINED
+
+(DEFUN |postMapping| (|u|) (PROG (|ISTMP#1| |source| |ISTMP#2| |target|) (RETURN (COND ((NULL (AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |source| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#2|)) (QUOTE T)))))))) |u|) ((QUOTE T) (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) (|unTuple| (|postTran| |source|))))))))) 
+;postOp x ==
+;  x=":=" =>
+;    $BOOT => 'SPADLET
+;    'LET
+;  x=":-" => 'LETD
+;  x='Attribute => 'ATTRIBUTE
+;  x
+
+;;;     ***       |postOp| REDEFINED
+
+(DEFUN |postOp| (|x|) (COND ((BOOT-EQUAL |x| (QUOTE |:=|)) (COND ($BOOT (QUOTE SPADLET)) ((QUOTE T) (QUOTE LET)))) ((BOOT-EQUAL |x| (QUOTE |:-|)) (QUOTE LETD)) ((BOOT-EQUAL |x| (QUOTE |Attribute|)) (QUOTE ATTRIBUTE)) ((QUOTE T) |x|))) 
+;postRepeat ['REPEAT,:m,x] == ['REPEAT,:postIteratorList m,postTran x]
+
+;;;     ***       |postRepeat| REDEFINED
+
+(DEFUN |postRepeat| (#0=#:G167247) (PROG (|LETTMP#1| |x| |m|) (RETURN (PROGN (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (CONS (QUOTE REPEAT) (APPEND (|postIteratorList| |m|) (CONS (|postTran| |x|) NIL))))))) 
+;postSEGMENT ['SEGMENT,a,b] ==
+;  key:= [a,'"..",:(b => [b]; nil)]
+;  postError ['"   Improper placement of segment",:bright key]
+
+;;;     ***       |postSEGMENT| REDEFINED
+
+(DEFUN |postSEGMENT| (#0=#:G167266) (PROG (|a| |b| |key|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (SPADLET |key| (CONS |a| (CONS (MAKESTRING "..") (COND (|b| (CONS |b| NIL)) ((QUOTE T) NIL))))) (|postError| (CONS (MAKESTRING "   Improper placement of segment") (|bright| |key|))))))) 
+;postCollect [constructOp,:m,x] ==
+;  x is [['elt,D,'construct],:y] =>
+;    postCollect [['elt,D,'COLLECT],:m,['construct,:y]]
+;  itl:= postIteratorList m
+;  x:= (x is ['construct,r] => r; x)  --added 84/8/31
+;  y:= postTran x
+;  finish(constructOp,itl,y) where
+;    finish(op,itl,y) ==
+;      y is [":",a] => ['REDUCE,'append,0,[op,:itl,a]]
+;      y is ['Tuple,:l] =>
+;        newBody:=
+;          or/[x is [":",y] for x in l] => postMakeCons l
+;          or/[x is ['SEGMENT,:.] for x in l] => tuple2List l
+;          ['construct,:postTranList l]
+;        ['REDUCE,'append,0,[op,:itl,newBody]]
+;      [op,:itl,y]
+
+;;;     ***       |postCollect,finish| REDEFINED
+
+(DEFUN |postCollect,finish| (|op| |itl| |y|) (PROG (|a| |l| |ISTMP#1| |newBody|) (RETURN (SEQ (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |a| NIL))) NIL)))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |y|)) (QUOTE T))) (EXIT (SEQ (SPADLET |newBody| (SEQ (IF (PROG (#0=#:G167314) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167324 NIL #0#) (#2=#:G167325 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (EXIT (|postMakeCons| |l|))) (IF (PROG (#3=#:G167332) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G167338 NIL #3#) (#5=#:G167339 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (EXIT (|tuple2List| |l|))) (EXIT (CONS (QUOTE |construct|) (|postTranList| |l|))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |newBody| NIL))) NIL)))))))) (EXIT (CONS |op| (APPEND |itl| (CONS |y| NIL)))))))) 
+
+;;;     ***       |postCollect| REDEFINED
+
+(DEFUN |postCollect| (#0=#:G167359) (PROG (|constructOp| |LETTMP#1| |m| |ISTMP#2| D |ISTMP#3| |itl| |ISTMP#1| |r| |x| |y|) (RETURN (PROGN (SPADLET |constructOp| (CAR #0#)) (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCAR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET D (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (EQ (QCAR |ISTMP#3|) (QUOTE |construct|)))))))) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (|postCollect| (CONS (CONS (QUOTE |elt|) (CONS D (CONS (QUOTE COLLECT) NIL))) (APPEND |m| (CONS (CONS (QUOTE |construct|) |y|) NIL))))) ((QUOTE T) (SPADLET |itl| (|postIteratorList| |m|)) (SPADLET |x| (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |r| (QCAR |ISTMP#1|)) (QUOTE T))))) |r|) ((QUOTE T) |x|))) (SPADLET |y| (|postTran| |x|)) (|postCollect,finish| |constructOp| |itl| |y|))))))) 
+;postTupleCollect [constructOp,:m,x] ==
+;  postCollect [constructOp,:m,['construct,x]]
+
+;;;     ***       |postTupleCollect| REDEFINED
+
+(DEFUN |postTupleCollect| (#0=#:G167402) (PROG (|constructOp| |LETTMP#1| |x| |m|) (RETURN (PROGN (SPADLET |constructOp| (CAR #0#)) (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (|postCollect| (CONS |constructOp| (APPEND |m| (CONS (CONS (QUOTE |construct|) (CONS |x| NIL)) NIL)))))))) 
+;postIteratorList x ==
+;  x is [p,:l] =>
+;    (p:= postTran p) is ['IN,y,u] =>
+;      u is ["|",a,b] => [['IN,y,postInSeq a],["|",b],:postIteratorList l]
+;      [['IN,y,postInSeq u],:postIteratorList l]
+;    [p,:postIteratorList l]
+;  x
+
+;;;     ***       |postIteratorList| REDEFINED
+
+(DEFUN |postIteratorList| (|x|) (PROG (|l| |p| |y| |ISTMP#3| |u| |ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (PROGN (SPADLET |p| (QCAR |x|)) (SPADLET |l| (QCDR |x|)) (QUOTE T))) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |p| (|postTran| |p|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE IN)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#3|)) (QUOTE T)))))))) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |\||)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (CONS (QUOTE IN) (CONS |y| (CONS (|postInSeq| |a|) NIL))) (CONS (CONS (QUOTE |\||) (CONS |b| NIL)) (|postIteratorList| |l|)))) ((QUOTE T) (CONS (CONS (QUOTE IN) (CONS |y| (CONS (|postInSeq| |u|) NIL))) (|postIteratorList| |l|))))) ((QUOTE T) (CONS |p| (|postIteratorList| |l|))))) ((QUOTE T) |x|))))) 
+;postin arg ==
+;  arg isnt ['in,i,seq] => systemErrorHere '"postin"
+;  ['in,postTran i, postInSeq seq]
+
+;;;     ***       |postin| REDEFINED
+
+(DEFUN |postin| (|arg|) (PROG (|ISTMP#1| |i| |ISTMP#2| |seq|) (RETURN (COND ((NULL (AND (PAIRP |arg|) (EQ (QCAR |arg|) (QUOTE |in|)) (PROGN (SPADLET |ISTMP#1| (QCDR |arg|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |i| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |seq| (QCAR |ISTMP#2|)) (QUOTE T)))))))) (|systemErrorHere| (MAKESTRING "postin"))) ((QUOTE T) (CONS (QUOTE |in|) (CONS (|postTran| |i|) (CONS (|postInSeq| |seq|) NIL)))))))) 
+;postIn arg ==
+;  arg isnt ['IN,i,seq] => systemErrorHere '"postIn"
+;  ['IN,postTran i,postInSeq seq]
+
+;;;     ***       |postIn| REDEFINED
+
+(DEFUN |postIn| (|arg|) (PROG (|ISTMP#1| |i| |ISTMP#2| |seq|) (RETURN (COND ((NULL (AND (PAIRP |arg|) (EQ (QCAR |arg|) (QUOTE IN)) (PROGN (SPADLET |ISTMP#1| (QCDR |arg|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |i| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |seq| (QCAR |ISTMP#2|)) (QUOTE T)))))))) (|systemErrorHere| (MAKESTRING "postIn"))) ((QUOTE T) (CONS (QUOTE IN) (CONS (|postTran| |i|) (CONS (|postInSeq| |seq|) NIL)))))))) 
+;postInSeq seq ==
+;  seq is ['SEGMENT,p,q] => postTranSegment(p,q)
+;  seq is ['Tuple,:l] => tuple2List l
+;  postTran seq
+
+;;;     ***       |postInSeq| REDEFINED
+
+(DEFUN |postInSeq| (|seq|) (PROG (|ISTMP#1| |p| |ISTMP#2| |q| |l|) (RETURN (COND ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |seq|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|postTranSegment| |p| |q|)) ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |seq|)) (QUOTE T))) (|tuple2List| |l|)) ((QUOTE T) (|postTran| |seq|)))))) 
+;postTranSegment(p,q) == ['SEGMENT,postTran p,(q => postTran q; nil)]
+
+;;;     ***       |postTranSegment| REDEFINED
+
+(DEFUN |postTranSegment| (|p| |q|) (CONS (QUOTE SEGMENT) (CONS (|postTran| |p|) (CONS (COND (|q| (|postTran| |q|)) ((QUOTE T) NIL)) NIL)))) 
+;tuple2List l ==
+;  l is [a,:l'] =>
+;    u:= tuple2List l'
+;    a is ['SEGMENT,p,q] =>
+;      null u => ['construct,postTranSegment(p,q)]
+;      $InteractiveMode and null $BOOT =>
+;        ['append,['construct,postTranSegment(p,q)],tuple2List l']
+;      ["nconc",['construct,postTranSegment(p,q)],tuple2List l']
+;    null u => ['construct,postTran a]
+;    ["cons",postTran a,tuple2List l']
+;  nil
+
+;;;     ***       |tuple2List| REDEFINED
+
+(DEFUN |tuple2List| (|l|) (PROG (|a| |l'| |u| |ISTMP#1| |p| |ISTMP#2| |q|) (RETURN (COND ((AND (PAIRP |l|) (PROGN (SPADLET |a| (QCAR |l|)) (SPADLET |l'| (QCDR |l|)) (QUOTE T))) (SPADLET |u| (|tuple2List| |l'|)) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((NULL |u|) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND |$InteractiveMode| (NULL $BOOT)) (CONS (QUOTE |append|) (CONS (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL)) (CONS (|tuple2List| |l'|) NIL)))) ((QUOTE T) (CONS (QUOTE |nconc|) (CONS (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL)) (CONS (|tuple2List| |l'|) NIL)))))) ((NULL |u|) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))) ((QUOTE T) (CONS (QUOTE |cons|) (CONS (|postTran| |a|) (CONS (|tuple2List| |l'|) NIL)))))) ((QUOTE T) NIL))))) 
+;SEGMENT(a,b) == [i for i in a..b]
+
+;;;     ***       SEGMENT REDEFINED
+
+(DEFUN SEGMENT (|a| |b|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G167597) (SPADLET #0# NIL) (RETURN (DO ((|i| |a| (+ |i| 1))) ((> |i| |b|) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS |i| #0#))))))))))) 
+;postReduce ['Reduce,op,expr] ==
+;  $InteractiveMode or expr is ['COLLECT,:.] =>
+;    ['REDUCE,op,0,postTran expr]
+;  postReduce ['Reduce,op,['COLLECT,['IN,g:= GENSYM(),expr],
+;    ['construct,  g]]]
+
+;;;     ***       |postReduce| REDEFINED
+
+(DEFUN |postReduce| (#0=#:G167610) (PROG (|op| |expr| |g|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |expr| (CADDR #0#)) (COND ((OR |$InteractiveMode| (AND (PAIRP |expr|) (EQ (QCAR |expr|) (QUOTE COLLECT)))) (CONS (QUOTE REDUCE) (CONS |op| (CONS 0 (CONS (|postTran| |expr|) NIL))))) ((QUOTE T) (|postReduce| (CONS (QUOTE |Reduce|) (CONS |op| (CONS (CONS (QUOTE COLLECT) (CONS (CONS (QUOTE IN) (CONS (SPADLET |g| (GENSYM)) (CONS |expr| NIL))) (CONS (CONS (QUOTE |construct|) (CONS |g| NIL)) NIL))) NIL)))))))))) 
+;postFlattenLeft(x,op) ==--
+;  x is [ =op,a,b] => [:postFlattenLeft(a,op),b]
+;  [x]
+
+;;;     ***       |postFlattenLeft| REDEFINED
+
+(DEFUN |postFlattenLeft| (|x| |op|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (EQUAL (QCAR |x|) |op|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (APPEND (|postFlattenLeft| |a| |op|) (CONS |b| NIL))) ((QUOTE T) (CONS |x| NIL)))))) 
+;postSemiColon u == postBlock ['Block,:postFlattenLeft(u,";")]
+
+;;;     ***       |postSemiColon| REDEFINED
+
+(DEFUN |postSemiColon| (|u|) (|postBlock| (CONS (QUOTE |Block|) (|postFlattenLeft| |u| (QUOTE |;|))))) 
+;postSequence ['Sequence,:l] == ['(elt $ makeRecord),:postTranList l]
+
+;;;     ***       |postSequence| REDEFINED
+
+(DEFUN |postSequence| (#0=#:G167652) (PROG (|l|) (RETURN (PROGN (SPADLET |l| (CDR #0#)) (CONS (QUOTE (|elt| $ |makeRecord|)) (|postTranList| |l|)))))) 
+;--------------------> NEW DEFINITION (see br-saturn.boot.pamphlet)
+;postSignature ['Signature,op,sig] ==
+;  sig is ["->",:.] =>
+;    sig1:= postType sig
+;    op:= postAtom (STRINGP op => INTERN op; op)
+;    ["SIGNATURE",op,:removeSuperfluousMapping killColons sig1]
+
+;;;     ***       |postSignature| REDEFINED
+
+(DEFUN |postSignature| (#0=#:G167665) (PROG (|sig| |sig1| |op|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |sig| (CADDR #0#)) (COND ((AND (PAIRP |sig|) (EQ (QCAR |sig|) (QUOTE ->))) (PROGN (SPADLET |sig1| (|postType| |sig|)) (SPADLET |op| (|postAtom| (COND ((STRINGP |op|) (INTERN |op|)) ((QUOTE T) |op|)))) (CONS (QUOTE SIGNATURE) (CONS |op| (|removeSuperfluousMapping| (|killColons| |sig1|))))))))))) 
+;killColons x ==
+;  atom x => x
+;  x is ['Record,:.] => x
+;  x is ['Union,:.] => x
+;  x is [":",.,y] => killColons y
+;  [killColons first x,:killColons rest x]
+
+;;;     ***       |killColons| REDEFINED
+
+(DEFUN |killColons| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |y|) (RETURN (COND ((ATOM |x|) |x|) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Record|))) |x|) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Union|))) |x|) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|killColons| |y|)) ((QUOTE T) (CONS (|killColons| (CAR |x|)) (|killColons| (CDR |x|)))))))) 
+;postSlash ['_/,a,b] ==
+;  STRINGP a => postTran ['Reduce,INTERN a,b]
+;  ['_/,postTran a,postTran b]
+
+;;;     ***       |postSlash| REDEFINED
+
+(DEFUN |postSlash| (#0=#:G167699) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (COND ((STRINGP |a|) (|postTran| (CONS (QUOTE |Reduce|) (CONS (INTERN |a|) (CONS |b| NIL))))) ((QUOTE T) (CONS (QUOTE /) (CONS (|postTran| |a|) (CONS (|postTran| |b|) NIL))))))))) 
+;removeSuperfluousMapping sig1 ==
+;  --get rid of this asap
+;  sig1 is [x,:y] and x is ['Mapping,:.] => [rest x,:y]
+;  sig1
+
+;;;     ***       |removeSuperfluousMapping| REDEFINED
+
+(DEFUN |removeSuperfluousMapping| (|sig1|) (PROG (|x| |y|) (RETURN (COND ((AND (PAIRP |sig1|) (PROGN (SPADLET |x| (QCAR |sig1|)) (SPADLET |y| (QCDR |sig1|)) (QUOTE T)) (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Mapping|))) (CONS (CDR |x|) |y|)) ((QUOTE T) |sig1|))))) 
+;postType typ ==
+;  typ is ["->",source,target] =>
+;    source="constant" => [LIST postTran target,"constant"]
+;    LIST ['Mapping,postTran target,:unTuple postTran source]
+;  typ is ["->",target] => LIST ['Mapping,postTran target]
+;  LIST postTran typ
+
+;;;     ***       |postType| REDEFINED
+
+(DEFUN |postType| (|typ|) (PROG (|source| |ISTMP#2| |ISTMP#1| |target|) (RETURN (COND ((AND (PAIRP |typ|) (EQ (QCAR |typ|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |typ|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |source| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((BOOT-EQUAL |source| (QUOTE |constant|)) (CONS (LIST (|postTran| |target|)) (CONS (QUOTE |constant|) NIL))) ((QUOTE T) (LIST (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) (|unTuple| (|postTran| |source|)))))))) ((AND (PAIRP |typ|) (EQ (QCAR |typ|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |typ|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#1|)) (QUOTE T))))) (LIST (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) NIL)))) ((QUOTE T) (LIST (|postTran| |typ|))))))) 
+;postTuple u ==
+;  u is ['Tuple] => u
+;  u is ['Tuple,:l,a] => (['Tuple,:postTranList rest u])
+
+;;;     ***       |postTuple| REDEFINED
+
+(DEFUN |postTuple| (|u|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (EQ (QCAR |u|) (QUOTE |Tuple|))) |u|) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (CONS (QUOTE |Tuple|) (|postTranList| (CDR |u|)))))))) 
+;--u is ['Tuple,:l,a] => (--a:= postTran a; ['Tuple,:postTranList rest u])
+;    --RDJ: don't understand need for above statement that is commented out
+;postWhere ['where,a,b] ==
+;  x:=
+;    b is ['Block,:c] => c
+;    LIST b
+;  ['where,postTran a,:postTranList x]
+
+;;;     ***       |postWhere| REDEFINED
+
+(DEFUN |postWhere| (#0=#:G167776) (PROG (|a| |b| |c| |x|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (SPADLET |x| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |Block|)) (PROGN (SPADLET |c| (QCDR |b|)) (QUOTE T))) |c|) ((QUOTE T) (LIST |b|)))) (CONS (QUOTE |where|) (CONS (|postTran| |a|) (|postTranList| |x|))))))) 
+;postWith ['with,a] ==
+;  $insidePostCategoryIfTrue: local := true
+;  a:= postTran a
+;  a is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE IF)) => ['CATEGORY,a]
+;  a is ['PROGN,:b] => ['CATEGORY,:b]
+;  a
+
+;;;     ***       |postWith| REDEFINED
+
+(DEFUN |postWith| (#0=#:G167795) (PROG (|$insidePostCategoryIfTrue| |a| |op| |b|) (DECLARE (SPECIAL |$insidePostCategoryIfTrue|)) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |$insidePostCategoryIfTrue| (QUOTE T)) (SPADLET |a| (|postTran| |a|)) (COND ((AND (PAIRP |a|) (PROGN (SPADLET |op| (QCAR |a|)) (QUOTE T)) (MEMQ |op| (QUOTE (SIGNATURE ATTRIBUTE IF)))) (CONS (QUOTE CATEGORY) (CONS |a| NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE PROGN)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (CONS (QUOTE CATEGORY) |b|)) ((QUOTE T) |a|)))))) 
+;postTransformCheck x ==
+;  $defOp: local:= nil
+;  postcheck x
+
+;;;     ***       |postTransformCheck| REDEFINED
+
+(DEFUN |postTransformCheck| (|x|) (PROG (|$defOp|) (DECLARE (SPECIAL |$defOp|)) (RETURN (PROGN (SPADLET |$defOp| NIL) (|postcheck| |x|))))) 
+;postcheck x ==
+;  atom x => nil
+;  x is ['DEF,form,[target,:.],:.] =>
+;    (setDefOp form; postcheckTarget target; postcheck rest rest x)
+;  x is ['QUOTE,:.] => nil
+;  postcheck first x
+;  postcheck rest x
+
+;;;     ***       |postcheck| REDEFINED
+
+(DEFUN |postcheck| (|x|) (PROG (|ISTMP#1| |form| |ISTMP#2| |ISTMP#3| |target|) (RETURN (COND ((ATOM |x|) NIL) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE DEF)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |form| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |target| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (|setDefOp| |form|) (|postcheckTarget| |target|) (|postcheck| (CDR (CDR |x|)))) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE QUOTE))) NIL) ((QUOTE T) (|postcheck| (CAR |x|)) (|postcheck| (CDR |x|))))))) 
+;setDefOp f ==
+;  if f is [":",g,:.] then f := g
+;  f := (atom f => f; first f)
+;  if $topOp then $defOp:= f else $topOp:= f
+
+;;;     ***       |setDefOp| REDEFINED
+
+(DEFUN |setDefOp| (|f|) (PROG (|ISTMP#1| |g|) (RETURN (PROGN (COND ((AND (PAIRP |f|) (EQ (QCAR |f|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |f|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |g| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |f| |g|))) (SPADLET |f| (COND ((ATOM |f|) |f|) ((QUOTE T) (CAR |f|)))) (COND (|$topOp| (SPADLET |$defOp| |f|)) ((QUOTE T) (SPADLET |$topOp| |f|))))))) 
+;postcheckTarget x ==
+;  -- doesn't seem that useful!
+;  isPackageType x => nil
+;  x is ['Join,:.] => nil
+;  NIL
+
+;;;     ***       |postcheckTarget| REDEFINED
+
+(DEFUN |postcheckTarget| (|x|) (COND ((|isPackageType| |x|) NIL) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Join|))) NIL) ((QUOTE T) NIL))) 
+;isPackageType x == not CONTAINED("$",x)
+
+;;;     ***       |isPackageType| REDEFINED
+
+(DEFUN |isPackageType| (|x|) (NULL (CONTAINED (QUOTE $) |x|))) 
+;unTuple x ==
+;  x is ['Tuple,:y] => y
+;  LIST x
+
+;;;     ***       |unTuple| REDEFINED
+
+(DEFUN |unTuple| (|x|) (PROG (|y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) |y|) ((QUOTE T) (LIST |x|)))))) 
+;--% APL TRANSFORMATION OF INPUT
+;aplTran x ==
+;  $BOOT => x
+;  $GENNO: local := 0
+;  u:= aplTran1 x
+;  containsBang u => throwKeyedMsg("S2IP0002",NIL)
+;  u
+
+;;;     ***       |aplTran| REDEFINED
+
+(DEFUN |aplTran| (|x|) (PROG ($GENNO |u|) (DECLARE (SPECIAL $GENNO)) (RETURN (COND ($BOOT |x|) ((QUOTE T) (SPADLET $GENNO 0) (SPADLET |u| (|aplTran1| |x|)) (COND ((|containsBang| |u|) (|throwKeyedMsg| (QUOTE S2IP0002) NIL)) ((QUOTE T) |u|))))))) 
+;containsBang u ==
+;  atom u => EQ(u,"!")
+;  u is [='QUOTE,.] => false
+;  or/[containsBang x for x in u]
+
+;;;     ***       |containsBang| REDEFINED
+
+(DEFUN |containsBang| (|u|) (PROG (|ISTMP#1|) (RETURN (SEQ (COND ((ATOM |u|) (EQ |u| (QUOTE !))) ((AND (PAIRP |u|) (EQUAL (QCAR |u|) (QUOTE QUOTE)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) NIL) ((QUOTE T) (PROG (#0=#:G167897) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167903 NIL #0#) (#2=#:G167904 |u| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (|containsBang| |x|)))))))))))))) 
+;aplTran1 x ==
+;  atom x => x
+;  [op,:argl1] := x
+;  argl := aplTranList argl1
+;  -- unary case f ! y
+;  op = "_!" =>
+;    argl is [f,y] =>
+;      y is [op',:y'] and op' = "_!" => aplTran1 [op,op,f,:y']
+;      $BOOT => ['COLLECT,['IN,g:=GENVAR(),aplTran1 y],[f,g]]
+;      ['map,f,aplTran1 y]
+;    x    --do not handle yet
+;  -- multiple argument case
+;  hasAplExtension argl is [arglAssoc,:futureArgl] =>
+;    -- choose the last aggregate type to be result of reshape
+;    ['reshape,['COLLECT,:[['IN,g,['ravel,a]] for [g,:a] in arglAssoc],
+;      aplTran1 [op,:futureArgl]],CDAR arglAssoc]
+;  [op,:argl]
+
+;;;     ***       |aplTran1| REDEFINED
+
+(DEFUN |aplTran1| (|x|) (PROG (|op| |argl1| |argl| |f| |y| |op'| |y'| |ISTMP#1| |arglAssoc| |futureArgl| |g| |a|) (RETURN (SEQ (COND ((ATOM |x|) |x|) ((QUOTE T) (SPADLET |op| (CAR |x|)) (SPADLET |argl1| (CDR |x|)) (SPADLET |argl| (|aplTranList| |argl1|)) (COND ((BOOT-EQUAL |op| (QUOTE !)) (COND ((AND (PAIRP |argl|) (PROGN (SPADLET |f| (QCAR |argl|)) (SPADLET |ISTMP#1| (QCDR |argl|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND ((AND (PAIRP |y|) (PROGN (SPADLET |op'| (QCAR |y|)) (SPADLET |y'| (QCDR |y|)) (QUOTE T)) (BOOT-EQUAL |op'| (QUOTE !))) (|aplTran1| (CONS |op| (CONS |op| (CONS |f| |y'|))))) ($BOOT (CONS (QUOTE COLLECT) (CONS (CONS (QUOTE IN) (CONS (SPADLET |g| (GENVAR)) (CONS (|aplTran1| |y|) NIL))) (CONS (CONS |f| (CONS |g| NIL)) NIL)))) ((QUOTE T) (CONS (QUOTE |map|) (CONS |f| (CONS (|aplTran1| |y|) NIL)))))) ((QUOTE T) |x|))) ((PROGN (SPADLET |ISTMP#1| (|hasAplExtension| |argl|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |arglAssoc| (QCAR |ISTMP#1|)) (SPADLET |futureArgl| (QCDR |ISTMP#1|)) (QUOTE T)))) (CONS (QUOTE |reshape|) (CONS (CONS (QUOTE COLLECT) (APPEND (PROG (#0=#:G167951) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167957 |arglAssoc| (CDR #1#)) (#2=#:G167941 NIL)) ((OR (ATOM #1#) (PROGN (SETQ #2# (CAR #1#)) NIL) (PROGN (PROGN (SPADLET |g| (CAR #2#)) (SPADLET |a| (CDR #2#)) #2#) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (CONS (QUOTE IN) (CONS |g| (CONS (CONS (QUOTE |ravel|) (CONS |a| NIL)) NIL))) #0#))))))) (CONS (|aplTran1| (CONS |op| |futureArgl|)) NIL))) (CONS (CDAR |arglAssoc|) NIL)))) ((QUOTE T) (CONS |op| |argl|))))))))) 
+;aplTranList x ==
+;  atom x => x
+;  [aplTran1 first x,:aplTranList rest x]
+
+;;;     ***       |aplTranList| REDEFINED
+
+(DEFUN |aplTranList| (|x|) (COND ((ATOM |x|) |x|) ((QUOTE T) (CONS (|aplTran1| (CAR |x|)) (|aplTranList| (CDR |x|)))))) 
+;hasAplExtension argl ==
+;  or/[x is ["_!",:.] for x in argl] =>
+;    u:= [futureArg for x in argl] where futureArg ==
+;      x is ["_!",y] =>
+;        z:= deepestExpression y
+;        arglAssoc := [[g := GENVAR(),:aplTran1 z],:arglAssoc]
+;        substitute(g,z,y)
+;      x
+;    [arglAssoc,:u]
+;  nil
+
+;;;     ***       |hasAplExtension| REDEFINED
+
+(DEFUN |hasAplExtension| (|argl|) (PROG (|ISTMP#1| |y| |z| |g| |arglAssoc| |u|) (RETURN (SEQ (COND ((PROG (#0=#:G167999) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G168005 NIL #0#) (#2=#:G168006 |argl| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE !)))))))))) (SPADLET |u| (PROG (#3=#:G168021) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G168030 |argl| (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE !)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |z| (|deepestExpression| |y|)) (SPADLET |arglAssoc| (CONS (CONS (SPADLET |g| (GENVAR)) (|aplTran1| |z|)) |arglAssoc|)) (MSUBST |g| |z| |y|)) ((QUOTE T) |x|)) #3#)))))))) (CONS |arglAssoc| |u|)) ((QUOTE T) NIL)))))) 
+;deepestExpression x ==
+;  x is ["_!",y] => deepestExpression y
+;  x
+
+;;;     ***       |deepestExpression| REDEFINED
+
+(DEFUN |deepestExpression| (|x|) (PROG (|ISTMP#1| |y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE !)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (|deepestExpression| |y|)) ((QUOTE T) |x|))))) 
+;;;Boot translation finished for postpar.boot
 \eject
 \begin{thebibliography}{99}
 \bibitem{1} nothing
diff --git a/src/interp/postpar.boot.pamphlet b/src/interp/postpar.boot.pamphlet
deleted file mode 100644
index 3497873..0000000
--- a/src/interp/postpar.boot.pamphlet
+++ /dev/null
@@ -1,1293 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp postpar.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-This file contains both the {\bf boot} code and the {\bf Lisp}
-code that is the result of the {\bf boot to lisp} translation.
-We need to keep the translated code around so we can bootstrap
-the system. In other words, we need this boot code translated
-so we can build the boot translator. 
-
-{\bf NOTE WELL: IF YOU CHANGE THIS BOOT CODE YOU MUST TRANSLATE
-THIS CODE TO LISP AND STORE THE RESULTING LISP CODE BACK INTO
-THIS FILE.}
-
-See the {\bf postpar.clisp} section below.
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- 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.
-
-@
-<<*>>=
-<<license>>
-
---% Yet Another Parser Transformation File
---These functions are used by for BOOT and SPAD code
---(see new2OldLisp, e.g.)
-
-postTransform y ==
-  x:= y
-  u:= postTran x
-  if u is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:=
-    [":",['LISTOF,:l,y],t]
-  postTransformCheck u
-  aplTran u
-
-displayPreCompilationErrors() ==
-  n:= #($postStack:= REMDUP NREVERSE $postStack)
-  n=0 => nil
-  errors:=
-    1<n => '"errors"
-    '"error"
-  if $InteractiveMode
-    then sayBrightly ['"   Semantic ",errors,'" detected: "]
-    else
-      heading:=
-        $topOp ^= '$topOp => ['"   ",$topOp,'" has"]
-        ['"   You have"]
-      sayBrightly [:heading,'%b,n,'%d,'"precompilation ",errors,'":"]
-  if 1<n then
-    (for x in $postStack for i in 1.. repeat sayMath ['"   ",i,'"_) ",:x])
-    else sayMath ['"    ",:first $postStack]
-  TERPRI()
-
-postTran x ==
-  atom x =>
-    postAtom x
-  op := first x
-  atom op and (f:= GET(op,'postTran)) => FUNCALL(f,x)
-  op is ['elt,a,b] =>
-    u:= postTran [b,:rest x]
-    [postTran op,:rest u]
-  op is ['Scripts,:.] =>
-    postScriptsForm(op,"append"/[unTuple postTran y for y in rest x])
-  op^=(y:= postOp op) => [y,:postTranList rest x]
-  postForm x
-
-postTranList x == [postTran y for y in x]
-
-postBigFloat x ==
-  [.,mant,:expon] := x
-  $BOOT => INT2RNUM(mant) * INT2RNUM(10) ** expon
-  eltword := if $InteractiveMode then "$elt" else 'elt
-  postTran [[eltword,'(Float),'float],[",",[",",mant,expon],10]]
-
-postAdd ['add,a,:b] ==
-  null b => postCapsule a
-  ['add,postTran a,postCapsule first b]
-
-checkWarning msg == postError concat('"Parsing error: ",msg)
- 
-checkWarningIndentation() ==
-  checkWarning ['"Apparent indentation error following",:bright "add"]
-
-postCapsule x ==
-  x isnt [op,:.] => checkWarningIndentation()
-  INTEGERP op or op = "==" => ['CAPSULE,postBlockItem x]
-  op = ";" => ['CAPSULE,:postBlockItemList postFlatten(x,";")]
-  op = "if" => ['CAPSULE,postBlockItem x]
-  checkWarningIndentation()
-
-postQUOTE x == x
-
-postColon u ==
-  u is [":",x] => [":",postTran x]
-  u is [":",x,y] => [":",postTran x,:postType y]
-
-postColonColon u ==
-  -- for Lisp package calling
-  -- boot syntax is package::fun but probably need to parenthesize it
-  $BOOT and u is ["::",package,fun] =>
-    INTERN(STRINGIMAGE fun, package)
-  postForm u
-
-postAtSign ["@",x,y] == ["@",postTran x,:postType y]
-
-postPretend ['pretend,x,y] == ['pretend,postTran x,:postType y]
-
-postConstruct u ==
-  u is ['construct,b] =>
-    a:= (b is [",",:.] => comma2Tuple b; b)
-    a is ['SEGMENT,p,q] => ['construct,postTranSegment(p,q)]
-    a is ['Tuple,:l] =>
-      or/[x is [":",y] for x in l] => postMakeCons l
-      or/[x is ['SEGMENT,:.] for x in l] => tuple2List l
-      ['construct,:postTranList l]
-    ['construct,postTran a]
-  u
-
-postError msg ==
-  BUMPERRORCOUNT 'precompilation
-  xmsg:=
-    $defOp ^= '$defOp and not InteractiveMode => [$defOp,'": ",:msg]
-    msg
-  $postStack:= [xmsg,:$postStack]
-  nil
-
-postMakeCons l ==
-  null l => 'nil
-  l is [[":",a],:l'] =>
-    l' => ['append,postTran a,postMakeCons l']
-    postTran a
-  ['cons,postTran first l,postMakeCons rest l]
-
-postAtom x ==
-  $BOOT => x
-  x=0 => '(Zero)
-  x=1 => '(One)
-  EQ(x,'T) => 'T_$ -- rename T in spad code to T$
-  IDENTP x and GETDATABASE(x,'NILADIC) => LIST x
-  x
-
-postBlock ['Block,:l,x] ==
-  ['SEQ,:postBlockItemList l,['exit,postTran x]]
-
-postBlockItemList l == [postBlockItem x for x in l]
-
-postBlockItem x ==
-  x:= postTran x
-  x is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>
-    [":",['LISTOF,:l,y],t]
-  x
-
-postCategory (u is ['CATEGORY,:l]) ==
-  --RDJ: ugh_ please -- someone take away need for PROGN as soon as possible
-  null l => u
-  op :=
-    $insidePostCategoryIfTrue = true => 'PROGN
-    'CATEGORY
-  [op,:[fn x for x in l]] where fn x ==
-    $insidePostCategoryIfTrue: local := true
-    postTran x
-
-postComma u == postTuple comma2Tuple u
-
-comma2Tuple u == ['Tuple,:postFlatten(u,",")]
-
-postDef [defOp,lhs,rhs] ==
---+
-  lhs is ["macro",name] => postMDef ["==>",name,rhs]
-
-  if not($BOOT) then recordHeaderDocumentation nil
-  if $maxSignatureLineNumber ^= 0 then
-    $docList := [['constructor,:$headerDocumentation],:$docList]
-    $maxSignatureLineNumber := 0
-    --reset this for next constructor; see recordDocumentation
-  lhs:= postTran lhs
-  [form,targetType]:=
-    lhs is [":",:.] => rest lhs
-    [lhs,nil]
-  if null $InteractiveMode and atom form then form := LIST form
-  newLhs:=
-    atom form => form
-    [op,:argl]:= [(x is [":",a,.] => a; x) for x in form]
-    [op,:postDefArgs argl]
-  argTypeList:=
-    atom form => nil
-    [(x is [":",.,t] => t; nil) for x in rest form]
-  typeList:= [targetType,:argTypeList]
-  if atom form then form := [form]
-  specialCaseForm := [nil for x in form]
-  ['DEF,newLhs,typeList,specialCaseForm,postTran rhs]
-
-postDefArgs argl ==
-  null argl => argl
-  argl is [[":",a],:b] =>
-    b => postError
-      ['"   Argument",:bright a,'"of indefinite length must be last"]
-    atom a or a is ['QUOTE,:.] => a
-    postError
-      ['"   Argument",:bright a,'"of indefinite length must be a name"]
-  [first argl,:postDefArgs rest argl]
-
-postMDef(t) ==
-  [.,lhs,rhs] := t
-  $InteractiveMode and not $BOOT =>
-    lhs := postTran lhs
-    null IDENTP lhs => throwKeyedMsg("S2IP0001",NIL)
-    ['MDEF,lhs,NIL,NIL,postTran rhs]
-  lhs:= postTran lhs
-  [form,targetType]:=
-    lhs is [":",:.] => rest lhs
-    [lhs,nil]
-  form:=
-    atom form => LIST form
-    form
-  newLhs:= [(x is [":",a,:.] => a; x) for x in form]
-  typeList:= [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]]
-  ['MDEF,newLhs,typeList,[nil for x in form],postTran rhs]
-
-postElt (u is [.,a,b]) ==
-  a:= postTran a
-  b is ['Sequence,:.] => [['elt,a,'makeRecord],:postTranList rest b]
-  ['elt,a,postTran b]
-
-postExit ["=>",a,b] == ['IF,postTran a,['exit,postTran b],'noBranch]
-
-
-postFlatten(x,op) ==
-  x is [ =op,a,b] => [:postFlatten(a,op),:postFlatten(b,op)]
-  LIST x
-
-postForm (u is [op,:argl]) ==
-  x:=
-    atom op =>
-      argl':= postTranList argl
-      op':=
-        true=> op
-        $BOOT => op
-        GET(op,'Led) or GET(op,'Nud) or op = 'IN => op
-        numOfArgs:= (argl' is [['Tuple,:l]] => #l; 1)
-        INTERNL("*",STRINGIMAGE numOfArgs,PNAME op)
-      [op',:argl']
-    op is ['Scripts,:.] => [:postTran op,:postTranList argl]
-    u:= postTranList u
-    if u is [['Tuple,:.],:.] then
-      postError ['"  ",:bright u,
-        '"is illegal because tuples cannot be applied!",'%l,
-          '"   Did you misuse infix dot?"]
-    u
-  x is [.,['Tuple,:y]] => [first x,:y]
-  x
-
-postQuote [.,a] == ['QUOTE,a]
-
-postScriptsForm(['Scripts,op,a],argl) ==
-  [getScriptName(op,a,#argl),:postTranScripts a,:argl]
-
-postScripts ['Scripts,op,a] ==
-  [getScriptName(op,a,0),:postTranScripts a]
-
-getScriptName(op,a,numberOfFunctionalArgs) ==
-  if null IDENTP op then
-    postError ['"   ",op,'" cannot have scripts"]
-  INTERNL("*",STRINGIMAGE numberOfFunctionalArgs,
-    decodeScripts a,PNAME op)
-
-postTranScripts a ==
-  a is ['PrefixSC,b] => postTranScripts b
-  a is [";",:b] => "append"/[postTranScripts y for y in b]
-  a is [",",:b] =>
-    ("append"/[fn postTran y for y in b]) where
-      fn x ==
-        x is ['Tuple,:y] => y
-        LIST x
-  LIST postTran a
-
-decodeScripts a ==
-  a is ['PrefixSC,b] => STRCONC(STRINGIMAGE 0,decodeScripts b)
-  a is [";",:b] => APPLX('STRCONC,[decodeScripts x for x in b])
-  a is [",",:b] =>
-    STRINGIMAGE fn a where fn a == (a is [",",:b] => +/[fn x for x in b]; 1)
-  STRINGIMAGE 1
-
-postIf t ==
-  t isnt ['if,:l] => t
-  ['IF,:[(null (x:= postTran x) and null $BOOT => 'noBranch; x)
-    for x in l]]
-
-postJoin ['Join,a,:l] ==
-  a:= postTran a
-  l:= postTranList l
-  if l is [b] and b is [name,:.] and MEMQ(name,'(ATTRIBUTE SIGNATURE)) then l
-    := LIST ['CATEGORY,b]
-  al:=
-    a is ['Tuple,:c] => c
-    LIST a
-  ['Join,:al,:l]
-
-postMapping u  ==
-  u isnt ["->",source,target] => u
-  ['Mapping,postTran target,:unTuple postTran source]
-
-postOp x ==
-  x=":=" =>
-    $BOOT => 'SPADLET
-    'LET
-  x=":-" => 'LETD
-  x='Attribute => 'ATTRIBUTE
-  x
-
-postRepeat ['REPEAT,:m,x] == ['REPEAT,:postIteratorList m,postTran x]
-
-postSEGMENT ['SEGMENT,a,b] ==
-  key:= [a,'"..",:(b => [b]; nil)]
-  postError ['"   Improper placement of segment",:bright key]
-
-postCollect [constructOp,:m,x] ==
-  x is [['elt,D,'construct],:y] =>
-    postCollect [['elt,D,'COLLECT],:m,['construct,:y]]
-  itl:= postIteratorList m
-  x:= (x is ['construct,r] => r; x)  --added 84/8/31
-  y:= postTran x
-  finish(constructOp,itl,y) where
-    finish(op,itl,y) ==
-      y is [":",a] => ['REDUCE,'append,0,[op,:itl,a]]
-      y is ['Tuple,:l] =>
-        newBody:=
-          or/[x is [":",y] for x in l] => postMakeCons l
-          or/[x is ['SEGMENT,:.] for x in l] => tuple2List l
-          ['construct,:postTranList l]
-        ['REDUCE,'append,0,[op,:itl,newBody]]
-      [op,:itl,y]
-
-postTupleCollect [constructOp,:m,x] ==
-  postCollect [constructOp,:m,['construct,x]]
-
-postIteratorList x ==
-  x is [p,:l] =>
-    (p:= postTran p) is ['IN,y,u] =>
-      u is ["|",a,b] => [['IN,y,postInSeq a],["|",b],:postIteratorList l]
-      [['IN,y,postInSeq u],:postIteratorList l]
-    [p,:postIteratorList l]
-  x
-
-postin arg ==
-  arg isnt ['in,i,seq] => systemErrorHere '"postin"
-  ['in,postTran i, postInSeq seq]
-
-postIn arg ==
-  arg isnt ['IN,i,seq] => systemErrorHere '"postIn"
-  ['IN,postTran i,postInSeq seq]
-
-postInSeq seq ==
-  seq is ['SEGMENT,p,q] => postTranSegment(p,q)
-  seq is ['Tuple,:l] => tuple2List l
-  postTran seq
-
-postTranSegment(p,q) == ['SEGMENT,postTran p,(q => postTran q; nil)]
-
-tuple2List l ==
-  l is [a,:l'] =>
-    u:= tuple2List l'
-    a is ['SEGMENT,p,q] =>
-      null u => ['construct,postTranSegment(p,q)]
-      $InteractiveMode and null $BOOT =>
-        ['append,['construct,postTranSegment(p,q)],tuple2List l']
-      ["nconc",['construct,postTranSegment(p,q)],tuple2List l']
-    null u => ['construct,postTran a]
-    ["cons",postTran a,tuple2List l']
-  nil
-
-SEGMENT(a,b) == [i for i in a..b]
-
-postReduce ['Reduce,op,expr] ==
-  $InteractiveMode or expr is ['COLLECT,:.] =>
-    ['REDUCE,op,0,postTran expr]
-  postReduce ['Reduce,op,['COLLECT,['IN,g:= GENSYM(),expr],
-    ['construct,  g]]]
-
-postFlattenLeft(x,op) ==--
-  x is [ =op,a,b] => [:postFlattenLeft(a,op),b]
-  [x]
-
-postSemiColon u == postBlock ['Block,:postFlattenLeft(u,";")]
-
-postSequence ['Sequence,:l] == ['(elt $ makeRecord),:postTranList l]
-
---------------------> NEW DEFINITION (see br-saturn.boot.pamphlet)
-postSignature ['Signature,op,sig] ==
-  sig is ["->",:.] =>
-    sig1:= postType sig
-    op:= postAtom (STRINGP op => INTERN op; op)
-    ["SIGNATURE",op,:removeSuperfluousMapping killColons sig1]
-
-killColons x ==
-  atom x => x
-  x is ['Record,:.] => x
-  x is ['Union,:.] => x
-  x is [":",.,y] => killColons y
-  [killColons first x,:killColons rest x]
-
-postSlash ['_/,a,b] ==
-  STRINGP a => postTran ['Reduce,INTERN a,b]
-  ['_/,postTran a,postTran b]
-
-removeSuperfluousMapping sig1 ==
-  --get rid of this asap
-  sig1 is [x,:y] and x is ['Mapping,:.] => [rest x,:y]
-  sig1
-
-postType typ ==
-  typ is ["->",source,target] =>
-    source="constant" => [LIST postTran target,"constant"]
-    LIST ['Mapping,postTran target,:unTuple postTran source]
-  typ is ["->",target] => LIST ['Mapping,postTran target]
-  LIST postTran typ
-
-postTuple u ==
-  u is ['Tuple] => u
-  u is ['Tuple,:l,a] => (['Tuple,:postTranList rest u])
---u is ['Tuple,:l,a] => (--a:= postTran a; ['Tuple,:postTranList rest u])
-    --RDJ: don't understand need for above statement that is commented out
-
-postWhere ['where,a,b] ==
-  x:=
-    b is ['Block,:c] => c
-    LIST b
-  ['where,postTran a,:postTranList x]
-
-postWith ['with,a] ==
-  $insidePostCategoryIfTrue: local := true
-  a:= postTran a
-  a is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE IF)) => ['CATEGORY,a]
-  a is ['PROGN,:b] => ['CATEGORY,:b]
-  a
-
-postTransformCheck x ==
-  $defOp: local:= nil
-  postcheck x
-
-postcheck x ==
-  atom x => nil
-  x is ['DEF,form,[target,:.],:.] =>
-    (setDefOp form; postcheckTarget target; postcheck rest rest x)
-  x is ['QUOTE,:.] => nil
-  postcheck first x
-  postcheck rest x
-
-setDefOp f ==
-  if f is [":",g,:.] then f := g
-  f := (atom f => f; first f)
-  if $topOp then $defOp:= f else $topOp:= f
-
-postcheckTarget x ==
-  -- doesn't seem that useful!
-  isPackageType x => nil
-  x is ['Join,:.] => nil
-  NIL
-
-isPackageType x == not CONTAINED("$",x)
-
-unTuple x ==
-  x is ['Tuple,:y] => y
-  LIST x
-
---% APL TRANSFORMATION OF INPUT
-
-aplTran x ==
-  $BOOT => x
-  $GENNO: local := 0
-  u:= aplTran1 x
-  containsBang u => throwKeyedMsg("S2IP0002",NIL)
-  u
-
-containsBang u ==
-  atom u => EQ(u,"!")
-  u is [='QUOTE,.] => false
-  or/[containsBang x for x in u]
-
-aplTran1 x ==
-  atom x => x
-  [op,:argl1] := x
-  argl := aplTranList argl1
-  -- unary case f ! y
-  op = "_!" =>
-    argl is [f,y] =>
-      y is [op',:y'] and op' = "_!" => aplTran1 [op,op,f,:y']
-      $BOOT => ['COLLECT,['IN,g:=GENVAR(),aplTran1 y],[f,g]]
-      ['map,f,aplTran1 y]
-    x    --do not handle yet
-  -- multiple argument case
-  hasAplExtension argl is [arglAssoc,:futureArgl] =>
-    -- choose the last aggregate type to be result of reshape
-    ['reshape,['COLLECT,:[['IN,g,['ravel,a]] for [g,:a] in arglAssoc],
-      aplTran1 [op,:futureArgl]],CDAR arglAssoc]
-  [op,:argl]
-
-aplTranList x ==
-  atom x => x
-  [aplTran1 first x,:aplTranList rest x]
-
-hasAplExtension argl ==
-  or/[x is ["_!",:.] for x in argl] =>
-    u:= [futureArg for x in argl] where futureArg ==
-      x is ["_!",y] =>
-        z:= deepestExpression y
-        arglAssoc := [[g := GENVAR(),:aplTran1 z],:arglAssoc]
-        substitute(g,z,y)
-      x
-    [arglAssoc,:u]
-  nil
-
-deepestExpression x ==
-  x is ["_!",y] => deepestExpression y
-  x
-@
-\section{postpar.clisp}
-<<postpar.clisp>>=
-
-(IN-PACKAGE "BOOT" )
-
-;--% Yet Another Parser Transformation File
-;--These functions are used by for BOOT and SPAD code
-;--(see new2OldLisp, e.g.)
-;postTransform y ==
-;  x:= y
-;  u:= postTran x
-;  if u is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:=
-;    [":",['LISTOF,:l,y],t]
-;  postTransformCheck u
-;  aplTran u
-
-;;;     ***       |postTransform| REDEFINED
-
-(DEFUN |postTransform| (|y|) (PROG (|x| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |t| |l| |u|) (RETURN (SEQ (PROGN (SPADLET |x| |y|) (SPADLET |u| (|postTran| |x|)) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G2336) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G2342 NIL (NULL #0#)) (#2=#:G2343 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (SPADLET |u| (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))))) (|postTransformCheck| |u|) (|aplTran| |u|)))))) 
-;displayPreCompilationErrors() ==
-;  n:= #($postStack:= REMDUP NREVERSE $postStack)
-;  n=0 => nil
-;  errors:=
-;    1<n => '"errors"
-;    '"error"
-;  if $InteractiveMode
-;    then sayBrightly ['"   Semantic ",errors,'" detected: "]
-;    else
-;      heading:=
-;        $topOp ^= '$topOp => ['"   ",$topOp,'" has"]
-;        ['"   You have"]
-;      sayBrightly [:heading,'%b,n,'%d,'"precompilation ",errors,'":"]
-;  if 1<n then
-;    (for x in $postStack for i in 1.. repeat sayMath ['"   ",i,'"_) ",:x])
-;    else sayMath ['"    ",:first $postStack]
-;  TERPRI()
-
-;;;     ***       |displayPreCompilationErrors| REDEFINED
-
-(DEFUN |displayPreCompilationErrors| NIL (PROG (|n| |errors| |heading|) (RETURN (SEQ (PROGN (SPADLET |n| (|#| (SPADLET |$postStack| (REMDUP (NREVERSE |$postStack|))))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (SPADLET |errors| (COND ((> |n| 1) (MAKESTRING "errors")) ((QUOTE T) (MAKESTRING "error")))) (COND (|$InteractiveMode| (|sayBrightly| (CONS (MAKESTRING "   Semantic ") (CONS |errors| (CONS (MAKESTRING " detected: ") NIL))))) ((QUOTE T) (SPADLET |heading| (COND ((NEQUAL |$topOp| (QUOTE |$topOp|)) (CONS (MAKESTRING "   ") (CONS |$topOp| (CONS (MAKESTRING " has") NIL)))) ((QUOTE T) (CONS (MAKESTRING "   You have") NIL)))) (|sayBrightly| (APPEND |heading| (CONS (QUOTE |%b|) (CONS |n| (CONS (QUOTE |%d|) (CONS (MAKESTRING "precompilation ") (CONS |errors| (CONS (MAKESTRING ":") NIL)))))))))) (COND ((> |n| 1) (DO ((#0=#:G2374 |$postStack| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayMath| (CONS (MAKESTRING "   ") (CONS |i| (CONS (MAKESTRING ") ") |x|)))))))) ((QUOTE T) (|sayMath| (CONS (MAKESTRING "    ") (CAR |$postStack|))))) (TERPRI)))))))) 
-;postTran x ==
-;  atom x =>
-;    postAtom x
-;  op := first x
-;  atom op and (f:= GET(op,'postTran)) => FUNCALL(f,x)
-;  op is ['elt,a,b] =>
-;    u:= postTran [b,:rest x]
-;    [postTran op,:rest u]
-;  op is ['Scripts,:.] =>
-;    postScriptsForm(op,"append"/[unTuple postTran y for y in rest x])
-;  op^=(y:= postOp op) => [y,:postTranList rest x]
-;  postForm x
-
-;;;     ***       |postTran| REDEFINED
-
-(DEFUN |postTran| (|x|) (PROG (|op| |f| |ISTMP#1| |a| |ISTMP#2| |b| |u| |y|) (RETURN (SEQ (COND ((ATOM |x|) (|postAtom| |x|)) ((QUOTE T) (SPADLET |op| (CAR |x|)) (COND ((AND (ATOM |op|) (SPADLET |f| (GETL |op| (QUOTE |postTran|)))) (FUNCALL |f| |x|)) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#1| (QCDR |op|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |u| (|postTran| (CONS |b| (CDR |x|)))) (CONS (|postTran| |op|) (CDR |u|))) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |Scripts|))) (|postScriptsForm| |op| (PROG (#0=#:G2405) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2410 (CDR |x|) (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|unTuple| (|postTran| |y|))))))))))) ((NEQUAL |op| (SPADLET |y| (|postOp| |op|))) (CONS |y| (|postTranList| (CDR |x|)))) ((QUOTE T) (|postForm| |x|))))))))) 
-;postTranList x == [postTran y for y in x]
-
-;;;     ***       |postTranList| REDEFINED
-
-(DEFUN |postTranList| (|x|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G2432) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2437 |x| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postTran| |y|) #0#))))))))))) 
-;postBigFloat x ==
-;  [.,mant,:expon] := x
-;  $BOOT => INT2RNUM(mant) * INT2RNUM(10) ** expon
-;  eltword := if $InteractiveMode then "$elt" else 'elt
-;  postTran [[eltword,'(Float),'float],[",",[",",mant,expon],10]]
-
-;;;     ***       |postBigFloat| REDEFINED
-
-(DEFUN |postBigFloat| (|x|) (PROG (|mant| |expon| |eltword|) (RETURN (PROGN (SPADLET |mant| (CADR |x|)) (SPADLET |expon| (CDDR |x|)) (COND ($BOOT (TIMES (INT2RNUM |mant|) (EXPT (INT2RNUM 10) |expon|))) ((QUOTE T) (SPADLET |eltword| (COND (|$InteractiveMode| (QUOTE |$elt|)) ((QUOTE T) (QUOTE |elt|)))) (|postTran| (CONS (CONS |eltword| (CONS (QUOTE (|Float|)) (CONS (QUOTE |float|) NIL))) (CONS (CONS (QUOTE |,|) (CONS (CONS (QUOTE |,|) (CONS |mant| (CONS |expon| NIL))) (CONS 10 NIL))) NIL))))))))) 
-;postAdd ['add,a,:b] ==
-;  null b => postCapsule a
-;  ['add,postTran a,postCapsule first b]
-
-;;;     ***       |postAdd| REDEFINED
-
-(DEFUN |postAdd| (#0=#:G2458) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CDDR #0#)) (COND ((NULL |b|) (|postCapsule| |a|)) ((QUOTE T) (CONS (QUOTE |add|) (CONS (|postTran| |a|) (CONS (|postCapsule| (CAR |b|)) NIL))))))))) 
-;checkWarning msg == postError concat('"Parsing error: ",msg)
-
-(DEFUN |checkWarning| (|msg|) (|postError| (|concat| (MAKESTRING "Parsing error: ") |msg|))) 
-;
-;checkWarningIndentation() ==
-;  checkWarning ['"Apparent indentation error following",:bright "add"]
-
-(DEFUN |checkWarningIndentation| NIL (|checkWarning| (CONS (MAKESTRING "Apparent indentation error following") (|bright| (QUOTE |add|))))) 
-;postCapsule x ==
-;  x isnt [op,:.] => checkWarningIndentation()
-;  INTEGERP op or op = "==" => ['CAPSULE,postBlockItem x]
-;  op = ";" => ['CAPSULE,:postBlockItemList postFlatten(x,";")]
-;  op = "if" => ['CAPSULE,postBlockItem x]
-;  checkWarningIndentation()
-
-;;;     ***       |postCapsule| REDEFINED
-
-(DEFUN |postCapsule| (|x|) (PROG (|op|) (RETURN (COND ((NULL (AND (PAIRP |x|) (PROGN (SPADLET |op| (QCAR |x|)) (QUOTE T)))) (|checkWarningIndentation|)) ((OR (INTEGERP |op|) (BOOT-EQUAL |op| (QUOTE ==))) (CONS (QUOTE CAPSULE) (CONS (|postBlockItem| |x|) NIL))) ((BOOT-EQUAL |op| (QUOTE |;|)) (CONS (QUOTE CAPSULE) (|postBlockItemList| (|postFlatten| |x| (QUOTE |;|))))) ((BOOT-EQUAL |op| (QUOTE |if|)) (CONS (QUOTE CAPSULE) (CONS (|postBlockItem| |x|) NIL))) ((QUOTE T) (|checkWarningIndentation|)))))) 
-;postQUOTE x == x
-
-;;;     ***       |postQUOTE| REDEFINED
-
-(DEFUN |postQUOTE| (|x|) |x|) 
-;postColon u ==
-;  u is [":",x] => [":",postTran x]
-;  u is [":",x,y] => [":",postTran x,:postType y]
-
-;;;     ***       |postColon| REDEFINED
-
-(DEFUN |postColon| (|u|) (PROG (|ISTMP#1| |x| |ISTMP#2| |y|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE |:|) (CONS (|postTran| |x|) NIL))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |:|) (CONS (|postTran| |x|) (|postType| |y|)))))))) 
-;postColonColon u ==
-;  -- for Lisp package calling
-;  -- boot syntax is package::fun but probably need to parenthesize it
-;  $BOOT and u is ["::",package,fun] =>
-;    INTERN(STRINGIMAGE fun, package)
-;  postForm u
-
-;;;     ***       |postColonColon| REDEFINED
-
-(DEFUN |postColonColon| (|u|) (PROG (|ISTMP#1| |package| |ISTMP#2| |fun|) (RETURN (COND ((AND $BOOT (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |::|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |package| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |fun| (QCAR |ISTMP#2|)) (QUOTE T))))))) (INTERN (STRINGIMAGE |fun|) |package|)) ((QUOTE T) (|postForm| |u|)))))) 
-;postAtSign ["@",x,y] == ["@",postTran x,:postType y]
-
-;;;     ***       |postAtSign| REDEFINED
-
-(DEFUN |postAtSign| (#0=#:G2540) (PROG (|x| |y|) (RETURN (PROGN (COND ((EQ (CAR #0#) (QUOTE @)) (CAR #0#))) (SPADLET |x| (CADR #0#)) (SPADLET |y| (CADDR #0#)) (CONS (QUOTE @) (CONS (|postTran| |x|) (|postType| |y|))))))) 
-;postPretend ['pretend,x,y] == ['pretend,postTran x,:postType y]
-
-;;;     ***       |postPretend| REDEFINED
-
-(DEFUN |postPretend| (#0=#:G2556) (PROG (|x| |y|) (RETURN (PROGN (SPADLET |x| (CADR #0#)) (SPADLET |y| (CADDR #0#)) (CONS (QUOTE |pretend|) (CONS (|postTran| |x|) (|postType| |y|))))))) 
-;postConstruct u ==
-;  u is ['construct,b] =>
-;    a:= (b is [",",:.] => comma2Tuple b; b)
-;    a is ['SEGMENT,p,q] => ['construct,postTranSegment(p,q)]
-;    a is ['Tuple,:l] =>
-;      or/[x is [":",y] for x in l] => postMakeCons l
-;      or/[x is ['SEGMENT,:.] for x in l] => tuple2List l
-;      ['construct,:postTranList l]
-;    ['construct,postTran a]
-;  u
-
-;;;     ***       |postConstruct| REDEFINED
-
-(DEFUN |postConstruct| (|u|) (PROG (|b| |a| |p| |ISTMP#2| |q| |l| |ISTMP#1| |y|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |a| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |,|))) (|comma2Tuple| |b|)) ((QUOTE T) |b|))) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |a|)) (QUOTE T))) (COND ((PROG (#0=#:G2598) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2608 NIL #0#) (#2=#:G2609 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (|postMakeCons| |l|)) ((PROG (#3=#:G2616) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G2622 NIL #3#) (#5=#:G2623 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (|tuple2List| |l|)) ((QUOTE T) (CONS (QUOTE |construct|) (|postTranList| |l|))))) ((QUOTE T) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))))) ((QUOTE T) |u|)))))) 
-;postError msg ==
-;  BUMPERRORCOUNT 'precompilation
-;  xmsg:=
-;    $defOp ^= '$defOp and not InteractiveMode => [$defOp,'": ",:msg]
-;    msg
-;  $postStack:= [xmsg,:$postStack]
-;  nil
-
-;;;     ***       |postError| REDEFINED
-
-(DEFUN |postError| (|msg|) (PROG (|xmsg|) (RETURN (PROGN (BUMPERRORCOUNT (QUOTE |precompilation|)) (SPADLET |xmsg| (COND ((AND (NEQUAL |$defOp| (QUOTE |$defOp|)) (NULL |InteractiveMode|)) (CONS |$defOp| (CONS (MAKESTRING ": ") |msg|))) ((QUOTE T) |msg|))) (SPADLET |$postStack| (CONS |xmsg| |$postStack|)) NIL)))) 
-;postMakeCons l ==
-;  null l => 'nil
-;  l is [[":",a],:l'] =>
-;    l' => ['append,postTran a,postMakeCons l']
-;    postTran a
-;  ['cons,postTran first l,postMakeCons rest l]
-
-;;;     ***       |postMakeCons| REDEFINED
-
-(DEFUN |postMakeCons| (|l|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l'|) (RETURN (COND ((NULL |l|) (QUOTE |nil|)) ((AND (PAIRP |l|) (PROGN (SPADLET |ISTMP#1| (QCAR |l|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (QUOTE T)))))) (PROGN (SPADLET |l'| (QCDR |l|)) (QUOTE T))) (COND (|l'| (CONS (QUOTE |append|) (CONS (|postTran| |a|) (CONS (|postMakeCons| |l'|) NIL)))) ((QUOTE T) (|postTran| |a|)))) ((QUOTE T) (CONS (QUOTE |cons|) (CONS (|postTran| (CAR |l|)) (CONS (|postMakeCons| (CDR |l|)) NIL)))))))) 
-;postAtom x ==
-;  $BOOT => x
-;  x=0 => '(Zero)
-;  x=1 => '(One)
-;  EQ(x,'T) => 'T_$ -- rename T in spad code to T$
-;  IDENTP x and GETDATABASE(x,'NILADIC) => LIST x
-;  x
-
-;;;     ***       |postAtom| REDEFINED
-
-(DEFUN |postAtom| (|x|) (COND ($BOOT |x|) ((EQL |x| 0) (QUOTE (|Zero|))) ((EQL |x| 1) (QUOTE (|One|))) ((EQ |x| (QUOTE T)) (QUOTE T$)) ((AND (IDENTP |x|) (GETDATABASE |x| (QUOTE NILADIC))) (LIST |x|)) ((QUOTE T) |x|))) 
-;postBlock ['Block,:l,x] ==
-;  ['SEQ,:postBlockItemList l,['exit,postTran x]]
-
-;;;     ***       |postBlock| REDEFINED
-
-(DEFUN |postBlock| (#0=#:G2675) (PROG (|LETTMP#1| |x| |l|) (RETURN (PROGN (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |l| (NREVERSE (CDR |LETTMP#1|))) (CONS (QUOTE SEQ) (APPEND (|postBlockItemList| |l|) (CONS (CONS (QUOTE |exit|) (CONS (|postTran| |x|) NIL)) NIL))))))) 
-;postBlockItemList l == [postBlockItem x for x in l]
-
-;;;     ***       |postBlockItemList| REDEFINED
-
-(DEFUN |postBlockItemList| (|l|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G2696) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2701 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postBlockItem| |x|) #0#))))))))))) 
-;postBlockItem x ==
-;  x:= postTran x
-;  x is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>
-;    [":",['LISTOF,:l,y],t]
-;  x
-
-;;;     ***       |postBlockItem| REDEFINED
-
-(DEFUN |postBlockItem| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |y| |ISTMP#5| |t| |l|) (RETURN (SEQ (PROGN (SPADLET |x| (|postTran| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCAR |ISTMP#3|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) (AND (PAIRP |ISTMP#4|) (PROGN (SPADLET |y| (QCAR |ISTMP#4|)) (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) (AND (PAIRP |ISTMP#5|) (EQ (QCDR |ISTMP#5|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#5|)) (QUOTE T)))))))) (PROGN (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T)))) (PROG (#0=#:G2754) (SPADLET #0# (QUOTE T)) (RETURN (DO ((#1=#:G2760 NIL (NULL #0#)) (#2=#:G2761 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (AND #0# (IDENTP |x|))))))))) (CONS (QUOTE |:|) (CONS (CONS (QUOTE LISTOF) (APPEND |l| (CONS |y| NIL))) (CONS |t| NIL)))) ((QUOTE T) |x|))))))) 
-;postCategory (u is ['CATEGORY,:l]) ==
-;  --RDJ: ugh_ please -- someone take away need for PROGN as soon as possible
-;  null l => u
-;  op :=
-;    $insidePostCategoryIfTrue = true => 'PROGN
-;    'CATEGORY
-;  [op,:[fn x for x in l]] where fn x ==
-;    $insidePostCategoryIfTrue: local := true
-;    postTran x
-
-;;;     ***       |postCategory,fn| REDEFINED
-
-(DEFUN |postCategory,fn| (|x|) (PROG (|$insidePostCategoryIfTrue|) (DECLARE (SPECIAL |$insidePostCategoryIfTrue|)) (RETURN (SEQ (SPADLET |$insidePostCategoryIfTrue| (QUOTE T)) (EXIT (|postTran| |x|)))))) 
-
-;;;     ***       |postCategory| REDEFINED
-
-(DEFUN |postCategory| (|u|) (PROG (|l| |op|) (RETURN (SEQ (PROGN (SPADLET |l| (CDR |u|)) (COND ((NULL |l|) |u|) ((QUOTE T) (SPADLET |op| (COND ((BOOT-EQUAL |$insidePostCategoryIfTrue| (QUOTE T)) (QUOTE PROGN)) ((QUOTE T) (QUOTE CATEGORY)))) (CONS |op| (PROG (#0=#:G2802) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G2807 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|postCategory,fn| |x|) #0#))))))))))))))) 
-;postComma u == postTuple comma2Tuple u
-
-;;;     ***       |postComma| REDEFINED
-
-(DEFUN |postComma| (|u|) (|postTuple| (|comma2Tuple| |u|))) 
-;comma2Tuple u == ['Tuple,:postFlatten(u,",")]
-
-;;;     ***       |comma2Tuple| REDEFINED
-
-(DEFUN |comma2Tuple| (|u|) (CONS (QUOTE |Tuple|) (|postFlatten| |u| (QUOTE |,|)))) 
-;postDef [defOp,lhs,rhs] ==
-;--+
-;  lhs is ["macro",name] => postMDef ["==>",name,rhs]
-;  if not($BOOT) then recordHeaderDocumentation nil
-;  if $maxSignatureLineNumber ^= 0 then
-;    $docList := [['constructor,:$headerDocumentation],:$docList]
-;    $maxSignatureLineNumber := 0
-;    --reset this for next constructor; see recordDocumentation
-;  lhs:= postTran lhs
-;  [form,targetType]:=
-;    lhs is [":",:.] => rest lhs
-;    [lhs,nil]
-;  if null $InteractiveMode and atom form then form := LIST form
-;  newLhs:=
-;    atom form => form
-;    [op,:argl]:= [(x is [":",a,.] => a; x) for x in form]
-;    [op,:postDefArgs argl]
-;  argTypeList:=
-;    atom form => nil
-;    [(x is [":",.,t] => t; nil) for x in rest form]
-;  typeList:= [targetType,:argTypeList]
-;  if atom form then form := [form]
-;  specialCaseForm := [nil for x in form]
-;  ['DEF,newLhs,typeList,specialCaseForm,postTran rhs]
-
-;;;     ***       |postDef| REDEFINED
-
-(DEFUN |postDef| (#0=#:G2875) (PROG (|defOp| |rhs| |name| |lhs| |targetType| |a| |LETTMP#1| |op| |argl| |newLhs| |ISTMP#1| |ISTMP#2| |t| |argTypeList| |typeList| |form| |specialCaseForm|) (RETURN (SEQ (PROGN (SPADLET |defOp| (CAR #0#)) (SPADLET |lhs| (CADR #0#)) (SPADLET |rhs| (CADDR #0#)) (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE |macro|)) (PROGN (SPADLET |ISTMP#1| (QCDR |lhs|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |name| (QCAR |ISTMP#1|)) (QUOTE T))))) (|postMDef| (CONS (QUOTE ==>) (CONS |name| (CONS |rhs| NIL))))) ((QUOTE T) (COND ((NULL $BOOT) (|recordHeaderDocumentation| NIL))) (COND ((NEQUAL |$maxSignatureLineNumber| 0) (SPADLET |$docList| (CONS (CONS (QUOTE |constructor|) |$headerDocumentation|) |$docList|)) (SPADLET |$maxSignatureLineNumber| 0))) (SPADLET |lhs| (|postTran| |lhs|)) (SPADLET |LETTMP#1| (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE |:|))) (CDR |lhs|)) ((QUOTE T) (CONS |lhs| (CONS NIL NIL))))) (SPADLET |form| (CAR |LETTMP#1|)) (SPADLET |targetType| (CADR |LETTMP#1|)) (COND ((AND (NULL |$InteractiveMode|) (ATOM |form|)) (SPADLET |form| (LIST |form|)))) (SPADLET |newLhs| (COND ((ATOM |form|) |form|) ((QUOTE T) (SPADLET |LETTMP#1| (PROG (#1=#:G2918) (SPADLET #1# NIL) (RETURN (DO ((#2=#:G2928 |form| (CDR #2#)) (|x| NIL)) ((OR (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) (NREVERSE0 #1#)) (SEQ (EXIT (SETQ #1# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL)))))) |a|) ((QUOTE T) |x|)) #1#)))))))) (SPADLET |op| (CAR |LETTMP#1|)) (SPADLET |argl| (CDR |LETTMP#1|)) (CONS |op| (|postDefArgs| |argl|))))) (SPADLET |argTypeList| (COND ((ATOM |form|) NIL) ((QUOTE T) (PROG (#3=#:G2944) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G2955 (CDR |form|) (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#2|)) (QUOTE T))))))) |t|) ((QUOTE T) NIL)) #3#)))))))))) (SPADLET |typeList| (CONS |targetType| |argTypeList|)) (COND ((ATOM |form|) (SPADLET |form| (CONS |form| NIL)))) (SPADLET |specialCaseForm| (PROG (#5=#:G2965) (SPADLET #5# NIL) (RETURN (DO ((#6=#:G2970 |form| (CDR #6#)) (|x| NIL)) ((OR (ATOM #6#) (PROGN (SETQ |x| (CAR #6#)) NIL)) (NREVERSE0 #5#)) (SEQ (EXIT (SETQ #5# (CONS NIL #5#)))))))) (CONS (QUOTE DEF) (CONS |newLhs| (CONS |typeList| (CONS |specialCaseForm| (CONS (|postTran| |rhs|) NIL)))))))))))) 
-;postDefArgs argl ==
-;  null argl => argl
-;  argl is [[":",a],:b] =>
-;    b => postError
-;      ['"   Argument",:bright a,'"of indefinite length must be last"]
-;    atom a or a is ['QUOTE,:.] => a
-;    postError
-;      ['"   Argument",:bright a,'"of indefinite length must be a name"]
-;  [first argl,:postDefArgs rest argl]
-
-;;;     ***       |postDefArgs| REDEFINED
-
-(DEFUN |postDefArgs| (|argl|) (PROG (|ISTMP#1| |ISTMP#2| |a| |b|) (RETURN (COND ((NULL |argl|) |argl|) ((AND (PAIRP |argl|) (PROGN (SPADLET |ISTMP#1| (QCAR |argl|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (QUOTE T)))))) (PROGN (SPADLET |b| (QCDR |argl|)) (QUOTE T))) (COND (|b| (|postError| (CONS (MAKESTRING "   Argument") (APPEND (|bright| |a|) (CONS (MAKESTRING "of indefinite length must be last") NIL))))) ((OR (ATOM |a|) (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE QUOTE)))) |a|) ((QUOTE T) (|postError| (CONS (MAKESTRING "   Argument") (APPEND (|bright| |a|) (CONS (MAKESTRING "of indefinite length must be a name") NIL))))))) ((QUOTE T) (CONS (CAR |argl|) (|postDefArgs| (CDR |argl|)))))))) 
-;postMDef(t) ==
-;  [.,lhs,rhs] := t
-;  $InteractiveMode and not $BOOT =>
-;    lhs := postTran lhs
-;    null IDENTP lhs => throwKeyedMsg("S2IP0001",NIL)
-;    ['MDEF,lhs,NIL,NIL,postTran rhs]
-;  lhs:= postTran lhs
-;  [form,targetType]:=
-;    lhs is [":",:.] => rest lhs
-;    [lhs,nil]
-;  form:=
-;    atom form => LIST form
-;    form
-;  newLhs:= [(x is [":",a,:.] => a; x) for x in form]
-;  typeList:= [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]]
-;  ['MDEF,newLhs,typeList,[nil for x in form],postTran rhs]
-
-;;;     ***       |postMDef| REDEFINED
-
-(DEFUN |postMDef| (|t|) (PROG (|rhs| |lhs| |LETTMP#1| |targetType| |form| |a| |newLhs| |ISTMP#1| |ISTMP#2| |typeList|) (RETURN (SEQ (PROGN (SPADLET |lhs| (CADR |t|)) (SPADLET |rhs| (CADDR |t|)) (COND ((AND |$InteractiveMode| (NULL $BOOT)) (SPADLET |lhs| (|postTran| |lhs|)) (COND ((NULL (IDENTP |lhs|)) (|throwKeyedMsg| (QUOTE S2IP0001) NIL)) ((QUOTE T) (CONS (QUOTE MDEF) (CONS |lhs| (CONS NIL (CONS NIL (CONS (|postTran| |rhs|) NIL)))))))) ((QUOTE T) (SPADLET |lhs| (|postTran| |lhs|)) (SPADLET |LETTMP#1| (COND ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) (QUOTE |:|))) (CDR |lhs|)) ((QUOTE T) (CONS |lhs| (CONS NIL NIL))))) (SPADLET |form| (CAR |LETTMP#1|)) (SPADLET |targetType| (CADR |LETTMP#1|)) (SPADLET |form| (COND ((ATOM |form|) (LIST |form|)) ((QUOTE T) |form|))) (SPADLET |newLhs| (PROG (#0=#:G3065) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3074 |form| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) |a|) ((QUOTE T) |x|)) #0#)))))))) (SPADLET |typeList| (CONS |targetType| (PROG (#2=#:G3090) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G3101 (CDR |form|) (CDR #3#)) (|x| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |x| (CAR #3#)) NIL)) (NREVERSE0 #2#)) (SEQ (EXIT (SETQ #2# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |t| (QCAR |ISTMP#2|)) (QUOTE T))))))) |t|) ((QUOTE T) NIL)) #2#))))))))) (CONS (QUOTE MDEF) (CONS |newLhs| (CONS |typeList| (CONS (PROG (#4=#:G3111) (SPADLET #4# NIL) (RETURN (DO ((#5=#:G3116 |form| (CDR #5#)) (|x| NIL)) ((OR (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) (NREVERSE0 #4#)) (SEQ (EXIT (SETQ #4# (CONS NIL #4#))))))) (CONS (|postTran| |rhs|) NIL)))))))))))) 
-;postElt (u is [.,a,b]) ==
-;  a:= postTran a
-;  b is ['Sequence,:.] => [['elt,a,'makeRecord],:postTranList rest b]
-;  ['elt,a,postTran b]
-
-;;;     ***       |postElt| REDEFINED
-
-(DEFUN |postElt| (|u|) (PROG (|b| |a|) (RETURN (PROGN (SPADLET |a| (CADR |u|)) (SPADLET |b| (CADDR |u|)) (SPADLET |a| (|postTran| |a|)) (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |Sequence|))) (CONS (CONS (QUOTE |elt|) (CONS |a| (CONS (QUOTE |makeRecord|) NIL))) (|postTranList| (CDR |b|)))) ((QUOTE T) (CONS (QUOTE |elt|) (CONS |a| (CONS (|postTran| |b|) NIL))))))))) 
-;postExit ["=>",a,b] == ['IF,postTran a,['exit,postTran b],'noBranch]
-
-;;;     ***       |postExit| REDEFINED
-
-(DEFUN |postExit| (#0=#:G3158) (PROG (|a| |b|) (RETURN (PROGN (COND ((EQ (CAR #0#) (QUOTE =>)) (CAR #0#))) (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (CONS (QUOTE IF) (CONS (|postTran| |a|) (CONS (CONS (QUOTE |exit|) (CONS (|postTran| |b|) NIL)) (CONS (QUOTE |noBranch|) NIL)))))))) 
-;postFlatten(x,op) ==
-;  x is [ =op,a,b] => [:postFlatten(a,op),:postFlatten(b,op)]
-;  LIST x
-
-;;;     ***       |postFlatten| REDEFINED
-
-(DEFUN |postFlatten| (|x| |op|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (EQUAL (QCAR |x|) |op|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (APPEND (|postFlatten| |a| |op|) (|postFlatten| |b| |op|))) ((QUOTE T) (LIST |x|)))))) 
-;postForm (u is [op,:argl]) ==
-;  x:=
-;    atom op =>
-;      argl':= postTranList argl
-;      op':=
-;        true=> op
-;        $BOOT => op
-;        GET(op,'Led) or GET(op,'Nud) or op = 'IN => op
-;        numOfArgs:= (argl' is [['Tuple,:l]] => #l; 1)
-;        INTERNL("*",STRINGIMAGE numOfArgs,PNAME op)
-;      [op',:argl']
-;    op is ['Scripts,:.] => [:postTran op,:postTranList argl]
-;    u:= postTranList u
-;    if u is [['Tuple,:.],:.] then
-;      postError ['"  ",:bright u,
-;        '"is illegal because tuples cannot be applied!",'%l,
-;          '"   Did you misuse infix dot?"]
-;    u
-;  x is [.,['Tuple,:y]] => [first x,:y]
-;  x
-
-;;;     ***       |postForm| REDEFINED
-
-(DEFUN |postForm| (|u|) (PROG (|op| |argl| |argl'| |l| |numOfArgs| |op'| |x| |ISTMP#1| |ISTMP#2| |y|) (RETURN (SEQ (PROGN (SPADLET |op| (CAR |u|)) (SPADLET |argl| (CDR |u|)) (SPADLET |x| (COND ((ATOM |op|) (SPADLET |argl'| (|postTranList| |argl|)) (SPADLET |op'| (SEQ (EXIT |op|) (COND ($BOOT (EXIT |op|))) (COND ((OR (GETL |op| (QUOTE |Led|)) (GETL |op| (QUOTE |Nud|)) (BOOT-EQUAL |op| (QUOTE IN))) (EXIT |op|))) (SPADLET |numOfArgs| (COND ((AND (PAIRP |argl'|) (EQ (QCDR |argl'|) NIL) (PROGN (SPADLET |ISTMP#1| (QCAR |argl'|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) (|#| |l|)) ((QUOTE T) 1))) (INTERNL (QUOTE *) (STRINGIMAGE |numOfArgs|) (PNAME |op|)))) (CONS |op'| |argl'|)) ((AND (PAIRP |op|) (EQ (QCAR |op|) (QUOTE |Scripts|))) (APPEND (|postTran| |op|) (|postTranList| |argl|))) ((QUOTE T) (SPADLET |u| (|postTranList| |u|)) (COND ((AND (PAIRP |u|) (PROGN (SPADLET |ISTMP#1| (QCAR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |Tuple|))))) (|postError| (CONS (MAKESTRING "  ") (APPEND (|bright| |u|) (CONS (MAKESTRING "is illegal because tuples cannot be applied!") (CONS (QUOTE |%l|) (CONS (MAKESTRING "   Did you misuse infix dot?") NIL)))))))) |u|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCAR |ISTMP#2|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |ISTMP#2|)) (QUOTE T))))))) (CONS (CAR |x|) |y|)) ((QUOTE T) |x|))))))) 
-;postQuote [.,a] == ['QUOTE,a]
-
-;;;     ***       |postQuote| REDEFINED
-
-(DEFUN |postQuote| (#0=#:G3255) (PROG (|a|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (CONS (QUOTE QUOTE) (CONS |a| NIL)))))) 
-;postScriptsForm(['Scripts,op,a],argl) ==
-;  [getScriptName(op,a,#argl),:postTranScripts a,:argl]
-
-;;;     ***       |postScriptsForm| REDEFINED
-
-(DEFUN |postScriptsForm| (#0=#:G3266 |argl|) (PROG (|op| |a|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |a| (CADDR #0#)) (CONS (|getScriptName| |op| |a| (|#| |argl|)) (APPEND (|postTranScripts| |a|) |argl|)))))) 
-;postScripts ['Scripts,op,a] ==
-;  [getScriptName(op,a,0),:postTranScripts a]
-
-;;;     ***       |postScripts| REDEFINED
-
-(DEFUN |postScripts| (#0=#:G3280) (PROG (|op| |a|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |a| (CADDR #0#)) (CONS (|getScriptName| |op| |a| 0) (|postTranScripts| |a|)))))) 
-;getScriptName(op,a,numberOfFunctionalArgs) ==
-;  if null IDENTP op then
-;    postError ['"   ",op,'" cannot have scripts"]
-;  INTERNL("*",STRINGIMAGE numberOfFunctionalArgs,
-;    decodeScripts a,PNAME op)
-
-;;;     ***       |getScriptName| REDEFINED
-
-(DEFUN |getScriptName| (|op| |a| |numberOfFunctionalArgs|) (PROGN (COND ((NULL (IDENTP |op|)) (|postError| (CONS (MAKESTRING "   ") (CONS |op| (CONS (MAKESTRING " cannot have scripts") NIL)))))) (INTERNL (QUOTE *) (STRINGIMAGE |numberOfFunctionalArgs|) (|decodeScripts| |a|) (PNAME |op|)))) 
-;postTranScripts a ==
-;  a is ['PrefixSC,b] => postTranScripts b
-;  a is [";",:b] => "append"/[postTranScripts y for y in b]
-;  a is [",",:b] =>
-;    ("append"/[fn postTran y for y in b]) where
-;      fn x ==
-;        x is ['Tuple,:y] => y
-;        LIST x
-;  LIST postTran a
-
-;;;     ***       |postTranScripts,fn| REDEFINED
-
-(DEFUN |postTranScripts,fn| (|x|) (PROG (|y|) (RETURN (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (EXIT |y|)) (EXIT (LIST |x|)))))) 
-
-;;;     ***       |postTranScripts| REDEFINED
-
-(DEFUN |postTranScripts| (|a|) (PROG (|ISTMP#1| |b|) (RETURN (SEQ (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |PrefixSC|)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (|postTranScripts| |b|)) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |;|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (PROG (#0=#:G3309) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3314 |b| (CDR #1#)) (|y| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |y| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (APPEND #0# (|postTranScripts| |y|))))))))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (PROG (#2=#:G3320) (SPADLET #2# NIL) (RETURN (DO ((#3=#:G3325 |b| (CDR #3#)) (|y| NIL)) ((OR (ATOM #3#) (PROGN (SETQ |y| (CAR #3#)) NIL)) #2#) (SEQ (EXIT (SETQ #2# (APPEND #2# (|postTranScripts,fn| (|postTran| |y|)))))))))) ((QUOTE T) (LIST (|postTran| |a|)))))))) 
-;decodeScripts a ==
-;  a is ['PrefixSC,b] => STRCONC(STRINGIMAGE 0,decodeScripts b)
-;  a is [";",:b] => APPLX('STRCONC,[decodeScripts x for x in b])
-;  a is [",",:b] =>
-;    STRINGIMAGE fn a where fn a == (a is [",",:b] => +/[fn x for x in b]; 1)
-;  STRINGIMAGE 1
-
-;;;     ***       |decodeScripts,fn| REDEFINED
-
-(DEFUN |decodeScripts,fn| (|a|) (PROG (|b|) (RETURN (SEQ (IF (AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (EXIT (PROG (#0=#:G3345) (SPADLET #0# 0) (RETURN (DO ((#1=#:G3350 |b| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (PLUS #0# (|decodeScripts,fn| |x|)))))))))) (EXIT 1))))) 
-
-;;;     ***       |decodeScripts| REDEFINED
-
-(DEFUN |decodeScripts| (|a|) (PROG (|ISTMP#1| |b|) (RETURN (SEQ (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |PrefixSC|)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T))))) (STRCONC (STRINGIMAGE 0) (|decodeScripts| |b|))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |;|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (APPLX (QUOTE STRCONC) (PROG (#0=#:G3367) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3372 |b| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|decodeScripts| |x|) #0#))))))))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |,|)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (STRINGIMAGE (|decodeScripts,fn| |a|))) ((QUOTE T) (STRINGIMAGE 1))))))) 
-;postIf t ==
-;  t isnt ['if,:l] => t
-;  ['IF,:[(null (x:= postTran x) and null $BOOT => 'noBranch; x)
-;    for x in l]]
-
-;;;     ***       |postIf| REDEFINED
-
-(DEFUN |postIf| (|t|) (PROG (|l| |x|) (RETURN (SEQ (COND ((NULL (AND (PAIRP |t|) (EQ (QCAR |t|) (QUOTE |if|)) (PROGN (SPADLET |l| (QCDR |t|)) (QUOTE T)))) |t|) ((QUOTE T) (CONS (QUOTE IF) (PROG (#0=#:G3392) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3397 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (COND ((AND (NULL (SPADLET |x| (|postTran| |x|))) (NULL $BOOT)) (QUOTE |noBranch|)) ((QUOTE T) |x|)) #0#)))))))))))))) 
-;postJoin ['Join,a,:l] ==
-;  a:= postTran a
-;  l:= postTranList l
-;  if l is [b] and b is [name,:.] and MEMQ(name,'(ATTRIBUTE SIGNATURE)) then l
-;    := LIST ['CATEGORY,b]
-;  al:=
-;    a is ['Tuple,:c] => c
-;    LIST a
-;  ['Join,:al,:l]
-
-;;;     ***       |postJoin| REDEFINED
-
-(DEFUN |postJoin| (#0=#:G3411) (PROG (|a| |b| |name| |l| |c| |al|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |l| (CDDR #0#)) (SPADLET |a| (|postTran| |a|)) (SPADLET |l| (|postTranList| |l|)) (COND ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) (PROGN (SPADLET |b| (QCAR |l|)) (QUOTE T)) (PAIRP |b|) (PROGN (SPADLET |name| (QCAR |b|)) (QUOTE T)) (MEMQ |name| (QUOTE (ATTRIBUTE SIGNATURE)))) (SPADLET |l| (LIST (CONS (QUOTE CATEGORY) (CONS |b| NIL)))))) (SPADLET |al| (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE |Tuple|)) (PROGN (SPADLET |c| (QCDR |a|)) (QUOTE T))) |c|) ((QUOTE T) (LIST |a|)))) (CONS (QUOTE |Join|) (APPEND |al| |l|)))))) 
-;postMapping u  ==
-;  u isnt ["->",source,target] => u
-;  ['Mapping,postTran target,:unTuple postTran source]
-
-;;;     ***       |postMapping| REDEFINED
-
-(DEFUN |postMapping| (|u|) (PROG (|ISTMP#1| |source| |ISTMP#2| |target|) (RETURN (COND ((NULL (AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |source| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#2|)) (QUOTE T)))))))) |u|) ((QUOTE T) (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) (|unTuple| (|postTran| |source|))))))))) 
-;postOp x ==
-;  x=":=" =>
-;    $BOOT => 'SPADLET
-;    'LET
-;  x=":-" => 'LETD
-;  x='Attribute => 'ATTRIBUTE
-;  x
-
-;;;     ***       |postOp| REDEFINED
-
-(DEFUN |postOp| (|x|) (COND ((BOOT-EQUAL |x| (QUOTE |:=|)) (COND ($BOOT (QUOTE SPADLET)) ((QUOTE T) (QUOTE LET)))) ((BOOT-EQUAL |x| (QUOTE |:-|)) (QUOTE LETD)) ((BOOT-EQUAL |x| (QUOTE |Attribute|)) (QUOTE ATTRIBUTE)) ((QUOTE T) |x|))) 
-;postRepeat ['REPEAT,:m,x] == ['REPEAT,:postIteratorList m,postTran x]
-
-;;;     ***       |postRepeat| REDEFINED
-
-(DEFUN |postRepeat| (#0=#:G3467) (PROG (|LETTMP#1| |x| |m|) (RETURN (PROGN (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (CONS (QUOTE REPEAT) (APPEND (|postIteratorList| |m|) (CONS (|postTran| |x|) NIL))))))) 
-;postSEGMENT ['SEGMENT,a,b] ==
-;  key:= [a,'"..",:(b => [b]; nil)]
-;  postError ['"   Improper placement of segment",:bright key]
-
-;;;     ***       |postSEGMENT| REDEFINED
-
-(DEFUN |postSEGMENT| (#0=#:G3486) (PROG (|a| |b| |key|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (SPADLET |key| (CONS |a| (CONS (MAKESTRING "..") (COND (|b| (CONS |b| NIL)) ((QUOTE T) NIL))))) (|postError| (CONS (MAKESTRING "   Improper placement of segment") (|bright| |key|))))))) 
-;postCollect [constructOp,:m,x] ==
-;  x is [['elt,D,'construct],:y] =>
-;    postCollect [['elt,D,'COLLECT],:m,['construct,:y]]
-;  itl:= postIteratorList m
-;  x:= (x is ['construct,r] => r; x)  --added 84/8/31
-;  y:= postTran x
-;  finish(constructOp,itl,y) where
-;    finish(op,itl,y) ==
-;      y is [":",a] => ['REDUCE,'append,0,[op,:itl,a]]
-;      y is ['Tuple,:l] =>
-;        newBody:=
-;          or/[x is [":",y] for x in l] => postMakeCons l
-;          or/[x is ['SEGMENT,:.] for x in l] => tuple2List l
-;          ['construct,:postTranList l]
-;        ['REDUCE,'append,0,[op,:itl,newBody]]
-;      [op,:itl,y]
-
-;;;     ***       |postCollect,finish| REDEFINED
-
-(DEFUN |postCollect,finish| (|op| |itl| |y|) (PROG (|a| |l| |ISTMP#1| |newBody|) (RETURN (SEQ (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |y|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |a| NIL))) NIL)))))) (IF (AND (PAIRP |y|) (EQ (QCAR |y|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |y|)) (QUOTE T))) (EXIT (SEQ (SPADLET |newBody| (SEQ (IF (PROG (#0=#:G3534) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G3544 NIL #0#) (#2=#:G3545 |l| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T)))))))))))) (EXIT (|postMakeCons| |l|))) (IF (PROG (#3=#:G3552) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G3558 NIL #3#) (#5=#:G3559 |l| (CDR #5#)) (|x| NIL)) ((OR #4# (ATOM #5#) (PROGN (SETQ |x| (CAR #5#)) NIL)) #3#) (SEQ (EXIT (SETQ #3# (OR #3# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE SEGMENT)))))))))) (EXIT (|tuple2List| |l|))) (EXIT (CONS (QUOTE |construct|) (|postTranList| |l|))))) (EXIT (CONS (QUOTE REDUCE) (CONS (QUOTE |append|) (CONS 0 (CONS (CONS |op| (APPEND |itl| (CONS |newBody| NIL))) NIL)))))))) (EXIT (CONS |op| (APPEND |itl| (CONS |y| NIL)))))))) 
-
-;;;     ***       |postCollect| REDEFINED
-
-(DEFUN |postCollect| (#0=#:G3579) (PROG (|constructOp| |LETTMP#1| |m| |ISTMP#2| D |ISTMP#3| |itl| |ISTMP#1| |r| |x| |y|) (RETURN (PROGN (SPADLET |constructOp| (CAR #0#)) (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (COND ((AND (PAIRP |x|) (PROGN (SPADLET |ISTMP#1| (QCAR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |elt|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET D (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (EQ (QCAR |ISTMP#3|) (QUOTE |construct|)))))))) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) (|postCollect| (CONS (CONS (QUOTE |elt|) (CONS D (CONS (QUOTE COLLECT) NIL))) (APPEND |m| (CONS (CONS (QUOTE |construct|) |y|) NIL))))) ((QUOTE T) (SPADLET |itl| (|postIteratorList| |m|)) (SPADLET |x| (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |construct|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |r| (QCAR |ISTMP#1|)) (QUOTE T))))) |r|) ((QUOTE T) |x|))) (SPADLET |y| (|postTran| |x|)) (|postCollect,finish| |constructOp| |itl| |y|))))))) 
-;postTupleCollect [constructOp,:m,x] ==
-;  postCollect [constructOp,:m,['construct,x]]
-
-;;;     ***       |postTupleCollect| REDEFINED
-
-(DEFUN |postTupleCollect| (#0=#:G3622) (PROG (|constructOp| |LETTMP#1| |x| |m|) (RETURN (PROGN (SPADLET |constructOp| (CAR #0#)) (SPADLET |LETTMP#1| (REVERSE (CDR #0#))) (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (NREVERSE (CDR |LETTMP#1|))) (|postCollect| (CONS |constructOp| (APPEND |m| (CONS (CONS (QUOTE |construct|) (CONS |x| NIL)) NIL)))))))) 
-;postIteratorList x ==
-;  x is [p,:l] =>
-;    (p:= postTran p) is ['IN,y,u] =>
-;      u is ["|",a,b] => [['IN,y,postInSeq a],["|",b],:postIteratorList l]
-;      [['IN,y,postInSeq u],:postIteratorList l]
-;    [p,:postIteratorList l]
-;  x
-
-;;;     ***       |postIteratorList| REDEFINED
-
-(DEFUN |postIteratorList| (|x|) (PROG (|l| |p| |y| |ISTMP#3| |u| |ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (PROGN (SPADLET |p| (QCAR |x|)) (SPADLET |l| (QCDR |x|)) (QUOTE T))) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |p| (|postTran| |p|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE IN)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL) (PROGN (SPADLET |u| (QCAR |ISTMP#3|)) (QUOTE T)))))))) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |\||)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (CONS (CONS (QUOTE IN) (CONS |y| (CONS (|postInSeq| |a|) NIL))) (CONS (CONS (QUOTE |\||) (CONS |b| NIL)) (|postIteratorList| |l|)))) ((QUOTE T) (CONS (CONS (QUOTE IN) (CONS |y| (CONS (|postInSeq| |u|) NIL))) (|postIteratorList| |l|))))) ((QUOTE T) (CONS |p| (|postIteratorList| |l|))))) ((QUOTE T) |x|))))) 
-;postin arg ==
-;  arg isnt ['in,i,seq] => systemErrorHere '"postin"
-;  ['in,postTran i, postInSeq seq]
-
-;;;     ***       |postin| REDEFINED
-
-(DEFUN |postin| (|arg|) (PROG (|ISTMP#1| |i| |ISTMP#2| |seq|) (RETURN (COND ((NULL (AND (PAIRP |arg|) (EQ (QCAR |arg|) (QUOTE |in|)) (PROGN (SPADLET |ISTMP#1| (QCDR |arg|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |i| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |seq| (QCAR |ISTMP#2|)) (QUOTE T)))))))) (|systemErrorHere| (MAKESTRING "postin"))) ((QUOTE T) (CONS (QUOTE |in|) (CONS (|postTran| |i|) (CONS (|postInSeq| |seq|) NIL)))))))) 
-;postIn arg ==
-;  arg isnt ['IN,i,seq] => systemErrorHere '"postIn"
-;  ['IN,postTran i,postInSeq seq]
-
-;;;     ***       |postIn| REDEFINED
-
-(DEFUN |postIn| (|arg|) (PROG (|ISTMP#1| |i| |ISTMP#2| |seq|) (RETURN (COND ((NULL (AND (PAIRP |arg|) (EQ (QCAR |arg|) (QUOTE IN)) (PROGN (SPADLET |ISTMP#1| (QCDR |arg|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |i| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |seq| (QCAR |ISTMP#2|)) (QUOTE T)))))))) (|systemErrorHere| (MAKESTRING "postIn"))) ((QUOTE T) (CONS (QUOTE IN) (CONS (|postTran| |i|) (CONS (|postInSeq| |seq|) NIL)))))))) 
-;postInSeq seq ==
-;  seq is ['SEGMENT,p,q] => postTranSegment(p,q)
-;  seq is ['Tuple,:l] => tuple2List l
-;  postTran seq
-
-;;;     ***       |postInSeq| REDEFINED
-
-(DEFUN |postInSeq| (|seq|) (PROG (|ISTMP#1| |p| |ISTMP#2| |q| |l|) (RETURN (COND ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |seq|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|postTranSegment| |p| |q|)) ((AND (PAIRP |seq|) (EQ (QCAR |seq|) (QUOTE |Tuple|)) (PROGN (SPADLET |l| (QCDR |seq|)) (QUOTE T))) (|tuple2List| |l|)) ((QUOTE T) (|postTran| |seq|)))))) 
-;postTranSegment(p,q) == ['SEGMENT,postTran p,(q => postTran q; nil)]
-
-;;;     ***       |postTranSegment| REDEFINED
-
-(DEFUN |postTranSegment| (|p| |q|) (CONS (QUOTE SEGMENT) (CONS (|postTran| |p|) (CONS (COND (|q| (|postTran| |q|)) ((QUOTE T) NIL)) NIL)))) 
-;tuple2List l ==
-;  l is [a,:l'] =>
-;    u:= tuple2List l'
-;    a is ['SEGMENT,p,q] =>
-;      null u => ['construct,postTranSegment(p,q)]
-;      $InteractiveMode and null $BOOT =>
-;        ['append,['construct,postTranSegment(p,q)],tuple2List l']
-;      ["nconc",['construct,postTranSegment(p,q)],tuple2List l']
-;    null u => ['construct,postTran a]
-;    ["cons",postTran a,tuple2List l']
-;  nil
-
-;;;     ***       |tuple2List| REDEFINED
-
-(DEFUN |tuple2List| (|l|) (PROG (|a| |l'| |u| |ISTMP#1| |p| |ISTMP#2| |q|) (RETURN (COND ((AND (PAIRP |l|) (PROGN (SPADLET |a| (QCAR |l|)) (SPADLET |l'| (QCDR |l|)) (QUOTE T))) (SPADLET |u| (|tuple2List| |l'|)) (COND ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE SEGMENT)) (PROGN (SPADLET |ISTMP#1| (QCDR |a|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |p| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |q| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((NULL |u|) (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL))) ((AND |$InteractiveMode| (NULL $BOOT)) (CONS (QUOTE |append|) (CONS (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL)) (CONS (|tuple2List| |l'|) NIL)))) ((QUOTE T) (CONS (QUOTE |nconc|) (CONS (CONS (QUOTE |construct|) (CONS (|postTranSegment| |p| |q|) NIL)) (CONS (|tuple2List| |l'|) NIL)))))) ((NULL |u|) (CONS (QUOTE |construct|) (CONS (|postTran| |a|) NIL))) ((QUOTE T) (CONS (QUOTE |cons|) (CONS (|postTran| |a|) (CONS (|tuple2List| |l'|) NIL)))))) ((QUOTE T) NIL))))) 
-;SEGMENT(a,b) == [i for i in a..b]
-
-;;;     ***       SEGMENT REDEFINED
-
-(DEFUN SEGMENT (|a| |b|) (PROG NIL (RETURN (SEQ (PROG (#0=#:G3817) (SPADLET #0# NIL) (RETURN (DO ((|i| |a| (+ |i| 1))) ((> |i| |b|) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS |i| #0#))))))))))) 
-;postReduce ['Reduce,op,expr] ==
-;  $InteractiveMode or expr is ['COLLECT,:.] =>
-;    ['REDUCE,op,0,postTran expr]
-;  postReduce ['Reduce,op,['COLLECT,['IN,g:= GENSYM(),expr],
-;    ['construct,  g]]]
-
-;;;     ***       |postReduce| REDEFINED
-
-(DEFUN |postReduce| (#0=#:G3830) (PROG (|op| |expr| |g|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |expr| (CADDR #0#)) (COND ((OR |$InteractiveMode| (AND (PAIRP |expr|) (EQ (QCAR |expr|) (QUOTE COLLECT)))) (CONS (QUOTE REDUCE) (CONS |op| (CONS 0 (CONS (|postTran| |expr|) NIL))))) ((QUOTE T) (|postReduce| (CONS (QUOTE |Reduce|) (CONS |op| (CONS (CONS (QUOTE COLLECT) (CONS (CONS (QUOTE IN) (CONS (SPADLET |g| (GENSYM)) (CONS |expr| NIL))) (CONS (CONS (QUOTE |construct|) (CONS |g| NIL)) NIL))) NIL)))))))))) 
-;postFlattenLeft(x,op) ==--
-;  x is [ =op,a,b] => [:postFlattenLeft(a,op),b]
-;  [x]
-
-;;;     ***       |postFlattenLeft| REDEFINED
-
-(DEFUN |postFlattenLeft| (|x| |op|) (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) (RETURN (COND ((AND (PAIRP |x|) (EQUAL (QCAR |x|) |op|) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) (APPEND (|postFlattenLeft| |a| |op|) (CONS |b| NIL))) ((QUOTE T) (CONS |x| NIL)))))) 
-;postSemiColon u == postBlock ['Block,:postFlattenLeft(u,";")]
-
-;;;     ***       |postSemiColon| REDEFINED
-
-(DEFUN |postSemiColon| (|u|) (|postBlock| (CONS (QUOTE |Block|) (|postFlattenLeft| |u| (QUOTE |;|))))) 
-;postSequence ['Sequence,:l] == ['(elt $ makeRecord),:postTranList l]
-
-;;;     ***       |postSequence| REDEFINED
-
-(DEFUN |postSequence| (#0=#:G3872) (PROG (|l|) (RETURN (PROGN (SPADLET |l| (CDR #0#)) (CONS (QUOTE (|elt| $ |makeRecord|)) (|postTranList| |l|)))))) 
-;postSignature ['Signature,op,sig] ==
-;  sig is ["->",:.] =>
-;    sig1:= postType sig
-;    op:= postAtom (STRINGP op => INTERN op; op)
-;    ["SIGNATURE",op,:removeSuperfluousMapping killColons sig1]
-
-;;;     ***       |postSignature| REDEFINED
-
-(DEFUN |postSignature| (#0=#:G3885) (PROG (|sig| |sig1| |op|) (RETURN (PROGN (SPADLET |op| (CADR #0#)) (SPADLET |sig| (CADDR #0#)) (COND ((AND (PAIRP |sig|) (EQ (QCAR |sig|) (QUOTE ->))) (PROGN (SPADLET |sig1| (|postType| |sig|)) (SPADLET |op| (|postAtom| (COND ((STRINGP |op|) (INTERN |op|)) ((QUOTE T) |op|)))) (CONS (QUOTE SIGNATURE) (CONS |op| (|removeSuperfluousMapping| (|killColons| |sig1|))))))))))) 
-;killColons x ==
-;  atom x => x
-;  x is ['Record,:.] => x
-;  x is ['Union,:.] => x
-;  x is [":",.,y] => killColons y
-;  [killColons first x,:killColons rest x]
-
-;;;     ***       |killColons| REDEFINED
-
-(DEFUN |killColons| (|x|) (PROG (|ISTMP#1| |ISTMP#2| |y|) (RETURN (COND ((ATOM |x|) |x|) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Record|))) |x|) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Union|))) |x|) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (|killColons| |y|)) ((QUOTE T) (CONS (|killColons| (CAR |x|)) (|killColons| (CDR |x|)))))))) 
-;postSlash ['_/,a,b] ==
-;  STRINGP a => postTran ['Reduce,INTERN a,b]
-;  ['_/,postTran a,postTran b]
-
-;;;     ***       |postSlash| REDEFINED
-
-(DEFUN |postSlash| (#0=#:G3919) (PROG (|a| |b|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (COND ((STRINGP |a|) (|postTran| (CONS (QUOTE |Reduce|) (CONS (INTERN |a|) (CONS |b| NIL))))) ((QUOTE T) (CONS (QUOTE /) (CONS (|postTran| |a|) (CONS (|postTran| |b|) NIL))))))))) 
-;removeSuperfluousMapping sig1 ==
-;  --get rid of this asap
-;  sig1 is [x,:y] and x is ['Mapping,:.] => [rest x,:y]
-;  sig1
-
-;;;     ***       |removeSuperfluousMapping| REDEFINED
-
-(DEFUN |removeSuperfluousMapping| (|sig1|) (PROG (|x| |y|) (RETURN (COND ((AND (PAIRP |sig1|) (PROGN (SPADLET |x| (QCAR |sig1|)) (SPADLET |y| (QCDR |sig1|)) (QUOTE T)) (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Mapping|))) (CONS (CDR |x|) |y|)) ((QUOTE T) |sig1|))))) 
-;postType typ ==
-;  typ is ["->",source,target] =>
-;    source="constant" => [LIST postTran target,"constant"]
-;    LIST ['Mapping,postTran target,:unTuple postTran source]
-;  typ is ["->",target] => LIST ['Mapping,postTran target]
-;  LIST postTran typ
-
-;;;     ***       |postType| REDEFINED
-
-(DEFUN |postType| (|typ|) (PROG (|source| |ISTMP#2| |ISTMP#1| |target|) (RETURN (COND ((AND (PAIRP |typ|) (EQ (QCAR |typ|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |typ|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |source| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#2|)) (QUOTE T))))))) (COND ((BOOT-EQUAL |source| (QUOTE |constant|)) (CONS (LIST (|postTran| |target|)) (CONS (QUOTE |constant|) NIL))) ((QUOTE T) (LIST (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) (|unTuple| (|postTran| |source|)))))))) ((AND (PAIRP |typ|) (EQ (QCAR |typ|) (QUOTE ->)) (PROGN (SPADLET |ISTMP#1| (QCDR |typ|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |target| (QCAR |ISTMP#1|)) (QUOTE T))))) (LIST (CONS (QUOTE |Mapping|) (CONS (|postTran| |target|) NIL)))) ((QUOTE T) (LIST (|postTran| |typ|))))))) 
-;postTuple u ==
-;  u is ['Tuple] => u
-;  u is ['Tuple,:l,a] => (['Tuple,:postTranList rest u])
-
-;;;     ***       |postTuple| REDEFINED
-
-(DEFUN |postTuple| (|u|) (PROG (|ISTMP#1| |ISTMP#2| |a| |l|) (RETURN (COND ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) (EQ (QCAR |u|) (QUOTE |Tuple|))) |u|) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Tuple|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) (PAIRP |ISTMP#2|) (PROGN (SPADLET |a| (QCAR |ISTMP#2|)) (SPADLET |l| (QCDR |ISTMP#2|)) (QUOTE T)) (PROGN (SPADLET |l| (NREVERSE |l|)) (QUOTE T))))) (CONS (QUOTE |Tuple|) (|postTranList| (CDR |u|)))))))) 
-;--u is ['Tuple,:l,a] => (--a:= postTran a; ['Tuple,:postTranList rest u])
-;    --RDJ: don't understand need for above statement that is commented out
-;postWhere ['where,a,b] ==
-;  x:=
-;    b is ['Block,:c] => c
-;    LIST b
-;  ['where,postTran a,:postTranList x]
-
-;;;     ***       |postWhere| REDEFINED
-
-(DEFUN |postWhere| (#0=#:G3996) (PROG (|a| |b| |c| |x|) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |b| (CADDR #0#)) (SPADLET |x| (COND ((AND (PAIRP |b|) (EQ (QCAR |b|) (QUOTE |Block|)) (PROGN (SPADLET |c| (QCDR |b|)) (QUOTE T))) |c|) ((QUOTE T) (LIST |b|)))) (CONS (QUOTE |where|) (CONS (|postTran| |a|) (|postTranList| |x|))))))) 
-;postWith ['with,a] ==
-;  $insidePostCategoryIfTrue: local := true
-;  a:= postTran a
-;  a is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE IF)) => ['CATEGORY,a]
-;  a is ['PROGN,:b] => ['CATEGORY,:b]
-;  a
-
-;;;     ***       |postWith| REDEFINED
-
-(DEFUN |postWith| (#0=#:G4015) (PROG (|$insidePostCategoryIfTrue| |a| |op| |b|) (DECLARE (SPECIAL |$insidePostCategoryIfTrue|)) (RETURN (PROGN (SPADLET |a| (CADR #0#)) (SPADLET |$insidePostCategoryIfTrue| (QUOTE T)) (SPADLET |a| (|postTran| |a|)) (COND ((AND (PAIRP |a|) (PROGN (SPADLET |op| (QCAR |a|)) (QUOTE T)) (MEMQ |op| (QUOTE (SIGNATURE ATTRIBUTE IF)))) (CONS (QUOTE CATEGORY) (CONS |a| NIL))) ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE PROGN)) (PROGN (SPADLET |b| (QCDR |a|)) (QUOTE T))) (CONS (QUOTE CATEGORY) |b|)) ((QUOTE T) |a|)))))) 
-;postTransformCheck x ==
-;  $defOp: local:= nil
-;  postcheck x
-
-;;;     ***       |postTransformCheck| REDEFINED
-
-(DEFUN |postTransformCheck| (|x|) (PROG (|$defOp|) (DECLARE (SPECIAL |$defOp|)) (RETURN (PROGN (SPADLET |$defOp| NIL) (|postcheck| |x|))))) 
-;postcheck x ==
-;  atom x => nil
-;  x is ['DEF,form,[target,:.],:.] =>
-;    (setDefOp form; postcheckTarget target; postcheck rest rest x)
-;  x is ['QUOTE,:.] => nil
-;  postcheck first x
-;  postcheck rest x
-
-;;;     ***       |postcheck| REDEFINED
-
-(DEFUN |postcheck| (|x|) (PROG (|ISTMP#1| |form| |ISTMP#2| |ISTMP#3| |target|) (RETURN (COND ((ATOM |x|) NIL) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE DEF)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |form| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (PROGN (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) (AND (PAIRP |ISTMP#3|) (PROGN (SPADLET |target| (QCAR |ISTMP#3|)) (QUOTE T))))))))) (|setDefOp| |form|) (|postcheckTarget| |target|) (|postcheck| (CDR (CDR |x|)))) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE QUOTE))) NIL) ((QUOTE T) (|postcheck| (CAR |x|)) (|postcheck| (CDR |x|))))))) 
-;setDefOp f ==
-;  if f is [":",g,:.] then f := g
-;  f := (atom f => f; first f)
-;  if $topOp then $defOp:= f else $topOp:= f
-
-;;;     ***       |setDefOp| REDEFINED
-
-(DEFUN |setDefOp| (|f|) (PROG (|ISTMP#1| |g|) (RETURN (PROGN (COND ((AND (PAIRP |f|) (EQ (QCAR |f|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#1| (QCDR |f|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |g| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |f| |g|))) (SPADLET |f| (COND ((ATOM |f|) |f|) ((QUOTE T) (CAR |f|)))) (COND (|$topOp| (SPADLET |$defOp| |f|)) ((QUOTE T) (SPADLET |$topOp| |f|))))))) 
-;postcheckTarget x ==
-;  -- doesn't seem that useful!
-;  isPackageType x => nil
-;  x is ['Join,:.] => nil
-;  NIL
-
-;;;     ***       |postcheckTarget| REDEFINED
-
-(DEFUN |postcheckTarget| (|x|) (COND ((|isPackageType| |x|) NIL) ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Join|))) NIL) ((QUOTE T) NIL))) 
-;isPackageType x == not CONTAINED("$",x)
-
-;;;     ***       |isPackageType| REDEFINED
-
-(DEFUN |isPackageType| (|x|) (NULL (CONTAINED (QUOTE $) |x|))) 
-;unTuple x ==
-;  x is ['Tuple,:y] => y
-;  LIST x
-
-;;;     ***       |unTuple| REDEFINED
-
-(DEFUN |unTuple| (|x|) (PROG (|y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) |y|) ((QUOTE T) (LIST |x|)))))) 
-;--% APL TRANSFORMATION OF INPUT
-;aplTran x ==
-;  $BOOT => x
-;  $GENNO: local := 0
-;  u:= aplTran1 x
-;  containsBang u => throwKeyedMsg("S2IP0002",NIL)
-;  u
-
-;;;     ***       |aplTran| REDEFINED
-
-(DEFUN |aplTran| (|x|) (PROG ($GENNO |u|) (DECLARE (SPECIAL $GENNO)) (RETURN (COND ($BOOT |x|) ((QUOTE T) (SPADLET $GENNO 0) (SPADLET |u| (|aplTran1| |x|)) (COND ((|containsBang| |u|) (|throwKeyedMsg| (QUOTE S2IP0002) NIL)) ((QUOTE T) |u|))))))) 
-;containsBang u ==
-;  atom u => EQ(u,"!")
-;  u is [='QUOTE,.] => false
-;  or/[containsBang x for x in u]
-
-;;;     ***       |containsBang| REDEFINED
-
-(DEFUN |containsBang| (|u|) (PROG (|ISTMP#1|) (RETURN (SEQ (COND ((ATOM |u|) (EQ |u| (QUOTE !))) ((AND (PAIRP |u|) (EQUAL (QCAR |u|) (QUOTE QUOTE)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) NIL) ((QUOTE T) (PROG (#0=#:G4117) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G4123 NIL #0#) (#2=#:G4124 |u| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (|containsBang| |x|)))))))))))))) 
-;aplTran1 x ==
-;  atom x => x
-;  [op,:argl1] := x
-;  argl := aplTranList argl1
-;  -- unary case f ! y
-;  op = "_!" =>
-;    argl is [f,y] =>
-;      y is [op',:y'] and op' = "_!" => aplTran1 [op,op,f,:y']
-;      $BOOT => ['COLLECT,['IN,g:=GENVAR(),aplTran1 y],[f,g]]
-;      ['map,f,aplTran1 y]
-;    x    --do not handle yet
-;  -- multiple argument case
-;  hasAplExtension argl is [arglAssoc,:futureArgl] =>
-;    -- choose the last aggregate type to be result of reshape
-;    ['reshape,['COLLECT,:[['IN,g,['ravel,a]] for [g,:a] in arglAssoc],
-;      aplTran1 [op,:futureArgl]],CDAR arglAssoc]
-;  [op,:argl]
-
-;;;     ***       |aplTran1| REDEFINED
-
-(DEFUN |aplTran1| (|x|) (PROG (|op| |argl1| |argl| |f| |y| |op'| |y'| |ISTMP#1| |arglAssoc| |futureArgl| |g| |a|) (RETURN (SEQ (COND ((ATOM |x|) |x|) ((QUOTE T) (SPADLET |op| (CAR |x|)) (SPADLET |argl1| (CDR |x|)) (SPADLET |argl| (|aplTranList| |argl1|)) (COND ((BOOT-EQUAL |op| (QUOTE !)) (COND ((AND (PAIRP |argl|) (PROGN (SPADLET |f| (QCAR |argl|)) (SPADLET |ISTMP#1| (QCDR |argl|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND ((AND (PAIRP |y|) (PROGN (SPADLET |op'| (QCAR |y|)) (SPADLET |y'| (QCDR |y|)) (QUOTE T)) (BOOT-EQUAL |op'| (QUOTE !))) (|aplTran1| (CONS |op| (CONS |op| (CONS |f| |y'|))))) ($BOOT (CONS (QUOTE COLLECT) (CONS (CONS (QUOTE IN) (CONS (SPADLET |g| (GENVAR)) (CONS (|aplTran1| |y|) NIL))) (CONS (CONS |f| (CONS |g| NIL)) NIL)))) ((QUOTE T) (CONS (QUOTE |map|) (CONS |f| (CONS (|aplTran1| |y|) NIL)))))) ((QUOTE T) |x|))) ((PROGN (SPADLET |ISTMP#1| (|hasAplExtension| |argl|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |arglAssoc| (QCAR |ISTMP#1|)) (SPADLET |futureArgl| (QCDR |ISTMP#1|)) (QUOTE T)))) (CONS (QUOTE |reshape|) (CONS (CONS (QUOTE COLLECT) (APPEND (PROG (#0=#:G4171) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G4177 |arglAssoc| (CDR #1#)) (#2=#:G4161 NIL)) ((OR (ATOM #1#) (PROGN (SETQ #2# (CAR #1#)) NIL) (PROGN (PROGN (SPADLET |g| (CAR #2#)) (SPADLET |a| (CDR #2#)) #2#) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (CONS (QUOTE IN) (CONS |g| (CONS (CONS (QUOTE |ravel|) (CONS |a| NIL)) NIL))) #0#))))))) (CONS (|aplTran1| (CONS |op| |futureArgl|)) NIL))) (CONS (CDAR |arglAssoc|) NIL)))) ((QUOTE T) (CONS |op| |argl|))))))))) 
-;aplTranList x ==
-;  atom x => x
-;  [aplTran1 first x,:aplTranList rest x]
-
-;;;     ***       |aplTranList| REDEFINED
-
-(DEFUN |aplTranList| (|x|) (COND ((ATOM |x|) |x|) ((QUOTE T) (CONS (|aplTran1| (CAR |x|)) (|aplTranList| (CDR |x|)))))) 
-;hasAplExtension argl ==
-;  or/[x is ["_!",:.] for x in argl] =>
-;    u:= [futureArg for x in argl] where futureArg ==
-;      x is ["_!",y] =>
-;        z:= deepestExpression y
-;        arglAssoc := [[g := GENVAR(),:aplTran1 z],:arglAssoc]
-;        substitute(g,z,y)
-;      x
-;    [arglAssoc,:u]
-;  nil
-
-;;;     ***       |hasAplExtension| REDEFINED
-
-(DEFUN |hasAplExtension| (|argl|) (PROG (|ISTMP#1| |y| |z| |g| |arglAssoc| |u|) (RETURN (SEQ (COND ((PROG (#0=#:G4219) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G4225 NIL #0#) (#2=#:G4226 |argl| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE !)))))))))) (SPADLET |u| (PROG (#3=#:G4241) (SPADLET #3# NIL) (RETURN (DO ((#4=#:G4250 |argl| (CDR #4#)) (|x| NIL)) ((OR (ATOM #4#) (PROGN (SETQ |x| (CAR #4#)) NIL)) (NREVERSE0 #3#)) (SEQ (EXIT (SETQ #3# (CONS (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE !)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (SPADLET |z| (|deepestExpression| |y|)) (SPADLET |arglAssoc| (CONS (CONS (SPADLET |g| (GENVAR)) (|aplTran1| |z|)) |arglAssoc|)) (MSUBST |g| |z| |y|)) ((QUOTE T) |x|)) #3#)))))))) (CONS |arglAssoc| |u|)) ((QUOTE T) NIL)))))) 
-;deepestExpression x ==
-;  x is ["_!",y] => deepestExpression y
-;  x
-
-;;;     ***       |deepestExpression| REDEFINED
-
-(DEFUN |deepestExpression| (|x|) (PROG (|ISTMP#1| |y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE !)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (|deepestExpression| |y|)) ((QUOTE T) |x|))))) 
-;;;Boot translation finished for postpar.boot
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/preparse.lisp.pamphlet b/src/interp/preparse.lisp.pamphlet
deleted file mode 100644
index 1222987..0000000
--- a/src/interp/preparse.lisp.pamphlet
+++ /dev/null
@@ -1,416 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp preparse.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\begin{verbatim}
-NAME:    Pre-Parsing Code
-PURPOSE: BOOT lines are massaged by PREPARSE to make them easier to parse:
-       1. Trailing -- comments are removed (this is already done, actually).
-       2. Comments between { and } are removed.
-       3. BOOT code is column-sensitive. Code which lines up columnarly is
-          parenthesized and semicolonized accordingly.  For example,
-
-               a
-                       b
-                       c
-                               d
-               e
-
-          becomes
-
-               a
-                       (b;
-                        c
-                               d)
-               e
-
-          Note that to do this correctly, we also need to keep track of
-          parentheses already in the code.
- 
-\end{verbatim}
-\section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; 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.
-
-@
-<<*>>=
-<<license>>
-
-(provide 'Boot)
- 
-(in-package "BOOT")
- 
-; Global storage
- 
-(defparameter $INDEX 0                          "File line number of most recently read line.")
-(defparameter $preparse-last-line ()            "Most recently read line.")
-(defparameter $preparseReportIfTrue NIL         "Should we print listings?")
-(defparameter $LineList nil                     "Stack of preparsed lines.")
-(defparameter $EchoLineStack nil                "Stack of lines to list.")
-(defparameter $IOIndex 0                        "Number of latest terminal input line.")
- 
-(defun Initialize-Preparse (strm)
-  (setq $INDEX 0 $LineList nil $EchoLineStack nil)
-  (setq $preparse-last-line (get-a-line strm)))
- 
-(defmacro pptest () `(/rp ">scratchpad>test.boot"))
- 
-(defun /RP (&optional (*boot-input-file* nil) (*boot-output-file* nil)
-                      ($preparseReportIfTrue t))
-  (with-open-stream
-    (in-stream (or (and *boot-input-file* (open *boot-input-file* :direction :input))
-                   *terminal-io*))
-    (declare (special in-stream))
-    (with-open-stream
-      (out-stream (if *boot-output-file*
-                      (open *boot-output-file* :direction :output)
-                      *terminal-io*))
-      (declare (special out-stream))
-      (initialize-preparse in-stream)
-      (do ((lines (PREPARSE in-stream) (PREPARSE in-stream))) ((null lines)))))
-  T)
- 
-(defun PREPARSE (Strm &aux (stack ()))
-  (SETQ $COMBLOCKLIST NIL $skipme NIL)
-  (when $preparse-last-line
-	(if (pairp $preparse-last-line)
-	    (setq stack $preparse-last-line)
-	  (push $preparse-last-line stack))
-        (setq $INDEX (- $INDEX (length stack))))
-  (let ((U (PREPARSE1 stack)))
-    (if $skipme (preparse strm)
-      (progn
-	(if $preparseReportIfTrue (PARSEPRINT U))
-	(setq |$headerDocumentation| NIL)
-	(SETQ |$docList| NIL)
-	(SETQ |$maxSignatureLineNumber| 0)
-	(SETQ |$constructorLineNumber| (IFCAR (IFCAR U)))
-	U))))
- 
-(defun PREPARSE1 (LineList)
- (PROG (($LINELIST LineList) $EchoLineStack NUM A I L PSLOC
-        INSTRING PCOUNT COMSYM STRSYM OPARSYM CPARSYM N NCOMSYM
-        (SLOC -1) (CONTINUE NIL)  (PARENLEV 0) (NCOMBLOCK ())
-        (LINES ()) (LOCS ()) (NUMS ()) functor  )
- READLOOP (DCQ (NUM . A) (preparseReadLine LineList))
-         (cond ((atEndOfUnit A)
-                (PREPARSE-ECHO LineList)
-                (COND ((NULL LINES) (RETURN NIL))
-                      (NCOMBLOCK
-                       (FINCOMBLOCK NIL NUMS LOCS NCOMBLOCK NIL)))
-                (RETURN (PAIR (NREVERSE NUMS)
-                              (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES))))))
-         (cond ((and (NULL LINES) (> (LENGTH A) 0) (EQ (CHAR A 0) #\) ))
-                ; this is a command line, don't parse it
-                (PREPARSE-ECHO LineList)
-                (setq $preparse-last-line nil) ;don't reread this line
-                (SETQ LINE a)
-		(CATCH 'SPAD_READER (|doSystemCommand| (subseq LINE 1)))
-		(GO READLOOP)))
-         (setq L (LENGTH A))
-         (if (EQ L 0) (GO READLOOP))
-         (setq PSLOC SLOC)
-         (setq I 0 INSTRING () PCOUNT 0)
- STRLOOP (setq STRSYM (OR (position #\" A :start I ) L))
-         (setq COMSYM (OR (search "--" A :start2 I ) L))
-         (setq NCOMSYM (OR (search "++" A :start2 I ) L))
-         (setq OPARSYM (OR (position #\( A :start I ) L))
-         (setq CPARSYM (OR (position #\) A :start I ) L))
-         (setq N (MIN STRSYM COMSYM NCOMSYM OPARSYM CPARSYM))
-         (cond ((= N L) (GO NOCOMS))
-               ((ESCAPED A N))
-               ((= N STRSYM) (setq INSTRING (NOT INSTRING)))
-               (INSTRING)
-               ((= N COMSYM) (setq A (subseq A 0 N)) (GO NOCOMS)) ; discard trailing comment
-               ((= N NCOMSYM)
-                (setq SLOC (INDENT-POS A))
-                (COND
-                  ((= SLOC N)
-                   (COND ((AND NCOMBLOCK (NOT (= N (CAR NCOMBLOCK))))
-                          (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist)
-                          (SETQ NCOMBLOCK NIL)))
-                   (SETQ NCOMBLOCK (CONS N (CONS A (IFCDR NCOMBLOCK))))
-                   (SETQ A ""))
-                  ('T (PUSH (STRCONC (GETFULLSTR N " ")
-                                  (SUBSTRING A N ())) $LINELIST)
-                      (SETQ $INDEX (SUB1 $INDEX))
-                      (SETQ A (SUBSEQ A 0 N))))
-         (GO NOCOMS))
-               ((= N OPARSYM) (setq PCOUNT (1+ PCOUNT)))
-               ((= N CPARSYM) (setq PCOUNT (1- PCOUNT))))
-         (setq I (1+ N))
-         (GO STRLOOP)
- NOCOMS  (setq SLOC (INDENT-POS A))
-         (setq A (DROPTRAILINGBLANKS A))
-         (cond ((NULL SLOC) (setq SLOC PSLOC) (GO READLOOP)))
-         (cond ((EQ (ELT A (MAXINDEX A)) XCAPE)
-                (setq CONTINUE T a (subseq A (MAXINDEX A))))
-               ((setq CONTINUE NIL)))
-         (if (and (null LINES) (= SLOC 0)) ;;test for skipping constructors
-             (if (and |$byConstructors|
-                      (null (search "==>" a))
-                      (not (member (setq functor (intern
-                                    (substring a 0 (STRPOSL ": (=" A 0 NIL))))
-                                   |$byConstructors|)))
-                 (setq $skipme 't)
-               (progn (push functor |$constructorsSeen|) (setq $skipme nil))))
-         (when (and LINES (EQL SLOC 0))
-             (IF (AND NCOMBLOCK (NOT (ZEROP (CAR NCOMBLOCK))))
-               (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist))
-	     (IF (NOT (IS-CONSOLE in-stream))
-		 (setq $preparse-last-line
-		       (nreverse $echolinestack)))
-             (RETURN (PAIR (NREVERSE NUMS)
-                        (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES)))))
-         (cond ((> PARENLEV 0) (PUSH NIL LOCS) (setq SLOC PSLOC) (GO REREAD)))
-         (COND (NCOMBLOCK
-                (FINCOMBLOCK NUM NUMS LOCS NCOMBLOCK linelist)
-                (setq NCOMBLOCK ())))
-         (PUSH SLOC LOCS)
- REREAD  (PREPARSE-ECHO LineList)
-         (PUSH A LINES)
-         (PUSH NUM NUMS)
-         (setq PARENLEV (+ PARENLEV PCOUNT))
-         (when (and (is-console in-stream) (not continue))
-            (setq $preparse-last-line nil)
-             (RETURN (PAIR (NREVERSE NUMS)
-                           (PARSEPILES (NREVERSE LOCS) (NREVERSE LINES)))))
- 
-         (GO READLOOP)))
- 
-;; NUM is the line number of the current line
-;; OLDNUMS is the list of line numbers of previous lines
-;; OLDLOCS is the list of previous indentation locations
-;; NCBLOCK is the current comment block
-(DEFUN FINCOMBLOCK (NUM OLDNUMS OLDLOCS NCBLOCK linelist)
-  (PUSH
-    (COND ((EQL (CAR NCBLOCK) 0) (CONS (1- NUM) (REVERSE (CDR NCBLOCK))))
-	      ;; comment for constructor itself paired with 1st line -1
-          ('T
-           (COND ($EchoLineStack
-                  (setq NUM (POP $EchoLineStack))
-                  (PREPARSE-ECHO linelist)
-                  (SETQ $EchoLineStack (LIST NUM))))
-	   (cons
-            ;; scan backwards for line to left of current
-	    (DO ((onums oldnums (cdr onums))
-		 (olocs oldlocs (cdr olocs))
-		 (sloc (car ncblock)))
-		((null onums) nil)
-		(if (and (numberp (car olocs))
-			 (<= (car olocs) sloc))
-		    (return (car onums))))
-	    (REVERSE (CDR NCBLOCK)))))
-    $COMBLOCKLIST))
- 
-(defun PARSEPRINT (L)
-  (if L
-      (progn (format t "~&~%       ***       PREPARSE      ***~%~%")
-             (dolist (X L) (format t "~5d. ~a~%" (car x) (cdr x)))
-             (format t "~%"))))
- 
-(DEFUN STOREBLANKS (LINE N)
-   (DO ((I 0 (ADD1 I))) ((= I N) LINE) (SETF (CHAR LINE I) #\ )))
- 
-(DEFUN INITIAL-SUBSTRING (PATTERN LINE)
-   (let ((ind (mismatch PATTERN LINE)))
-     (OR (NULL IND) (EQL IND (SIZE PATTERN)))))
- 
-(DEFUN SKIP-IFBLOCK (X)
-   (PROG (LINE IND)
-     (DCQ (IND . LINE) (preparseReadLine1 X))
-      (IF (NOT (STRINGP LINE))  (RETURN (CONS IND LINE)))
-      (IF (ZEROP (SIZE LINE)) (RETURN (SKIP-IFBLOCK X)))
-      (COND ((CHAR= (ELT LINE 0) #\) )
-          (COND
-            ((INITIAL-SUBSTRING ")if" LINE)
-                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 3)))
-                       (RETURN (preparseReadLine X)))
-                      ('T (RETURN (SKIP-IFBLOCK X)))))
-            ((INITIAL-SUBSTRING ")elseif" LINE)
-                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 7)))
-                       (RETURN (preparseReadLine X)))
-                      ('T (RETURN (SKIP-IFBLOCK X)))))
-            ((INITIAL-SUBSTRING ")else" LINE)
-             (RETURN (preparseReadLine X)))
-            ((INITIAL-SUBSTRING ")endif" LINE)
-             (RETURN (preparseReadLine X)))
-            ((INITIAL-SUBSTRING ")fin" LINE)
-	     (RETURN (CONS IND NIL))))))
-      (RETURN (SKIP-IFBLOCK X)) ) )
- 
-(DEFUN SKIP-TO-ENDIF (X)
-   (PROG (LINE IND)
-     (DCQ (IND . LINE) (preparseReadLine1 X))
-      (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE)))
-            ((INITIAL-SUBSTRING LINE ")endif")
-             (RETURN (preparseReadLine X)))
-            ((INITIAL-SUBSTRING LINE ")fin") (RETURN (CONS IND NIL)))
-            ('T (RETURN (SKIP-TO-ENDIF X))))))
- 
-(DEFUN preparseReadLine (X)
-    (PROG (LINE IND)
-      (DCQ (IND . LINE) (preparseReadLine1 X))
-      (COND ((NOT (STRINGP LINE)) (RETURN (CONS IND LINE))))
-      (COND ((ZEROP (SIZE LINE))
-             (RETURN (CONS IND LINE))))
-      (COND ((CHAR= (ELT LINE 0) #\) )
-          (COND
-            ((INITIAL-SUBSTRING ")if" LINE)
-                (COND ((EVAL (|string2BootTree| (STOREBLANKS LINE 3)))
-                       (RETURN (preparseReadLine X)))
-                      ('T (RETURN (SKIP-IFBLOCK X)))))
-            ((INITIAL-SUBSTRING ")elseif" LINE)
-             (RETURN (SKIP-TO-ENDIF X)))
-            ((INITIAL-SUBSTRING ")else" LINE)
-             (RETURN (SKIP-TO-ENDIF X)))
-            ((INITIAL-SUBSTRING ")endif" LINE)
-             (RETURN (preparseReadLine X)))
-            ((INITIAL-SUBSTRING ")fin" LINE)
-	     (SETQ *EOF* T)
-	     (RETURN (CONS IND NIL)) ) )))
-      (RETURN (CONS IND LINE)) ))
- 
-(DEFUN preparseReadLine1 (X)
-    (PROG (LINE IND)
-      (SETQ LINE (if $LINELIST
-                     (pop $LINELIST)
-              (expand-tabs (get-a-line in-stream))))
-      (setq $preparse-last-line LINE)
-      (and (stringp line) (incf $INDEX))
-      (COND
-        ( (NOT (STRINGP LINE))
-          (RETURN (CONS $INDEX LINE)) ) )
-      (SETQ LINE (DROPTRAILINGBLANKS LINE))
-      (PUSH (COPY-SEQ LINE) $EchoLineStack)
-    ;; next line must evaluate $INDEX before recursive call
-      (RETURN
-        (CONS
-          $INDEX
-          (COND
-            ( (AND (> (SETQ IND (MAXINDEX LINE)) -1) (char= (ELT LINE IND) #\_))
-              (setq $preparse-last-line
-                    (STRCONC (SUBSTRING LINE 0 IND) (CDR (preparseReadLine1 X))) ))
-            ( 'T
-              LINE ) ))) ) )
- 
-;;(defun preparseReadLine (X)
-;;  (declare (special $LINELIST $echoLineStack))
-;;  (PROG (LINE IND)
-;;        (setq LINE
-;;              (if $LINELIST
-;;                  (pop $LINELIST)
-;;                  (get-a-line in-stream)))
-;;        (setq $preparse-last-line LINE)
-;;        (and (stringp line) (incf $INDEX))
-;;        (if (NOT (STRINGP LINE)) (RETURN (CONS $INDEX LINE)))
-;;        (setq LINE (DROPTRAILINGBLANKS LINE))
-;;        (if Echo-Meta (PUSH (COPY-SEQ LINE) $EchoLineStack))
-;;        ; next line must evaluate $INDEX before recursive call
-;;        (RETURN
-;;          (CONS $INDEX
-;;                (if (and (> (setq IND (MAXINDEX LINE)) -1)
-;;                       (EQ (ELT LINE IND) #\_))
-;;                    (setq $preparse-last-line
-;;                        (STRCONC (SUBSEQ LINE 0 IND)
-;;                                 (CDR (preparseReadLine X))))
-;;                    LINE)))))
- 
-(defun PREPARSE-ECHO (linelist)
-  (if Echo-Meta (REPEAT (IN X (REVERSE $EchoLineStack))
-                        (format out-stream "~&;~A~%" X)))
-  (setq $EchoLineStack ()))
- 
-(defun ESCAPED (STR N) (and (> N 0) (EQ (CHAR STR (1- N)) XCAPE)))
- 
-(defun atEndOfUnit (X) (NULL (STRINGP X)) )
- 
-(defun PARSEPILES (LOCS LINES)
-  "Add parens and semis to lines to aid parsing."
-  (mapl #'add-parens-and-semis-to-line (NCONC LINES '(" ")) (nconc locs '(nil)))
-  LINES)
- 
-(defun add-parens-and-semis-to-line (slines slocs)
- 
-  "The line to be worked on is (CAR SLINES).  It's indentation is (CAR SLOCS).  There
-is a notion of current indentation. Then:
- 
-A. Add open paren to beginning of following line if following line's indentation
-   is greater than current, and add close paren to end of last succeeding line
-   with following line's indentation.
-B. Add semicolon to end of line if following line's indentation is the same.
-C. If the entire line consists of the single keyword then or else, leave it alone."
- 
-  (let ((start-column (car slocs)))
-    (if (and start-column (> start-column 0))
-        (let ((count 0) (i 0))
-          (seq
-           (mapl #'(lambda (next-lines nlocs)
-                     (let ((next-line (car next-lines)) (next-column (car nlocs)))
-                       (incf i)
-                       (if next-column
-                           (progn (setq next-column (abs next-column))
-                                  (if (< next-column start-column) (exit nil))
-                                  (cond ((and (eq next-column start-column)
-                                              (rplaca nlocs (- (car nlocs)))
-                                              (not (infixtok next-line)))
-                                         (setq next-lines (drop (1- i) slines))
-                                         (rplaca next-lines (addclose (car next-lines) #\;))
-                                         (setq count (1+ count))))))))
-                 (cdr slines) (cdr slocs)))
-          (if (> count 0)
-              (progn (setf (char (car slines) (1- (nonblankloc (car slines))))
-                           #\( )
-                     (setq slines (drop (1- i) slines))
-                     (rplaca slines (addclose (car slines) #\) ))))))))
- 
-(defun INFIXTOK (S) (MEMBER (STRING2ID-N S 1) '(|then| |else|) :test #'eq))
- 
- 
-(defun ADDCLOSE (LINE CHAR)
-  (cond ((char= (FETCHCHAR LINE (MAXINDEX LINE)) #\; )
-         (SETELT LINE (MAXINDEX LINE) CHAR)
-         (if (char= CHAR #\;) LINE (suffix #\; LINE)))
-        ((suffix char LINE))))
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet
index 962138b..14e9ffe 100644
--- a/src/interp/util.lisp.pamphlet
+++ b/src/interp/util.lisp.pamphlet
@@ -149,7 +149,7 @@ After this function is called the image is clean and can be saved.
   (resethashtables)
   (setq *load-verbose* nil)
   (|setBootAutloadProperties| comp-functions comp-files)
-  (|setBootAutloadProperties| parse-functions parse-files)
+;  (|setBootAutloadProperties| parse-functions parse-files)
   (|setBootAutloadProperties| browse-functions browse-files)
   (|setBootAutloadProperties| translate-functions translate-files)
   (|setNAGBootAutloadProperties| nagbr-functions nagbr-files)
@@ -354,15 +354,15 @@ the chapter name.
 This is the {\bf boot parser} subsystem. It is only needed by 
 developers who translate boot code to Common Lisp.
 <<parse-functions>>=
-(setq parse-functions
-      '(
-;;      loadparser
-	|oldParserAutoloadOnceTrigger|
-	|PARSE-Expression|
-	boot-parse-1
-	BOOT
-	SPAD
-	init-boot/spad-reader))
+;(setq parse-functions
+;      '(
+;;;      loadparser
+;	|oldParserAutoloadOnceTrigger|
+;	|PARSE-Expression|
+;	boot-parse-1
+;	BOOT
+;	SPAD
+;	init-boot/spad-reader))
 
 @
 \subsubsection{comp-functions}