* boot/Makefile.pamphlet: Remove.

	* boot/translator.boot: New.
	* boot/translator.boot: Remove.
	* boot/tokens.boot: New.
	* boot/tokens.boot.pamphlet: Remove.
	* boot/scanner.boot: New.
	* boot/scanner.boot.pamphlet: Remove.
	* boot/pile.boot: New.
	* boot/pile.boot.pamphlet: Remove.
	* boot/parser.boot: New.
	* boot/parser.boot.pamphlet: New.
	* boot/initial-env.lisp: New.
	* boot/initial-env.lisp.pamphlet: Remove.
	* boot/includer.boot: New.
	* boot/includer.boot.pamphlet: Remove.
	* boot/ast.boot: New.
	* boot/ast.boot.pamphlet: Remove.

20 files changed, 5719 insertions, 7908 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index c52458b5..5bdbf5f8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,25 @@
 2008-01-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/Makefile.pamphlet: Remove.
+	* boot/translator.boot: New.
+	* boot/translator.boot: Remove.
+	* boot/tokens.boot: New.
+	* boot/tokens.boot.pamphlet: Remove.
+	* boot/scanner.boot: New.
+	* boot/scanner.boot.pamphlet: Remove.
+	* boot/pile.boot: New.
+	* boot/pile.boot.pamphlet: Remove.
+	* boot/parser.boot: New.
+	* boot/parser.boot.pamphlet: New.
+	* boot/initial-env.lisp: New.
+	* boot/initial-env.lisp.pamphlet: Remove.
+	* boot/includer.boot: New.
+	* boot/includer.boot.pamphlet: Remove.
+	* boot/ast.boot: New.
+	* boot/ast.boot.pamphlet: Remove.
+
+2008-01-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	Fix SF/1872551
 	* interp/c-util.boot (dollarIfRepHack): New.
 	(RepIfRepHack): Likewise.
diff --git a/src/boot/Makefile.in b/src/boot/Makefile.in
index 94d98c33..c438d385 100644
--- a/src/boot/Makefile.in
+++ b/src/boot/Makefile.in
@@ -1,9 +1,68 @@
+## Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
+## All rights reserved.
+## Copyright (C) 2007-2008, Gabriel Dos Reis.
+## All rights reserved.
+##
+## Redistribution and use in source and binary forms, with or without
+## modification, are permitted provided that the following conditions are
+## met:
+##
+##     - Redistributions of source code must retain the above copyright
+##       notice, this list of conditions and the following disclaimer.
+##
+##     - Redistributions in binary form must reproduce the above copyright
+##       notice, this list of conditions and the following disclaimer in
+##       the documentation and/or other materials provided with the
+##       distribution.
+##
+##     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+##       names of its contributors may be used to endorse or promote products
+##       derived from this software without specific prior written permission.
+##
+## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+## IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+## TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+## PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+## OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+## EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+## PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+## PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+## LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+## NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+## SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+##
+
+##
+## Abstract:
+##   OpenAxiom is built in layers. The first layer is contructed into
+##   an image called `bootsys'. The `bootsys' image is used
+##   to translate Boot code to Common Lisp code.  Since a Boot coded
+##   interpreter is needed to translate the code for the Boot coded
+##   interpreter we have a ``boot-strapping'' problem.  In order to get
+##   the whole process to start we need certain files kept in 
+##   common lisp form. This directory contains those files.
+##
+
+## We start with a Lisp image created in a previous build step (src/lisp).
+## That image is used to build Boot translator executable through the
+## entire bootstrap process.
+
 AXIOM_LOCAL_LISP_sources = initial-env.lisp
 AXIOM_LOCAL_LISP = ../lisp/lisp$(EXEEXT)
-PROCLAIMS=(load "$(srcdir)/boot-proclaims.lisp")
 
+
+## FASLs that comprises `bootsys'
+boot_SOURCES = initial-env.lisp $(boot_sources)
+boot_sources = tokens.boot includer.boot scanner.boot \
+	pile.boot ast.boot parser.boot  translator.boot
+boot_clisp = $(boot_sources:.boot=.clisp)
 boot_objects = initial-env.$(FASLEXT) $(boot_sources:.boot=.$(FASLEXT))
 
+# Garbage produced by GCL during compilation
+boot_data = $(boot_sources:.boot=.data)
+boot_fn = $(boot_sources:.boot=.fn)
+
+##
 ## ECL's program construction model is not based on image-dumping.  It is
 ## closer to `traditional C' application building.  Therefore, since
 ## bootsys is an augmentation of base-lisp, we need to have the objects
@@ -12,28 +71,10 @@ ifeq (@axiom_lisp_flavor@,ecl)
 boot_objects_extra = ../lisp/core.$(FASLEXT)
 endif
 
-boot_SOURCES = \
-	initial-env.lisp.pamphlet \
-	$(addsuffix .pamphlet, $(boot_sources))
-
-pamphlets = Makefile.pamphlet $(boot_SOURCES)
-boot_sources = tokens.boot includer.boot scanner.boot \
-	pile.boot ast.boot parser.boot  translator.boot
-
-boot_clisp = $(boot_sources:.boot=.clisp)
-boot_data = $(boot_sources:.boot=.data)
-boot_fn = $(boot_sources:.boot=.fn)
-boot_cached_clisp = $(boot_sources:.boot=.clisp)
-
-COMPILE_LISP = \
-	$(axiom_build_document) --tag=lisp --mode=compile --output=$@
-
-BOOT_TO_LISP = \
-	$(axiom_build_document) --tag=boot --mode=translate \
-	--use=./prev-stage/bootsys $<
-
+# reference to this directory from toplevel
 subdir = src/boot/
  
+## Make rule toplevel entry points.
 .PHONY: all-ax all-boot
 all: all-ax all-boot
 
@@ -43,119 +84,139 @@ stamp: $(axiom_build_bindir)/bootsys$(EXEEXT)
 	@rm -f stamp
 	$(STAMP) $@
 
+## The final `bootsys' image.
 $(axiom_build_bindir)/bootsys$(EXEEXT): stage2/bootsys$(EXEEXT)
 	$(mkinstalldirs) $(axiom_build_bindir)
 	$(INSTALL_PROGRAM) stage2/bootsys$(EXEEXT) $(axiom_build_bindir)
 
-.PRECIOUS: stage0/%.clisp
-.PRECIOUS: stage0/%.$(FASLEXT)
+.PRECIOUS: strap/%.$(FASLEXT)
+
+##
+## The bootstrapping `bootsys' image.
+##
 
-stage0_boot_clisp = $(addprefix stage0/, $(boot_clisp))
+# The bootstrapping Lisp code is cached in the subdirectory strap/.
+# It is built first, followed by stage 1, and stage 2 `bootsys' images.
+strap_boot_clisp = $(addprefix strap/, $(boot_clisp))
 
-stage0_boot_objects = $(addprefix stage0/, $(boot_objects))
+strap_boot_objects = \
+	$(addprefix strap/, $(boot_objects))
 
-stage0/stamp: stage0/bootsys$(EXEEXT)
+strap/stamp: strap/bootsys$(EXEEXT)
 	@rm -f $@
 	@$(STAMP) $@
 
-stage0/bootsys$(EXEEXT): $(stage0_boot_objects)
+strap/bootsys$(EXEEXT): $(strap_boot_objects)
 	$(AXIOM_LOCAL_LISP) -- --make --main="|AxiomCore|::|topLevel|"\
-		 --output=$@ --load-directory=stage0 \
-		$(boot_objects_extra) $(stage0_boot_objects)
+		 --output=$@ --load-directory=strap \
+		$(boot_objects_extra) $(strap_boot_objects)
 
 
-.PRECIOUS: %/.started
-%/.started:
-	$(mkinstalldirs) $*
-	$(STAMP) $@
-
-$(stage0_boot_objects): $(AXIOM_LOCAL_LISP)
-
-stage0/%.clisp: $(srcdir)/%.boot.pamphlet stage0/.started
-	$(axiom_build_document) --tangle=$*.clisp --output=$@ $<
+$(strap_boot_objects): $(AXIOM_LOCAL_LISP)
 
-%/initial-env.$(FASLEXT): initial-env.lisp %/.started
-	$(AXIOM_LOCAL_LISP) -- --compile --output=$@ $<
+##
+## Stage 1 `bootsys' image.
+##
 
 .PRECIOUS: stage1/%.$(FASLEXT)
 .PRECIOUS: stage1/%.clisp
 
+stage1_boot_clisp = $(addprefix stage1/, $(boot_clisp))
+
+stage1_boot_objects = \
+	$(addprefix stage1/, $(boot_objects))
+
 stage1/stamp: stage1/bootsys$(EXEEXT)
 	rm -f $@
 	$(STAMP) $@
 
-stage1/bootsys$(EXEEXT): $(addprefix stage1/, $(boot_objects))
+stage1/bootsys$(EXEEXT): $(stage1_boot_objects)
 	$(AXIOM_LOCAL_LISP) -- --make --main="|AxiomCore|::|topLevel|" \
 		 --output=$@ --load-directory=stage1 \
-		$(boot_objects_extra) $(addprefix stage1/, $(boot_objects))
+		$(boot_objects_extra) $(stage1_boot_objects)
+
+stage1/%.clisp: %.boot strap/stamp stage1/.started
+	strap/bootsys -- --translate --output=$@ $<
+
 
-stage1/%.clisp: %.boot stage0/stamp stage1/.started
-	stage0/bootsys -- --translate --output=$@ $<
+##
+## Stage 2 `bootsys' image.
+##
 
 .PRECIOUS: stage2/%.$(FASLEXT)
 .PRECIOUS: stage2/%.clisp
 
+stage2_boot_clisp = $(addprefix stage2/, $(boot_clisp))
+
+stage2_boot_objects = \
+	$(addprefix stage2/, $(boot_objects))
+
 stage2/stamp: stage2/bootsys$(EXEEXT)
 	@echo Building stage 2
 	$(STAMP) $@
 
-stage2/bootsys$(EXEEXT): $(addprefix stage2/, $(boot_objects))
+stage2/bootsys$(EXEEXT): $(stage2_boot_objects)
 	$(AXIOM_LOCAL_LISP) -- --make --main="|AxiomCore|::|topLevel|" \
 		--output=$@ --load-directory=stage2 \
-		$(boot_objects_extra) $(addprefix stage2/, $(boot_objects))
+		$(boot_objects_extra) $(stage2_boot_objects)
 
 stage2/%.clisp: %.boot stage1/stamp stage2/.started
 	stage1/bootsys -- --translate --output=$@ $<
 
+##
+## Generic rules for compiling FASLs
+##
+
+.PRECIOUS: %/.started
+%/.started:
+	$(mkinstalldirs) $*
+	$(STAMP) $@
+
 ## Dependency for various modules.  
 ## FIXME: This should be automatically extracted from the
 ## Boot source file at packaging time.
 
+%/initial-env.$(FASLEXT): initial-env.lisp %/.started
+	$(AXIOM_LOCAL_LISP) -- --compile --output=$@ $<
+
 %/tokens.$(FASLEXT): %/tokens.clisp %/initial-env.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
 %/includer.$(FASLEXT): %/includer.clisp %/tokens.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
 %/scanner.$(FASLEXT): %/scanner.clisp %/tokens.$(FASLEXT) %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
 %/pile.$(FASLEXT): %/pile.clisp %/scanner.$(FASLEXT) %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
 %/ast.$(FASLEXT): %/ast.clisp %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
 %/parser.$(FASLEXT): %/parser.clisp %/ast.$(FASLEXT) %/scanner.$(FASLEXT) \
 		 %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
 %/translator.$(FASLEXT): %/translator.clisp %/parser.$(FASLEXT) \
 		%/ast.$(FASLEXT) %/pile.$(FASLEXT) %/scanner.$(FASLEXT) \
 		%/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-.PRECIOUS: %.boot
-%.boot: $(srcdir)/%.boot.pamphlet
-	$(axiom_build_document) --tangle $< 
-.PRECIOUS: %.boot
+	$(AXIOM_LOCAL_LISP) -- --output=$@ --compile --load-directory=$* $<
 
-%.boot: $(srcdir)/%.boot.pamphlet
-	$(axiom_build_document) --tangle $<
-.PRECIOUS: %.lisp
 
-initial-env.lisp: initial-env.lisp.pamphlet
-	$(axiom_build_document) --tangle $<
+##
+## Cleaning mess
+##
 
 mostlyclean-local:
 	@rm -f $(axiom_build_bindir)/bootsys$(EXEEXT)
 	@rm -rf prev-stage
-	@rm -rf stage0 stage1 stage2
+	@rm -rf strap stage1 stage2
 	@rm -f *.data *.fn
 	@rm -f stamp
 
 clean-local: mostlyclean-local
 	@rm -f $(boot_sources)
-	@rm -f *.clisp *.lisp
+	@rm -f *.clisp
 
 distclean-local: clean-local
diff --git a/src/boot/Makefile.pamphlet b/src/boot/Makefile.pamphlet
deleted file mode 100644
index 6ce07945..00000000
--- a/src/boot/Makefile.pamphlet
+++ /dev/null
@@ -1,1630 +0,0 @@
-%% Oh Emacs, this is a -*- Makefile -*-, so give me tabs.
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/Makefile} Pamphlet}
-\author{Timothy Daly \and Gabriel Dos~Reis}
-
-\begin{document}
-\maketitle
-
-\begin{abstract}
-  \Tool{OpenAxiom} is built in layers. The first layer is contructed into
-  an image called {\bf bootsys}. The \Tool{bootsys} image is used
-  to translate Boot code to Common Lisp code.  Since a Boot coded
-  interpreter is needed to translate the code for the Boot coded
-  interpreter we have a ``boot-strapping'' problem.  In order to get
-  the whole process to start we need certain files kept in 
-  common lisp form. This directory contains those files.
-\end{abstract}
-\eject
-
-\tableofcontents
-\eject
-
-\section{Introduction}
-\label{sec:intro}
- 
-The Scratchpad language is implemented by using a mixture of Lisp and
-a more convenient language for writing Lisp called \emph{Boot}.
-This document contains a description of the Boot language, and some
-details of the resulting Lisp programs.
-The description of the translation
-functions available are at the end of this file.
- 
-The main difference between Lisp and Boot is in the syntax for
-the application of a function to its argument.
-The Lisp format [[(F X Y Z)]], means, when [[F]] is a function,
-the application of [[F]] to its arguments [[X]], [[Y]], and [[Z]],
-is written in Boot as [[F(X,Y,Z)]].
-When [[F]] is a special Lisp word it will be written
-in Boot by using some other syntactic construction, such as spelling
-in CAPITAL LETTERS.
- 
-Boot contains an easy method of writing expressions that denote lists,
-and provides an analogous method of writing patterns containing variables
-and constants which denote a particular class of lists.  The pattern
-is matched against a particular list at run time,
-and if the list belongs to the class then its variables will
-take on the values of components of the list.  Similarly, Boot provides
-an easy way of writting discriminated unions or algebraic types, and 
-pattern matching as found in ML.
- 
- A second convenient feature provided by Boot is a method of
-writing programs that iterate over the elements of one or more lists
-and which either transform the state of the machine, or
-produce some object from the list or lists.
-
-
-\section{Boot To Common Lisp Translaters}
-\label{sec:boot-to-cl}
-
-The Boot to Common Lisp translation is organized in several 
-separate logical phases.  At the moment, those phases are not
-really separate; but from a logical point of view, it is better
-to think of them that way.
-
-
-\subsection{The Boot Includer}
-\label{sec:boot-to-cl:includer}
-
-The Boot Includer is the module that reads Boot codes from source files.
-The details of the Includer, as well as the grammar of the include
-files are to be found in \File{includer.boot}
-
-
-\subsection{The Scanner}
-\label{sec:boot-to-cl:scanner}
-
-The tokenization process is implemented in \File{scanner.boot}.  Further 
-details about keywords and reserved identifiers are available in
-\File{tokens.boot}.
-
-
-\subsection{Piling}
-\label{sec:boot-to-cl:piling}
-
-The Boot language uses layout to delimit blocks of expressions. After
-the scanner pass, and before the parser pass is another pass called
-\emph{piling}.  The piling pass inserts tokens to unambiguously delimit
-the boundaries of piles.  This is implemented in 
-\File{pile.boot}
-
-
-\subsection{The Parser}
-\label{sec:boot-to-cl:piling}
-
-The Boot parser is implemented in \File{parser.boot}.  It is a hand-written 
-recursive descent parser 
-based on \emph{parser combinators} methodology.  Thoe files also
-implicitly defines the grammar of the Boot language.
-
-
-\subsection{The Transformer}
-\label{sec:boot-to-cl:transfo}
-
-As observed earlier, the Boot language was originally defined as a syntactic
-sugar over Common Lisp.  Consequently, it semantics is defined by
-tranformation to Lisp.  The transformers are defined in
-\File{ast.boot}.  
-
-\subsection{Utils}
-\label{sec:boot-to-cl:utils}
-
-Finally, the file \File{translator.boot} is a pot-pourri of many utility
-functions.  It also contains the entry points to the Boot translater.
-
-
-\section{Boot}
-\label{sec:boot}
- 
-\subsection{Lines and Commands}
- 
-If the first character of a line is a closing parenthesis the line
-is treated as a command which controls the lines that will be
-passed to the translater rather than being passed itself.
-The command [[)include filename]] filemodifier will for example
-be replaced by the lines in the file [[filename filemodifier]].
- 
-If a line starts with a closing parenthesis it will be called a command
-line, otherwise it will be called a plain line.
-The command lines are
-\begin{verbatim} 
-name            as written
- 
-Include         )include filename filemodifier
-IncludeLisp     )includelisp filename filemodifier
-If              )if bootexpression
-Else            )else
-ElseIf          )elseif bootexpression
-EndIf           )endif
-Fin             )fin
-Say             )say  string
-Eval            )eval bootexpression
-EvalStrings     )evalstrings bootexpression
-Package         )package packagename
- 
-SimpleLine::= PlainLine | Include | IncludeLisp |Say | Eval | EvalStrings
-              | Package
-\end{verbatim} 
-
-A [[PlainLine]] is delivered to the translater as is.
- 
-An [[Include]] delivers the lines in the file filename.filemodifier,
-treated as boot lines.
- 
-An [[IncludeLisp]] delivers the lines in the specified file, treated as Lisp
-lines. The only comments allowed in lisp files that are included in
-this way require that the semicolon is at the beginning of the line.
- 
-A [[Say]] outputs the remainder of the line to the console,
-   delivering nothing to the translater.
- 
-An [[Eval]] translates the reminder of the line, assumed to be
-   written in Boot, to Lisp, and evaluates it, delivering nothing to
-   the translater.
- 
-An [[EvalStrings]] also translates and evaluates the rest of the line
-   but this time assumes that the Boot expression denotes a list
-   of strings which are then delivered to the translater
-   instead of the EvalString line. The strings are treated as Boot lines.
- 
-It is also possible to include or exclude lines based upon some
-condition which is the result of translating and evaluating
-the boot expression that follows an )if or )elseif command.
-This construction will be called a Conditional. A file will be
-composed from SimpleLines and Conditionals. A file is either
-terminated by the end of file or by a Fin line.
-\begin{verbatim}  
-Components ::=(SimpleLine | Conditional)*
- 
-File ::= Components  ( Fin | empty)
- 
-A conditional is bracketed by an If and an EndIf.
- 
-Conditional ::= If Components Elselines EndIf
-\end{verbatim} 
-
-If the boot expression following the )if has value true then the
-Components are delivered but not the ElseLines,
-otherwise the Components are ignored ,and the ElseLines
-are delivered to the translater. In any case the lines after
-the EndIf are then processed.
-\begin{verbatim}  
-ElseLines ::= Else Components | ElseIf Components ElseLines | empty
-\end{verbatim} 
-
-When the Elselines of a Conditional is being included then if an
-"Else Components" phrase is encountered then the following
-Components are included
-otherwise if an "ElseIf Components ElseLines" phrase is encountered then
-the boot expression following the )elseif is evaluated and
-if true the following Components are included, if false the
-following ElseLines is included.
- 
- 
-\subsection{Boot syntax and semantics}
-
-The semantics of Boot was originally defined by translation to Lisp.
-Ideally, we would like to give it a self-contained semantics, 
-without explicitly referring to Lisp, or if we must we should use
-lambda calculus.
-
-\subsubsection{Source character set}
-\label{sec:boot:char-set}
-
-???What is the source character set???  That of Common Lisp?
-
-\subsubsection{Identifiers}
-\label{sec:boot:identifier}
- 
-The standard identifiers start with a letter ([[a-z]] or [[A-Z]])
-dollar sign ([[$]]), question mark ([[?]]), or the percent sign 
-([[\%]]), and are followed by any number of letters, digits, single 
-quotes([[']]), question marks, or percent signs.
-It is possible however, by using the escape character ([[\_]]), 
-to construct identifiers that contain any
-characters except the blank or newline character. The rules in this case
-are that an escape character followed by any non-blank character
-will start an identifier with that character.  Once an identifier
-has been started either in this way or by a letter, [[$]], or 
-[[%]], then it may be continued either with a letter, digit, 
-quote , question mark or percent sign, or with
-an escape character followed by any non-blank character.
-Certain words having the form of identifiers are not classified as
-such, but are reserved words. They are listed below.
- 
-An identifier ends when a blank or end of line is encountered, or
-an escape character followed by a blank or end of line, or a
-character which is not a letter, digit, quote, question mark
-or percent sign is found. Two identifiers are equal if the
-strings produced by replacing each escape followed by a character
-by that character are equal character by character.
- 
-\subsubsection{Numbers}
-\label{sec:boot:number}
- 
-Integers start with a digit ([[0-9]]) and are followed by any number
-of digits.  The syntax for floating point numbers is
-\begin{verbatim}
-<.I | I. | I.I> <E|e> <+ | - | empty> I 
-\end{verbatim}
-where I is an integer.
- 
-\subsubsection{Strings}
-\label{sec:boot:string}
- 
-Strings of characters are enclosed by double quote signs. They cannot
-span two or more lines and an escape character within a string will
-include the next character regardless of its nature.
-The meaning of a string depends somewhat on the context in which
-it is found, but in general a bare string denotes the interned atom
-making up its body whereas when it is preceded by a single quote (')
-it denotes the string of characters enclosed.
- 
-\subsubsection{S-expressions}
-\label{sec:boot:s-expression}
- 
-An s-expression is preceded by a single quote and is followed by
-a Lisp s-expression.
-\begin{verbatim}  
-sexpression ::=identifier | integer | MINUS integer | float | string
-            | QUOTE sexpression | parenthesized sexpression1
- 
-sexpression1 ::=sexpression (DOT sexpression | sexpression1)| empty
-\end{verbatim}  
-
-There are two ways to quote an iddentifier: either 'name or "name", which
-both give rise to (QUOTE name). However a string that is a
-component of an sexpression will denote the string unless it is the
-sole component of the s-expression in which case it denotes a string
-i.e. '"name" gives rise to "name" in Lisp rather than (QUOTE "name").
- 
- 
-\subsubsection{Keywords}
-\label{sec:boot:keyword}
- 
-The table of key words follows, each is given an upper case
-name for use in the description of the syntax.
-\begin{verbatim} 
-        as written      name
- 
-            and          AND
-            by           BY
-            case         CASE
-            cross        CROSS
-            else         ELSE
-            for          FOR
-            if           IF
-            in           IN
-            is           IS
-            isnt         ISNT
-            of           OF
-            or           OR
-            repeat       REPEAT
-            return       RETURN
-            structure    STRUCTURE
-            then         THEN
-            until        UNTIL
-            where        WHERE
-            while        WHILE
-            .            DOT
-            :            COLON
-            ,            COMMA
-            ;            SEMICOLON
-            *            TIMES
-            **           POWER
-            /            SLASH
-            +            PLUS
-            -            MINUS
-            <            LT
-            >            GT
-            <=           LE
-            >=           GE
-            =            SHOEEQ
-            ^            NOT
-            ^=           NE
-            ..           SEG
-            #            LENGTH
-            =>           EXIT
-            :=           BEC
-            ==           DEF
-            ==>          MDEF
-            (            OPAREN
-            )            CPAREN
-            (|           OBRACK
-            |)           CBRACK
-            [            OBRACK
-            ]            CBRACK
-            suchthat     BAR
-            '            QUOTE
-            |            BAR
-\end{verbatim}  
- 
-\subsubsection{Primary}
-\label{sec:boot:primar-expr}
-
-\begin{verbatim} 
-constant::= integer | string | float | sexpression
-\end{verbatim} 
-
-The value of a constant does not depend on the context in which it
-is found.
-\begin{verbatim}  
-primary::= name | constant | construct | block | tuple |  pile
-\end{verbatim} 
-
-The primaries are the simplest constituents of the language and
-either denote some object or perform some transformation of the
-machine state, or both.
-The statements are the largest constituents and enclosing them
-in parentheses converts them into a primary.
- 
-An alternative method of grouping uses indentation to indicate the
-parenthetical structure.
-A number of lines whose first non-space characters are in the same
-column will be called a \emph{pile}.  The translater first tokenizes the
-lines producing identifier, key word, integer, string or float tokens,
-and then examines the pile structure of a Boot program
-in order to add additional tokens called [[SETTAB]], [[BACKTAB]] 
-and [[BACKSET]].
-These tokens may be considered as commands for creating a pile.
-The [[SETTAB]] starts a new line indented from the previous line and
-pushes the resulting column number on to a stack of tab positions.
-The [[BACKTAB]] will start a new line at the column position found
-at the head of the stack and removes it from the stack.
-The [[BACKSET]] has the same effect as a [[BACKTAB]] immediately followed
-by a [[SETTAB]].
-The meaning of a sequence of tokens containing [[SETTAB]],
-[[BACKTAB]], and [[BACKSET]] is the same the sequence in which each
-[[SETTAB]] is replaced by [[OPAREN]] , each [[BACKTAB]] is replaced by
-[[CPAREN]], and each [[BACKSET]] is replaced by [[SEMICOLON]]. By
-construction the [[BACKTABS]] and [[SETTABS]] are properly nested.
-\begin{verbatim}  
-listof(p,s)== p | p s ... s p
- 
-parenthesized s ::=   OPAREN s CPAREN
-piled         s ::=   SETTAB s BACKTAB
- 
-blockof s ::=    parenthesized (listof (s,SEMICOLON))
-pileof s  ::=    piled         (listof (s,BACKSET  ))
-\end{verbatim} 
-
-A pileof s has the same meaning as a blockof s.
-There is however a slight difference because piling is weaker than
-separation by semicolons. In other words the pile items
-may be listof(s,SEMICOLON).
-In other words if statements::= listof(statement,SEMICOLON) then
-we can have a pileof statements which has the same meaning as
-the flattened sequence formed by replacing
-all [[BACKSET]]'s by [[SEMICOLON]]'s.
- 
-A blockof statement is translated to a compound statement
-e.g. in the absence of any exits,
-(a;b;c;d) is translated to (PROGN a b c d).
- 
-\subsubsection{Selectors}
-\label{sec:boot:selector}
-
-\begin{verbatim}  
-selector::= leftassociative(primary, DOT)
-\end{verbatim} 
-
-A selector [[a.b]] denotes some component of a structure, and in
-general is translated to [[(ELT a b)]]. There are some special identifiers
-that may be used in the [[b]] position to denote list components, of which
-more later.
-The [[DOT]] has a greater precedence than juxtaposition and is
-left associative, For example
-\begin{verbatim} 
-a.b.c  is grouped as (a.b).c which is translated to
-  (ELT (ELT a b) c)
- 
-application ::= selector selector ... selector
- 
-\end{verbatim} 
-
-Application of function to argument is denoted by juxtaposition.
- 
-A sequence of selectors is right associative and so
-[[f g h x]] is grouped as [[f(g(h x))]]. The applications [[f x]] and 
-[[f(x)]]
-mean the application of [[f]] to [[x]] and get translated to
-the Lisp [[(f x)]]. The application of a function to the empty list
-is written [[f()]], meaning the Lisp [[(f)]].  [[f(x,y,z)]] gets translated to
-the Lisp [[(f x y z)]].
-Common Lisp does not permit a variable to occur in operator position,
-so that when f is a variable its application has to be
-put in argument position of a [[FUNCALL]] or [[APPLY]].
-[[f(x,y,z)]] has to be replaced by [[FUNCALL(f,x,y)]] which gets translated to
-the Lisp [[(FUNCALL f x y z)]].
-In Common Lisp each symbol might refer
-to two objects a function and a non-function. In order to resolve
-this ambiguity when a function symbol appears in a context other
-than operator position it has to be preceded by the symbol [[FUNCTION]].
-Also it is possible to produce the function type symbol from the
-non-function symbol by applying [[SYMBOL-FUNCTION]] to it.
- 
-Certain reserved words called infixed operators namely
-[[POWER]], [[TIMES]], [[SLASH]], [[PLUS]], [[MINUS]], [[IS]],
-[[EQ]], [[NE]] , [[GT]], [[GE]], [[LT]], [[LE]], [[IN]], [[AND]], 
-[[OR]], indicate application by being placed between their 2 arguments.
- 
-Infixed application may be either right- or left-associative.
-\begin{verbatim}  
-rightassociative(p,o)::= p o p o p o ... o p
-                    ==  p o (p o (p o ... o p)))
- 
-leftassociative(p,o)::= p o p o p o ... o p
-                    ==  (((p o p) o p) o ...) o p
- 
- 
-exponent ::= rightassociative(application,POWER)
- 
-reduction ::= (infixedoperator |string | thetaname) SLASH application
-\end{verbatim} 
-
-In a reduction the application denotes a list of items and
-operator [[SLASH]] application accumulates the list elements from the
-left using the operator
-\begin{verbatim} 
-e.g.  +/[a,b,c] means (((0+a)+b)+c)
-\end{verbatim} 
-
-Only certain operators are provided with values when the list is empty
-they are [[and]], [[or]], [[+]], [[*]], [[max]], [[min]], [[append]], 
-[[union]]. However any function can be used as an operator by enclosing it 
-in double quotes. In this case the reduction is not applicable to an
-empty list.
-\begin{verbatim}  
-multiplication ::= rightassociative(exponent,TIMES|SLASH) | reduction
- 
-minus ::= MINUS multiplication | multiplication
- 
-arith ::= leftasscociative(minus,PLUS | MINUS)
- 
-is ::= arith | arith (IS | ISNT) pattern
- 
-comparison ::= is (EQ | NE | GT | GE | LT | LE | IN) is | is
- 
-and  ::= leftassociative (comparison,AND)
- 
-return ::= and | RETURN and
- 
-expression ::= leftassociative(return,OR)
-\end{verbatim}  
-
-The infixed operators denote application of the function to its
-two arguments. To summarize,
-the infixed operators are, in order of decreasing precedence
-strengths.
-\begin{verbatim}  
-        .
-        juxtaposition
-        **
-        * /
-        + -
-        is
-        = ^= > >= < <= in
-        and
-        or
-\end{verbatim} 
-
-\subsubsection{Conditionals}
-\label{sec:boot:conditional}
-
-\begin{verbatim}  
-conditional ::= IF where THEN where |
-                IF where THEN where ELSE where
- 
-IF a THEN b is translated to (COND (a b)) and
-IF a THEN b else c is translated to (COND (a b) (T c))
- 
-statement::= conditional | loop | expression
-\end{verbatim} 
-
-\subsubsection{Loops}
-\label{sec:boot:iteration}
-
-\begin{verbatim} 
-loop ::= crossproduct REPEAT statement | REPEAT statement
- 
-iterator ::= forin | suchthat | until | while
- 
-iterators ::= iterator iterator ... iterator
- 
-crossproduct ::=rightassociative(iterators,CROSS)
- 
-suchthat ::= BAR where
- 
-while ::= WHILE expression
- 
-until ::= UNTIL expression
- 
-forin ::= for variable IN segment |
-          for variable IN segment BY arith
- 
-segment::= arith | arith SEG arith | arith SEG
-\end{verbatim} 
-
-A loop performs an iterated transformation of the state which is
-specified by its statement component and its iterators.
-The forin construction introduces a new variable which is assigned
-the elements of the list which is the value of the segment in the order
-in which they appear in the list .
- 
-A segment of the form [[arith]] denotes a list,
-and segments of the form [[arith SEG arith]] and
-[[arith SEG]] denote terminating and non-terminating
-arithmetic progressions.
-The [[BY arith]] option is the step size, if omitted the step is [[1]].
- 
-Two or more [[forin]]'s may control a loop.
-The associated lists are scanned in parallel and
-a variable of one [[forin]] may not appear in the segment expression that
-denotes the list in a second [[forin]].
-Such a variable may however occur in the conditions for filtering or
-introduced by a [[suchthat]], or for termination introduced by a
-while iterator, and in the statement of the loop.
-The [[forin]] variables are local to the statement, the conditions
-that follow a [[while]] or [[suchthat]] in the same list of iterators and
-have no meaning outside them.
-The loop will be terminated when one of its [[forin]] lists is null, or
-if the condition in a [[while]] is not satisfied. The list
-elements are filtered by all the [[suchthat]] conditions.
-The ordering of the iterators is irrelevant to the meaning, so it is
-best to avoid side effects within the conditions for filtering and
-termination.
- 
-It is possible to control a loop by using a \emph{cross-product} of iterators.
-The iteration in the case [[iterators1 CROSS iterators2]] is over
-all pairs of list items one from the list denoted by
-iterators1 and the other from the list denoted by iterators2.
-In this case the variables introduced [[forin]] statements in 
-[[iterators1]] may be used in [[iterators2]].
- 
-\subsubsection{Lists}
-\label{sec:boot:list}
- 
-Boot contains a simple way of specifying lists that are constructed
-by [[CONS]] and [[APPEND]], or by transforming one list to another in a
-systematic manner.
-\begin{verbatim}  
-construct ::= OBRACK construction CBRACK
- 
-construction ::= comma | comma iteratortail
- 
-iteratortail ::= REPEAT iterators | iterators
-\end{verbatim} 
-
-A construct expression denotes a list and may also have a list
-of controlling iterators having the same syntax as a loop. In this
-case the expression is enclosed in brackets and the iterators follow
-the expression they qualify, rather than preceding it.
- 
-In the case that there are no iterators the construct expression
-denotes a list by listing its components separated by commas, or by
-a comma followed by a colon. In the simple case in which there are no
-colons the Boot expression [a,b,c,d] translates to the Lisp
-[[(LIST a b c d)]] or [[(CONS a (CONS b (CONS c (CONS d NIL))))]].
- 
-When elements are separated by comma colon, however, the expression
-that follows will be assumed to denote a list which will be appended
-to the following list, rather than consed. An exception to this rule
-is that a colon preceding the last expression is translated to
-the expression itself. If it immediately preceded by a CONS
-then it need not denote a list.
- 
-For example:
-\begin{verbatim} 
-[] is translated to the empty list NIL
-[a] is translated to the 1-list (LIST a) or (CONS a NIL)
-[:a] is translated to a
-[a,b] is translated to the 2-list (LIST a b) or (CONS a (CONS b NIL))
-[:a,b] is translated to (APPEND a (CONS b NIL))
-[a,:b] is translated to (CONS a b)
-[:a,:b] is translated to (APPEND a b)
-[:a,b,c] is translated to (APPEND a (CONS b (CONS c NIL)))
-[a,:b,c] is translated to (CONS a (APPEND b (CONS c NIL)))
-[a,b,:c] is translated to (CONS a (CONS b c))
-\end{verbatim} 
-
-If the construct expression has iterators that control the production
-of the list the resulting list depends on the form of the comma
-expression.
-i.e.
-\begin{verbatim} 
-construction ::= comma iteratortail
-\end{verbatim} 
-
-If the comma expression is recognised as denoting a list
-by either preceding it by a colon, or having commas at top level
-as above, then the successive values are appended.  If not then
-the successive values are consed.
-e.g.
-\begin{verbatim} 
-[f i for i in x] denotes the list formed by applying f to each
-  member of the list x.
- 
-[:f i for i in 0..n] denotes the list formed by appending the
-  lists f i for each i in 0..n.
-\end{verbatim} 
-
-\subsubsection{Patterns}
-\label{sec:boot:pattern}
-
-\begin{verbatim}  
-is ::= arith | arith IS  pattern
-\end{verbatim} 
-
-The pattern in the proposition [[arith IS pattern]] has the same form
-as the construct phrase without iterators. In this case, however it
-denotes a class of lists rather than a list, and is composed
-from identifiers rather than expressions.  The proposition
-is translated into a program that tests whether the arith expression
-denotes a list that belongs to the class. If it does then the value
-of the is expression is true and the identifiers in
-the pattern are assigned the values of the corresponding
-components of the list. If the list does not match the pattern
-the value of the is expression is false and the values of the
-identifier might be changed in some unknown way that reflects the
-partial success of the matching.
-Because of this uncertainty,
-it is advisable to use the variables in a pattern
-as new definitions rather than assigning to variables that are
-defined elsewhere.
-\begin{verbatim}  
-pattern::= identifier | constant | [ patternlist ]
-\end{verbatim} 
-
-The value of [[arith IS identifier]] is [[true]] and the value of 
-[[arith]] is assigned to the [[identifier]].
-[[(PROGN (SETQ identifier arith) T)]]
-The expression [[arith IS constant]] is translated to 
-[[(EQUAL constant arith)]].
-The expression arith [[IS [ pattenlist ] ]]
-produces a program which tests whether arith denotes a list
-of the right length and that each patternitem matches the corresponding
-list component.
- 
-\begin{verbatim} 
-patternitem ::= EQ application  | DOT | pattern | name := pattern
-\end{verbatim} 
-
-If the [[patternitem]] is [[EQ application]] then the value is true if
-the component is [[EQUAL]] to the value of the application expression.
-If the [[patternitem]] is [[DOT]] then the value is [[true]] regardless of the
-nature of the component.  It is used as a place-holder to test
-whether the component exists.
-If the patternitem is pattern then the component is matched against
-the pattern as above.
-If the [[patternitem]] is [[name:=pattern]] then the component is 
-matched against 
-the pattern as above, and if the value is [[true]] the component is assigned
-to the name.  This last provision enables both a component and
-its components to be given names.
-\begin{verbatim}  
-patternlist ::= listof(patternitem,COMMA)|
-                listof(patternitem,COMMA) COMMA patterntail
-                patterntail
- 
-patterncolon ::= COLON patternitem
- 
-patterntail ::= patterncolon |
-               patterncolon COMMA listof(patternitem,COMMA)
-\end{verbatim} 
-
-The [[patternlist]] may contain one colon to indicate that the following
-patternitem can match a list of any length. In this case
-the matching rule is to construct the expression
-with [[CONS]] and [[APPEND]] from the pattern as shown above and then test
-whether the list can be constructed in this way, and if so
-deduce the components and assign them to identifiers.
- 
-The effect of a pattern that occurs as a variable in a for iterator
-is to filter the list by the pattern.
-\begin{verbatim}  
-forin ::= for pattern IN segment
-\end{verbatim} 
-
-is translated to two iterators
-\begin{verbatim} 
-          for g IN segment | g IS pattern
-\end{verbatim} 
-where [[g]] is an invented identifier.
-\begin{verbatim} 
-forin ::= for (name:=pattern) IN segment
-\end{verbatim} 
-
-is translated to two iterators
-\begin{verbatim} 
-          for name IN segment BAR name IS pattern
-\end{verbatim} 
-
-in order to both filter the list elements, and name both elements and
-their components.
- 
-\subsubsection{Assignments}
-\label{sec:boot:assignment}
- 
-A pattern may also occur on the left hand side of an assignment
-statement, and has a slightly different meaning.
-The purpose in this case is to give names to the components
-of the list which is the value of the right hand side.
-In this case no checking
-is done that the list matches the pattern precisely and the only
-effect is to construct the selectors that correspond to
-the identifiers in the pattern, apply them to the value of the
-right hand side and assign the selected components
-to the corresponding identifiers.
-The effect of applying [[CAR]] or [[CDR]] to arguments to which they are not
-applicable will depend on the underlying Lisp system.
-\begin{verbatim}  
-assignment::= assignvariable BECOMES assignment| statement
- 
-assignvariable := OBRACK patternlist CBRACK | assignlhs
-\end{verbatim} 
-
-The assignment having a pattern as its left hand side is reduced
-as explained above to one or more assignments having an identifier
-on the left hand side.
-The meaning of the assignment depends on whether the identifier
-starts with a dollar sign or not, if it is and whether it is followed by
-[[:local]] or [[:fluid]].
-If the identifier does not start with a dollar sign it
-is treated as local to the body of the function in which it
-occurs, and
-if it is not already an argument of the function,
-a declaration to that effect is added to the Lisp code
-by adding a [[PROG]] construction at top level within the body of the
-function definition.  Note also the all local variables and fluid variables
-are treated this way, resulting in initialization to [[nil]] before
-execution of the body of the function.  Consequently care must be
-exercised when assigning to Lisp special global variables.  If you
-do not want that implicitly initialization to [[nil]], then use the
-explicit [[SETQ]] Lisp special form in an application syntax.
- 
-If such an identifier assignment does not occur in the body
-of a function but in a top level expression then
-it is also treated as a local. The sole exception to this rule
-is when the top level expression is an assignment to an identifier
-in which case it is treated as global.
- 
-If the left hand side of an assignment is an identifier that starts with
-a dollar sign it will not be classified as a local but will
-be treated as non-local. If it is also followed by [[:local]] then it
-will be treated as a declaration of a [[FLUID]] (VMLisp) or [[SPECIAL]]
-variable (Common Lisp) which will be given an initial value which is the
-value of the right hand side of the assignment statement.
-The [[FLUID]] or [[SPECIAL]] variables may be referred to or assigned to
-by functions that are applied in the body of the declaration.
- 
-If the left hand side of an assignment statement is
-an identifier that does not start with a dollar sign followed
-by [[:local]] then it will also be treated as a [[FLUID]] or [[SPECIAL]]
-declaration, however it may only be assigned to in the body
-of the function in which the assignment it occurs.
-\begin{verbatim}  
-assignment::= assignvariable BECOMES assignment | statement
- 
-assignvariable := OBRACK patternlist CBRACK | assignlhs
- 
-assignlhs::= name | name COLON local |
-     name DOT primary DOT ... DOT primary
-\end{verbatim} 
-
-If the left hand side of an assignment has the form
-\begin{verbatim}  
-     name DOT primary DOT ... DOT primary
-\end{verbatim} 
-the assignment statement will denote an updating of some component
-of the value of name.  In general [[name DOT primary := statement]]
-will get translated to [[(SETELT name primary statement)]] or
-[[(SETF (ELT name primary) statement)]]
-There are however certain identifiers that denote components of
-a list which will get translated to statements that update that
-component (see appendix) e.g. 
-\begin{verbatim} 
-a.car:=b is translated to (SETF (CAR a) b) in Common Lisp.
-\end{verbatim} 
-The iterated [[DOT]] is used to update components of components
-and e.g 
-
-\begin{verbatim} 
-a.b.c:=d is translated to (SETF (ELT (ELT a b)c) d)
- 
-exit::= assignment | assignment EXIT where
-\end{verbatim} 
-
-The exit format [[assignment EXIT where]] is used to give a value to
-a blockof or pileof statements in which it occurs at top level.
- 
-The expression
-\begin{verbatim} 
- (a =>b;c) will be translated to if a then b else c or
- (COND (a b) (T c))
-\end{verbatim} 
-
-If the exit is not a component of a blockof or pileof statements
-then 
-\begin{verbatim} 
-a=>b will be translated to (COND (a b))
-\end{verbatim}  
-
-\subsubsection{Definitions}
- 
-Functions may be defined using the syntax
-\begin{verbatim}  
-functiondefinition::= name DEF where | name variable DEF where
- 
- 
-variable ::= parenthesized variablelist | pattern
- 
-variableitem ::=
-     name| pattern | name BECOMES pattern | name IS pattern
- 
-variablelist ::= variableitem | COLON name |
-             variableitem COMMA variablelist
-\end{verbatim} 
-
-Function definitions may only occur at top level or after a [[where]].
-The [[name]] is the name of the function being defined, and the
-most frequently used form of the [[variable]] is either a single name
-or a parenthesized list of names separated by commas.
-In this case the translation to Lisp is straightforward, for example:
-\begin{verbatim} 
-f x == E  or f(x)==E is translated to (DEFUN f (x) TE)
-f (x,y,z)==E is translated to (DEFUN f (x y z) TE)
-f ()==E is translated to (DEFUN f () TE)
-\end{verbatim} 
-
-where [[TE]] is the translation of [[E]].
-At top level 
-\begin{verbatim} 
-f==E is translated to (DEFUN f () TE)
-\end{verbatim} 
-
-The function being defined is that which when applied to its arguments
-produces the value of the body as result where the variables
-in the body take on the values of its arguments.
- 
-A pattern may also occur in the variable of a definition of a function
-and serves the purpose, similar to the left hand side of assignments,
-of naming the list components.
-The phrase
-\begin{verbatim} 
- name pattern DEF where
-is translated to
-        name g DEF (pattern:=g;where)
-\end{verbatim} 
-
-similarly
-\begin{verbatim}  
- name1 name2 := pattern  DEF where  or name1 name2 is pattern  DEF where
- 
-are both translated to
-        name1 name2 DEF (pattern:=name2;where)
-\end{verbatim}  
-
-similarly for patterns that occur as components of a list of
-variables. order
-\begin{verbatim} 
-variablelist ::=
-  variableitem | COLON name | variableitem COMMA variablelist
-\end{verbatim} 
-
-The parenthesized [[variablelist]] that occurs as a variable of a function
-definition can contain variables separated by commas but can also
-have a comma colon as its last separator.
- 
-This means that the function is applicable to lists of different
-sizes and that only the first few elements corresponding to the
-variables separated by commas are named, and
-the last name after the colon denotes the rest of the list.
- 
-Macros may be defined only at top level, and must always have a variable
-\begin{verbatim}  
-macrodefinition::=  name variable MDEF where
-\end{verbatim} 
-
-The effect of a [[macrodefinition]] is to produce a Lisp macro
-which is applied to arguments that are treated as expressions, rather
-than their values, and whose result if formed by first substituting
-the expressions for occurrences of the variables within the body
-and then evaluating the resulting expression.
- 
-\subsubsection{Where Clauses}
-\label{sec:boot:where-clause}
- 
-Expressions may be qualified by one or more function definitions
-using the syntax
-\begin{verbatim}  
-where ::= exit | exit WHERE qualifier
- 
-qualifier ::= functiondefinition |
-      pileof (functiondefinition) | blockof functiondefinition
-\end{verbatim} 
-
-The functions may only be used within the expression that is qualified.
-This feature has to be used with some care, however, because
-a where clause may only occur within a function body, and
-the component functions are extruded, so to speak, from their contexts
-renamed, and made into top level function definitions.
-As a result the variables of the outer function cannot be referred to
-within the inner function.
-If a qualifying function has the format [[name DEF where]] then
-the [[where]] phrase is substituted for all occurences of the name
-within the expression qualified.
-If an expression is qualified by a phrase that is not a
-function definition then the result will be a compound statement
-in which the qualifying phrase is followed by the qualified phrase.
- 
-\subsubsection{Tuples}
-\label{sec:boot:tuples}
-
-Although a tuple may appear syntactically
-in any position occupied by a primary
-it will only be given meaning when it is the argument to a function.
-To denote a list it has to be enclosed in brackets rather than
-parentheses. A tuple at top level is treated as if its components
-appeared at top level in the order of the list.
-\begin{verbatim}  
-tuple::=   parenthesized (listof (where,COMMA))
-\end{verbatim} 
-
-\subsubsection{Blocks and Piles}
-\label{sec:boot:block}
-
-\begin{verbatim}  
-block::=   parenthesized (listof (where,SEMICOLON))
-pile::=    piled (listof (listof(where,SEMICOLON),BACKSET))
-A block or a pile get translated to a compound statement or PROGN
-\end{verbatim} 
-
-\subsubsection{Top Level}
-\label{sec:boot:top-level}
-
-\begin{verbatim}  
-toplevel ::=  functiondefinition | macrodefinition | primary
-\end{verbatim} 
-
-\subsubsection{Translation Functions}
-\label{sec:boot:translation}
-
-\begin{verbatim}  
-(boottocl "filename")
-translates the file "filename.boot" to 
-the common lisp file "filename.clisp"
-\end{verbatim} 
-
-\begin{verbatim} 
-(bootclam "filename")
-translates the file "filename.boot" to 
-the common lisp file "filename.clisp" 
-\end{verbatim} 
-
-producing, for each function a
-hash table to store previously computed values indexed by argument
-list.  The function first looks in the hash table for the result
-if there returns it, if not computes the result and stores it in the
-table.
- 
-\begin{verbatim}  
-(boottoclc "filename")
-translates the file "filename.boot" to
-the common lisp file "filename.clisp" 
-with the original boot code as comments
-\end{verbatim} 
- 
-\begin{verbatim} 
-(boot "filename")
-translates the file "filename.boot" to
-the common lisp file "filename.clisp", 
-compiles it to the file  "filename.bbin" 
-and loads  the bbin file.
-\end{verbatim} 
-
-\begin{verbatim} 
-(bo "filename")
-translates the file "filename.boot"
-and prints the result at the console
-\end{verbatim} 
-
-\begin{verbatim} 
-(stout "string") translates the string "string"  
-and prints the result at the console
-\end{verbatim} 
- 
-\begin{verbatim} 
-(sttomc "string") translates the string "string"  
-to common lisp, and compiles the result.
-\end{verbatim} 
- 
-\begin{verbatim} 
-(fc "functionname" "filename")
-attempts to find the boot function
-functionname in the file filename, 
-if found it translates it to common
-lisp, compiles and loads it.
-\end{verbatim} 
- 
-\begin{verbatim} 
-BOOT_-COMPILE_-DEFINITION_-FROM_-FILE(fn,symbol)
- is similar to fc, fn is the file name but symbol is the  symbol
- of the function name rather than the string.
-(fn,symbol)
-\end{verbatim} 
- 
-\begin{verbatim} 
-BOOT_-EVAL_-DEFINITION_-FROM_-FILE(fn,symbol)
-attempts to find the definition of symbol in file fn, but this time
-translation is followed by EVAL rather than COMPILE
-\end{verbatim} 
- 
-\begin{verbatim} 
-(defuse "filename")
-Translates the file filename, and writes a report of the
-functions defined and not used, and used and not defined in the
-file filename.defuse
-\end{verbatim} 
- 
-\begin{verbatim} 
-(xref "filename")
-Translates the file filename, and writes a report of the
-names  used, and  where used to the file filename.xref
-\end{verbatim}
-
-\subsection{Reserved identifiers}
-\label{sec:boot:reserved-identifiers}
-
-The following identifiers are reserved by Boot.
-\begin{verbatim}
-  and    append   apply     atom      car    cdr       cons      copy
-  croak  drop     exit      false     first  function  genvar    IN
-  is     isnt     lastNode  LAST      list   member    mkpf      nconc
-  nil    not      NOT       nreverse  null   or        otherwise PAIRP
-  removeDuplicates          rest      reverse          setDifference
-  setIntersection setPart   setUnion  size   strconc   substitute
-  take   true     PLUS      MINUS     TIMES  POWER     SLASH     LT
-  GT     LE       GE        SHOEEQ    NE     T
-\end{verbatim}
-
-The following identifiers designate special accessor functions in Boot.
-\begin{verbatim}
-  setName     setLabel    setLevel   setType    setVar    setLeaf
-  setLeaf     setDef      aGeneral   aMode      aTree     aValue
-  attributes  cacheCount  cacheName  cacheReset cacheType env
-  expr        CAR         mmCondition           mmDC      mmImplementation
-  mmSignature mmTarget    mode       op         opcode    opSig
-  CDR         sig         source     streamCode streamDef streamName
-  target
-\end{verbatim}
-
-
-\section{The Makefile}
-\label{sec:Makefile}
-
-When all of the native object files are produced we construct a
-lisp image that contains the boot translator, called [[bootsys]], which
-lives in the [[$(axiom_target_bindir)]] directory.  This [[bootsys]] image
-is critical for the rest of the makefiles to succeed.
- 
-There are two halves of this file. the first half compiles the .lisp files
-that live in the src/boot directory. the second half compiles the .clisp
-files (which are generated from the .boot files). It is important that
-the .clisp files are kept in the src/boot directory for the boot translator
-as they cannot be recreated without a boot translator (a bootstrap problem).
- 
-An important subtlety is that files in the boot translator depend on the
-file npextras. there are 3 macros in npextras that must be in the lisp
-workspace (\verb$|shoeOpenInputFile| |shoeOpenOutputFile| memq$). 
-
-\subsection{Environment}
-\label{sec:Makefile:env}
-
-\subsubsection{Lisp Images}
-\label{sec:Makefile:env:lisp-images}
-
-We will use create and use several lisp images during the build
-process. We name them here for convenience. 
-
-\paragraph{[[AXIOM_LOCAL_LISP]].}  We start with a Lisp image
-created in a previous build step (src/lisp).   That image is used
-to build Boot translator executable through the entire bootstrap process.
-<<environment>>=
-AXIOM_LOCAL_LISP_sources = initial-env.lisp
-AXIOM_LOCAL_LISP = ../lisp/lisp$(EXEEXT)
-@
-
-
-\section{Proclaim optimization}
-\label{sec:proclaim}
-
-GCL, and possibly other common lisps, can generate much better
-code if the function argument types and return values are proclaimed.
-
-In theory what we should do is scan all of the functions in the system
-and create a file of proclaim definitions. These proclaim definitions
-should be loaded into the image before we do any compiles so they can
-allow the compiler to optimize function calling.
-
-GCL has an approximation to this scanning which we use here. 
-
-The first step is to build a version of GCL that includes gcl\_collectfn.
-This file contains code that enhances the lisp compiler and creates a
-hash table of structs. Each struct in the hash table describes information
-that about the types of the function being compiled and the types of its
-arguments. At the end of the compile-file this hash table is written out
-to a ".fn" file. 
-
-The second step is to build axiom images (depsys, interpsys, AXIOMsys)
-which contain the gcl\_collectfn code.
-
-The third step is to build the system. This generates a .fn file for 
-each lisp file that gets compiled.
-
-The fourth step is to build the proclaims.lisp files. There is one
-proclaims.lisp file for 
-boot (boot-proclaims.lisp), 
-interp (interp-proclaims.lisp), and 
-algebra (algebra-proclaims.lisp).
-
-To build the proclaims file (e.g. for interp) we:
-\begin{verbatim}
-(a) cd to obj/linux/interp
-(b) (yourpath)/axiom/obj/linux/bin/lisp
-(c) (load "sys-pkg.lsp") 
-(d) (mapcar #'load (directory "*.fn"))
-(e) (with-open-file (out "interp-proclaims.lisp" :direction :output) 
-      (compiler::make-proclaims out))
-\end{verbatim}
-Note that step (c) is only used for interp, not for boot.
-
-The fifth step is to copy the newly constructed proclaims file back
-into the src/interp diretory (or boot, algebra).
-
-In order for this information to be used during compiles we define
-<<environment>>=
-PROCLAIMS=(load "$(srcdir)/boot-proclaims.lisp")
-
-@
-
-\section{Special Commands}
-\label{sec:special-commands}
-
-We are working in a build environment that combines Makefile
-technology with Lisp technology. Instead of invoking a command
-like {\bf gcc} and giving it arguments we will be creating 
-Lisp S-expressions and piping them into a Lisp image. The
-Lisp image starts, reads the S-expression from standard input,
-evaluates it, and finding an end-of-stream on standard input, exits.
-
-
-\section{The Boot Compiler}
-\label{sec:boot-compiler}
-
-This section describes the set of object files that make the Boot compiler.
-
-\subsection{The Bootstrap files}
-\label{sec:boot-compiler:bootstrap}
-
-This is a list of all of the files that must be loaded to construct the
-boot translator image. 
-<<environment>>= 
-boot_objects = initial-env.$(FASLEXT) $(boot_sources:.boot=.$(FASLEXT))
-
-## ECL's program construction model is not based on image-dumping.  It is
-## closer to `traditional C' application building.  Therefore, since
-## bootsys is an augmentation of base-lisp, we need to have the objects
-## that made up base-lisp too.
-ifeq (@axiom_lisp_flavor@,ecl)
-boot_objects_extra = ../lisp/core.$(FASLEXT)
-endif
-
-boot_SOURCES = \
-	initial-env.lisp.pamphlet \
-	$(addsuffix .pamphlet, $(boot_sources))
-
-pamphlets = Makefile.pamphlet $(boot_SOURCES)
-@
-
-[[$(boot_sources)]] is a list of the boot file targets. If you modify a
-boot file you'll have to explicitly build the clisp files and
-merge the generated code back into the pamphlet by hand. The
-assumption is that if you know enough to change the fundamental
-bootstrap files you know how to migrate the changes back.
-This process, by design, does not occur automatically (though it
-could).
-
-The Boot compiler, [[bootsys]], is built from a set of source files
-written in Boot.  Note that the order is 
-important as earlier files will contain code needed by later files.
-<<environment>>=
-boot_sources = tokens.boot includer.boot scanner.boot \
-	pile.boot ast.boot parser.boot  translator.boot
-
-boot_clisp = $(boot_sources:.boot=.clisp)
-boot_data = $(boot_sources:.boot=.data)
-boot_fn = $(boot_sources:.boot=.fn)
-@
-These source files use macros defined in the first set, and they be compiled
-in an environment where those macros are present.
-
-
-
-The Boot source file for [[bootsys]] are automatically extracted --- 
-only during bootstrap --- from the pamphlets into the current build
-directory.  When bootstrapping, they are the inputs to the stage0, stage1
- [[bootsys]] compilers.
-
-<<boot from pamphlet>>=
-.PRECIOUS: %.boot
-%.boot: $(srcdir)/%.boot.pamphlet
-	$(axiom_build_document) --tangle $< 
-@
-
-Since the Boot language is defined as a syntactic sugar over Lisp 
-(a reasonably tasty sugar), the
-the second set of source files (written in Boot) is first translated 
-to Lisp, and the result of that translation is subsequently compiled to
-native object files.
-
-Partly for bootstrapping reasons, and partly because OpenAxiom (therefore
-Boot) is not yet widespread, the pamphlets for the source files written 
-in Boot currently keep a cache of their translated versions.  Hopefully
-the maintainance of that cache will be unnecessary as the build machinery
-becomes more and more improved, and OpenAxiom gets in widespread use.
-<<environment>>=
-boot_cached_clisp = $(boot_sources:.boot=.clisp)
-@
-
-\section{Bootstrapping Boot}
-\label{sec:bootstrapping}
-
-When the system is configured for bootstrap, we build the Boot compiler ---
-[[bootsys]] --- in three steps:
-\begin{enumerate}
-\item a stage-0 Boot compiler, built from the cached (Lisp) source files;
-
-\item a stage-1 Boot compiler, built the original Boot source files using the
-  stage-0 Boot compiler; 
-
-\item and a stage-2 Boot compiler, built from original Boot source files 
-  using the stage-2 Boot compiler.
-\end{enumerate}
-Notice that in last two steps, the source file written in Boot are first
-translated to Lisp using the freshly built Boot compiler, and the resulting
-Lisp files subsequently compiled to natve object files.
-
-Ideally, we should also compare the intermediate Lisp source files from 
-stage 1 and 2 to detect possible miscompilation.  We don't do that 
-for the moment.
-
-\subsection{Compiling the Boot source files}
-\label{sec:bootstrapping:source-files}
-
-We compile the Boot compiler source files written in Boot only 
-at stage 1 and 2 (when bootstrapping).  As explained earlier, the
-compilation of these files proceeds in two steps:
-\begin{enumerate}
-\item Translate the Boot source files to Lisp code, 
-\item compile the resulting Lisp source files to native object code.
-\end{enumerate}
-
-<<compile Boot files from pamphlets>>=
-## Dependency for various modules.  
-## FIXME: This should be automatically extracted from the
-## Boot source file at packaging time.
-
-%/tokens.$(FASLEXT): %/tokens.clisp %/initial-env.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-%/includer.$(FASLEXT): %/includer.clisp %/tokens.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-%/scanner.$(FASLEXT): %/scanner.clisp %/tokens.$(FASLEXT) %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-%/pile.$(FASLEXT): %/pile.clisp %/scanner.$(FASLEXT) %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-%/ast.$(FASLEXT): %/ast.clisp %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-%/parser.$(FASLEXT): %/parser.clisp %/ast.$(FASLEXT) %/scanner.$(FASLEXT) \
-		 %/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-%/translator.$(FASLEXT): %/translator.clisp %/parser.$(FASLEXT) \
-		%/ast.$(FASLEXT) %/pile.$(FASLEXT) %/scanner.$(FASLEXT) \
-		%/includer.$(FASLEXT)
-	$(AXIOM_LOCAL_LISP) -- --compile --load-directory=$* $<
-
-<<boot from pamphlet>>
-@
-
-\subsection{Building [[bootsys]]}
-\label{sec:bootstrapping:build-bootsys}
-
-\subsection{The various bootstrapping stages}
-\label{sec:bootstrapping:stages}
-
-The bootstrapping phase is carried out in three stages:
-\begin{itemize}
-\item[Stage 0] we compile the cached Lisp translations of the Boot codes.  
-   Currently, these translations are functionally equivalent
-   to the final \Tool{bootsys} we get out of the bootstrap.  Ideally, 
-   this should just be powerfull enough to translate the \Tool{bootsys}
-   Boot codes.  The compilation of thee Lisp code is done with the
-   Lisp image [[$(AXIOM_LOCAL_LISP)]].
-
-\item[Stage 1] Using the \Tool{bootsys} built from the previous 
-  stage (\eg{} from 
-  cached Lisp translations), we build a new \Tool{bootsys} from the
-  Boot codes proper.
-\label{sec:bootstrapping:stages}
-
-\item[Stage 2] Finally, we build another (and final) \Tool{bootsys} image 
-  using the \Tool{bootsys} from Stage 1.  This is the \Tool{bootsys}
-  image that is used to build the rest of the OpenAxiom system.
-\end{itemize}
-
-Stage 1 and Stage 2 are structurally identical.  Ideally, we should be
-doing a bootstrap compare.
-
-Although all the \Tool{bootsys} images are powerful enough to 
-compile Boot codes directly, we don't use them for compilation.
-Instead, we the fresh, clean, [[$(AXIOM_LOCAL_LISP)]] image.
-The reason is that the process of compiling a Boot source file
-may have the side effect of loading a module in the compiler (as
-by-product of resolving module dependencies).  But such module
-will contain objects already present in the compiler and being
-used.  Consequently, we must use a fresh image to guarantee
-clean and reproductible build and semantics.  Notice that only
-the compilation of \Tool{bootsys} itself needs that care.
-The rest of the OpenAxiom system should use \Tool{bootsys} to 
-compile Boot codes, instead of manually going through the
-Lisp translation phase.
-
-
-\subsubsection{Stage 0}
-\label{sec:bootstrapping:stages:stage-0}
-
-We build the stage-0 Boot compiler from the cached Lisp souces code.
-<<stage 0 boot compiler>>=
-.PRECIOUS: stage0/%.clisp
-.PRECIOUS: stage0/%.$(FASLEXT)
-
-stage0_boot_clisp = $(addprefix stage0/, $(boot_clisp))
-
-stage0_boot_objects = $(addprefix stage0/, $(boot_objects))
-
-stage0/stamp: stage0/bootsys$(EXEEXT)
-	@rm -f $@
-	@$(STAMP) $@
-
-stage0/bootsys$(EXEEXT): $(stage0_boot_objects)
-	$(AXIOM_LOCAL_LISP) -- --make --main="|AxiomCore|::|topLevel|"\
-		 --output=$@ --load-directory=stage0 \
-		$(boot_objects_extra) $(stage0_boot_objects)
-
-
-.PRECIOUS: %/.started
-%/.started:
-	$(mkinstalldirs) $*
-	$(STAMP) $@
-
-$(stage0_boot_objects): $(AXIOM_LOCAL_LISP)
-
-stage0/%.clisp: $(srcdir)/%.boot.pamphlet stage0/.started
-	$(axiom_build_document) --tangle=$*.clisp --output=$@ $<
-
-%/initial-env.$(FASLEXT): initial-env.lisp %/.started
-	$(AXIOM_LOCAL_LISP) -- --compile --output=$@ $<
-@
-
-\subsubsection{Stage 1}
-\label{sec:bootstrapping:stages:stage-1}
-
-<<stage 1 boot compiler>>=
-.PRECIOUS: stage1/%.$(FASLEXT)
-.PRECIOUS: stage1/%.clisp
-
-stage1/stamp: stage1/bootsys$(EXEEXT)
-	rm -f $@
-	$(STAMP) $@
-
-stage1/bootsys$(EXEEXT): $(addprefix stage1/, $(boot_objects))
-	$(AXIOM_LOCAL_LISP) -- --make --main="|AxiomCore|::|topLevel|" \
-		 --output=$@ --load-directory=stage1 \
-		$(boot_objects_extra) $(addprefix stage1/, $(boot_objects))
-
-stage1/%.clisp: %.boot stage0/stamp stage1/.started
-	stage0/bootsys -- --translate --output=$@ $<
-@
-
-\subsubsection{Stage 2}
-\label{sec:bootstrapping:stages:stage-2}
-
-<<stage 2 boot compiler>>=
-.PRECIOUS: stage2/%.$(FASLEXT)
-.PRECIOUS: stage2/%.clisp
-
-stage2/stamp: stage2/bootsys$(EXEEXT)
-	@echo Building stage 2
-	$(STAMP) $@
-
-stage2/bootsys$(EXEEXT): $(addprefix stage2/, $(boot_objects))
-	$(AXIOM_LOCAL_LISP) -- --make --main="|AxiomCore|::|topLevel|" \
-		--output=$@ --load-directory=stage2 \
-		$(boot_objects_extra) $(addprefix stage2/, $(boot_objects))
-
-stage2/%.clisp: %.boot stage1/stamp stage2/.started
-	stage1/bootsys -- --translate --output=$@ $<
-@
-
-<<bootstrap>>=
-<<stage 0 boot compiler>>
-
-<<stage 1 boot compiler>>
-
-<<stage 2 boot compiler>>
-@
-
-
-\section{Making the documentation}
-\label{sec:doc}
-
-\subsection{Compiling Lisp files without deps from pamphlets}
-<<initial-env.lisp>>=
-.PRECIOUS: %.lisp
-
-initial-env.lisp: initial-env.lisp.pamphlet
-	$(axiom_build_document) --tangle $<
-@
-
-\subsection{boot from pamphlet}
-<<boot from pamphlet>>=
-.PRECIOUS: %.boot
-
-%.boot: $(srcdir)/%.boot.pamphlet
-	$(axiom_build_document) --tangle $<
-@
-
-
-\section{Making the documentation}
-<<environment>>=
-
-COMPILE_LISP = \
-	$(axiom_build_document) --tag=lisp --mode=compile --output=$@
-
-BOOT_TO_LISP = \
-	$(axiom_build_document) --tag=boot --mode=translate \
-	--use=./prev-stage/bootsys $<
-@
-
-\section{Cleanup}
-<<cleanup>>=
-mostlyclean-local:
-	@rm -f $(axiom_build_bindir)/bootsys$(EXEEXT)
-	@rm -rf prev-stage
-	@rm -rf stage0 stage1 stage2
-	@rm -f *.data *.fn
-	@rm -f stamp
-
-clean-local: mostlyclean-local
-	@rm -f $(boot_sources)
-	@rm -f *.clisp *.lisp
-
-distclean-local: clean-local
-@
-
-
-\section{Global variables}
-
-The Boot implementation uses a number of global variables 
-for communication between several routines.  Some of them follow
-the syntactic convention of starting their names with [[$]].  Some
-don't.
-
-\subsection{[[$linepos]]}
-
-\subsection{[[$f]]}
-
-\subsection{[[$r]]}
-
-\subsection{[[$ln]]}
-
-\subsection{[[$sz]]}
-
-\subsection{[[$n]]}
-
-\subsection{[[$floatok]]}
-
-\subsection{[[$bfClamming]]}
-
-\subsection{[[$GenVarCounter]]}
-
-\subsection{[[$inputstream]]}
-
-\subsection{[[$stack]]}
-
-\subsection{[[$stok]]}
-
-\subsection{[[$ttok]]}
-
-\subsection{[[$op]]}
-
-\subsection{[[$wheredefs]]}
-
-\subsection{[[$typings]]}
-
-\subsection{[[$returns]]}
-
-\subsection{[[$bpCount]]}
-
-\subsection{[[$bpParentCount]]}
-
-\subsection{[[$lispWordTable]]}
-
-\subsection{[[$bootUsed]]}
-
-\subsection{[[$bootDefinedTwice]]}
-
-\subsection{[[$used]]}
-
-\subsection{[[$letGenVarCounter]]}
-
-\subsection{[[$isGenVarCounter]]}
-
-\subsection{[[$inDefIS]]}
-
-\subsection{[[$fluidVars]]}
-
-\subsection{[[$locVars]]}
-
-\subsection{[[$dollarVars]]}
-
-
-
-
-\section{The Makefile}
-<<*>>=
-<<environment>>
-
-subdir = src/boot/
- 
-.PHONY: all-ax all-boot
-all: all-ax all-boot
-
-all-ax all-boot: stamp
-
-stamp: $(axiom_build_bindir)/bootsys$(EXEEXT)
-	@rm -f stamp
-	$(STAMP) $@
-
-$(axiom_build_bindir)/bootsys$(EXEEXT): stage2/bootsys$(EXEEXT)
-	$(mkinstalldirs) $(axiom_build_bindir)
-	$(INSTALL_PROGRAM) stage2/bootsys$(EXEEXT) $(axiom_build_bindir)
-
-<<bootstrap>>
-
-<<compile Boot files from pamphlets>>
-<<initial-env.lisp>>
-
-<<cleanup>>
-@
-
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} src/boot/boothdr.lisp.pamphlet
-\bibitem{2} src/boot/includer.boot.pamphlet
-\bibitem{3} src/boot/pile.boot.pamphlet
-\bibitem{4} src/boot/scanner.boot.pamphlet
-\bibitem{5} src/boot/exports.lisp.pamphlet
-\bibitem{7} src/boot/translator.boot.pamphlet
-\bibitem{8} src/boot/parser.boot.pamphlet
-\bibitem{9} src/boot/tokens.boot.pamphlet
-\bibitem{10} src/boot/ast.boot.pamphlet
-\end{thebibliography}
-\end{document}
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
new file mode 100644
index 00000000..4c0c02d4
--- /dev/null
+++ b/src/boot/ast.boot
@@ -0,0 +1,1087 @@
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+--
+-- Abstract:
+--   This file defines the AST data structure and helper functions
+--   for representing Boot programs.
+--
+
+module '"boot-ast"
+import '"includer"
+
+)package "BOOTTRAN"
+
+++ True means that Boot functions should be translated to use
+++ hash tables to remember values.  By default, functions are
+++ translated with the obvious semantics, e.g. no caching.
+$bfClamming := false
+
+++ A Boot string is no different from a Lisp string.  Same holds 
+++ for symbols and sequences.  In an ideal world, these would be
+++ built-in/library data types.
+String <=> STRING
+Symbol <=> SYMBOL
+Sequence <=> SEQUENCE
+
+++ Ideally, we would like to say that a List T if either nil or a 
+++ cons of a T and List of T.  However, we don't support parameterized
+++ alias definitions yet.
+List <=> nil or cons
+
+++ Currently, the Boot processor uses Lisp symbol datatype for names.
+++ That causes the BOOTTRAN package to contain more symbols than we would
+++ like.  In the future, we want want to intern `on demand'.  How that
+++ interacts with renaming is to be worked out.
+structure Name == Name(Symbol)
+
+structure Ast ==
+  Command(String)                       -- includer command
+  Module(String)                        -- module declaration
+  Import(String)                        -- import module
+  ImportSignature(Name, Signature)      -- import function declaration
+  TypeAlias(Name, List, List)           -- type alias definition
+  Signature(Name, Mapping)              -- op: S -> T
+  Mapping(Ast, List)                    -- (S1, S2) -> T
+  SuffixDot(Ast)                        -- x . 
+  Quote(Ast)                            -- 'x
+  EqualName(Name)                       -- =x        -- patterns
+  Colon(Name)                           -- :x
+  QualifiedName(Name, Name)             -- m::x
+  Bracket(Ast)                          -- [x, y]
+  UnboundedSegment(Ast)                 -- 3..
+  BoundedSgement(Ast, Ast)              -- 2..4
+  Tuple(List)                           -- comma-separated expression sequence
+  ColonAppend(Ast, Ast)                 -- [:y] or [x, :y]
+  Is(Ast, Ast)                          -- e is p    -- patterns
+  Isnt(Ast, Ast)                        -- e isnt p  -- patterns
+  Reduce(Ast, Ast)                      -- +/[...]
+  PrefixExpr(Name, Ast)                 -- #v
+  Call(Ast, Sequence)                   -- f(x, y , z)
+  InfixExpr(Name, Ast, Ast)             -- x + y
+  ConstantDefinition(Name, Ast)         -- x == y
+  Definition(Name, List, Ast, Ast)      -- f x == y
+  Macro(Name, List, Ast)                -- m x ==> y
+  SuchThat(Ast)                         -- | p
+  Assignment(Ast, Ast)                  -- x := y
+  While(Ast)                            -- while p           -- iterator
+  Until(Ast)                            -- until p           -- iterator
+  For(Ast, Ast, Ast)                    -- for x in e by k   -- iterator
+  Exit(Ast, Ast)                        -- p => x
+  Iterators(List)                       -- list of iterators
+  Cross(List)                           -- iterator cross product
+  Repeat(Sequence, Ast)                 -- while p repeat s
+  Pile(Sequence)                        -- pile of expression sequence
+  Append(Sequence)                      -- concatenate lists
+  Case(Ast, Sequence)                   -- case x of ...
+  Return(Ast)                           -- return x
+  Where(Ast, Sequence)                  -- e where f x == y
+  Structure(Ast, Sequence)              -- structure Foo == ...
+
+-- TRUE if we are currently building the syntax tree for an 'is' 
+-- expression.
+$inDefIS := false
+ 
+bfGenSymbol()==
+    $GenVarCounter:=$GenVarCounter+1
+    INTERN(CONCAT ('"bfVar#",STRINGIMAGE $GenVarCounter))
+ 
+bfListOf x==x
+ 
+bfColon x== ["COLON",x]
+
+bfColonColon(package, name) == 
+  INTERN(SYMBOL_-NAME name, package)
+ 
+bfSymbol x==
+   STRINGP x=> x
+   ['QUOTE,x]
+ 
+bfDot()== "DOT"
+ 
+bfSuffixDot x==[x,"DOT"]
+ 
+bfEqual(name)== ["EQUAL",name]
+ 
+bfBracket(part) == part
+ 
+bfPile(part)    == part
+ 
+bfAppend x== APPLY(function APPEND,x)
+ 
+bfColonAppend (x,y) ==
+     if null x
+     then
+      if y is ["BVQUOTE",:a]
+      then ["&REST",["QUOTE",:a]]
+      else ["&REST",y]
+     else cons(CAR x,bfColonAppend(CDR x,y))
+ 
+bfDefinition(bflhsitems, bfrhs,body) ==
+       ['DEF,bflhsitems,bfrhs,body]
+ 
+bfMDefinition(bflhsitems, bfrhs,body) ==
+       bfMDef('MDEF,bflhsitems,bfrhs,body)
+ 
+bfCompDef x ==
+  case x of
+    ConstantDefinition(n, e) => x
+    otherwise =>
+      x is [def, op, args, body] =>
+        bfDef(def,op,args,body)
+      coreError '"invalid AST"
+ 
+bfBeginsDollar x==  EQL('"$".0,(PNAME x).0)
+ 
+compFluid id== ["FLUID",id]
+ 
+compFluidize x==
+  IDENTP x and bfBeginsDollar x=>compFluid x
+  ATOM x =>x
+  EQCAR(x,"QUOTE")=>x
+  cons(compFluidize(CAR x),compFluidize(CDR x))
+ 
+bfTuple x== ["TUPLE",:x]
+ 
+bfTupleP x==EQCAR(x,"TUPLE")
+ 
+bfTupleIf x==
+  if bfTupleP x
+  then x
+  else bfTuple x
+ 
+bfTupleConstruct b ==
+  a:= if bfTupleP b
+      then cdr b
+      else [b]
+  or/[x is ["COLON",.] for x in a] => bfMakeCons a
+  ["LIST",:a]
+ 
+bfConstruct b ==
+  a:= if bfTupleP b
+      then cdr b
+      else [b]
+  bfMakeCons a
+ 
+bfMakeCons l ==
+  null l => NIL
+  l is [["COLON",a],:l1] =>
+    l1 => ['APPEND,a,bfMakeCons l1]
+    a
+  ['CONS,first l,bfMakeCons rest l]
+ 
+bfFor(bflhs,U,step) ==
+     if EQCAR (U,'tails)
+     then  bfForTree('ON, bflhs, CADR U)
+     else
+       if EQCAR(U,"SEGMENT")
+       then  bfSTEP(bflhs,CADR U,step,CADDR U)
+       else  bfForTree('IN, bflhs, U)
+ 
+bfForTree(OP,lhs,whole)==
+         whole:=if bfTupleP whole then bfMakeCons cdr whole else whole
+         ATOM lhs =>bfINON [OP,lhs,whole]
+         lhs:=if bfTupleP lhs then CADR lhs else lhs
+         EQCAR(lhs,"L%T") =>
+             G:=CADR lhs
+             [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,CADDR lhs)]
+         G:=bfGenSymbol()
+         [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,lhs)]
+ 
+ 
+bfSTEP(id,fst,step,lst)==
+      initvar:=[id]
+      initval:=[fst]
+      inc:=if ATOM step
+           then step
+           else
+               g1:=bfGenSymbol()
+               initvar:=cons(g1,initvar)
+               initval:=cons(step,initval)
+               g1
+      final:=if ATOM lst
+             then lst
+             else
+               g2:=bfGenSymbol()
+               initvar:=cons(g2,initvar)
+               initval:=cons(lst,initval)
+               g2
+      ex:=
+          null lst=> []
+          INTEGERP inc =>
+              pred:=if MINUSP inc then "<" else ">"
+              [[pred,id,final]]
+          [['COND,[['MINUSP,inc],
+                ["<",id,final]],['T,[">",id,final]]]]
+      suc:=[['SETQ,id,["+",id,inc]]]
+      [[initvar,initval,suc,[],ex,[]]]
+ 
+ 
+bfINON x==
+    [op,id,whole]:=x
+    if EQ(op,"ON")
+    then bfON(id,whole)
+    else bfIN(id,whole)
+ 
+bfIN(x,E)==
+    g:=bfGenSymbol()
+    [[[g,x],[E,nil],[['SETQ,g,['CDR, g]]],[],
+        [['OR,['ATOM,g],['PROGN,['SETQ,x,['CAR,g]] ,'NIL]]],[]]]
+ 
+bfON(x,E)==
+    [[[x],[E],[['SETQ,x,['CDR, x]]],[],
+        [['ATOM,x]],[]]]
+ 
+bfSuchthat p== [[[],[],[],[p],[],[]]]
+ 
+bfWhile p== [[[],[],[],[],[bfNOT p],[]]]
+ 
+bfUntil p==
+     g:=bfGenSymbol()
+     [[[g],[nil],[['SETQ,g,p]],[],[g],[]]]
+ 
+bfIterators x==["ITERATORS",:x]
+ 
+bfCross x== ["CROSS",:x]
+ 
+bfLp(iters,body)==
+     EQCAR (iters,"ITERATORS")=>bfLp1(CDR iters,body)
+     bfLpCross(CDR iters,body)
+ 
+bfLpCross(iters,body)==
+     if null cdr iters
+     then bfLp(car iters,body)
+     else bfLp(car iters,bfLpCross(cdr iters,body))
+ 
+bfSep(iters)==
+     if null iters
+     then [[],[],[],[],[],[]]
+     else
+         f:=first iters
+         r:=bfSep rest iters
+         [append(i,j) for i in f for j in r]
+ 
+bfReduce(op,y)==
+     a:=if EQCAR(op,"QUOTE") then CADR op else op
+     op:=bfReName a
+     init:=GET(op,"SHOETHETA")
+     g:=bfGenSymbol()
+     g1:=bfGenSymbol()
+     body:=['SETQ,g,[op,g,g1]]
+     if null init
+     then
+        g2:=bfGenSymbol()
+        init:=['CAR,g2]
+        ny:=['CDR,g2]
+        it:= ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,ny)]]
+        bfMKPROGN [['L%T,g2,y],bfLp(it,body)]
+     else
+        init:=car init
+        it:= ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,y)]]
+        bfLp(it,body)
+ 
+bfReduceCollect(op,y)==
+   if EQCAR (y,"COLLECT")
+   then
+     body:=y.1
+     itl:=y.2
+     a:=if EQCAR(op,"QUOTE") then CADR op else op
+     op:=bfReName a
+     init:=GET(op,"SHOETHETA")
+     bfOpReduce(op,init,body,itl)
+   else
+     a:=bfTupleConstruct (y.1)
+     bfReduce(op,a)
+ 
+-- delayed collect
+ 
+bfDCollect(y,itl)== ["COLLECT",y,itl]
+ 
+bfDTuple x== ["DTUPLE",x]
+ 
+bfCollect(y,itl) ==
+      y is ["COLON",a] => bf0APPEND(a,itl)
+      y is ["TUPLE",:.] =>
+        newBody:=bfConstruct y
+        bf0APPEND(newBody,itl)
+      bf0COLLECT(y,itl)
+ 
+bf0COLLECT(y,itl)==bfListReduce('CONS,y,itl)
+ 
+ 
+bf0APPEND(y,itl)==
+     g:=bfGenSymbol()
+     body:=['SETQ,g,['APPEND,['REVERSE,y],g]]
+     extrait:= [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
+     bfLp2(extrait,itl,body)
+ 
+bfListReduce(op,y,itl)==
+     g:=bfGenSymbol()
+     body:=['SETQ,g,[op,y,g]]
+     extrait:= [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
+     bfLp2(extrait,itl,body)
+ 
+bfLp1(iters,body)==
+      [vars,inits,sucs,filters,exits,value]:=bfSep bfAppend iters
+      nbody:=if null filters then body else bfAND [:filters,body]
+      value:=if null value then "NIL" else car value
+      exits:= ["COND",[bfOR exits,["RETURN",value]],
+                  ['(QUOTE T),nbody]]
+      loop := ["LOOP",exits,:sucs]
+      if vars then loop := 
+        ["LET",[[v, i] for v in vars for i in inits], loop]
+      loop
+ 
+bfLp2(extrait,itl,body)==
+     EQCAR (itl,"ITERATORS")=>bfLp1(cons(extrait,CDR itl),body)
+     iters:=cdr itl
+     bfLpCross
+          ([["ITERATORS",extrait,:CDAR iters],:CDR iters],body)
+ 
+bfOpReduce(op,init,y,itl)==
+     g:=bfGenSymbol()
+     body:=
+         EQ(op,"AND")=>
+                bfMKPROGN [["SETQ",g,y],
+                    ['COND, [['NOT,g],['RETURN,'NIL]]]]
+         EQ(op,"OR") =>
+                bfMKPROGN [["SETQ",g,y],
+                             ['COND, [g,['RETURN,g]]]]
+         ['SETQ,g,[op,g,y]]
+     if null init
+     then
+        g1:=bfGenSymbol()
+        init:=['CAR,g1]
+        y:=['CDR,g1]
+        extrait:= [[[g],[init],[],[],[],[g]]]
+        bfMKPROGN [['L%T,g1,y],bfLp2(extrait,itl,body)]
+     else
+        init:=car init
+        extrait:= [[[g],[init],[],[],[],[g]]]
+        bfLp2(extrait,itl,body)
+ 
+bfLoop1 body == bfLp (bfIterators nil,body)
+ 
+bfSegment1(lo)==     ["SEGMENT",lo,nil]
+ 
+bfSegment2(lo,hi)==   ["SEGMENT",lo,hi]
+ 
+bfForInBy(variable,collection,step)==
+         bfFor(variable,collection,step)
+ 
+bfForin(lhs,U)==bfFor(lhs,U,1)
+ 
+bfLocal(a,b)==
+         EQ(b,"FLUID")=>  compFluid a
+         EQ(b,"fluid")=>  compFluid a
+         EQ(b,"local") =>  compFluid a
+    --   $typings:=cons(["TYPE",b,a],$typings)
+         a
+ 
+bfTake(n,x)==
+     null x=>x
+     n=0 => nil
+     cons(car x,bfTake(n-1,cdr x))
+ 
+bfDrop(n,x)==
+     null x or n=0 =>x
+     bfDrop(n-1,cdr x)
+ 
+bfDefSequence l ==  ['SEQ,: l]
+ 
+bfReturnNoName a ==
+      ["RETURN",a]
+ 
+bfSUBLIS(p,e)==
+  ATOM e=>bfSUBLIS1(p,e)
+  EQCAR(e,"QUOTE")=>e
+  cons(bfSUBLIS(p,car e),bfSUBLIS(p,cdr e))
+ 
++++ Returns e/p, where e is an atom.  We assume that the
++++ DEFs form a system admitting a fix point; otherwise we may
++++ loop forever.  That can happen only if nullary goats
++++ are recursive -- which they are not supposed to be.
++++ We don't enforce that restriction though.
+bfSUBLIS1(p,e)==
+   null p =>e
+   f:=CAR p
+   EQ(CAR f,e)=> bfSUBLIS(p, CDR f)
+   bfSUBLIS1(cdr p,e)
+ 
+defSheepAndGoats(x)==
+    EQCAR (x,"DEF") =>
+        [def,op,args,body]:=x
+        argl:=if bfTupleP args
+              then cdr args
+              else [args]
+        if null argl
+        then
+          opassoc:=[[op,:body]]
+          [opassoc,[],[]]
+        else
+          op1:=INTERN CONCAT(PNAME $op,'",",PNAME op)
+          opassoc:=[[op,:op1]]
+          defstack:=[["DEF",op1,args,body]]
+          [opassoc,defstack,[]]
+    EQCAR (x,"SEQ") =>  defSheepAndGoatsList(cdr x)
+    [[],[],[x]]
+ 
+defSheepAndGoatsList(x)==
+     if null x
+     then [[],[],[]]
+     else
+       [opassoc,defs,nondefs]    := defSheepAndGoats car x
+       [opassoc1,defs1,nondefs1] := defSheepAndGoatsList cdr x
+       [append(opassoc,opassoc1),append(defs,defs1),
+            append(nondefs,nondefs1)]
+--% LET
+ 
+bfLetForm(lhs,rhs) ==   ['L%T,lhs,rhs]
+ 
+bfLET1(lhs,rhs) ==
+  IDENTP lhs         => bfLetForm(lhs,rhs)
+  lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
+  IDENTP rhs and not bfCONTAINED(rhs,lhs) =>
+    rhs1 := bfLET2(lhs,rhs)
+    EQCAR(rhs1,'L%T) => bfMKPROGN [rhs1,rhs]
+    EQCAR(rhs1,'PROGN) => APPEND(rhs1,[rhs])
+    if IDENTP CAR rhs1 then rhs1 := CONS(rhs1,NIL)
+    bfMKPROGN [:rhs1,rhs]
+  CONSP(rhs) and EQCAR(rhs,'L%T) and IDENTP(name := CADR rhs) =>
+    -- handle things like [a] := x := foo
+    l1 := bfLET1(name,CADDR rhs)
+    l2 := bfLET1(lhs,name)
+    EQCAR(l2,'PROGN) => bfMKPROGN [l1,:CDR l2]
+    if IDENTP CAR l2 then l2 := cons(l2,nil)
+    bfMKPROGN [l1,:l2,name]
+  g := INTERN CONCAT('"LETTMP#",STRINGIMAGE $letGenVarCounter)
+  $letGenVarCounter := $letGenVarCounter + 1
+  rhs1 := ['L%T,g,rhs]
+  let1 := bfLET1(lhs,g)
+  EQCAR(let1,'PROGN) => bfMKPROGN [rhs1,:CDR let1]
+  if IDENTP CAR let1 then let1 := CONS(let1,NIL)
+  bfMKPROGN [rhs1,:let1,g]
+ 
+bfCONTAINED(x,y)==
+    EQ(x,y) => true
+    ATOM y=> false
+    bfCONTAINED(x,car y) or bfCONTAINED(x,cdr y)
+ 
+bfLET2(lhs,rhs) ==
+  IDENTP lhs => bfLetForm(lhs,rhs)
+  NULL lhs   => NIL
+  lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
+  lhs is ['L%T,a,b] =>
+    a := bfLET2(a,rhs)
+    null (b := bfLET2(b,rhs)) => a
+    ATOM b => [a,b]
+    CONSP CAR b => CONS(a,b)
+    [a,b]
+  lhs is ['CONS,var1,var2] =>
+    var1 = "DOT" or (CONSP(var1) and EQCAR(var1,'QUOTE)) =>
+      bfLET2(var2,addCARorCDR('CDR,rhs))
+    l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
+    null var2 or EQ(var2,"DOT") =>l1
+    if CONSP l1 and ATOM CAR l1 then l1 := cons(l1,nil)
+    IDENTP var2 =>
+      [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))]
+    l2 := bfLET2(var2,addCARorCDR('CDR,rhs))
+    if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+    APPEND(l1,l2)
+  lhs is ['APPEND,var1,var2] =>
+    patrev := bfISReverse(var2,var1)
+    rev := ['REVERSE,rhs]
+    g := INTERN CONCAT('"LETTMP#", STRINGIMAGE $letGenVarCounter)
+    $letGenVarCounter := $letGenVarCounter + 1
+    l2 := bfLET2(patrev,g)
+    if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+    var1 = "DOT" => [['L%T,g,rev],:l2]
+    last l2 is ['L%T, =var1, val1] =>
+      [['L%T,g,rev],:REVERSE CDR REVERSE l2,
+       bfLetForm(var1,['NREVERSE,val1])]
+    [['L%T,g,rev],:l2,bfLetForm(var1,['NREVERSE,var1])]
+  lhs is ["EQUAL",var1] =>
+    ['COND,[["EQUAL",var1,rhs],var1]]
+  -- The original expression may be one that involves literals as 
+  -- sub-patterns, e.g.
+  --      ['SEQ, :l, ['exit, 1, x]] := item
+  -- We continue the processing as if that expression had been written
+  --      item is ['SEQ, :l, ['exit, 1, x]]
+  -- and generate appropriate codes.
+  --                  -- gdr/2007-04-02.
+  isPred :=
+    $inDefIS => bfIS1(rhs,lhs)
+    bfIS(rhs,lhs)
+  ['COND,[isPred,rhs]]
+ 
+ 
+bfLET(lhs,rhs) ==
+  $letGenVarCounter : local := 1
+--  $inbfLet : local := true
+  bfLET1(lhs,rhs)
+ 
+addCARorCDR(acc,expr) ==
+  NULL CONSP expr => [acc,expr]
+  acc = 'CAR and EQCAR(expr,'REVERSE) =>
+      ["CAR",["LAST",:CDR expr]]
+ --   cons('last,CDR expr)
+  funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
+            CDAAR CDDAR CDADR CDDDR)
+  p := bfPosition(CAR expr,funs)
+  p = -1 => [acc,expr]
+  funsA := '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR CAAADR
+             CAADDR CADAAR CADDAR CADADR CADDDR)
+  funsR := '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR CDAADR
+             CDADDR CDDAAR CDDDAR CDDADR CDDDDR)
+  if acc = 'CAR then CONS(funsA.p,CDR expr)
+  else               CONS(funsR.p,CDR expr)
+ 
+bfPosition(x,l) ==  bfPosn(x,l,0)
+bfPosn(x,l,n) ==
+      null l => -1
+      x=first l => n
+      bfPosn(x,rest l,n+1)
+ 
+--% IS
+ 
+bfISApplication(op,left,right)==
+   EQ(op ,"IS")      => bfIS(left,right)
+   EQ(op ,"ISNT")    => bfNOT bfIS(left,right)
+   [op ,left,right]
+ 
+bfIS(left,right)==
+    $isGenVarCounter:local :=1
+    $inDefIS :local :=true
+    bfIS1(left,right)
+ 
+bfISReverse(x,a) ==
+  x is ['CONS,:.] =>
+    NULL CADDR x => ['CONS,CADR x, a]
+    y := bfISReverse(CADDR x, NIL)
+    RPLACA(CDDR y,['CONS,CADR x,a])
+    y
+  bpSpecificErrorHere '"Error in bfISReverse"
+  bpTrap()
+ 
+bfIS1(lhs,rhs) ==
+  NULL rhs =>
+    ['NULL,lhs]
+  STRINGP rhs =>
+    ['EQ,lhs,['QUOTE,INTERN rhs]]
+  NUMBERP rhs =>
+    ["EQUAL",lhs,rhs]
+  ATOM rhs =>
+    ['PROGN,bfLetForm(rhs,lhs),''T]
+  rhs is ['QUOTE,a] =>
+    IDENTP a => ['EQ,lhs,rhs]
+    ["EQUAL",lhs,rhs]
+  rhs is ['L%T,c,d] =>
+    l :=
+      bfLET(c,lhs)
+--    $inbfLet => bfLET1(c,lhs)
+--    bfLET(c,lhs)
+    bfAND [bfIS1(lhs,d),bfMKPROGN [l,''T]]
+  rhs is ["EQUAL",a] =>
+    ["EQUAL",lhs,a]
+  CONSP lhs =>
+    g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+    $isGenVarCounter := $isGenVarCounter + 1
+    bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)]
+  rhs is ['CONS,a,b] =>
+    a = "DOT" =>
+      NULL b =>
+        bfAND [['CONSP,lhs],
+               ['EQ,['CDR,lhs],'NIL]]
+      bfAND [['CONSP,lhs],
+             bfIS1(['CDR,lhs],b)]
+    NULL b =>
+      bfAND [['CONSP,lhs],
+             ['EQ,['CDR,lhs],'NIL],_
+             bfIS1(['CAR,lhs],a)]
+    b = "DOT" =>
+      bfAND [['CONSP,lhs],bfIS1(['CAR,lhs],a)]
+    a1 := bfIS1(['CAR,lhs],a)
+    b1 := bfIS1(['CDR,lhs],b)
+    a1 is ['PROGN,c,''T] and b1 is ['PROGN,:cls] =>
+      bfAND [['CONSP,lhs],bfMKPROGN [c,:cls]]
+    bfAND [['CONSP,lhs],a1,b1]
+  rhs is ['APPEND,a,b] =>
+    patrev := bfISReverse(b,a)
+    g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+    $isGenVarCounter := $isGenVarCounter + 1
+    rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],''T]]
+    l2 := bfIS1(g,patrev)
+    if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+    a = "DOT" => bfAND [rev,:l2]
+    bfAND [rev,:l2,['PROGN,bfLetForm(a,['NREVERSE,a]),''T]]
+  bpSpecificErrorHere '"bad IS code is generated"
+  bpTrap()
+ 
+bfApplication(bfop, bfarg) ==
+         if bfTupleP bfarg
+         then cons(bfop,CDR bfarg)
+         else cons(bfop,[bfarg])
+ 
+
+++ Token renaming.  New Boot and Old Boot differs in the set of
+++ tokens they rename.  When converting code written in Old Boot
+++ to New Boot, it is helpful to have some noise about potential
+++ divergence in semantics.  So, when compiling with --boot=old,
+++ we compute the renaming in both Old Boot and New Boot and compare
+++ the results.  If they differ, we prefer the old meaning, with some
+++ warnings.  Notice that the task is compounded by the fact the
+++ tokens in both language do not always agreee.
+++ However, to minimize the flood of false positive, we
+++ keep a list of symbols which apparently differ in meanings, but
+++ which have been verified to agree.  
+++ This is a valuable automated tool during the transition period.
+
+-- return the meaning of the x in Old Boot.
+bfGetOldBootName x ==
+  a := GET(x, "OLD-BOOT") => car a
+  x
+
+-- returns true if x has same meaning in both Old Boot and New Boot.
+bfSameMeaning x ==
+  GET(x, 'RENAME_-OK)
+ 
+-- returns the meaning of x in the appropriate Boot dialect.
+bfReName x==
+  newName :=
+    a := GET(x,"SHOERENAME") => car a
+    x
+  $translatingOldBoot and not bfSameMeaning x =>
+    oldName := bfGetOldBootName x
+    if newName ^= oldName then
+       warn [PNAME x, '" as `", PNAME newName, _
+             '"_' differs from Old Boot `", PNAME oldName, '"_'"]
+    oldName
+  newName
+
+ 
+bfInfApplication(op,left,right)==
+   EQ(op,"EQUAL") => bfQ(left,right)
+   EQ(op,"/=")    => bfNOT bfQ(left,right)
+   EQ(op,">")     => bfLessp(right,left)
+   EQ(op,"<")     => bfLessp(left,right)
+   EQ(op,"<=")    => bfNOT bfLessp(right,left)
+   EQ(op,">=")    => bfNOT bfLessp(left,right)
+   EQ(op,"OR")    => bfOR [left,right]
+   EQ(op,"AND")   => bfAND [left,right]
+   [op,left,right]
+ 
+bfNOT x==
+   x is ["NOT",a]=> a
+   x is ["NULL",a]=> a
+   ["NOT",x]
+ 
+bfFlatten(op, x) ==
+      EQCAR(x,op) => CDR x
+      [x]
+ 
+bfOR l  ==
+       null l => NIL
+       null cdr l => CAR l
+       ["OR",:[:bfFlatten("OR",c) for c in l]]
+ 
+bfAND l ==
+       null l=> 'T
+       null cdr l => CAR l
+       ["AND",:[:bfFlatten("AND",c) for c in l]]
+ 
+ 
+defQuoteId x==  EQCAR(x,"QUOTE") and IDENTP CADR x
+ 
+bfSmintable x==
+  INTEGERP x or CONSP x and
+      MEMQ(CAR x, '(SIZE LENGTH))
+ 
+bfQ(l,r)==
+       if bfSmintable l or bfSmintable r
+       then  ["EQL",l,r]
+       else if defQuoteId l or defQuoteId r
+            then  ["EQ",l,r]
+            else
+              if null l
+              then ["NULL",r]
+              else if null r
+                   then ["NULL",l]
+                   else ["EQUAL",l,r]
+ 
+bfLessp(l,r)==
+      if r=0
+      then ["MINUSP", l]
+      else ["<",l,r]
+ 
+bfMDef (defOp,op,args,body) ==
+  argl:=if bfTupleP args then cdr args else [args]
+  [gargl,sgargl,nargl,largl]:=bfGargl argl
+  sb:=[cons(i,j) for i in nargl for j in sgargl]
+  body:= SUBLIS(sb,body)
+  sb2 := [["CONS",["QUOTE",i],j] for i in sgargl for j in largl]
+  body := ["SUBLIS",["LIST",:sb2],["QUOTE",body]]
+  lamex:= ["MLAMBDA",gargl,body]
+  def:= [op,lamex]
+  bfTuple
+     cons(shoeComp def,[:shoeComps bfDef1 d for d in $wheredefs])
+ 
+bfGargl argl==
+      if null argl
+      then [[],[],[],[]]
+      else
+        [a,b,c,d]:=bfGargl cdr argl
+        if car argl="&REST"
+        then [cons(car argl,b),b,c,
+             cons(["CONS",["QUOTE","LIST"],car d],cdr d)]
+        else
+            f:=bfGenSymbol()
+            [cons(f,a),cons(f,b),cons(car argl,c),cons(f,d)]
+ 
+bfDef1 [defOp,op,args,body] ==
+  argl:=if bfTupleP args then cdr args else [args]
+  [quotes,control,arglp,body]:=bfInsertLet (argl,body)
+  quotes=>shoeLAM(op,arglp,control,body)
+  [[op,["LAMBDA",arglp,body]]]
+ 
+shoeLAM (op,args,control,body)==
+  margs :=bfGenSymbol()
+  innerfunc:=INTERN(CONCAT(PNAME op,",LAM"))
+  [[innerfunc,["LAMBDA",args,body]],
+     [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc],
+                    ["WRAP",margs, ["QUOTE", control]]]]]]
+ 
+bfDef(defOp,op,args,body) ==
+ $bfClamming =>
+          [.,op1,arg1,:body1]:=shoeComp first bfDef1 [defOp,op,args,body]
+          bfCompHash(op1,arg1,body1)
+ bfTuple
+  [:shoeComps bfDef1 d for d in  cons([defOp,op,args,body],$wheredefs)]
+ 
+shoeComps  x==[shoeComp def for def in x]
+shoeComp x==
+     a:=shoeCompTran CADR x
+     if EQCAR(a,"LAMBDA")
+     then ["DEFUN",CAR x,CADR a,:CDDR a]
+     else ["DEFMACRO",CAR x,CADR a,:CDDR a]
+ 
+bfInsertLet(x,body)==
+   if null x
+   then [false,nil,x,body]
+   else
+      if x is ["&REST",a]
+      then if a is ["QUOTE",b]
+           then [true,"QUOTE",["&REST",b],body]
+           else [false,nil,x,body]
+      else
+       [b,norq,name1,body1]:=  bfInsertLet1 (car x,body)
+       [b1,norq1,name2,body2]:=  bfInsertLet (cdr x,body1)
+       [b or b1,cons(norq,norq1),cons(name1,name2),body2]
+ 
+bfInsertLet1(y,body)==
+   if y is ["L%T",l,r]
+   then  [false,nil,l,bfMKPROGN [bfLET(r,l),body]]
+   else if IDENTP y
+        then [false,nil,y,body]
+        else
+          if y is ["BVQUOTE",b]
+          then [true,"QUOTE",b,body]
+          else
+            g:=bfGenSymbol()
+            ATOM y => [false,nil,g,body]
+            [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]]
+ 
+shoeCompTran x==
+   lamtype:=CAR x
+   args   :=CADR x
+   body   :=CDDR x
+   $fluidVars:local:=nil
+   $locVars:local:=nil
+   $dollarVars:local:=nil
+   shoeCompTran1 body
+   $locVars:=SETDIFFERENCE(SETDIFFERENCE($locVars,
+                                  $fluidVars),shoeATOMs args)
+   body:=
+       if $fluidVars or $locVars or $dollarVars or $typings
+       then
+         lvars:=append($fluidVars,$locVars)
+         $fluidVars:=UNION($fluidVars,$dollarVars)
+         if null $fluidVars
+         then
+            null $typings=> shoePROG(lvars,body)
+            shoePROG(lvars,[["DECLARE",:$typings],:body])
+         else
+           fvars:=["DECLARE",["SPECIAL",:$fluidVars]]
+           null $typings => shoePROG(lvars,[fvars,:body])
+           shoePROG(lvars,[fvars,["DECLARE",:$typings],:body])
+       else shoePROG([], body)
+   fl:=shoeFluids args
+   body:=if fl
+         then
+           fvs:=["DECLARE",["SPECIAL",:fl]]
+           cons(fvs,body)
+         else body
+   [lamtype,args, :body]
+
+shoePROG(v,b)==
+    null b => [["PROG", v]]
+    [:blist,blast] := b
+    [["PROG",v,:blist,["RETURN", blast]]]
+
+shoeFluids x==
+         if null x
+         then nil
+         else if IDENTP x and bfBeginsDollar x
+              then [x]
+              else
+                if EQCAR(x,"QUOTE")
+                then []
+                else
+                  if ATOM x
+                  then nil
+                  else  append(shoeFluids car x,shoeFluids cdr x)
+shoeATOMs x==
+         if null x
+         then nil
+         else if ATOM x
+              then [x]
+              else append(shoeATOMs car x,shoeATOMs cdr x)
+ 
+shoeCompTran1 x==
+    ATOM x=>
+                IDENTP x and bfBeginsDollar x=>
+                    $dollarVars:=
+                          MEMQ(x,$dollarVars)=>$dollarVars
+                          cons(x,$dollarVars)
+                nil
+    U:=car x
+    EQ(U,"QUOTE")=>nil
+    x is ["L%T",l,r]=>
+                RPLACA (x,"SETQ")
+                shoeCompTran1 r
+                IDENTP l =>
+                  not bfBeginsDollar l=>
+                    $locVars:=
+                          MEMQ(l,$locVars)=>$locVars
+                          cons(l,$locVars)
+                  $dollarVars:=
+                          MEMQ(l,$dollarVars)=>$dollarVars
+                          cons(l,$dollarVars)
+                EQCAR(l,"FLUID")=>
+                    $fluidVars:=
+                         MEMQ(CADR l,$fluidVars)=>$fluidVars
+                         cons(CADR l,$fluidVars)
+                    RPLACA (CDR x,CADR l)
+    MEMQ(U,'(PROG LAMBDA))=>
+         newbindings:=nil
+         for y in CADR x repeat
+             not MEMQ(y,$locVars)=>
+                  $locVars:=cons(y,$locVars)
+                  newbindings:=cons(y,newbindings)
+         res:=shoeCompTran1 CDDR x
+         $locVars:=[y for y in $locVars | not MEMQ(y,newbindings)]
+    shoeCompTran1 car x
+    shoeCompTran1 cdr x
+ 
+bfTagged(a,b)==
+    IDENTP a =>
+         EQ(b,"FLUID") =>  bfLET(compFluid a,NIL)
+         EQ(b,"fluid") =>  bfLET(compFluid a,NIL)
+         EQ(b,"local") =>  bfLET(compFluid a,NIL)
+         $typings:=cons(["TYPE",b,a],$typings)
+         a
+    ["THE",b,a]
+ 
+bfAssign(l,r)==
+   if bfTupleP l then bfSetelt(CADR l,CDDR l ,r) else bfLET(l,r)
+ 
+bfSetelt(e,l,r)==
+    if null cdr l
+    then defSETELT(e,car l,r)
+    else bfSetelt(bfElt(e,car l),cdr l,r)
+ 
+bfElt(expr,sel)==
+      y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
+      y=>
+         INTEGERP y => ["ELT",expr,y]
+         [y,expr]
+      ["ELT",expr,sel]
+ 
+defSETELT(var,sel,expr)==
+      y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
+      y=>
+         INTEGERP y => ["SETF",["ELT",var,y],expr]
+         ["SETF",[y,var],expr]
+      ["SETF",["ELT",var,sel],expr]
+ 
+bfIfThenOnly(a,b)==
+    b1:=if EQCAR (b,"PROGN") then CDR b else [b]
+    ["COND",[a,:b1]]
+ 
+bfIf(a,b,c)==
+    b1:=if EQCAR (b,"PROGN") then CDR b else [b]
+    EQCAR (c,"COND") => ["COND",[a,:b1],:CDR c]
+    c1:=if EQCAR (c,"PROGN") then CDR c else [c]
+    ["COND",[a,:b1],['(QUOTE T),:c1]]
+ 
+bfExit(a,b)==  ["COND",[a,["IDENTITY",b]]]
+ 
+bfMKPROGN l==
+    a:=[:bfFlattenSeq c for c in tails l]
+    null a=> nil
+    null CDR a=> CAR a
+    ["PROGN",:a]
+ 
+bfFlattenSeq x ==
+      null x=>NIL
+      f:=CAR x
+      ATOM f =>if CDR x then nil else [f]
+      EQCAR(f,"PROGN") =>
+              CDR x=>  [i for i in CDR f| not ATOM i]
+              CDR f
+      [f]
+ 
+bfSequence l ==
+      null l=> NIL
+      transform:= [[a,b] for x in l while
+              x is ["COND",[a,["IDENTITY",b]]]]
+      no:=#transform
+      before:= bfTake(no,l)
+      aft   := bfDrop(no,l)
+      null before =>
+              null rest l =>
+                   f:=first l
+                   if EQCAR(f,"PROGN")
+                   then bfSequence CDR f
+                   else f
+              bfMKPROGN [first l,bfSequence rest l]
+      null aft => ["COND",:transform]
+      ["COND",:transform,['(QUOTE T),bfSequence aft]]
+ 
+bfWhere (context,expr)==
+  [opassoc,defs,nondefs] := defSheepAndGoats context
+  a:=[[def,op,args,bfSUBLIS(opassoc,body)]
+               for d in defs  |d is [def,op,args,body]]
+  $wheredefs:=append(a,$wheredefs)
+  bfMKPROGN bfSUBLIS(opassoc,NCONC(nondefs,[expr]))
+ 
+--shoeReadLispString(s,n)==
+--    n>= # s => nil
+--    [exp,ind]:=shoeReadLisp(s,n)
+--    null exp => nil
+--    cons(exp,shoeReadLispString(s,ind))
+ 
+bfReadLisp string==bfTuple shoeReadLispString (string,0)
+
+bfCompHash(op,argl,body) ==
+  auxfn:= INTERN CONCAT (PNAME op,'";")
+  computeFunction:= ["DEFUN",auxfn,argl,:body]
+  bfTuple [computeFunction,:bfMain(auxfn,op)]
+ 
+shoeCompileTimeEvaluation x ==
+  ["EVAL-WHEN", [KEYWORD::COMPILE_-TOPLEVEL], x]
+
+shoeEVALANDFILEACTQ x==  
+  ["EVAL-WHEN", [KEYWORD::EXECUTE, KEYWORD::LOAD_-TOPLEVEL], x]
+ 
+bfMain(auxfn,op)==
+  g1:= bfGenSymbol()
+  arg:=["&REST",g1]
+  computeValue := ['APPLY,["FUNCTION",auxfn],g1]
+  cacheName:= INTERN CONCAT (PNAME op,'";AL")
+  g2:= bfGenSymbol()
+  getCode:=   ['GETHASH,g1,cacheName]
+  secondPredPair:= [['SETQ,g2,getCode],g2]
+  putCode:=   ['SETF ,getCode,computeValue]
+  thirdPredPair:= ['(QUOTE T),putCode]
+  codeBody:= ['PROG,[g2],
+               ['RETURN,['COND,secondPredPair,thirdPredPair]]]
+  mainFunction:= ["DEFUN",op,arg,codeBody]
+ 
+  cacheType:=     'hash_-table
+  cacheResetCode:=   ['SETQ,cacheName,['MAKE_-HASHTABLE,
+                        ["QUOTE","UEQUAL"]]]
+  cacheCountCode:= ['hashCount,cacheName]
+  cacheVector:=
+      [op,cacheName,cacheType,cacheResetCode,cacheCountCode]
+  [mainFunction,
+    shoeEVALANDFILEACTQ
+      ["SETF",["GET",
+           ["QUOTE", op],["QUOTE",'cacheInfo]],["QUOTE", cacheVector]],
+            shoeEVALANDFILEACTQ  cacheResetCode ]
+ 
+bfNameOnly x==
+      if x="t"
+      then ["T"]
+      else  [x]
+ 
+bfNameArgs (x,y)==
+    y:=if EQCAR(y,"TUPLE") then CDR y else [y]
+    cons(x,y)
+ 
+bfStruct(name,arglist)==
+  bfTuple [bfCreateDef i for i in arglist]
+ 
+bfCreateDef x==
+     if null cdr x
+     then
+       f:=car x
+       ["SETQ",f,["LIST",["QUOTE",f]]]
+     else
+       a:=[bfGenSymbol() for i in cdr x]
+       ["DEFUN",car x,a,["CONS",["QUOTE",car x],["LIST",:a]]]
+ 
+bfCaseItem(x,y)==[x,y]
+ 
+bfCase(x,y)==
+         g:=bfGenSymbol()
+         g1:=bfGenSymbol()
+         a:=bfLET(g,x)
+         b:=bfLET(g1,["CDR",g])
+         c:=bfCaseItems (g1,y)
+         bfMKPROGN [a,b,["CASE",["CAR", g],:c]]
+ 
+bfCaseItems(g,x)==  [bfCI(g,i,j) for [i,j] in x]
+ 
+bfCI(g,x,y)==
+    a:=cdr x
+    if null a
+    then [car x,y]
+    else
+       b:=[[i,bfCARCDR(j,g)] for i in a for j in 0..]
+       [car x,["LET",b,y]]
+ 
+bfCARCDR (n,g)==[INTERN CONCAT ('"CA",bfDs n,'"R"),g]
+ 
+bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
+
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
new file mode 100644
index 00000000..2f81c55a
--- /dev/null
+++ b/src/boot/includer.boot
@@ -0,0 +1,390 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+--
+-- Abstract:
+--   This file defines the includer (or preprocessor) of Boot programs.
+--
+
+module '"boot-includer"
+import '"tokens"
+
+)package "BOOTTRAN"
+-- BOOT INCLUDER
+ 
+-- Line syntax is
+--
+--  Include ::= (SimpleLine | If )*  | ( )fin | empty)
+--
+--  SimpleLine::=
+--        PlainLine |            includes the line
+--        )say line |            outputs line to console
+--        )eval line |           evaluates the boot line
+--                                 nothing included
+--        )line line |           line is reproduced as is in lisp output
+--        )lisp line |           line is read by lisp READ
+--        )package line |        produces (IN-PACKAGE line) in lisp
+--                                     output
+--        )include filename |    includes the file as boot code
+--        )includelisp filename |  includes the file as lisp code
+--                                   read by lisp READ
+--        )includelines  filename |  includes the file as is
+--                                     in lisp output
+--
+-- If ::= )if SimpleLine* ElseLines )endif
+--
+-- ElseLines ::= )else SimpleLine* | )elseif SimpleLine* ElseLines | empty
+
+-- returns a printable representation of X, when it is a symbol
+-- or a character, as string.  Otherwise, returns nil.
+PNAME x ==
+  SYMBOLP x => SYMBOL_-NAME x
+  CHARACTERP x => STRING x
+  nil
+
+-- converts X, a 1-length string, to a character.
+char x ==
+  CHAR(PNAME x, 0)
+
+EQCAR(x,y)== CONSP x and EQ(CAR x,y)
+
+-- returns the string representation of object X.
+STRINGIMAGE x ==
+  WRITE_-TO_-STRING x
+
+-- close STREAM.
+shoeCLOSE stream ==
+  CLOSE stream
+
+-- error out if file is not found. 
+shoeNotFound fn == 
+  coreError [fn, '" not found"]
+  nil
+
+ 
+shoeReadLispString(s,n) ==
+    l:=# s
+    n >= l => nil
+    READ_-FROM_-STRING CONCAT ( "(", SUBSTRING(s,n,l-n) ,")")
+
+-- read a line from stream
+shoeReadLine stream ==
+  READ_-LINE(stream, nil, nil)
+
+-- write LINE to standard terminal I/O.
+shoeConsole line ==
+  WRITE_-LINE(line, _*TERMINAL_-IO_*)
+ 
+shoeSpaces n  ==  MAKE_-FULL_-CVEC(n, '".")
+ 
+SoftShoeError(posn,key)==
+    coreError ['"in line ", STRINGIMAGE lineNo posn]
+    shoeConsole lineString posn
+    shoeConsole CONCAT(shoeSpaces lineCharacter posn,'"|")
+    shoeConsole key
+ 
+bpSpecificErrorAtToken(tok, key) ==
+     a:=shoeTokPosn tok
+     SoftShoeError(a,key)
+ 
+bpSpecificErrorHere(key) ==  bpSpecificErrorAtToken($stok, key)
+
+bpGeneralErrorHere() ==  bpSpecificErrorHere('"syntax error")
+ 
+bpIgnoredFromTo(pos1, pos2) ==
+    shoeConsole CONCAT('"ignored from line ", STRINGIMAGE lineNo pos1)
+    shoeConsole lineString pos1
+    shoeConsole CONCAT(shoeSpaces lineCharacter pos1,'"|")
+    shoeConsole CONCAT('"ignored through line ", STRINGIMAGE lineNo pos2)
+    shoeConsole lineString pos2
+    shoeConsole CONCAT(shoeSpaces lineCharacter pos2,'"|")
+
+-- Line inclusion support.
+ 
+lineNo p==CDAAR p
+lineString p==CAAAR p
+lineCharacter p==CDR p
+ 
+shoePackageStartsAt (lines,sz,name,stream)==
+   bStreamNull stream => [[],['nullstream]]
+   a:=CAAR stream
+   if #a >= 8 and SUBSTRING(a,0,8)='")package"
+   then shoePackageStartsAt(cons(CAAR stream,lines),sz,name,CDR stream)
+   else
+     if #a<sz
+     then shoePackageStartsAt(lines, sz,name,CDR stream)
+     else if SUBSTRING(a,0,sz)=name and (#a>sz and not shoeIdChar(a.sz))
+          then [lines,stream]
+          else shoePackageStartsAt(lines,sz,name,CDR stream)
+ 
+shoeFindLines(fn,name,a)==
+   if null a
+   then
+      shoeNotFound fn
+      []
+   else
+      [lines,b]:=shoePackageStartsAt([],#name,name, shoeInclude
+                        bAddLineNumber(bRgen a,bIgen 0))
+      b:=shoeTransform2 b
+      if bStreamNull b
+      then
+           shoeConsole CONCAT (name,'" not found in ",fn)
+           []
+      else
+         if null lines
+         then shoeConsole '")package not found"
+         append(reverse lines,car b)
+
+-- Lazy inclusion support.
+
+$bStreamNil:=["nullstream"]
+ 
+bStreamNull x==
+  null x or EQCAR (x,"nullstream") => true
+  while EQCAR(x,"nonnullstream") repeat
+          st:=APPLY(CADR x,CDDR x)
+          RPLACA(x,CAR st)
+          RPLACD(x,CDR st)
+  EQCAR(x,"nullstream")
+ 
+bMap(f,x)==bDelay(function bMap1, [f,x])
+ 
+bMap1(:z)==
+     [f,x]:=z
+     if bStreamNull x
+     then $bStreamNil
+     else cons(FUNCALL(f,car x),bMap(f,cdr x))
+
+shoeFileMap(f, fn)==
+     a:=shoeInputFile fn
+     null a =>
+        shoeConsole CONCAT(fn,'" NOT FOUND")
+        $bStreamNil
+     shoeConsole CONCAT('"READING ",fn)
+     shoeInclude  bAddLineNumber(bMap(f,bRgen a),bIgen 0)
+
+ 
+bDelay(f,x)==cons("nonnullstream",[f,:x])
+ 
+bAppend(x,y)==bDelay(function bAppend1,[x,y])
+ 
+bAppend1(:z)==
+     if bStreamNull car z
+     then if bStreamNull CADR z
+          then ["nullstream"]
+          else CADR z
+     else cons(CAAR z,bAppend(CDAR z,CADR z))
+ 
+bNext(f,s)==bDelay(function bNext1,[f,s])
+ 
+bNext1(f,s)==
+      bStreamNull s=> ["nullstream"]
+      h:= APPLY(f, [s])
+      bAppend(car h,bNext(f,cdr h))
+ 
+bRgen s==bDelay(function bRgen1,[s])
+ 
+bRgen1(:s) ==
+        a:=shoeReadLine car s
+        if shoePLACEP a
+        then
+--          shoeCLOSE car s
+            ["nullstream"]
+        else cons(a,bRgen car s)
+ 
+bIgen n==bDelay(function bIgen1,[n])
+ 
+bIgen1(:n)==
+        n:=car n+1
+        cons(n,bIgen n)
+ 
+bAddLineNumber(f1,f2)==bDelay(function bAddLineNumber1,[f1,f2])
+ 
+bAddLineNumber1(:f)==
+     [f1,f2] := f
+     bStreamNull f1 =>  ["nullstream"]
+     bStreamNull f2 =>  ["nullstream"]
+     cons(cons(CAR f1,CAR f2),bAddLineNumber(CDR f1,CDR f2))
+
+
+ 
+shoeFileInput fn==shoeFileMap(function IDENTITY,fn)
+ 
+shoePrefixLisp x== CONCAT('")lisp",x)
+shoeLispFileInput fn== shoeFileMap(function shoePrefixLisp,fn)
+ 
+shoePrefixLine x== CONCAT('")line",x)
+shoeLineFileInput fn== shoeFileMap(function shoePrefixLine,fn)
+ 
+shoePrefix?(prefix,whole) ==
+     #prefix > #whole => false
+     good:=true
+     for i in 0..#prefix-1 for j in 0.. while good repeat
+                good:= prefix.i = whole.j
+     if good then SUBSTRING(whole,#prefix,nil) else good
+ 
+shoePlainLine?(s) ==
+         #s = 0 =>  true
+         s.0 ^= char ")"
+ 
+shoeSay?          s  == shoePrefix?('")say",         s)
+shoeEval?         s  == shoePrefix?('")eval",        s)
+shoeInclude?      s  == shoePrefix?('")include",     s)
+shoeFin?          s  == shoePrefix?('")fin",         s)
+shoeIf?           s  == shoePrefix?('")if",          s)
+shoeEndIf?        s  == shoePrefix?('")endif",       s)
+shoeElse?         s  == shoePrefix?('")else",        s)
+shoeElseIf?       s  == shoePrefix?('")elseif",      s)
+shoePackage?      s  == shoePrefix?('")package",     s)
+shoeLisp?         s  == shoePrefix?('")lisp",        s)
+shoeIncludeLisp?  s  == shoePrefix?('")includelisp" ,s)
+shoeLine?         s  == shoePrefix?('")line",        s)
+shoeIncludeLines? s  == shoePrefix?('")includelines",s)
+shoeIncludeFunction? s  == shoePrefix?('")includefunction",s)
+ 
+shoeBiteOff x==
+         n:=STRPOSL('" ",x,0,true)
+         null n =>  false
+         n1:=STRPOSL ('" ",x,n,nil)
+         null n1 =>  [SUBSTRING(x,n,nil),'""]
+         [SUBSTRING(x,n,n1-n),SUBSTRING(x,n1,nil)]
+ 
+shoeFileName x==
+         a:=shoeBiteOff x
+         null a =>  '""
+         c:=shoeBiteOff CADR a
+         null c =>  CAR a
+         CONCAT(CAR a,'".",CAR c)
+ 
+shoeFnFileName x==
+         a:=shoeBiteOff x
+         null a =>  ['"",'""]
+         c:=shoeFileName CADR a
+         null c =>  [CAR a,'""]
+         [CAR a, c]
+ 
+shoeFunctionFileInput [fun,fn]==
+    shoeOpenInputFile (a,fn,
+     shoeInclude bAddLineNumber( shoeFindLines(fn,fun,a),bIgen 0))
+ 
+shoeInclude s== bDelay(function shoeInclude1,[s])
+shoeInclude1 s==
+      bStreamNull s=> s
+      [h,:t]  :=s
+      string  :=CAR h
+      command :=shoeFin? string  => $bStreamNil
+      command :=shoeIf? string   => shoeThen([true],[STTOMC command],t)
+      bAppend(shoeSimpleLine h,shoeInclude t)
+ 
+shoeSimpleLine(h) ==
+      string  :=CAR h
+      shoePlainLine? string=> [h]
+      command:=shoeLisp? string => [h]
+      command:=shoeIncludeLisp? string =>
+                  shoeLispFileInput shoeFileName command
+      command:=shoeIncludeFunction? string =>
+                  shoeFunctionFileInput shoeFnFileName command
+      command:=shoeLine? string => [h]
+      command:=shoeIncludeLines? string =>
+                  shoeLineFileInput shoeFileName command
+      command:=shoeInclude? string => shoeFileInput shoeFileName command
+      command:=shoePackage? string => [h]
+      command:=shoeSay? string =>
+                shoeConsole command
+                nil
+      command:=shoeEval? string =>
+                STTOMC command
+                nil
+      shoeLineSyntaxError(h)
+      nil
+ 
+shoeThen(keep,b,s)== bDelay(function shoeThen1,[keep,b,s])
+shoeThen1(keep,b,s)==
+    bPremStreamNull s=> s
+    [h,:t]  :=s
+    string  :=CAR h
+    command :=shoeFin? string  => bPremStreamNil(h)
+    keep1:= car keep
+    b1   := car b
+    command :=shoeIf? string  =>
+      keep1 and b1=>  shoeThen(cons(true,keep),cons(STTOMC command,b),t)
+      shoeThen(cons(false,keep),cons(false,b),t)
+    command :=shoeElseIf? string=>
+      keep1 and not b1=>
+          shoeThen(cons(true,rest keep),cons(STTOMC command,rest b),t)
+      shoeThen(cons(false,rest keep),cons(false,rest b),t)
+    command :=shoeElse? string =>
+     keep1 and not b1=>shoeElse(cons(true,rest keep),cons(true,rest b),t)
+     shoeElse(cons(false,rest keep),cons(false,rest b),t)
+    command :=shoeEndIf? string=>
+         null cdr b=>  shoeInclude t
+         shoeThen(rest keep,rest b,t)
+    keep1 and b1 => bAppend(shoeSimpleLine h,shoeThen(keep,b,t))
+    shoeThen(keep,b,t)
+ 
+shoeElse(keep,b,s)== bDelay(function shoeElse1,[keep,b,s])
+shoeElse1(keep,b,s)==
+    bPremStreamNull s=> s
+    [h,:t]  :=s
+    string  :=CAR h
+    command :=shoeFin? string => bPremStreamNil(h)
+    b1:=car b
+    keep1:=car keep
+    command :=shoeIf? string=>
+      keep1 and b1=> shoeThen(cons(true,keep),cons(STTOMC command,b),t)
+      shoeThen(cons(false,keep),cons(false,b),t)
+    command :=shoeEndIf? string =>
+         null cdr b=>  shoeInclude t
+         shoeThen(rest keep,rest b,t)
+    keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t))
+    shoeElse(keep,b,t)
+ 
+shoeLineSyntaxError(h)==
+     shoeConsole CONCAT('"INCLUSION SYNTAX ERROR IN LINE ",
+                                STRINGIMAGE CDR h)
+     shoeConsole car h
+     shoeConsole '"LINE IGNORED"
+ 
+bPremStreamNil(h)==
+       shoeConsole CONCAT('"UNEXPECTED )fin IN LINE ",STRINGIMAGE CDR h)
+       shoeConsole car h
+       shoeConsole '"REST OF FILE IGNORED"
+       $bStreamNil
+ 
+bPremStreamNull(s)==
+     if bStreamNull s
+     then
+        shoeConsole '"FILE TERMINATED BEFORE )endif"
+        true
+     else false
diff --git a/src/boot/includer.boot.pamphlet b/src/boot/includer.boot.pamphlet
deleted file mode 100644
index 9775aeb1..00000000
--- a/src/boot/includer.boot.pamphlet
+++ /dev/null
@@ -1,1226 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/includer.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\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.
-@
-
-\section{Call graphs}
-
-The followng sections give summarize symbols referenced by each 
-function defined in this pamphlet.
-
-\subsection{[[shoeFileMap]]}
-\begin{itemize}
-\item \Code{shoeInputFile} --- \File{initial-env.lisp}
-\item \Code{\$bStreamNil}  --- this file
-\item \Code{shoeConsole}  --- \File{initial-env.lisp}
-\item \Code{CONCAT} --- \File{initial-env.lisp}
-\item \Code{shoeInclude} --- this file
-\item \Code{bAddLineNumber} --- \File{ptyout.boot}
-\item \Code{bMap} --- \File{pytout.boot}
-\item \Code{bRgen} ---  \File{pytout.boot}
-\item \Code{bIgen} --- \File{pytout.boot}
-\end{itemize}
-
-\subsection{[[shoeFileInput]]}
-\begin{itemize}
-\item \Code{shoeFileMap} --- this file
-\end{itemize}
-
-\subsection{[[shoePrefixLisp]]}
-\begin{itemize}
-\item \Code{CONCAT} --- \File{npextras.lisp}
-\end{itemize}
-
-\subsection{[[shoeLispFileInput]]}
-\begin{itemize}
-\item \Code{shoeFileMap} --- this file
-\item \Code{shoePrefixLisp} --- this file
-\end{itemize}
-
-\subsection{[[shoePrefixLine]]}
-\begin{itemize}
-\item \Code{CONCAT} --- \File{initial-env.lisp}
-\end{itemize}
-
-\subsection{[[shoeLineFileInput]]}
-\begin{itemize}
-\item \Code{shoeFileMap} -- this file
-\item \Code{shoePrefixLine} -- this file
-\end{itemize}
-
-
-\subsection{[[shoePrefix?]]}
-\begin{itemize}
-\item \Code{SUBSTRING} --- \File{initial-env.lisp}
-\end{itemize}
-
-\subsection{[[shoePlainLine?]]}
-\begin{itemize}
-\item \Code{char}
-\end{itemize}
-
-\subsection{[[shoeSay?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeEval?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeInclude?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeFin?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeIf?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeEndIf?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeElse?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeElseIf?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoePackage?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeLisp?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeIncludeLisp?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeLine?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeIncludeLines?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeIncludeFunction?]]}
-\begin{itemize}
-\item \Code{shoePrefix?}
-\end{itemize}
-
-\subsection{[[shoeBiteOff]]}
-\begin{itemize}
-\item \Code{STRPOSL} --- \File{initial-env.lisp}
-\item \Code{SUBSTRING} --- \File{initial-env.lisp}
-\end{itemize}
-
-\subsection{[[shoeFileName]]}
-\begin{itemize}
-\item \Code{shoeBiteOff} --- this file
-\item \Code{CONCAT} --- \File{initial-env.lisp}
-\end{itemize}
-
-\subsection{[[shoeFnFileName]]}
-\begin{itemize}
-\item \Code{shoeBiteOff} --- this file
-\item \Code{CONCAT} --- \File{initial-env.lisp}
-\end{itemize}
-
-\subsection{[[shoeFunctionFileInput]]}
-\begin{itemize}
-\item \Code{shoeOpenInputFile} --- \File{initial-env.lisp}
-\item \Code{shoeInclude} --- this file
-\item \Code{bAddLineNumber} --- \File{ptyout.boot}
-\item \Code{shoeFindLines} --- \File{ptyout.boot}
-\item \Code{bIgen} --- \File{ptyout.boot}
-\end{itemize}
-
-\subsection{[[shoeInclude]]}
-\begin{itemize}
-\item \Code{bDelay} --- \File{ptyout.boot}
-\item \Code{shoeInclude1} --- this file
-\end{itemize}
-
-\subsection{[[shoeInclude1]]}
-\begin{itemize}
-\item \Code{bStreamNull} --- \File{ptyout.boot}
-\item \Code{shoeFin?} --- this file
-\item \Code{\$bStreamNil} --- tis file
-\item \Code{shoeIf?} --- this file
-\item \Code{shoeThen} --- this file
-\item \Code{STTOMC} --- this file
-\item \Code{bAppend} --- \File{ptyout.boot}
-\item \Code{shoeSimpleLine} --- this file
-\item \Code{shoeInclude} --- this file
-\end{itemize}
-
-\subsection{[[shoeSimpleLine]]}
-\begin{itemize}
-\item \Code{shoePlainLine?} --- this file
-\item \Code{shoeLisp?} --- this file
-\item \Code{shoeIncludeLisp?} --- this file
-\item \Code{shoeLispFileInput} --- this file
-\item \Code{shoeFileName} --- this file
-\item \Code{shoeIncludeFunction?} --- this file
-\item \Code{shoeFunctionFileInput} --- this file
-\item \Code{shoeFnFileName} --- this file
-\item \Code{shoeLine?} --- this file
-\item \Code{shoeIncludeLines?} --- this file
-\item \Code{shoeInclude?} --- this file
-\item \Code{shoeFileInput} --- this file
-\item \Code{shoePackage?} --- this file
-\item \Code{shoeSay?} --- this file
-\item \Code{shoeConsole} --- this file
-\item \Code{shoeEval?} --- this file
-\item \Code{STTOMC} --- \File{ptyout.boot}
-\item \Code{shoeLineSyntaxError} --- this file
-\end{itemize}
-
-\subsection{[[shoeThen]]}
-\begin{itemize}
-\item \Code{bDelay} --- \File{ptyout.boot}
-\item \Code{shoeThen1} --- this file
-\end{itemize}
-
-\subsection{[[shoeThen1]]}
-\begin{itemize}
-\item \Code{bPremStreamNull} --- this file
-\item \Code{shoeFin?} --- this file
-\item \Code{bPremStreamNil} --- this file
-\item \Code{shoeIf?} --- this file
-\item \Code{shoeThen} --- this file
-\item \Code{STTOMC} --- \File{ptyout.boot}
-\item \Code{shoeThen} --- this file
-\item \Code{shoeElseIf?} --- this file
-\item \Code{shoeElse?} --- this file
-\item \Code{shoeElse} --- this file
-\item \Code{shoeEndIf?} --- this file
-\item \Code{shoeInclude} --- this file
-\item \Code{bAppend} --- \File{ptyout.boot}
-\item \Code{shoeSimpleLine} --- this file
-\end{itemize}
-
-\subsection{[[shoeElse]]}
-\begin{itemize}
-\item \Code{bDelay} --- \File{ptyout.boot}
-\item \Code{shoeElse1} --- this file
-\item \Code{bPremStreamNull} --- this file
-\item \Code{shoeFin?} --- this file
-\item \Code{bPremStreamNil} --- this file
-\item \Code{shoeIf?} --- this file
-\item \Code{shoeThen} --- this file
-\item \Code{STTOMC} --- \File{ptyout.boot}
-\item \Code{shoeEndIf?} --- this file
-\item \Code{bAppend} --- \File{ptyout.boot}
-\item \Code{shoeSimpleLine} --- this file
-\item \Code{shoeElse} --- this file
-\end{itemize}
-
-\subsection{[[shoeLineSyntaxError]]}
-\begin{itemize}
-\item \Code{shoeConsole} --- \File{ptyout.boot}
-\item \Code{CONCAT} --- \File{initial-env.lisp}
-\item \Code{STRINGIMAGE} --- \File{initial-env.lisp}
-\end{itemize}
-
-\subsection{[[bPremStreamNil]]}
-\begin{itemize}
-\item \Code{shoeConsole} --- \File{initial-env.lisp}
-\item \Code{CONCAT} --- \File{initial-env.lisp}
-\item \Code{STRINGIMAGE} --- \File{initial-env.lisp}
-\item \Code{\$bStreamNil} --- this file
-\end{itemize}
-
-\subsection{[[bPremStreamNull]]}
-\begin{itemize}
-\item \Code{bStreamNull} --- \File{ptyout.boot}
-\item \Code{shoeConsole} --- \File{initial-env.lisp}
-\end{itemize}
-
-
-\section{The Boot code}
-
-<<*>>=
-<<license>>
-
-module '"boot-includer"
-import '"tokens"
-
-)package "BOOTTRAN"
--- BOOT INCLUDER
- 
--- Line syntax is
---
---  Include ::= (SimpleLine | If )*  | ( )fin | empty)
---
---  SimpleLine::=
---        PlainLine |            includes the line
---        )say line |            outputs line to console
---        )eval line |           evaluates the boot line
---                                 nothing included
---        )line line |           line is reproduced as is in lisp output
---        )lisp line |           line is read by lisp READ
---        )package line |        produces (IN-PACKAGE line) in lisp
---                                     output
---        )include filename |    includes the file as boot code
---        )includelisp filename |  includes the file as lisp code
---                                   read by lisp READ
---        )includelines  filename |  includes the file as is
---                                     in lisp output
---
--- If ::= )if SimpleLine* ElseLines )endif
---
--- ElseLines ::= )else SimpleLine* | )elseif SimpleLine* ElseLines | empty
-
--- returns a printable representation of X, when it is a symbol
--- or a character, as string.  Otherwise, returns nil.
-PNAME x ==
-  SYMBOLP x => SYMBOL_-NAME x
-  CHARACTERP x => STRING x
-  nil
-
--- converts X, a 1-length string, to a character.
-char x ==
-  CHAR(PNAME x, 0)
-
-EQCAR(x,y)== CONSP x and EQ(CAR x,y)
-
--- returns the string representation of object X.
-STRINGIMAGE x ==
-  WRITE_-TO_-STRING x
-
--- close STREAM.
-shoeCLOSE stream ==
-  CLOSE stream
-
--- error out if file is not found. 
-shoeNotFound fn == 
-  coreError [fn, '" not found"]
-  nil
-
- 
-shoeReadLispString(s,n) ==
-    l:=# s
-    n >= l => nil
-    READ_-FROM_-STRING CONCAT ( "(", SUBSTRING(s,n,l-n) ,")")
-
--- read a line from stream
-shoeReadLine stream ==
-  READ_-LINE(stream, nil, nil)
-
--- write LINE to standard terminal I/O.
-shoeConsole line ==
-  WRITE_-LINE(line, _*TERMINAL_-IO_*)
- 
-shoeSpaces n  ==  MAKE_-FULL_-CVEC(n, '".")
- 
-SoftShoeError(posn,key)==
-    coreError ['"in line ", STRINGIMAGE lineNo posn]
-    shoeConsole lineString posn
-    shoeConsole CONCAT(shoeSpaces lineCharacter posn,'"|")
-    shoeConsole key
- 
-bpSpecificErrorAtToken(tok, key) ==
-     a:=shoeTokPosn tok
-     SoftShoeError(a,key)
- 
-bpSpecificErrorHere(key) ==  bpSpecificErrorAtToken($stok, key)
-
-bpGeneralErrorHere() ==  bpSpecificErrorHere('"syntax error")
- 
-bpIgnoredFromTo(pos1, pos2) ==
-    shoeConsole CONCAT('"ignored from line ", STRINGIMAGE lineNo pos1)
-    shoeConsole lineString pos1
-    shoeConsole CONCAT(shoeSpaces lineCharacter pos1,'"|")
-    shoeConsole CONCAT('"ignored through line ", STRINGIMAGE lineNo pos2)
-    shoeConsole lineString pos2
-    shoeConsole CONCAT(shoeSpaces lineCharacter pos2,'"|")
-
--- Line inclusion support.
- 
-lineNo p==CDAAR p
-lineString p==CAAAR p
-lineCharacter p==CDR p
- 
-shoePackageStartsAt (lines,sz,name,stream)==
-   bStreamNull stream => [[],['nullstream]]
-   a:=CAAR stream
-   if #a >= 8 and SUBSTRING(a,0,8)='")package"
-   then shoePackageStartsAt(cons(CAAR stream,lines),sz,name,CDR stream)
-   else
-     if #a<sz
-     then shoePackageStartsAt(lines, sz,name,CDR stream)
-     else if SUBSTRING(a,0,sz)=name and (#a>sz and not shoeIdChar(a.sz))
-          then [lines,stream]
-          else shoePackageStartsAt(lines,sz,name,CDR stream)
- 
-shoeFindLines(fn,name,a)==
-   if null a
-   then
-      shoeNotFound fn
-      []
-   else
-      [lines,b]:=shoePackageStartsAt([],#name,name, shoeInclude
-                        bAddLineNumber(bRgen a,bIgen 0))
-      b:=shoeTransform2 b
-      if bStreamNull b
-      then
-           shoeConsole CONCAT (name,'" not found in ",fn)
-           []
-      else
-         if null lines
-         then shoeConsole '")package not found"
-         append(reverse lines,car b)
-
--- Lazy inclusion support.
-
-$bStreamNil:=["nullstream"]
- 
-bStreamNull x==
-  null x or EQCAR (x,"nullstream") => true
-  while EQCAR(x,"nonnullstream") repeat
-          st:=APPLY(CADR x,CDDR x)
-          RPLACA(x,CAR st)
-          RPLACD(x,CDR st)
-  EQCAR(x,"nullstream")
- 
-bMap(f,x)==bDelay(function bMap1, [f,x])
- 
-bMap1(:z)==
-     [f,x]:=z
-     if bStreamNull x
-     then $bStreamNil
-     else cons(FUNCALL(f,car x),bMap(f,cdr x))
-
-shoeFileMap(f, fn)==
-     a:=shoeInputFile fn
-     null a =>
-        shoeConsole CONCAT(fn,'" NOT FOUND")
-        $bStreamNil
-     shoeConsole CONCAT('"READING ",fn)
-     shoeInclude  bAddLineNumber(bMap(f,bRgen a),bIgen 0)
-
- 
-bDelay(f,x)==cons("nonnullstream",[f,:x])
- 
-bAppend(x,y)==bDelay(function bAppend1,[x,y])
- 
-bAppend1(:z)==
-     if bStreamNull car z
-     then if bStreamNull CADR z
-          then ["nullstream"]
-          else CADR z
-     else cons(CAAR z,bAppend(CDAR z,CADR z))
- 
-bNext(f,s)==bDelay(function bNext1,[f,s])
- 
-bNext1(f,s)==
-      bStreamNull s=> ["nullstream"]
-      h:= APPLY(f, [s])
-      bAppend(car h,bNext(f,cdr h))
- 
-bRgen s==bDelay(function bRgen1,[s])
- 
-bRgen1(:s) ==
-        a:=shoeReadLine car s
-        if shoePLACEP a
-        then
---          shoeCLOSE car s
-            ["nullstream"]
-        else cons(a,bRgen car s)
- 
-bIgen n==bDelay(function bIgen1,[n])
- 
-bIgen1(:n)==
-        n:=car n+1
-        cons(n,bIgen n)
- 
-bAddLineNumber(f1,f2)==bDelay(function bAddLineNumber1,[f1,f2])
- 
-bAddLineNumber1(:f)==
-     [f1,f2] := f
-     bStreamNull f1 =>  ["nullstream"]
-     bStreamNull f2 =>  ["nullstream"]
-     cons(cons(CAR f1,CAR f2),bAddLineNumber(CDR f1,CDR f2))
-
-
- 
-shoeFileInput fn==shoeFileMap(function IDENTITY,fn)
- 
-shoePrefixLisp x== CONCAT('")lisp",x)
-shoeLispFileInput fn== shoeFileMap(function shoePrefixLisp,fn)
- 
-shoePrefixLine x== CONCAT('")line",x)
-shoeLineFileInput fn== shoeFileMap(function shoePrefixLine,fn)
- 
-shoePrefix?(prefix,whole) ==
-     #prefix > #whole => false
-     good:=true
-     for i in 0..#prefix-1 for j in 0.. while good repeat
-                good:= prefix.i = whole.j
-     if good then SUBSTRING(whole,#prefix,nil) else good
- 
-shoePlainLine?(s) ==
-         #s = 0 =>  true
-         s.0 ^= char ")"
- 
-shoeSay?          s  == shoePrefix?('")say",         s)
-shoeEval?         s  == shoePrefix?('")eval",        s)
-shoeInclude?      s  == shoePrefix?('")include",     s)
-shoeFin?          s  == shoePrefix?('")fin",         s)
-shoeIf?           s  == shoePrefix?('")if",          s)
-shoeEndIf?        s  == shoePrefix?('")endif",       s)
-shoeElse?         s  == shoePrefix?('")else",        s)
-shoeElseIf?       s  == shoePrefix?('")elseif",      s)
-shoePackage?      s  == shoePrefix?('")package",     s)
-shoeLisp?         s  == shoePrefix?('")lisp",        s)
-shoeIncludeLisp?  s  == shoePrefix?('")includelisp" ,s)
-shoeLine?         s  == shoePrefix?('")line",        s)
-shoeIncludeLines? s  == shoePrefix?('")includelines",s)
-shoeIncludeFunction? s  == shoePrefix?('")includefunction",s)
- 
-shoeBiteOff x==
-         n:=STRPOSL('" ",x,0,true)
-         null n =>  false
-         n1:=STRPOSL ('" ",x,n,nil)
-         null n1 =>  [SUBSTRING(x,n,nil),'""]
-         [SUBSTRING(x,n,n1-n),SUBSTRING(x,n1,nil)]
- 
-shoeFileName x==
-         a:=shoeBiteOff x
-         null a =>  '""
-         c:=shoeBiteOff CADR a
-         null c =>  CAR a
-         CONCAT(CAR a,'".",CAR c)
- 
-shoeFnFileName x==
-         a:=shoeBiteOff x
-         null a =>  ['"",'""]
-         c:=shoeFileName CADR a
-         null c =>  [CAR a,'""]
-         [CAR a, c]
- 
-shoeFunctionFileInput [fun,fn]==
-    shoeOpenInputFile (a,fn,
-     shoeInclude bAddLineNumber( shoeFindLines(fn,fun,a),bIgen 0))
- 
-shoeInclude s== bDelay(function shoeInclude1,[s])
-shoeInclude1 s==
-      bStreamNull s=> s
-      [h,:t]  :=s
-      string  :=CAR h
-      command :=shoeFin? string  => $bStreamNil
-      command :=shoeIf? string   => shoeThen([true],[STTOMC command],t)
-      bAppend(shoeSimpleLine h,shoeInclude t)
- 
-shoeSimpleLine(h) ==
-      string  :=CAR h
-      shoePlainLine? string=> [h]
-      command:=shoeLisp? string => [h]
-      command:=shoeIncludeLisp? string =>
-                  shoeLispFileInput shoeFileName command
-      command:=shoeIncludeFunction? string =>
-                  shoeFunctionFileInput shoeFnFileName command
-      command:=shoeLine? string => [h]
-      command:=shoeIncludeLines? string =>
-                  shoeLineFileInput shoeFileName command
-      command:=shoeInclude? string => shoeFileInput shoeFileName command
-      command:=shoePackage? string => [h]
-      command:=shoeSay? string =>
-                shoeConsole command
-                nil
-      command:=shoeEval? string =>
-                STTOMC command
-                nil
-      shoeLineSyntaxError(h)
-      nil
- 
-shoeThen(keep,b,s)== bDelay(function shoeThen1,[keep,b,s])
-shoeThen1(keep,b,s)==
-    bPremStreamNull s=> s
-    [h,:t]  :=s
-    string  :=CAR h
-    command :=shoeFin? string  => bPremStreamNil(h)
-    keep1:= car keep
-    b1   := car b
-    command :=shoeIf? string  =>
-      keep1 and b1=>  shoeThen(cons(true,keep),cons(STTOMC command,b),t)
-      shoeThen(cons(false,keep),cons(false,b),t)
-    command :=shoeElseIf? string=>
-      keep1 and not b1=>
-          shoeThen(cons(true,rest keep),cons(STTOMC command,rest b),t)
-      shoeThen(cons(false,rest keep),cons(false,rest b),t)
-    command :=shoeElse? string =>
-     keep1 and not b1=>shoeElse(cons(true,rest keep),cons(true,rest b),t)
-     shoeElse(cons(false,rest keep),cons(false,rest b),t)
-    command :=shoeEndIf? string=>
-         null cdr b=>  shoeInclude t
-         shoeThen(rest keep,rest b,t)
-    keep1 and b1 => bAppend(shoeSimpleLine h,shoeThen(keep,b,t))
-    shoeThen(keep,b,t)
- 
-shoeElse(keep,b,s)== bDelay(function shoeElse1,[keep,b,s])
-shoeElse1(keep,b,s)==
-    bPremStreamNull s=> s
-    [h,:t]  :=s
-    string  :=CAR h
-    command :=shoeFin? string => bPremStreamNil(h)
-    b1:=car b
-    keep1:=car keep
-    command :=shoeIf? string=>
-      keep1 and b1=> shoeThen(cons(true,keep),cons(STTOMC command,b),t)
-      shoeThen(cons(false,keep),cons(false,b),t)
-    command :=shoeEndIf? string =>
-         null cdr b=>  shoeInclude t
-         shoeThen(rest keep,rest b,t)
-    keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t))
-    shoeElse(keep,b,t)
- 
-shoeLineSyntaxError(h)==
-     shoeConsole CONCAT('"INCLUSION SYNTAX ERROR IN LINE ",
-                                STRINGIMAGE CDR h)
-     shoeConsole car h
-     shoeConsole '"LINE IGNORED"
- 
-bPremStreamNil(h)==
-       shoeConsole CONCAT('"UNEXPECTED )fin IN LINE ",STRINGIMAGE CDR h)
-       shoeConsole car h
-       shoeConsole '"REST OF FILE IGNORED"
-       $bStreamNil
- 
-bPremStreamNull(s)==
-     if bStreamNull s
-     then
-        shoeConsole '"FILE TERMINATED BEFORE )endif"
-        true
-     else false
-@
-
-
-\section{Translated Lisp code}
-
-<<includer.clisp>>=
-(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-includer"))
-
-(IMPORT-MODULE "tokens")
-
-(IN-PACKAGE "BOOTTRAN")
-
-(DEFUN PNAME (|x|)
-  (PROG ()
-    (RETURN
-      (COND
-        ((SYMBOLP |x|) (SYMBOL-NAME |x|))
-        ((CHARACTERP |x|) (STRING |x|))
-        ('T NIL)))))
-
-(DEFUN |char| (|x|) (PROG () (RETURN (CHAR (PNAME |x|) 0))))
-
-(DEFUN EQCAR (|x| |y|)
-  (PROG () (RETURN (AND (CONSP |x|) (EQ (CAR |x|) |y|)))))
-
-(DEFUN STRINGIMAGE (|x|) (PROG () (RETURN (WRITE-TO-STRING |x|))))
-
-(DEFUN |shoeCLOSE| (|stream|) (PROG () (RETURN (CLOSE |stream|))))
-
-(DEFUN |shoeNotFound| (|fn|)
-  (PROG ()
-    (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
-
-(DEFUN |shoeReadLispString| (|s| |n|)
-  (PROG (|l|)
-    (RETURN
-      (PROGN
-        (SETQ |l| (LENGTH |s|))
-        (COND
-          ((NOT (< |n| |l|)) NIL)
-          ('T
-           (READ-FROM-STRING
-               (CONCAT '|(| (SUBSTRING |s| |n| (- |l| |n|)) '|)|))))))))
-
-(DEFUN |shoeReadLine| (|stream|)
-  (PROG () (RETURN (READ-LINE |stream| NIL NIL))))
-
-(DEFUN |shoeConsole| (|line|)
-  (PROG () (RETURN (WRITE-LINE |line| *TERMINAL-IO*))))
-
-(DEFUN |shoeSpaces| (|n|) (PROG () (RETURN (MAKE-FULL-CVEC |n| "."))))
-
-(DEFUN |SoftShoeError| (|posn| |key|)
-  (PROG ()
-    (RETURN
-      (PROGN
-        (|coreError| (LIST "in line " (STRINGIMAGE (|lineNo| |posn|))))
-        (|shoeConsole| (|lineString| |posn|))
-        (|shoeConsole|
-            (CONCAT (|shoeSpaces| (|lineCharacter| |posn|)) "|"))
-        (|shoeConsole| |key|)))))
-
-(DEFUN |bpSpecificErrorAtToken| (|tok| |key|)
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|shoeTokPosn| |tok|))
-        (|SoftShoeError| |a| |key|)))))
-
-(DEFUN |bpSpecificErrorHere| (|key|)
-  (PROG ()
-    (DECLARE (SPECIAL |$stok|))
-    (RETURN (|bpSpecificErrorAtToken| |$stok| |key|))))
-
-(DEFUN |bpGeneralErrorHere| ()
-  (PROG () (RETURN (|bpSpecificErrorHere| "syntax error"))))
-
-(DEFUN |bpIgnoredFromTo| (|pos1| |pos2|)
-  (PROG ()
-    (RETURN
-      (PROGN
-        (|shoeConsole|
-            (CONCAT "ignored from line "
-                    (STRINGIMAGE (|lineNo| |pos1|))))
-        (|shoeConsole| (|lineString| |pos1|))
-        (|shoeConsole|
-            (CONCAT (|shoeSpaces| (|lineCharacter| |pos1|)) "|"))
-        (|shoeConsole|
-            (CONCAT "ignored through line "
-                    (STRINGIMAGE (|lineNo| |pos2|))))
-        (|shoeConsole| (|lineString| |pos2|))
-        (|shoeConsole|
-            (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|"))))))
-
-(DEFUN |lineNo| (|p|) (PROG () (RETURN (CDAAR |p|))))
-
-(DEFUN |lineString| (|p|) (PROG () (RETURN (CAAAR |p|))))
-
-(DEFUN |lineCharacter| (|p|) (PROG () (RETURN (CDR |p|))))
-
-(DEFUN |shoePackageStartsAt| (|lines| |sz| |name| |stream|)
-  (PROG (|a|)
-    (RETURN
-      (COND
-        ((|bStreamNull| |stream|) (LIST NIL (LIST '|nullstream|)))
-        ('T
-         (PROGN
-           (SETQ |a| (CAAR |stream|))
-           (COND
-             ((AND (NOT (< (LENGTH |a|) 8))
-                   (EQUAL (SUBSTRING |a| 0 8) ")package"))
-              (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|)
-                  |sz| |name| (CDR |stream|)))
-             ((< (LENGTH |a|) |sz|)
-              (|shoePackageStartsAt| |lines| |sz| |name|
-                  (CDR |stream|)))
-             ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
-                   (< |sz| (LENGTH |a|))
-                   (NULL (|shoeIdChar| (ELT |a| |sz|))))
-              (LIST |lines| |stream|))
-             ('T
-              (|shoePackageStartsAt| |lines| |sz| |name|
-                  (CDR |stream|))))))))))
-
-(DEFUN |shoeFindLines| (|fn| |name| |a|)
-  (PROG (|b| |lines| |LETTMP#1|)
-    (RETURN
-      (COND
-        ((NULL |a|) (|shoeNotFound| |fn|) NIL)
-        (#0='T
-         (SETQ |LETTMP#1|
-               (|shoePackageStartsAt| NIL (LENGTH |name|) |name|
-                   (|shoeInclude|
-                       (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0)))))
-         (SETQ |lines| (CAR |LETTMP#1|)) (SETQ |b| (CADR |LETTMP#1|))
-         (SETQ |b| (|shoeTransform2| |b|))
-         (COND
-           ((|bStreamNull| |b|)
-            (|shoeConsole| (CONCAT |name| " not found in " |fn|)) NIL)
-           (#0#
-            (COND
-              ((NULL |lines|) (|shoeConsole| ")package not found")))
-            (APPEND (REVERSE |lines|) (CAR |b|)))))))))
-
-(DEFPARAMETER |$bStreamNil| (LIST '|nullstream|))
-
-(DEFUN |bStreamNull| (|x|)
-  (PROG (|st|)
-    (RETURN
-      (COND
-        ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
-        ('T
-         (PROGN
-           (LOOP
-             (COND
-               ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
-               ('T
-                (PROGN
-                  (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
-                  (RPLACA |x| (CAR |st|))
-                  (RPLACD |x| (CDR |st|))))))
-           (EQCAR |x| '|nullstream|)))))))
-
-(DEFUN |bMap| (|f| |x|)
-  (PROG () (RETURN (|bDelay| #'|bMap1| (LIST |f| |x|)))))
-
-(DEFUN |bMap1| (&REST |z|)
-  (PROG (|x| |f|)
-    (DECLARE (SPECIAL |$bStreamNil|))
-    (RETURN
-      (PROGN
-        (SETQ |f| (CAR |z|))
-        (SETQ |x| (CADR |z|))
-        (COND
-          ((|bStreamNull| |x|) |$bStreamNil|)
-          ('T (CONS (FUNCALL |f| (CAR |x|)) (|bMap| |f| (CDR |x|)))))))))
-
-(DEFUN |shoeFileMap| (|f| |fn|)
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$bStreamNil|))
-    (RETURN
-      (PROGN
-        (SETQ |a| (|shoeInputFile| |fn|))
-        (COND
-          ((NULL |a|)
-           (PROGN
-             (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
-             |$bStreamNil|))
-          ('T
-           (PROGN
-             (|shoeConsole| (CONCAT "READING " |fn|))
-             (|shoeInclude|
-                 (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
-                     (|bIgen| 0))))))))))
-
-(DEFUN |bDelay| (|f| |x|)
-  (PROG () (RETURN (CONS '|nonnullstream| (CONS |f| |x|)))))
-
-(DEFUN |bAppend| (|x| |y|)
-  (PROG () (RETURN (|bDelay| #'|bAppend1| (LIST |x| |y|)))))
-
-(DEFUN |bAppend1| (&REST |z|)
-  (PROG ()
-    (RETURN
-      (COND
-        ((|bStreamNull| (CAR |z|))
-         (COND
-           ((|bStreamNull| (CADR |z|)) (LIST '|nullstream|))
-           (#0='T (CADR |z|))))
-        (#0# (CONS (CAAR |z|) (|bAppend| (CDAR |z|) (CADR |z|))))))))
-
-(DEFUN |bNext| (|f| |s|)
-  (PROG () (RETURN (|bDelay| #'|bNext1| (LIST |f| |s|)))))
-
-(DEFUN |bNext1| (|f| |s|)
-  (PROG (|h|)
-    (RETURN
-      (COND
-        ((|bStreamNull| |s|) (LIST '|nullstream|))
-        ('T
-         (PROGN
-           (SETQ |h| (APPLY |f| (LIST |s|)))
-           (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|)))))))))
-
-(DEFUN |bRgen| (|s|)
-  (PROG () (RETURN (|bDelay| #'|bRgen1| (LIST |s|)))))
-
-(DEFUN |bRgen1| (&REST |s|)
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|shoeReadLine| (CAR |s|)))
-        (COND
-          ((|shoePLACEP| |a|) (LIST '|nullstream|))
-          ('T (CONS |a| (|bRgen| (CAR |s|)))))))))
-
-(DEFUN |bIgen| (|n|)
-  (PROG () (RETURN (|bDelay| #'|bIgen1| (LIST |n|)))))
-
-(DEFUN |bIgen1| (&REST |n|)
-  (PROG ()
-    (RETURN
-      (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|))))))
-
-(DEFUN |bAddLineNumber| (|f1| |f2|)
-  (PROG () (RETURN (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|)))))
-
-(DEFUN |bAddLineNumber1| (&REST |f|)
-  (PROG (|f2| |f1|)
-    (RETURN
-      (PROGN
-        (SETQ |f1| (CAR |f|))
-        (SETQ |f2| (CADR |f|))
-        (COND
-          ((|bStreamNull| |f1|) (LIST '|nullstream|))
-          ((|bStreamNull| |f2|) (LIST '|nullstream|))
-          ('T
-           (CONS (CONS (CAR |f1|) (CAR |f2|))
-                 (|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))))))
-
-(DEFUN |shoeFileInput| (|fn|)
-  (PROG () (RETURN (|shoeFileMap| #'IDENTITY |fn|))))
-
-(DEFUN |shoePrefixLisp| (|x|) (PROG () (RETURN (CONCAT ")lisp" |x|))))
-
-(DEFUN |shoeLispFileInput| (|fn|)
-  (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLisp| |fn|))))
-
-(DEFUN |shoePrefixLine| (|x|) (PROG () (RETURN (CONCAT ")line" |x|))))
-
-(DEFUN |shoeLineFileInput| (|fn|)
-  (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLine| |fn|))))
-
-(DEFUN |shoePrefix?| (|prefix| |whole|)
-  (PROG (|good|)
-    (RETURN
-      (COND
-        ((< (LENGTH |whole|) (LENGTH |prefix|)) NIL)
-        ('T
-         (PROGN
-           (SETQ |good| T)
-           (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
-             (LOOP
-               (COND
-                 ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
-                 ('T
-                  (SETQ |good|
-                        (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
-               (SETQ |i| (+ |i| 1))
-               (SETQ |j| (+ |j| 1))))
-           (COND
-             (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
-             ('T |good|))))))))
-
-(DEFUN |shoePlainLine?| (|s|)
-  (PROG ()
-    (RETURN
-      (COND
-        ((EQL (LENGTH |s|) 0) T)
-        ('T (NOT (EQUAL (ELT |s| 0) (|char| '|)|))))))))
-
-(DEFUN |shoeSay?| (|s|) (PROG () (RETURN (|shoePrefix?| ")say" |s|))))
-
-(DEFUN |shoeEval?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")eval" |s|))))
-
-(DEFUN |shoeInclude?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")include" |s|))))
-
-(DEFUN |shoeFin?| (|s|) (PROG () (RETURN (|shoePrefix?| ")fin" |s|))))
-
-(DEFUN |shoeIf?| (|s|) (PROG () (RETURN (|shoePrefix?| ")if" |s|))))
-
-(DEFUN |shoeEndIf?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")endif" |s|))))
-
-(DEFUN |shoeElse?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")else" |s|))))
-
-(DEFUN |shoeElseIf?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")elseif" |s|))))
-
-(DEFUN |shoePackage?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")package" |s|))))
-
-(DEFUN |shoeLisp?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")lisp" |s|))))
-
-(DEFUN |shoeIncludeLisp?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")includelisp" |s|))))
-
-(DEFUN |shoeLine?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")line" |s|))))
-
-(DEFUN |shoeIncludeLines?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")includelines" |s|))))
-
-(DEFUN |shoeIncludeFunction?| (|s|)
-  (PROG () (RETURN (|shoePrefix?| ")includefunction" |s|))))
-
-(DEFUN |shoeBiteOff| (|x|)
-  (PROG (|n1| |n|)
-    (RETURN
-      (PROGN
-        (SETQ |n| (STRPOSL " " |x| 0 T))
-        (COND
-          ((NULL |n|) NIL)
-          (#0='T
-           (PROGN
-             (SETQ |n1| (STRPOSL " " |x| |n| NIL))
-             (COND
-               ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
-               (#0#
-                (LIST (SUBSTRING |x| |n| (- |n1| |n|))
-                      (SUBSTRING |x| |n1| NIL)))))))))))
-
-(DEFUN |shoeFileName| (|x|)
-  (PROG (|c| |a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|shoeBiteOff| |x|))
-        (COND
-          ((NULL |a|) "")
-          (#0='T
-           (PROGN
-             (SETQ |c| (|shoeBiteOff| (CADR |a|)))
-             (COND
-               ((NULL |c|) (CAR |a|))
-               (#0# (CONCAT (CAR |a|) "." (CAR |c|)))))))))))
-
-(DEFUN |shoeFnFileName| (|x|)
-  (PROG (|c| |a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|shoeBiteOff| |x|))
-        (COND
-          ((NULL |a|) (LIST "" ""))
-          (#0='T
-           (PROGN
-             (SETQ |c| (|shoeFileName| (CADR |a|)))
-             (COND
-               ((NULL |c|) (LIST (CAR |a|) ""))
-               (#0# (LIST (CAR |a|) |c|))))))))))
-
-(DEFUN |shoeFunctionFileInput| (|bfVar#2|)
-  (PROG (|fn| |fun|)
-    (RETURN
-      (PROGN
-        (SETQ |fun| (CAR |bfVar#2|))
-        (SETQ |fn| (CADR |bfVar#2|))
-        (|shoeOpenInputFile| |a| |fn|
-            (|shoeInclude|
-                (|bAddLineNumber| (|shoeFindLines| |fn| |fun| |a|)
-                    (|bIgen| 0))))))))
-
-(DEFUN |shoeInclude| (|s|)
-  (PROG () (RETURN (|bDelay| #'|shoeInclude1| (LIST |s|)))))
-
-(DEFUN |shoeInclude1| (|s|)
-  (PROG (|command| |string| |t| |h|)
-    (DECLARE (SPECIAL |$bStreamNil|))
-    (RETURN
-      (COND
-        ((|bStreamNull| |s|) |s|)
-        (#0='T
-         (PROGN
-           (SETQ |h| (CAR |s|))
-           (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
-           (COND
-             ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
-             ((SETQ |command| (|shoeIf?| |string|))
-              (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
-             (#0#
-              (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|))))))))))
-
-(DEFUN |shoeSimpleLine| (|h|)
-  (PROG (|command| |string|)
-    (RETURN
-      (PROGN
-        (SETQ |string| (CAR |h|))
-        (COND
-          ((|shoePlainLine?| |string|) (LIST |h|))
-          ((SETQ |command| (|shoeLisp?| |string|)) (LIST |h|))
-          ((SETQ |command| (|shoeIncludeLisp?| |string|))
-           (|shoeLispFileInput| (|shoeFileName| |command|)))
-          ((SETQ |command| (|shoeIncludeFunction?| |string|))
-           (|shoeFunctionFileInput| (|shoeFnFileName| |command|)))
-          ((SETQ |command| (|shoeLine?| |string|)) (LIST |h|))
-          ((SETQ |command| (|shoeIncludeLines?| |string|))
-           (|shoeLineFileInput| (|shoeFileName| |command|)))
-          ((SETQ |command| (|shoeInclude?| |string|))
-           (|shoeFileInput| (|shoeFileName| |command|)))
-          ((SETQ |command| (|shoePackage?| |string|)) (LIST |h|))
-          ((SETQ |command| (|shoeSay?| |string|))
-           (PROGN (|shoeConsole| |command|) NIL))
-          ((SETQ |command| (|shoeEval?| |string|))
-           (PROGN (STTOMC |command|) NIL))
-          ('T (PROGN (|shoeLineSyntaxError| |h|) NIL)))))))
-
-(DEFUN |shoeThen| (|keep| |b| |s|)
-  (PROG () (RETURN (|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))))
-
-(DEFUN |shoeThen1| (|keep| |b| |s|)
-  (PROG (|b1| |keep1| |command| |string| |t| |h|)
-    (RETURN
-      (COND
-        ((|bPremStreamNull| |s|) |s|)
-        (#0='T
-         (PROGN
-           (SETQ |h| (CAR |s|))
-           (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
-           (COND
-             ((SETQ |command| (|shoeFin?| |string|))
-              (|bPremStreamNil| |h|))
-             (#0#
-              (PROGN
-                (SETQ |keep1| (CAR |keep|))
-                (SETQ |b1| (CAR |b|))
-                (COND
-                  ((SETQ |command| (|shoeIf?| |string|))
-                   (COND
-                     ((AND |keep1| |b1|)
-                      (|shoeThen| (CONS T |keep|)
-                          (CONS (STTOMC |command|) |b|) |t|))
-                     (#0#
-                      (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
-                  ((SETQ |command| (|shoeElseIf?| |string|))
-                   (COND
-                     ((AND |keep1| (NULL |b1|))
-                      (|shoeThen| (CONS T (CDR |keep|))
-                          (CONS (STTOMC |command|) (CDR |b|)) |t|))
-                     (#0#
-                      (|shoeThen| (CONS NIL (CDR |keep|))
-                          (CONS NIL (CDR |b|)) |t|))))
-                  ((SETQ |command| (|shoeElse?| |string|))
-                   (COND
-                     ((AND |keep1| (NULL |b1|))
-                      (|shoeElse| (CONS T (CDR |keep|))
-                          (CONS T (CDR |b|)) |t|))
-                     (#0#
-                      (|shoeElse| (CONS NIL (CDR |keep|))
-                          (CONS NIL (CDR |b|)) |t|))))
-                  ((SETQ |command| (|shoeEndIf?| |string|))
-                   (COND
-                     ((NULL (CDR |b|)) (|shoeInclude| |t|))
-                     (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
-                  ((AND |keep1| |b1|)
-                   (|bAppend| (|shoeSimpleLine| |h|)
-                       (|shoeThen| |keep| |b| |t|)))
-                  (#0# (|shoeThen| |keep| |b| |t|))))))))))))
-
-(DEFUN |shoeElse| (|keep| |b| |s|)
-  (PROG () (RETURN (|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))))
-
-(DEFUN |shoeElse1| (|keep| |b| |s|)
-  (PROG (|keep1| |b1| |command| |string| |t| |h|)
-    (RETURN
-      (COND
-        ((|bPremStreamNull| |s|) |s|)
-        (#0='T
-         (PROGN
-           (SETQ |h| (CAR |s|))
-           (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
-           (COND
-             ((SETQ |command| (|shoeFin?| |string|))
-              (|bPremStreamNil| |h|))
-             (#0#
-              (PROGN
-                (SETQ |b1| (CAR |b|))
-                (SETQ |keep1| (CAR |keep|))
-                (COND
-                  ((SETQ |command| (|shoeIf?| |string|))
-                   (COND
-                     ((AND |keep1| |b1|)
-                      (|shoeThen| (CONS T |keep|)
-                          (CONS (STTOMC |command|) |b|) |t|))
-                     (#0#
-                      (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
-                  ((SETQ |command| (|shoeEndIf?| |string|))
-                   (COND
-                     ((NULL (CDR |b|)) (|shoeInclude| |t|))
-                     (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
-                  ((AND |keep1| |b1|)
-                   (|bAppend| (|shoeSimpleLine| |h|)
-                       (|shoeElse| |keep| |b| |t|)))
-                  (#0# (|shoeElse| |keep| |b| |t|))))))))))))
-
-(DEFUN |shoeLineSyntaxError| (|h|)
-  (PROG ()
-    (RETURN
-      (PROGN
-        (|shoeConsole|
-            (CONCAT "INCLUSION SYNTAX ERROR IN LINE "
-                    (STRINGIMAGE (CDR |h|))))
-        (|shoeConsole| (CAR |h|))
-        (|shoeConsole| "LINE IGNORED")))))
-
-(DEFUN |bPremStreamNil| (|h|)
-  (PROG ()
-    (DECLARE (SPECIAL |$bStreamNil|))
-    (RETURN
-      (PROGN
-        (|shoeConsole|
-            (CONCAT "UNEXPECTED )fin IN LINE " (STRINGIMAGE (CDR |h|))))
-        (|shoeConsole| (CAR |h|))
-        (|shoeConsole| "REST OF FILE IGNORED")
-        |$bStreamNil|))))
-
-(DEFUN |bPremStreamNull| (|s|)
-  (PROG ()
-    (RETURN
-      (COND
-        ((|bStreamNull| |s|)
-         (|shoeConsole| "FILE TERMINATED BEFORE )endif") T)
-        ('T NIL)))))
-
-@
-
-
-\end{document}
diff --git a/src/boot/initial-env.lisp.pamphlet b/src/boot/initial-env.lisp
index d3242458..d256e7c4 100644
--- a/src/boot/initial-env.lisp.pamphlet
+++ b/src/boot/initial-env.lisp
@@ -1,29 +1,7 @@
-%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/initial-env.lisp} Pamphlet}
-\author{Gabriel Dos~Reis \and Timothy Daly}
-
-\begin{document}
-\maketitle
-
-\begin{abstract}
-  This pamphlet defines the base initial environment for building
-  a Boot translator image.  It essentially etablishes a namespace
-  (package \Code{Boot}) for the Boot translator, and defines 
-  some macros that need to be present during translation of Boot
-  source files.
-\end{abstract}
-
-\tableofcontents
-\eject
-
-\section{License}
-
-<<license>>=
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
 ;; modification, are permitted provided that the following conditions are
@@ -52,60 +30,23 @@
 ;; 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.
+;;
 
-@
 
-\section{The \code{BOOTTRAN} package}
+;;
+;; Abstract:
+;;  This file defines the base initial environment for building
+;;  a Boot translator image.  It essentially etablishes a namespace
+;;  (package BOOTTRAN) for the Boot translator, and defines 
+;;  some macros that need to be present during translation of Boot
+;;  source files.
+;; 
 
-All Boot translator functions are defined in the package
-\code{BOOTTRAN}.  It is expected that the translator interfaces
-with the rest of the system only through the functions explicitly exported
-by \code{BOOTTRAN}:
-<<boot-translator>>=
 (defpackage "BOOTTRAN"
   (:use "AxiomCore")
   #+:common-lisp  (:use "COMMON-LISP")
   #-:common-lisp  (:use "LISP"))
 
-@
-
-\section{I/O macros}
-
-The Boot translator source codes make uses of some 
-higher order functions.  For various reasons, including efficiency,
-they are defined as Lisp macros and must therefore be available in each
-source file that uses them.
-
-\subsection{[[shoeInputFile]]}
-
-<<with-input-file>>=
-(defmacro |shoeOpenInputFile|
-     (stream fn prog)
-    `(with-open-file (,stream ,fn :direction :input
-       :if-does-not-exist nil) ,prog))
-@
-
-This macro creates a input stream object from a file name [[fn]], and 
-processes it with [[prog]].  If the file name designates a non-existent 
-file, the standard input is used instead.
-
-\subsection{[[shoeOpenOutputFile]]}
-<<with-output-file>>=
-(defmacro |shoeOpenOutputFile|
-     (stream fn prog)
-    `(with-open-file (,stream ,fn :direction :output
-       :if-exists :supersede) ,prog))
-@
-
-This macro creates an output stream object from a file name [[fn]], and 
-processes it with [[prog]].  The output file is overwritten if it exists.
-
-\section{Putting it together}
-
-<<*>>=
-<<license>>
-
-<<boot-translator>>
 
 (in-package "BOOTTRAN")
 
@@ -113,12 +54,22 @@ processes it with [[prog]].  The output file is overwritten if it exists.
 #+:ieee-floating-point (defparameter $ieee t)
 #-:ieee-floating-point (defparameter $ieee nil)
 
-(defmacro memq (a b) `(member ,a ,b :test #'eq))
+(defmacro memq (a b) 
+  `(member ,a ,b :test #'eq))
+
 (defvar *lisp-bin-filetype* "o")
+
 (defvar *lisp-source-filetype* "lisp")
-(defun setdifference (x y) (set-difference x y))
-(defun make-cvec (sint) (make-string sint))
-(defun MAKE-VEC (n) (make-array n))
+
+(defun setdifference (x y)
+  (set-difference x y))
+
+(defun make-cvec (sint)
+  (make-string sint))
+
+(defun MAKE-VEC (n) 
+  (make-array n))
+
 (defun concat (&rest l)
   (progn
     (setq l (mapcar #'string l))
@@ -127,16 +78,22 @@ processes it with [[prog]].  The output file is overwritten if it exists.
 (defun |shoeInputFile| (filespec )
   (open filespec :direction :input :if-does-not-exist nil))
 
-<<with-input-file>>
+(defmacro |shoeOpenInputFile|
+  (stream fn prog)
+    `(with-open-file (,stream ,fn :direction :input
+       :if-does-not-exist nil) ,prog))
 
-<<with-output-file>>
+(defmacro |shoeOpenOutputFile|
+  (stream fn prog)
+    `(with-open-file (,stream ,fn :direction :output
+       :if-exists :supersede) ,prog))
 
 (defun shoeprettyprin1 (x &optional (stream *standard-output*))
   (let ((*print-pretty* t)
-	(*print-array* t)
-	(*print-circle* t)
-	(*print-level* nil)
-	(*print-length* nil))
+        (*print-array* t)
+        (*print-circle* t)
+        (*print-level* nil)
+        (*print-length* nil))
     (prin1 x stream)))
  
 (defun reallyprettyprint (x &optional (stream *terminal-io*))
@@ -144,14 +101,15 @@ processes it with [[prog]].  The output file is overwritten if it exists.
  
 (defun shoeprettyprin0 (x &optional (stream *standard-output*))
   (let ((*print-pretty* nil)
-	(*print-array* t)
-	(*print-circle* t)
-	(*print-level* nil)
-	(*print-length* nil))
+        (*print-array* t)
+        (*print-circle* t)
+        (*print-level* nil)
+        (*print-length* nil))
     (prin1 x stream)))
  
 (defun shoenotprettyprint (x &optional (stream *terminal-io*))
-  (shoeprettyprin0 x stream) (terpri stream))
+  (shoeprettyprin0 x stream) 
+  (terpri stream))
 
 (defun make-full-cvec (sint &optional (char #\space))
   (make-string sint :initial-element (character char)))
@@ -160,22 +118,23 @@ processes it with [[prog]].  The output file is overwritten if it exists.
   (eq item nil))
 
 (defun substring (cvec start length)
-  (if length (subseq cvec start (+ start length))
+  (if length 
+      (subseq cvec start (+ start length))
     (subseq cvec start)))
 
 (defun MAKE-HASHTABLE (id1)
   (let ((test (case id1
-		    ((EQ ID) #'eq)
-		    (CVEC #'equal)
-		    ((UEQUAL EQUAL) #'equal)
-		    (otherwise (error "bad arg to make-hashtable")))))
+                    ((EQ ID) #'eq)
+                    (CVEC #'equal)
+                    ((UEQUAL EQUAL) #'equal)
+                    (otherwise (error "bad arg to make-hashtable")))))
     (make-hash-table :test test)))
 
 (defun HKEYS (table)
   (let (keys)
     (maphash #'(lambda (key val) 
-		 (declare (ignore val))
-		 (push key keys)) table)
+                 (declare (ignore val))
+                 (push key keys)) table)
     keys))
 
 
@@ -198,25 +157,32 @@ processes it with [[prog]].  The output file is overwritten if it exists.
  
 (defun strpos (what in start dontcare)
   (setq what (string what) in (string in))
-  (if dontcare (progn (setq dontcare (character dontcare))
-		      (search what in :start2 start
-			      :test #'(lambda (x y) (or (eql x dontcare)
-							(eql x y)))))
+  (if dontcare
+      (progn 
+	(setq dontcare (character dontcare))
+	(search what in :start2 start
+		:test #'(lambda (x y) (or (eql x dontcare)
+					  (eql x y)))))
     (search what in :start2 start)))
  
 
 (defun strposl (table cvec sint item)
   (setq cvec (string cvec))
   (if (not item)
-      (position table cvec :test #'(lambda (x y) (position y x)) :start sint)
-    (position table cvec :test-not #'(lambda (x y) (position y x))
-	      :start sint  )))
+      (position table cvec 
+		:test #'(lambda (x y) (position y x))
+		:start sint)
+    (position table cvec 
+	      :test-not #'(lambda (x y) (position y x))
+              :start sint)))
 
 (defun VEC-SETELT (vec ind val) 
   (setf (elt vec ind) val))
 
 (defun  bvec-make-full (n x)
-  (make-array (list n) :element-type 'bit :initial-element x))
+  (make-array (list n) 
+	      :element-type 'bit
+	      :initial-element x))
 
 (defun make-bvec (n)
   (bvec-make-full n 0))
@@ -226,8 +192,8 @@ processes it with [[prog]].  The output file is overwritten if it exists.
 
 (defun size (l)
   (cond ((vectorp l) (length l))
-	((consp l) (list-length l))
-	(t 0)))
+        ((consp l) (list-length l))
+        (t 0)))
 
 (defun identp (a) 
   (and (symbolp a) a))
@@ -237,7 +203,3 @@ processes it with [[prog]].  The output file is overwritten if it exists.
 
 (defun |last| (x)
   (car (last x)))
-@
-
-
-\end{document}
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
new file mode 100644
index 00000000..9908a68a
--- /dev/null
+++ b/src/boot/parser.boot
@@ -0,0 +1,1041 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+--
+-- Abstract:
+--   This file defines the Boot grammar and parser.  The parser
+--   is hand-written based on `parser combinators' technology.
+--
+
+
+module '"boot-parser"
+import '"includer"
+import '"scanner"
+import '"ast"
+ 
+)package "BOOTTRAN"
+ 
+
+++ true when the current function definition has its parameters 
+++ written round parenthesis.
+$sawParenthesizedHead := false
+
+++ true if the current function definition has a return statement.
+$bodyHasReturn := false
+
+
+bpFirstToken()==
+      $stok:=
+          if null $inputStream
+          then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
+          else CAR $inputStream
+      $ttok:=shoeTokPart $stok
+      true
+ 
+bpFirstTok()==
+      $stok:=
+          if null $inputStream
+          then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
+          else CAR $inputStream
+      $ttok:=shoeTokPart $stok
+      $bpParenCount>0 and EQCAR($stok,"KEY") =>
+             EQ($ttok,"SETTAB")=>
+                $bpCount:=$bpCount+1
+                bpNext()
+             EQ($ttok,"BACKTAB")=>
+                $bpCount:=$bpCount-1
+                bpNext()
+             EQ($ttok,"BACKSET")=>
+                bpNext()
+             true
+      true
+ 
+bpNext() ==
+     $inputStream := CDR($inputStream)
+     bpFirstTok()
+ 
+bpNextToken() ==
+     $inputStream := CDR($inputStream)
+     bpFirstToken()
+ 
+bpState()== [$inputStream,$stack,$bpParenCount,$bpCount]
+--cons($inputStream,$stack)
+ 
+bpRestore(x)==
+      $inputStream:=CAR x
+      bpFirstToken()
+      $stack:=CADR x
+      $bpParenCount:=CADDR x
+      $bpCount:=CADDDR x
+      true
+ 
+bpPush x==$stack:=CONS(x,$stack)
+ 
+bpPushId()==
+   $stack:=CONS(bfReName $ttok,$stack)
+ 
+bpPop1()==
+       a:=CAR $stack
+       $stack:=CDR $stack
+       a
+ 
+bpPop2()==
+       a:=CADR $stack
+       RPLACD($stack,CDDR $stack)
+       a
+ 
+bpPop3()==
+       a:=CADDR $stack
+       RPLACD(CDR $stack,CDDDR $stack)
+       a
+ 
+bpIndentParenthesized f==
+    $bpCount:local:=0
+    a:=$stok
+    if bpEqPeek "OPAREN"
+    then
+      $bpParenCount:=$bpParenCount+1
+      bpNext()
+      if APPLY(f,nil) and bpFirstTok() and
+              (bpEqPeek "CPAREN" or bpParenTrap(a))
+      then
+            $bpParenCount:=$bpParenCount-1
+            bpNextToken()
+            $bpCount=0 => true
+            $inputStream:=append( bpAddTokens $bpCount,$inputStream)
+            bpFirstToken()
+            $bpParenCount=0 =>
+                     bpCancel()
+                     true
+            true
+      else if bpEqPeek "CPAREN"
+           then
+              bpPush  bfTuple []
+              $bpParenCount:=$bpParenCount-1
+              bpNextToken()
+              true
+           else bpParenTrap(a)
+    else false
+ 
+bpParenthesized f==
+    a:=$stok
+    if bpEqKey "OPAREN"
+    then
+      if APPLY(f,nil) and (bpEqKey "CPAREN" or bpParenTrap(a))
+      then true
+      else if bpEqKey "CPAREN"
+           then
+              bpPush  bfTuple []
+              true
+           else bpParenTrap(a)
+    else false
+ 
+bpBracket f==
+    a:=$stok
+    if bpEqKey "OBRACK"
+    then
+      if APPLY(f,nil) and (bpEqKey "CBRACK" or bpBrackTrap(a))
+      then bpPush bfBracket bpPop1 ()
+      else if bpEqKey "CBRACK"
+           then bpPush  []
+           else bpBrackTrap(a)
+    else false
+ 
+bpPileBracketed f==
+              if bpEqKey "SETTAB"
+              then if bpEqKey "BACKTAB"
+                   then true
+                   else if APPLY(f,nil) and
+                            (bpEqKey "BACKTAB" or bpPileTrap())
+                        then bpPush bfPile bpPop1()
+                        else false
+              else false
+ 
+bpListof(f,str1,g)==
+    if APPLY(f,nil)
+    then
+        if bpEqKey str1 and (APPLY(f,nil) or bpTrap())
+        then
+          a:=$stack
+          $stack:=nil
+          while bpEqKey str1 and (APPLY(f,nil) or bpTrap()) repeat 0
+          $stack:=cons(NREVERSE $stack,a)
+          bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
+        else
+          true
+    else false
+ 
+ 
+-- to do ,<backset>
+bpListofFun(f,h,g)==
+    if APPLY(f,nil)
+    then
+        if APPLY(h,nil) and (APPLY(f,nil) or bpTrap())
+        then
+          a:=$stack
+          $stack:=nil
+          while APPLY(h,nil) and (APPLY(f,nil) or bpTrap()) repeat 0
+          $stack:=cons(NREVERSE $stack,a)
+          bpPush FUNCALL(g, bfListOf [bpPop3(),bpPop2(),:bpPop1()])
+        else
+          true
+    else false
+ 
+bpList(f,str1,g)==
+    if APPLY(f,nil)
+    then
+        if bpEqKey str1 and (APPLY(f,nil) or bpTrap())
+        then
+          a:=$stack
+          $stack:=nil
+          while bpEqKey str1 and (APPLY(f,nil) or bpTrap()) repeat 0
+          $stack:=cons(NREVERSE $stack,a)
+          bpPush FUNCALL(g,  [bpPop3(),bpPop2(),:bpPop1()])
+        else
+          bpPush FUNCALL(g, [bpPop1()])
+    else bpPush FUNCALL(g, [])
+ 
+bpOneOrMore f==
+       APPLY(f,nil)=>
+         a:=$stack
+         $stack:=nil
+         while APPLY(f,nil) repeat 0
+         $stack:=cons(NREVERSE $stack,a)
+         bpPush cons(bpPop2(),bpPop1())
+       false
+ 
+ 
+-- s must transform the head of the stack
+bpAnyNo s==
+     while APPLY(s,nil) repeat 0
+     true
+ 
+ 
+-- AndOr(k,p,f)= k p
+bpAndOr(keyword,p,f)==
+   bpEqKey keyword and (APPLY(p,nil) or bpTrap())
+          and bpPush FUNCALL(f, bpPop1())
+ 
+bpConditional f==
+  if  bpEqKey "IF" and (bpWhere() or bpTrap()) and
+                   (bpEqKey "BACKSET" or true)
+  then
+           if bpEqKey "SETTAB"
+           then if bpEqKey "THEN"
+                then  (APPLY(f,nil) or bpTrap()) and bpElse(f) and bpEqKey "BACKTAB"
+                else  bpMissing "THEN"
+           else if bpEqKey "THEN"
+                then (APPLY(f,nil) or bpTrap()) and bpElse(f)
+                else bpMissing "then"
+  else false
+ 
+bpElse(f)==
+           a:=bpState()
+           if bpBacksetElse()
+           then  (APPLY(f,nil) or bpTrap()) and
+                 bpPush bfIf(bpPop3(),bpPop2(),bpPop1())
+           else
+              bpRestore a
+              bpPush bfIfThenOnly(bpPop2(),bpPop1())
+ 
+bpBacksetElse()==
+    if bpEqKey "BACKSET"
+    then bpEqKey "ELSE"
+    else bpEqKey "ELSE"
+ 
+bpEqPeek s ==  EQCAR($stok,"KEY") and EQ(s,$ttok)
+ 
+bpEqKey s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and bpNext()
+bpEqKeyNextTok s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and
+                  bpNextToken()
+ 
+bpPileTrap()   == bpMissing  "BACKTAB"
+bpBrackTrap(x) == bpMissingMate("]",x)
+bpParenTrap(x) == bpMissingMate(")",x)
+ 
+bpMissingMate(close,open)==
+   bpSpecificErrorAtToken(open, '"possibly missing mate")
+   bpMissing close
+ 
+bpMissing s==
+   bpSpecificErrorHere(CONCAT(PNAME s,'" possibly missing"))
+   THROW("TRAPPOINT","TRAPPED")
+ 
+bpCompMissing s == bpEqKey s or bpMissing s
+ 
+bpTrap()==
+   bpGeneralErrorHere()
+   THROW("TRAPPOINT","TRAPPED")
+ 
+bpRecoverTrap()==
+  bpFirstToken()
+  pos1 := shoeTokPosn $stok
+  bpMoveTo 0
+  pos2 := shoeTokPosn $stok
+  bpIgnoredFromTo(pos1, pos2)
+  bpPush  [['"pile syntax error"]]
+ 
+bpListAndRecover(f)==
+   a:=$stack
+   b:=nil
+   $stack:=nil
+   done:=false
+   c:=$inputStream
+   while not done repeat
+--   $trapped:local:=false
+     found:=CATCH("TRAPPOINT",APPLY(f,nil))
+     if found="TRAPPED"
+     then
+        $inputStream:=c
+        bpRecoverTrap()
+     else if not found
+          then
+            $inputStream:=c
+            bpGeneralErrorHere()
+            bpRecoverTrap()
+     if bpEqKey "BACKSET"
+     then
+        c:=$inputStream
+     else if bpEqPeek "BACKTAB"  or null $inputStream
+          then
+             done:=true
+          else
+            $inputStream:=c
+            bpGeneralErrorHere()
+            bpRecoverTrap()
+            if bpEqPeek "BACKTAB"  or null $inputStream
+            then done:=true
+            else
+                bpNext()
+                c:=$inputStream
+     b:=cons(bpPop1(),b)
+   $stack:=a
+   bpPush NREVERSE b
+ 
+bpMoveTo n==
+     null $inputStream  => true
+     bpEqPeek "BACKTAB" =>
+                n=0  => true
+                bpNextToken()
+                $bpCount:=$bpCount-1
+                bpMoveTo(n-1)
+     bpEqPeek "BACKSET" =>
+                n=0  => true
+                bpNextToken()
+                bpMoveTo n
+     bpEqPeek "SETTAB"  =>
+                bpNextToken()
+                bpMoveTo(n+1)
+     bpEqPeek "OPAREN"  =>
+                bpNextToken()
+                $bpParenCount:=$bpParenCount+1
+                bpMoveTo n
+     bpEqPeek "CPAREN"  =>
+                bpNextToken()
+                $bpParenCount:=$bpParenCount-1
+                bpMoveTo n
+     bpNextToken()
+     bpMoveTo n
+ 
+-- A fully qualified name could be interpreted as a left reduction
+-- of an '::' infix operator.  At the moment, we don't use
+-- that general interpretation.
+
+-- When this routine is called, a symbol is already pushed on the
+-- stack.  When this routine finished execution, we have either
+-- reduced a '::' and a name, or nothing.  In either case, a 
+-- symbol is present on the stack.
+bpQualifiedName() ==
+  bpEqPeek "COLON-COLON" =>
+    bpNext()
+    EQCAR($stok, "ID") and bpPushId() and bpNext()
+      and bpPush bfColonColon(bpPop2(), bpPop1())
+  false
+
+++ Name:
+++   ID
+++   Name :: ID
+bpName() ==
+  EQCAR( $stok,"ID") =>
+    bpPushId()
+    bpNext()
+    bpAnyNo function bpQualifiedName
+  false
+
+
+++ Constant:
+++   INTEGER
+++   FLOAT
+++   LISP
+++   LISPEXPR
+++   LINE
+++   QUOTE S-Expression
+++   STRING
+bpConstTok() ==
+     MEMQ(shoeTokType $stok, '(INTEGER FLOAT)) =>
+          bpPush $ttok
+          bpNext()
+     EQCAR($stok,"LISP")=> bpPush bfReadLisp $ttok and bpNext()
+     EQCAR($stok,"LISPEXP")=> bpPush $ttok and bpNext()
+     EQCAR($stok,"LINE")=> bpPush ["+LINE", $ttok] and bpNext()
+     bpEqPeek "QUOTE" =>
+          bpNext()
+          (bpSexp() or bpTrap()) and
+               bpPush bfSymbol bpPop1()
+     bpString()
+
+++ Parse a module definitoin
+++   Module:
+++     MODULE QUOTE String
+bpModule() ==
+  bpEqKey "MODULE" =>
+    -- we really want to check that the next token is indeed
+    -- a string.  For the moment, we delay the type checking
+    -- to the Lisp compiler/interpreter.  That is likely to 
+    -- cause cryptic diagnostics.  To be fixed.
+    bpConstTok() and bpPush Module bpPop1()
+  false
+
+++ Parse a module import, or a import declaration for a foreign entity.
+++ Import:
+++    IMPORT Name for Signature
+++    IMPORT QUOTE String
+bpImport() ==
+  bpEqKey "IMPORT" =>
+    (bpName() and (bpEqKey "FOR" or bpTrap()) and bpSignature()
+       and bpPush ImportSignature(bpPop2(), bpPop1()))
+         or 
+          -- we really want to check that the next token is indeed
+          -- a string.  For the moment, we delay the type checking
+          -- to the Lisp compiler/interpreter.  That is likely to 
+          -- cause cryptic diagnostics.  To be fixed.
+           (bpConstTok() and bpPush Import bpPop1())
+  false
+
+-- Parse a type alias defnition:
+--    type-alias-definition: 
+--          identifier <=> logical-expression
+bpTypeAliasDefition() ==
+  (bpName() or bpTrap()) and 
+    bpEqKey "TDEF" and bpLogical() and
+      bpPush TypeAlias(bpPop2(), nil, bpPop1())
+
+++ Parse a signature declaration
+++  Signature:
+++    Name COLON Mapping
+bpSignature() ==
+  bpName() and bpEqKey "COLON" and bpMapping()
+    and bpPush Signature(bpPop2(), bpPop1())
+
+++ Parse a mapping expression
+++   Mapping:
+++      (Name | IdList) -> Name
+bpMapping() ==
+  (bpName() or bpIdList()) and bpEqKey "ARROW" and bpName()
+    and bpPush Mapping(bpPop1(), bpPop1())
+
+bpCancel()==
+    a:=bpState()
+    if bpEqKeyNextTok  "SETTAB"
+    then if bpCancel()
+         then  if bpEqKeyNextTok  "BACKTAB"
+               then true
+               else
+                   bpRestore a
+                   false
+         else
+           if bpEqKeyNextTok "BACKTAB"
+           then true
+           else
+              bpRestore a
+              false
+    else false
+bpAddTokens n==
+         n=0 => nil
+         n>0=> cons(shoeTokConstruct("KEY","SETTAB",shoeTokPosn $stok),bpAddTokens(n-1))
+         cons(shoeTokConstruct("KEY","BACKTAB",shoeTokPosn $stok),bpAddTokens(n+1))
+ 
+bpExceptions()==
+     bpEqPeek "DOT" or bpEqPeek "QUOTE" or
+          bpEqPeek "OPAREN" or bpEqPeek "CPAREN" or
+             bpEqPeek "SETTAB" or bpEqPeek "BACKTAB"
+                or bpEqPeek "BACKSET"
+ 
+ 
+bpSexpKey()==
+      EQCAR( $stok,"KEY") and not bpExceptions()=>
+               a:=GET($ttok,"SHOEINF")
+               null a=>  bpPush $ttok and bpNext()
+               bpPush a and bpNext()
+      false
+ 
+bpAnyId()==
+  bpEqKey "MINUS"  and (EQCAR($stok,"INTEGER") or bpTrap()) and
+          bpPush MINUS $ttok and bpNext() or
+             bpSexpKey() or
+                   MEMQ(shoeTokType $stok, '(ID INTEGER STRING FLOAT))
+                      and  bpPush $ttok and  bpNext()
+ 
+bpSexp()==
+    bpAnyId() or
+        bpEqKey "QUOTE"  and  (bpSexp() or bpTrap())
+           and bpPush bfSymbol bpPop1() or
+               bpIndentParenthesized function bpSexp1
+ 
+bpSexp1()== bpFirstTok() and
+    bpSexp() and
+     (bpEqKey "DOT" and bpSexp() and bpPush CONS (bpPop2(),bpPop1())or
+           bpSexp1() and bpPush CONS (bpPop2(),bpPop1())) or
+               bpPush nil
+ 
+bpPrimary1() ==
+   bpName() or
+     bpDot() or
+      bpConstTok() or
+       bpConstruct() or
+        bpCase() or
+         bpStruct() or
+          bpPDefinition() or
+           bpBPileDefinition()
+ 
+bpPrimary()==  bpFirstTok() and (bpPrimary1() or bpPrefixOperator())
+ 
+bpDot()== bpEqKey "DOT" and bpPush bfDot ()
+ 
+bpPrefixOperator()==
+   EQCAR( $stok,"KEY") and
+     GET($ttok,"SHOEPRE") and bpPushId() and  bpNext()
+ 
+bpInfixOperator()==
+  EQCAR( $stok,"KEY") and
+    GET($ttok,"SHOEINF") and bpPushId() and  bpNext()
+ 
+bpSelector()==
+            bpEqKey "DOT" and (bpPrimary()
+               and bpPush(bfElt(bpPop2(),bpPop1()))
+                  or bpPush bfSuffixDot bpPop1() )
+ 
+bpOperator()==   bpPrimary() and bpAnyNo function bpSelector
+ 
+bpApplication()==
+   bpPrimary() and bpAnyNo function bpSelector and
+      (bpApplication() and
+            bpPush(bfApplication(bpPop2(),bpPop1())) or true)
+ 
+bpTagged()==
+      bpApplication() and
+         (bpEqKey "COLON" and (bpApplication() or bpTrap()) and
+           bpPush bfTagged(bpPop2(),bpPop1()) or true)
+ 
+bpExpt()== bpRightAssoc('(POWER),function bpTagged)
+ 
+bpInfKey s==
+ EQCAR( $stok,"KEY") and
+   MEMBER($ttok,s) and bpPushId() and bpNext()
+ 
+bpInfGeneric s== bpInfKey s and  (bpEqKey "BACKSET" or true)
+ 
+bpRightAssoc(o,p)==
+    a:=bpState()
+    if APPLY(p,nil)
+    then
+       while  bpInfGeneric o and (bpRightAssoc(o,p) or bpTrap()) repeat
+             bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
+       true
+    else
+       bpRestore a
+       false
+ 
+bpLeftAssoc(operations,parser)==
+    if APPLY(parser,nil)
+    then
+       while bpInfGeneric(operations) and
+         (APPLY(parser,nil) or bpTrap())
+           repeat
+             bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
+       true
+    else false
+ 
+bpString()==
+     EQ(shoeTokType $stok,"STRING") and
+         bpPush(["QUOTE",INTERN $ttok]) and bpNext()
+ 
+bpThetaName() ==
+        if EQCAR( $stok,"ID") and GET($ttok,"SHOETHETA")
+        then
+           bpPushId()
+           bpNext()
+        else false
+ 
+bpReduceOperator()==
+         bpInfixOperator() or bpString()
+                or bpThetaName()
+ 
+bpReduce()==
+     a:=bpState()
+     if bpReduceOperator() and bpEqKey "SLASH"
+     then
+        bpEqPeek "OBRACK" => (bpDConstruct() or bpTrap()) and
+                     bpPush bfReduceCollect(bpPop2(),bpPop1())
+        (bpApplication() or bpTrap()) and
+                bpPush bfReduce(bpPop2(),bpPop1())
+     else
+        bpRestore a
+        false
+ 
+bpTimes()==
+    bpReduce() or bpLeftAssoc('(TIMES  SLASH),function bpExpt)
+ 
+bpMinus()==
+   bpInfGeneric '(MINUS) and (bpTimes() or bpTrap())
+        and bpPush(bfApplication(bpPop2(),bpPop1()))
+          or bpTimes()
+ 
+bpArith()==bpLeftAssoc('(PLUS MINUS),function bpMinus)
+ 
+bpIs()==
+     bpArith() and (bpInfKey '(IS ISNT) and (bpPattern() or bpTrap())
+        and bpPush bfISApplication(bpPop2(),bpPop2(),bpPop1())
+           or true)
+ 
+bpBracketConstruct(f)==
+        bpBracket f and bpPush bfConstruct bpPop1 ()
+ 
+bpCompare()==
+     bpIs() and (bpInfKey  '(SHOEEQ SHOENE LT LE GT GE IN)
+        and (bpIs() or bpTrap())
+           and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
+               or true)
+ 
+bpAnd()== bpLeftAssoc('(AND),function bpCompare)
+ 
+
+++ Note the fact that a return statement is used in the body
+++ of current function definition.
+bpNoteReturnStmt() ==
+  $bodyHasReturn := true
+  true
+
+bpReturn()==
+         (bpEqKey "RETURN" and bpNoteReturnStmt() and
+           (bpAnd() or bpTrap()) and
+                bpPush bfReturnNoName bpPop1()) or bpAnd()
+ 
+ 
+bpLogical()== bpLeftAssoc('(OR),function bpReturn)
+ 
+bpExpression()==
+     bpEqKey "COLON" and (bpLogical() and
+              bpPush bfApplication ("COLON",bpPop1())
+                    or bpTrap()) or bpLogical()
+ 
+bpStatement()==
+  bpConditional function bpWhere or bpLoop()  or bpExpression()
+ 
+bpLoop()==
+     bpIterators() and
+      (bpCompMissing "REPEAT" and
+         (bpWhere() or bpTrap()) and
+            bpPush bfLp(bpPop2(),bpPop1()))
+                or
+                  bpEqKey "REPEAT" and (bpLogical() or bpTrap()) and
+                       bpPush bfLoop1 bpPop1 ()
+ 
+bpSuchThat()==bpAndOr("BAR",function bpWhere,function bfSuchthat)
+ 
+bpWhile()==bpAndOr ("WHILE",function bpLogical,function bfWhile)
+ 
+bpUntil()==bpAndOr ("UNTIL",function bpLogical,function bfUntil)
+ 
+bpForIn()==
+  bpEqKey "FOR" and (bpVariable() or bpTrap()) and (bpCompMissing "IN")
+      and ((bpSeg()  or bpTrap()) and
+       (bpEqKey "BY" and (bpArith() or bpTrap()) and
+        bpPush bfForInBy(bpPop3(),bpPop2(),bpPop1())) or
+         bpPush bfForin(bpPop2(),bpPop1()))
+ 
+bpSeg()==
+   bpArith() and
+      (bpEqKey "SEG" and
+       (bpArith() and bpPush(bfSegment2(bpPop2(),bpPop1()))
+         or bpPush(bfSegment1(bpPop1()))) or true)
+ 
+bpIterator()==
+  bpForIn() or bpSuchThat() or bpWhile() or bpUntil()
+ 
+bpIteratorList()==bpOneOrMore function bpIterator
+       and bpPush bfIterators bpPop1 ()
+ 
+bpCrossBackSet()== bpEqKey "CROSS" and (bpEqKey "BACKSET" or true)
+ 
+bpIterators()==
+         bpListofFun(function bpIteratorList,
+              function bpCrossBackSet,function bfCross)
+ 
+bpAssign()==
+            a:=bpState()
+            if bpStatement()
+            then
+                 if bpEqPeek "BEC"
+                 then
+                   bpRestore a
+                   bpAssignment() or bpTrap()
+                 else true
+            else
+                 bpRestore a
+                 false
+ 
+bpAssignment()==
+       bpAssignVariable() and
+         bpEqKey "BEC" and
+           (bpAssign() or bpTrap()) and
+              bpPush bfAssign (bpPop2(),bpPop1())
+ 
+-- should only be allowed in sequences
+bpExit()==
+     bpAssign() and (bpEqKey "EXIT" and
+         ((bpWhere() or bpTrap()) and
+            bpPush bfExit (bpPop2(),bpPop1()))
+              or true)
+
+++ returns true if the next token introduces a definition.
+bpBeginDefinition() ==
+  bpEqPeek "DEF" or 
+    $sawParenthesizedHead and bpEqPeek "COLON"
+
+bpDefinition()==
+        a:=bpState()
+        bpExit() =>
+             bpBeginDefinition() =>
+                bpRestore a
+                bpDef()
+             bpEqPeek "TDEF" =>
+                bpRestore a
+                bpTypeAliasDefition()
+             bpEqPeek "MDEF" =>
+                bpRestore a
+                bpMdef()
+             true
+        bpRestore a
+        false
+ 
+bpStoreName()==
+  $op := car $stack
+  $wheredefs := nil
+  $typings := nil
+  $returnType := true           -- assume we may return anything
+  $bodyHasReturn := false
+  true
+
+bpReturnType() ==
+  -- a return type is acceptable for a function definition only
+  -- if its parameters are written in round parenthesis.  
+  -- In particular, we reject the situation `foo x:Integer == ...'
+  $sawParenthesizedHead and bpEqKey "COLON" =>
+    bpApplication() or bpTrap()
+    $returnType := bpPop1()
+    true
+  true
+ 
+bpDef() ==  
+  bpName() and bpStoreName() and
+    bpDefTail() and bpPush bfCompDef bpPop1 ()
+ 
+bpDDef() ==  bpName() and bpDefTail()
+
+++ Parse the remaining of a simple definition.
+bpSimpleDefinitionTail() ==
+  bpEqKey "DEF" and
+    (bpWhere() or bpTrap())
+      and bpPush ConstantDefinition(bpPop2(), bpPop1())
+
+++ Parse the remaining of a compound definition.
+bpCompoundDefinitionTail() ==
+  bpVariable()  and bpReturnType()  and
+    bpEqKey "DEF" and (bpWhere() or bpTrap())
+      and bpPush bfDefinition(bpPop3(),bpPop2(),bpPop1())
+
+
+++ Parse the remainding of a definition.  When we reach this point
+++ we know we must parse a definition and we have already parsed
+++ the name of the main operator in the definition.
+bpDefTail() ==
+  bpSimpleDefinitionTail()
+    or bpCompoundDefinitionTail()
+ 
+ 
+bpMDefTail()==
+ --   bpEqKey "MDEF" and
+ --   (bpWhere() or bpTrap())
+ --     and bpPush bfMDefinition1(bpPop2(),bpPop1())
+ --      or
+           (bpVariable() or bpTrap()) and
+             bpEqKey "MDEF" and (bpWhere() or bpTrap())
+                 and bpPush bfMDefinition(bpPop3(),bpPop2(),bpPop1())
+ 
+bpMdef()== bpName() and bpStoreName() and bpMDefTail()
+ 
+bpWhere()==
+    bpDefinition() and
+       (bpEqKey "WHERE" and (bpDefinitionItem() or bpTrap())
+           and bpPush bfWhere(bpPop1(),bpPop1()) or true)
+ 
+bpDefinitionItem()==
+          a:=bpState()
+          if bpDDef()
+          then true
+          else
+             bpRestore a
+             if bpBDefinitionPileItems()
+             then true
+             else
+               bpRestore a
+               if bpPDefinitionItems()
+               then true
+               else
+                   bpRestore a
+                   bpWhere()
+ 
+bpDefinitionPileItems()==
+    bpListAndRecover function bpDefinitionItem
+           and bpPush bfDefSequence bpPop1()
+ 
+bpBDefinitionPileItems()== bpPileBracketed function bpDefinitionPileItems
+ 
+bpSemiColonDefinition()==bpSemiListing
+    (function bpDefinitionItem,function bfDefSequence)
+ 
+bpPDefinitionItems()==bpParenthesized function bpSemiColonDefinition
+ 
+bpComma()== 
+  bpModule() or bpImport() or
+    bpTuple function bpWhere
+ 
+bpTuple(p)==bpListofFun(p,function bpCommaBackSet,function bfTuple)
+ 
+bpCommaBackSet()== bpEqKey "COMMA" and (bpEqKey "BACKSET" or true)
+ 
+bpSemiColon()==bpSemiListing (function bpComma,function bfSequence)
+ 
+bpSemiListing(p,f)==bpListofFun(p,function bpSemiBackSet,f)
+ 
+bpSemiBackSet()== bpEqKey "SEMICOLON" and (bpEqKey "BACKSET" or true)
+ 
+bpPDefinition()==  bpIndentParenthesized function bpSemiColon
+ 
+bpPileItems()==
+    bpListAndRecover function bpSemiColon and bpPush bfSequence bpPop1()
+ 
+bpBPileDefinition()==  bpPileBracketed function bpPileItems
+ 
+bpIteratorTail()==
+     (bpEqKey "REPEAT" or true) and bpIterators()
+ 
+--bpExpression()==  bpLogical()
+ 
+bpConstruct()==bpBracket function bpConstruction
+ 
+bpConstruction()==
+     bpComma() and
+        (bpIteratorTail() and
+             bpPush bfCollect (bpPop2(),bpPop1()) or
+                bpPush bfTupleConstruct bpPop1())
+ 
+bpDConstruct()==bpBracket function bpDConstruction
+ 
+bpDConstruction()==
+     bpComma() and
+        (bpIteratorTail() and
+             bpPush bfDCollect (bpPop2(),bpPop1()) or
+                bpPush bfDTuple bpPop1())
+ 
+ 
+ 
+--PATTERN
+ 
+--bpNameOrDot() == bpName() or bpDot() or bpEqual()
+ 
+bpPattern()== bpBracketConstruct function bpPatternL
+                or bpName() or bpConstTok()
+ 
+bpEqual()==
+   bpEqKey "SHOEEQ" and (bpApplication() or bpConstTok() or
+                bpTrap()) and bpPush bfEqual bpPop1()
+ 
+bpRegularPatternItem() ==
+   bpEqual() or
+     bpConstTok() or bpDot() or
+      bpName() and
+         ((bpEqKey "BEC" and (bpPattern() or bpTrap())
+              and bpPush bfAssign(bpPop2(),bpPop1())) or true)
+                    or bpBracketConstruct function bpPatternL
+ 
+bpRegularPatternItemL()==
+      bpRegularPatternItem() and bpPush [bpPop1()]
+ 
+bpRegularList()==
+       bpListof(function bpRegularPatternItemL,"COMMA",function bfAppend)
+ 
+bpPatternColon()==
+     bpEqKey "COLON" and (bpRegularPatternItem() or bpTrap())
+              and bpPush [bfColon bpPop1()]
+ 
+ 
+-- only one colon
+bpPatternL() == bpPatternList() and bpPush bfTuple bpPop1()
+ 
+bpPatternList()==
+     if bpRegularPatternItemL()
+     then
+        while (bpEqKey  "COMMA" and (bpRegularPatternItemL() or
+            (bpPatternTail()
+              and bpPush append(bpPop2(),bpPop1())
+                or bpTrap();false) )) repeat
+                  bpPush append(bpPop2(),bpPop1())
+        true
+     else bpPatternTail()
+ 
+bpPatternTail()==
+     bpPatternColon() and
+         (bpEqKey "COMMA" and (bpRegularList() or bpTrap())
+              and bpPush append (bpPop2(),bpPop1()) or true)
+ 
+-- BOUND VARIABLE
+bpRegularBVItem() ==
+  bpBVString() or
+     bpConstTok() or
+      (bpName() and
+         (bpEqKey "COLON" and (bpApplication() or bpTrap())
+            and bpPush bfTagged(bpPop2(), bpPop1()) or
+              bpEqKey "BEC" and (bpPattern() or bpTrap())
+                and bpPush bfAssign(bpPop2(),bpPop1()) or
+                  (bpEqKey "IS" and (bpPattern() or bpTrap())
+                     and bpPush bfAssign(bpPop2(),bpPop1())) or true))
+                       or bpBracketConstruct function bpPatternL
+ 
+bpBVString()==
+     EQ(shoeTokType $stok,"STRING") and
+         bpPush(["BVQUOTE",INTERN $ttok]) and bpNext()
+ 
+bpRegularBVItemL() ==
+      bpRegularBVItem() and bpPush [bpPop1()]
+ 
+bpColonName()==
+     bpEqKey "COLON" and (bpName() or bpBVString() or bpTrap())
+ 
+ 
+-- at most one colon at end
+bpBoundVariablelist()==
+     if bpRegularBVItemL()
+     then
+        while (bpEqKey  "COMMA" and (bpRegularBVItemL() or
+            (bpColonName()
+              and bpPush  bfColonAppend(bpPop2(),bpPop1())
+                or bpTrap();false) )) repeat
+                   bpPush append(bpPop2(),bpPop1())
+        true
+     else bpColonName() and bpPush bfColonAppend(nil,bpPop1())
+ 
+
+++ Mark the start of parameter list enclosed in round parenthesis
+bpBeginParameterList() ==
+  $sawParenthesizedHead := false
+  true
+
+++ Mark the end of parameter list enclosed in round parenthesis
+bpEndParameterList() ==
+  $sawParenthesizedHead := true
+
+bpVariable()==
+  bpBeginParameterList() and
+    bpParenthesized function bpBoundVariablelist and
+       bpPush bfTupleIf bpPop1() and bpEndParameterList()
+         or bpBracketConstruct function bpPatternL
+                or bpName() or bpConstTok()
+ 
+bpAssignVariable()==
+      bpBracketConstruct function bpPatternL or bpAssignLHS()
+ 
+bpAssignLHS()==
+   bpName() and (bpEqKey "COLON" and (bpApplication() or bpTrap())
+     and bpPush bfLocal(bpPop2(),bpPop1())
+        or bpEqKey "DOT" and bpList(function bpPrimary,"DOT",
+              function bfListOf)
+          and bpChecknull() and
+            bpPush bfTuple(cons(bpPop2(),bpPop1()))
+                 or true)
+bpChecknull()==
+      a:=bpPop1()
+      if null a
+      then bpTrap()
+      else bpPush a
+
+bpStruct()==
+   bpEqKey "STRUCTURE" and
+      (bpName() or bpTrap()) and
+        (bpEqKey "DEF" or bpTrap()) and
+           bpTypeList() and bpPush bfStruct(bpPop2(),bpPop1())
+ 
+bpTypeList() == bpPileBracketed function bpTypeItemList
+       or bpTerm() and bpPush [bpPop1()]
+ 
+bpTypeItemList() ==  bpListAndRecover function bpTerm
+ 
+bpTerm() ==
+          (bpName() or bpTrap()) and
+            ((bpParenthesized function bpIdList and
+              bpPush bfNameArgs (bpPop2(),bpPop1()))
+                or bpName() and bpPush bfNameArgs(bpPop2(),bpPop1()))
+                 or bpPush(bfNameOnly bpPop1())
+ 
+bpIdList()== bpTuple function bpName
+ 
+bpCase()==
+      bpEqKey "CASE" and
+        (bpWhere() or bpTrap()) and
+           (bpEqKey "OF" or bpMissing "OF") and
+                 bpPiledCaseItems()
+ 
+bpPiledCaseItems()==
+   bpPileBracketed function bpCaseItemList and
+       bpPush bfCase(bpPop2(),bpPop1())
+bpCaseItemList()==
+   bpListAndRecover function bpCaseItem
+ 
+bpCaseItem()==
+    (bpTerm() or bpTrap()) and
+       (bpEqKey "EXIT" or bpTrap()) and
+         (bpWhere() or bpTrap()) and
+            bpPush bfCaseItem (bpPop2(),bpPop1())
+
diff --git a/src/boot/pile.boot b/src/boot/pile.boot
new file mode 100644
index 00000000..0b8b1651
--- /dev/null
+++ b/src/boot/pile.boot
@@ -0,0 +1,143 @@
+-- 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.
+
+
+module '"boot-pile"
+import '"includer"
+import '"scanner"
+ 
+)package "BOOTTRAN"
+shoeFirstTokPosn t== shoeTokPosn CAAR t
+shoeLastTokPosn  t== shoeTokPosn CADR t
+shoePileColumn t==CDR shoeTokPosn CAAR t
+ 
+-- s is a token-dq-stream
+ 
+shoePileInsert (s)==
+     if bStreamNull s
+     then cons([],s)
+     else
+         toktype:=shoeTokType CAAAR s
+         if toktype ="LISP"  or toktype = "LINE"
+         then cons([car s],cdr s)
+         else
+            a:=shoePileTree(-1,s)
+            cons([a.2],a.3)
+ 
+shoePileTree(n,s)==
+    if bStreamNull s
+    then [false,n,[],s]
+    else
+        [h,t]:=[car s,cdr s]
+        hh:=shoePileColumn h
+        if hh > n
+        then shoePileForests(h,hh,t)
+        else [false,n,[],s]
+ 
+eqshoePileTree(n,s)==
+    if bStreamNull s
+    then [false,n,[],s]
+    else
+        [h,t]:=[car s,cdr s]
+        hh:=shoePileColumn h
+        if hh = n
+        then shoePileForests(h,hh,t)
+        else [false,n,[],s]
+ 
+shoePileForest(n,s)==
+     [b,hh,h,t]:= shoePileTree(n,s)
+     if b
+     then
+       [h1,t1]:=shoePileForest1(hh,t)
+       [cons(h,h1),t1]
+     else [[],s]
+ 
+shoePileForest1(n,s)==
+     [b,n1,h,t]:= eqshoePileTree(n,s)
+     if b
+     then
+       [h1,t1]:=shoePileForest1(n,t)
+       [cons(h,h1),t1]
+     else [[],s]
+ 
+shoePileForests(h,n,s)==
+      [h1,t1]:=shoePileForest(n,s)
+      if bStreamNull h1
+      then [true,n,h,s]
+      else shoePileForests(shoePileCtree(h,h1),n,t1)
+ 
+shoePileCtree(x,y)==dqAppend(x,shoePileCforest y)
+ 
+-- only enshoePiles forests with >=2 trees
+ 
+shoePileCforest x==
+   if null x
+   then []
+   else if null cdr x
+        then car x
+        else
+           a:=car x
+           b:=shoePileCoagulate(a,rest x)
+           if null cdr b
+           then car b
+           else shoeEnPile shoeSeparatePiles b
+ 
+shoePileCoagulate(a,b)==
+    if null b
+    then [a]
+    else
+      c:=car b
+      if EQ(shoeTokPart CAAR c,"THEN") or EQ(shoeTokPart CAAR c,"ELSE")
+      then shoePileCoagulate (dqAppend(a,c),cdr b)
+      else
+         d:=CADR a
+         e:=shoeTokPart d
+         if EQCAR(d,"KEY") and
+               (GET(e,"SHOEINF") or EQ(e,"COMMA") or EQ(e,"SEMICOLON"))
+         then shoePileCoagulate(dqAppend(a,c),cdr b)
+         else cons(a,shoePileCoagulate(c,rest b))
+ 
+shoeSeparatePiles x==
+  if null x
+  then []
+  else if null cdr x
+       then car x
+       else
+         a:=car x
+         semicolon:=dqUnit
+                shoeTokConstruct("KEY", "BACKSET",shoeLastTokPosn a)
+         dqConcat [a,semicolon,shoeSeparatePiles cdr x]
+ 
+shoeEnPile x==
+   dqConcat [dqUnit shoeTokConstruct("KEY","SETTAB",shoeFirstTokPosn x),
+             x, _
+             dqUnit shoeTokConstruct("KEY","BACKTAB",shoeLastTokPosn  x)]
+ 
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
new file mode 100644
index 00000000..cd127781
--- /dev/null
+++ b/src/boot/scanner.boot
@@ -0,0 +1,514 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+
+module '"boot-lexer"
+import '"tokens"
+import '"includer"
+
+)package "BOOTTRAN"
+
+-- converts X to double-float.
+double x ==
+  FLOAT(x, 1.0)
+ 
+dqUnit s==(a:=[s];CONS(a,a))
+ 
+dqAppend(x,y)==
+    if null x
+    then y
+    else if null y
+         then x
+         else
+              RPLACD (CDR x,CAR y)
+              RPLACD (x,    CDR y)
+              x
+ 
+dqConcat ld==
+    if null ld
+    then nil
+    else if null rest ld
+         then first ld
+         else dqAppend(first ld,dqConcat rest ld)
+ 
+dqToList s==if null s then nil else CAR s
+ 
+shoeConstructToken(ln,lp,b,n)==[b.0,b.1,:cons(lp,n)]
+shoeTokType x== CAR x
+shoeTokPart x== CADR x
+shoeTokPosn x== CDDR x
+shoeTokConstruct(x,y,z)==[x,y,:z]
+ 
+shoeNextLine(s)==
+     if bStreamNull s
+     then false
+     else
+       $linepos:=s
+       $f:= CAR s
+       $r:= CDR s
+       $ln:=CAR $f
+       $n:=STRPOSL('" ",$ln,0,true)
+       $sz :=# $ln
+       null $n => true
+       QENUM($ln,$n)=shoeTAB =>
+                  a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ")
+                  $ln.$n:='" ".0
+                  $ln:=CONCAT(a,$ln)
+                  s1:=cons(cons($ln,CDR $f),$r)
+                  shoeNextLine s1
+       true
+ 
+shoeLineToks(s)==
+   $f: local:=nil
+   $r:local :=nil
+   $ln:local :=nil
+   $n:local:=nil
+   $sz:local := nil
+   $floatok:local:=true
+   $linepos:local:=s
+   not shoeNextLine s =>  CONS(nil,nil)
+   null $n => shoeLineToks $r
+   fst:=QENUM($ln,0)
+   EQL(fst,shoeCLOSEPAREN)=>
+            command:=shoeLine? $ln=>
+              dq:=dqUnit shoeConstructToken
+                       ($ln,$linepos,shoeLeafLine command,0)
+              cons([dq],$r)
+            command:=shoeLisp? $ln=> shoeLispToken($r,command)
+            command:=shoePackage? $ln=>
+       --       z:=car shoeBiteOff command
+              a:=CONCAT('"(IN-PACKAGE ",command,'")")
+              dq:=dqUnit shoeConstructToken
+                       ($ln,$linepos,shoeLeafLisp a,0)
+              cons([dq],$r)
+            shoeLineToks $r
+   toks:=[]
+   while $n<$sz repeat toks:=dqAppend(toks,shoeToken())
+   null toks => shoeLineToks $r
+   cons([toks],$r)
+ 
+shoeLispToken(s,string)==
+      string:=
+            # string=0 or EQL(QENUM(string,0),QENUM('";",0))=> '""
+            string
+      ln:=$ln
+      linepos:=$linepos
+      [r,:st]:=shoeAccumulateLines(s,string)
+      dq:=dqUnit shoeConstructToken(ln,linepos,shoeLeafLisp st,0)
+      cons([dq],r)
+ 
+shoeAccumulateLines(s,string)==
+   not shoeNextLine s =>  CONS(s,string)
+   null $n => shoeAccumulateLines($r,string)
+   # $ln=0 => shoeAccumulateLines($r,string)
+   fst:=QENUM($ln,0)
+   EQL(fst,shoeCLOSEPAREN)=>
+            command:=shoeLisp? $ln
+            command and #command>0 =>
+                EQL(QENUM(command,0),QENUM('";",0))=>
+                            shoeAccumulateLines($r,string)
+                a:=STRPOS('";",command,0,nil)
+                a=>
+                  shoeAccumulateLines($r,
+                     CONCAT(string,SUBSTRING(command,0,a-1)))
+                shoeAccumulateLines($r,CONCAT(string,command))
+            shoeAccumulateLines($r,string)
+   CONS(s,string)
+
+-- returns true if token t is closing `parenthesis'.
+shoeCloser t ==
+  MEMQ(shoeKeyWord t, '(CPAREN CBRACK))
+ 
+shoeToken () ==
+      ln:=$ln
+      c:=QENUM($ln,$n)
+      linepos:=$linepos
+      n:=$n
+      ch:=$ln.$n
+      b:=
+            shoeStartsComment()          =>
+                           shoeComment()
+                           []
+            shoeStartsNegComment()       =>
+                           shoeNegComment()
+                           []
+            c=shoeLispESCAPE      =>
+                           shoeLispEscape()
+            shoePunctuation c        => shoePunct ()
+            shoeStartsId ch          => shoeWord  (false)
+            c=shoeSPACE              =>
+                           shoeSpace ()
+                           []
+            c = shoeSTRING_CHAR        => shoeString ()
+            shoeDigit ch               => shoeNumber ()
+            c=shoeESCAPE               => shoeEscape()
+            c=shoeTAB                  =>
+                                       $n:=$n+1
+                                       []
+            shoeError ()
+      null b => nil
+      dqUnit shoeConstructToken(ln,linepos,b,n)
+ 
+-- to pair badge and badgee
+shoeLeafId x==  ["ID",INTERN x]
+ 
+shoeLeafKey x==["KEY",shoeKeyWord x]
+ 
+shoeLeafInteger x==["INTEGER",shoeIntValue x]
+ 
+shoeLeafFloat(a,w,e)==
+    b:=shoeIntValue CONCAT(a,w)
+    c:= double b *  EXPT(double 10, e-#w)
+    ["FLOAT",c]
+ 
+shoeLeafString x  == ["STRING",x]
+ 
+shoeLeafLisp x    == ["LISP",x]
+shoeLeafLispExp x    == ["LISPEXP",x]
+ 
+shoeLeafLine x    == ["LINE",x]
+ 
+shoeLeafComment x == ["COMMENT", x]
+ 
+shoeLeafNegComment x== ["NEGCOMMENT", x]
+ 
+shoeLeafError x   == ["ERROR",x]
+ 
+shoeLeafSpaces x  == ["SPACES",x]
+ 
+shoeLispEscape()==
+         $n:=$n+1
+         if $n>=$sz
+         then
+             SoftShoeError(cons($linepos,$n),'"lisp escape error")
+             shoeLeafError ($ln.$n)
+         else
+            a:=shoeReadLispString($ln,$n)
+            null a =>
+             SoftShoeError(cons($linepos,$n),'"lisp escape error")
+             shoeLeafError ($ln.$n)
+            [exp,n]:=a
+            null n =>
+                 $n:= $sz
+                 shoeLeafLispExp  exp
+            $n:=n
+            shoeLeafLispExp  exp
+shoeEscape()==
+         $n:=$n+1
+         a:=shoeEsc()
+         if a then shoeWord true else nil
+ 
+shoeEsc()==
+     if $n>=$sz
+     then if shoeNextLine($r)
+          then
+               while null $n repeat shoeNextLine($r)
+               shoeEsc()
+               false
+          else false
+     else
+           n1:=STRPOSL('" ",$ln,$n,true)
+           if null n1
+           then
+               shoeNextLine($r)
+               while null $n repeat shoeNextLine($r)
+               shoeEsc()
+               false
+           else true
+ 
+shoeStartsComment()==
+    if $n<$sz
+    then
+         if QENUM($ln,$n)=shoePLUSCOMMENT
+         then
+            www:=$n+1
+            if www>=$sz
+            then false
+            else QENUM($ln,www) = shoePLUSCOMMENT
+         else false
+    else false
+ 
+shoeStartsNegComment()==
+    if $n< $sz
+    then
+         if QENUM($ln,$n)=shoeMINUSCOMMENT
+         then
+            www:=$n+1
+            if www>=$sz
+            then false
+            else QENUM($ln,www) = shoeMINUSCOMMENT
+         else false
+    else false
+ 
+shoeNegComment()==
+      n:=$n
+      $n:=$sz
+      shoeLeafNegComment SUBSTRING($ln,n,nil)
+ 
+shoeComment()==
+      n:=$n
+      $n:=$sz
+      shoeLeafComment SUBSTRING($ln,n,nil)
+ 
+shoePunct()==
+            sss:=shoeMatch($ln,$n)
+            $n:=$n+#sss
+            shoeKeyTr sss
+ 
+shoeKeyTr w==
+       if EQ(shoeKeyWord w,"DOT")
+       then if $floatok
+            then shoePossFloat(w)
+            else shoeLeafKey w
+       else
+           $floatok:=not shoeCloser w
+           shoeLeafKey w
+ 
+shoePossFloat (w)==
+     if $n>=$sz or not shoeDigit $ln.$n
+     then shoeLeafKey w
+     else
+       w:=shoeInteger()
+       shoeExponent('"0",w)
+ 
+ 
+shoeSpace()==
+           n:=$n
+           $n:=STRPOSL('" ",$ln,$n,true)
+           $floatok:=true
+           if null $n
+           then
+              shoeLeafSpaces 0
+              $n:= # $ln
+           else shoeLeafSpaces ($n-n)
+ 
+shoeString()==
+            $n:=$n+1
+            $floatok:=false
+            shoeLeafString shoeS ()
+ 
+shoeS()==
+   if $n>=$sz
+   then
+     SoftShoeError(cons($linepos,$n),'"quote added")
+     '""
+   else
+           n:=$n
+           strsym :=STRPOS ('"_"",$ln,$n,nil) or $sz
+           escsym:=STRPOS ('"__"
+                          ,$ln,$n,nil)  or $sz
+           mn:=MIN(strsym,escsym)
+           if mn=$sz
+           then
+                 $n:=$sz
+                 SoftShoeError(cons($linepos,$n),'"quote added")
+                 SUBSTRING($ln,n,nil)
+           else if mn=strsym
+                then
+                   $n:=mn+1
+                   SUBSTRING($ln,n,mn-n)
+                else
+                  str:=SUBSTRING($ln,n,mn-n)
+                  $n:=mn+1
+                  a:=shoeEsc()
+                  b:=if a
+                     then
+                       str:=CONCAT(str,$ln.$n)
+                       $n:=$n+1
+                       shoeS()
+                     else shoeS()
+                  CONCAT(str,b)
+ 
+ 
+ 
+ 
+shoeIdEnd(line,n)==
+     while n<#line and shoeIdChar line.n repeat n:=n+1
+     n
+ 
+ 
+shoeDigit x== DIGIT_-CHAR_-P x
+ 
+shoeW(b)==
+       n1:=$n
+       $n:=$n+1
+       l:=$sz
+       endid:=shoeIdEnd($ln,$n)
+       if endid=l or QENUM($ln,endid)^=shoeESCAPE
+       then
+           $n:=endid
+           [b,SUBSTRING($ln,n1,endid-n1)]
+       else
+           str:=SUBSTRING($ln,n1,endid-n1)
+           $n:=endid+1
+           a:=shoeEsc()
+           bb:=if a
+               then shoeW(true)
+               else [b,'""]   --  escape finds space or newline
+           [bb.0 or b,CONCAT(str,bb.1)]
+ 
+shoeWord(esp) ==
+          aaa:=shoeW(false)
+          w:=aaa.1
+          $floatok:=false
+          if esp or aaa.0
+          then shoeLeafId w
+          else if shoeKeyWordP w
+               then
+                  $floatok:=true
+                  shoeLeafKey w
+               else shoeLeafId  w
+ 
+shoeInteger()==shoeInteger1(false)
+ 
+shoeInteger1(zro) ==
+       n:=$n
+       l:= $sz
+       while $n<l and shoeDigit($ln.$n) repeat $n:=$n+1
+       if $n=l or QENUM($ln,$n)^=shoeESCAPE
+       then if n=$n and zro
+            then '"0"
+            else SUBSTRING($ln,n,$n-n)
+       else
+             str:=SUBSTRING($ln,n,$n-n)
+             $n:=$n+1
+             a:=shoeEsc()
+             bb:=shoeInteger1(zro)
+             CONCAT(str,bb)
+ 
+shoeIntValue(s) ==
+       ns := #s
+       ival := 0
+       for i in 0..ns-1 repeat
+           d := shoeOrdToNum ELT(s,i)
+           ival := 10*ival + d
+       ival
+ 
+shoeNumber() ==
+       a := shoeInteger()
+       if $n>=$sz
+       then shoeLeafInteger a
+       else
+           if $floatok and QENUM($ln,$n)=shoeDOT
+           then
+             n:=$n
+             $n:=$n+1
+             if  $n<$sz and QENUM($ln,$n)=shoeDOT
+             then
+               $n:=n
+               shoeLeafInteger a
+             else
+               w:=shoeInteger1(true)
+               shoeExponent(a,w)
+           else shoeLeafInteger a
+ 
+shoeExponent(a,w)==
+     if $n>=$sz
+     then shoeLeafFloat(a,w,0)
+     else
+        n:=$n
+        c:=QENUM($ln,$n)
+        if c=shoeEXPONENT1 or c=shoeEXPONENT2
+        then
+           $n:=$n+1
+           if $n>=$sz
+           then
+             $n:=n
+             shoeLeafFloat(a,w,0)
+           else if shoeDigit($ln.$n)
+                then
+                  e:=shoeInteger()
+                  e:=shoeIntValue e
+                  shoeLeafFloat(a,w,e)
+                else
+                  c1:=QENUM($ln,$n)
+                  if c1=shoePLUSCOMMENT or c1=shoeMINUSCOMMENT
+                  then
+                    $n:=$n+1
+                    if $n>=$sz
+                    then
+                      $n:=n
+                      shoeLeafFloat(a,w,0)
+                    else
+                      if shoeDigit($ln.$n)
+                      then
+                        e:=shoeInteger()
+                        e:=shoeIntValue e
+                        shoeLeafFloat(a,w,
+                          (if c1=shoeMINUSCOMMENT then MINUS e else e))
+                      else
+                        $n:=n
+                        shoeLeafFloat(a,w,0)
+        else shoeLeafFloat(a,w,0)
+ 
+shoeError()==
+      n:=$n
+      $n:=$n+1
+      SoftShoeError(cons($linepos,n),
+        CONCAT( '"The character whose number is ",
+                STRINGIMAGE QENUM($ln,n),'" is not a Boot character"))
+      shoeLeafError ($ln.n)
+ 
+shoeOrdToNum x== DIGIT_-CHAR_-P x
+ 
+shoeKeyWord st   == GETHASH(st,shoeKeyTable)
+ 
+shoeKeyWordP st  ==  not null GETHASH(st,shoeKeyTable)
+ 
+shoeMatch(l,i)==shoeSubStringMatch(l,shoeDict,i)
+ 
+shoeSubStringMatch (l,d,i)==
+       h:= QENUM(l, i)
+       u:=ELT(d,h)
+       ll:=SIZE l
+       done:=false
+       s1:='""
+       for j in 0.. SIZE u - 1 while not done repeat
+          s:=ELT(u,j)
+          ls:=SIZE s
+          done:=if ls+i > ll
+                then false
+                else
+                 eql:= true
+                 for k in 1..ls-1 while eql repeat
+                    eql:= EQL(QENUM(s,k),QENUM(l,k+i))
+                 if eql
+                 then
+                   s1:=s
+                   true
+                 else false
+       s1
+ 
+shoePunctuation c== shoePun.c =1
+ 
diff --git a/src/boot/ast.boot.pamphlet b/src/boot/strap/ast.clisp
index b0c2f483..591bd9bf 100644
--- a/src/boot/ast.boot.pamphlet
+++ b/src/boot/strap/ast.clisp
@@ -1,1118 +1,3 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/ast.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-\begin{abstract}
-\end{abstract}
-
-\tableofcontents
-\eject
-
-Note that shoeReadLispString has a duplicate definition in this file.
-I don't know why. I've commented out the first definition since it
-gets overwritten.
-
-\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.
-
-@
-
-\section{Abstract syntax tree}
-
-<<abstract syntax tree>>=
-++ A Boot string is no different from a Lisp string.  Same holds 
-++ for symbols and sequences.  In an ideal world, these would be
-++ built-in/library data types.
-String <=> STRING
-Symbol <=> SYMBOL
-Sequence <=> SEQUENCE
-
-++ Ideally, we would like to say that a List T if either nil or a 
-++ cons of a T and List of T.  However, we don't support parameterized
-++ alias definitions yet.
-List <=> nil or cons
-
-++ Currently, the Boot processor uses Lisp symbol datatype for names.
-++ That causes the BOOTTRAN package to contain more symbols than we would
-++ like.  In the future, we want want to intern `on demand'.  How that
-++ interacts with renaming is to be worked out.
-structure Name == Name(Symbol)
-
-structure Ast ==
-  Command(String)			-- includer command
-  Module(String)			-- module declaration
-  Import(String)			-- import module
-  ImportSignature(Name, Signature)      -- import function declaration
-  TypeAlias(Name, List, List)		-- type alias definition
-  Signature(Name, Mapping)		-- op: S -> T
-  Mapping(Ast, List)			-- (S1, S2) -> T
-  SuffixDot(Ast)			-- x . 
-  Quote(Ast)				-- 'x
-  EqualName(Name)			-- =x        -- patterns
-  Colon(Name)				-- :x
-  QualifiedName(Name, Name)		-- m::x
-  Bracket(Ast)				-- [x, y]
-  UnboundedSegment(Ast)			-- 3..
-  BoundedSgement(Ast, Ast)		-- 2..4
-  Tuple(List)				-- comma-separated expression sequence
-  ColonAppend(Ast, Ast)			-- [:y] or [x, :y]
-  Is(Ast, Ast)				-- e is p    -- patterns
-  Isnt(Ast, Ast)			-- e isnt p  -- patterns
-  Reduce(Ast, Ast)			-- +/[...]
-  PrefixExpr(Name, Ast)			-- #v
-  Call(Ast, Sequence)			-- f(x, y , z)
-  InfixExpr(Name, Ast, Ast)		-- x + y
-  ConstantDefinition(Name, Ast)         -- x == y
-  Definition(Name, List, Ast, Ast)	-- f x == y
-  Macro(Name, List, Ast)                -- m x ==> y
-  SuchThat(Ast)			        -- | p
-  Assignment(Ast, Ast)			-- x := y
-  While(Ast)				-- while p           -- iterator
-  Until(Ast)				-- until p           -- iterator
-  For(Ast, Ast, Ast)			-- for x in e by k   -- iterator
-  Exit(Ast, Ast)			-- p => x
-  Iterators(List)			-- list of iterators
-  Cross(List)				-- iterator cross product
-  Repeat(Sequence, Ast)			-- while p repeat s
-  Pile(Sequence)			-- pile of expression sequence
-  Append(Sequence)			-- concatenate lists
-  Case(Ast, Sequence)			-- case x of ...
-  Return(Ast)				-- return x
-  Where(Ast, Sequence)                  -- e where f x == y
-  Structure(Ast, Sequence)		-- structure Foo == ...
-@
-
-
-\section{Putting it all together}
-<<*>>=
-<<license>>
-
-module '"boot-ast"
-import '"includer"
-
-)package "BOOTTRAN"
-
-++ True means that Boot functions should be translated to use
-++ hash tables to remember values.  By default, functions are
-++ translated with the obvious semantics, e.g. no caching.
-$bfClamming := false
-
-<<abstract syntax tree>>
-
--- TRUE if we are currently building the syntax tree for an 'is' 
--- expression.
-$inDefIS := false
- 
-bfGenSymbol()==
-    $GenVarCounter:=$GenVarCounter+1
-    INTERN(CONCAT ('"bfVar#",STRINGIMAGE $GenVarCounter))
- 
-bfListOf x==x
- 
-bfColon x== ["COLON",x]
-
-bfColonColon(package, name) == 
-  INTERN(SYMBOL_-NAME name, package)
- 
-bfSymbol x==
-   STRINGP x=> x
-   ['QUOTE,x]
- 
-bfDot()== "DOT"
- 
-bfSuffixDot x==[x,"DOT"]
- 
-bfEqual(name)== ["EQUAL",name]
- 
-bfBracket(part) == part
- 
-bfPile(part)    == part
- 
-bfAppend x== APPLY(function APPEND,x)
- 
-bfColonAppend (x,y) ==
-     if null x
-     then
-      if y is ["BVQUOTE",:a]
-      then ["&REST",["QUOTE",:a]]
-      else ["&REST",y]
-     else cons(CAR x,bfColonAppend(CDR x,y))
- 
-bfDefinition(bflhsitems, bfrhs,body) ==
-       ['DEF,bflhsitems,bfrhs,body]
- 
-bfMDefinition(bflhsitems, bfrhs,body) ==
-       bfMDef('MDEF,bflhsitems,bfrhs,body)
- 
-bfCompDef x ==
-  case x of
-    ConstantDefinition(n, e) => x
-    otherwise =>
-      x is [def, op, args, body] =>
-        bfDef(def,op,args,body)
-      coreError '"invalid AST"
- 
-bfBeginsDollar x==  EQL('"$".0,(PNAME x).0)
- 
-compFluid id== ["FLUID",id]
- 
-compFluidize x==
-  IDENTP x and bfBeginsDollar x=>compFluid x
-  ATOM x =>x
-  EQCAR(x,"QUOTE")=>x
-  cons(compFluidize(CAR x),compFluidize(CDR x))
- 
-bfTuple x== ["TUPLE",:x]
- 
-bfTupleP x==EQCAR(x,"TUPLE")
- 
-bfTupleIf x==
-  if bfTupleP x
-  then x
-  else bfTuple x
- 
-bfTupleConstruct b ==
-  a:= if bfTupleP b
-      then cdr b
-      else [b]
-  or/[x is ["COLON",.] for x in a] => bfMakeCons a
-  ["LIST",:a]
- 
-bfConstruct b ==
-  a:= if bfTupleP b
-      then cdr b
-      else [b]
-  bfMakeCons a
- 
-bfMakeCons l ==
-  null l => NIL
-  l is [["COLON",a],:l1] =>
-    l1 => ['APPEND,a,bfMakeCons l1]
-    a
-  ['CONS,first l,bfMakeCons rest l]
- 
-bfFor(bflhs,U,step) ==
-     if EQCAR (U,'tails)
-     then  bfForTree('ON, bflhs, CADR U)
-     else
-       if EQCAR(U,"SEGMENT")
-       then  bfSTEP(bflhs,CADR U,step,CADDR U)
-       else  bfForTree('IN, bflhs, U)
- 
-bfForTree(OP,lhs,whole)==
-         whole:=if bfTupleP whole then bfMakeCons cdr whole else whole
-         ATOM lhs =>bfINON [OP,lhs,whole]
-         lhs:=if bfTupleP lhs then CADR lhs else lhs
-         EQCAR(lhs,"L%T") =>
-             G:=CADR lhs
-             [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,CADDR lhs)]
-         G:=bfGenSymbol()
-         [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,lhs)]
- 
- 
-bfSTEP(id,fst,step,lst)==
-      initvar:=[id]
-      initval:=[fst]
-      inc:=if ATOM step
-           then step
-           else
-               g1:=bfGenSymbol()
-               initvar:=cons(g1,initvar)
-               initval:=cons(step,initval)
-               g1
-      final:=if ATOM lst
-             then lst
-             else
-               g2:=bfGenSymbol()
-               initvar:=cons(g2,initvar)
-               initval:=cons(lst,initval)
-               g2
-      ex:=
-          null lst=> []
-          INTEGERP inc =>
-              pred:=if MINUSP inc then "<" else ">"
-              [[pred,id,final]]
-          [['COND,[['MINUSP,inc],
-                ["<",id,final]],['T,[">",id,final]]]]
-      suc:=[['SETQ,id,["+",id,inc]]]
-      [[initvar,initval,suc,[],ex,[]]]
- 
- 
-bfINON x==
-    [op,id,whole]:=x
-    if EQ(op,"ON")
-    then bfON(id,whole)
-    else bfIN(id,whole)
- 
-bfIN(x,E)==
-    g:=bfGenSymbol()
-    [[[g,x],[E,nil],[['SETQ,g,['CDR, g]]],[],
-        [['OR,['ATOM,g],['PROGN,['SETQ,x,['CAR,g]] ,'NIL]]],[]]]
- 
-bfON(x,E)==
-    [[[x],[E],[['SETQ,x,['CDR, x]]],[],
-        [['ATOM,x]],[]]]
- 
-bfSuchthat p== [[[],[],[],[p],[],[]]]
- 
-bfWhile p== [[[],[],[],[],[bfNOT p],[]]]
- 
-bfUntil p==
-     g:=bfGenSymbol()
-     [[[g],[nil],[['SETQ,g,p]],[],[g],[]]]
- 
-bfIterators x==["ITERATORS",:x]
- 
-bfCross x== ["CROSS",:x]
- 
-bfLp(iters,body)==
-     EQCAR (iters,"ITERATORS")=>bfLp1(CDR iters,body)
-     bfLpCross(CDR iters,body)
- 
-bfLpCross(iters,body)==
-     if null cdr iters
-     then bfLp(car iters,body)
-     else bfLp(car iters,bfLpCross(cdr iters,body))
- 
-bfSep(iters)==
-     if null iters
-     then [[],[],[],[],[],[]]
-     else
-         f:=first iters
-         r:=bfSep rest iters
-         [append(i,j) for i in f for j in r]
- 
-bfReduce(op,y)==
-     a:=if EQCAR(op,"QUOTE") then CADR op else op
-     op:=bfReName a
-     init:=GET(op,"SHOETHETA")
-     g:=bfGenSymbol()
-     g1:=bfGenSymbol()
-     body:=['SETQ,g,[op,g,g1]]
-     if null init
-     then
-        g2:=bfGenSymbol()
-        init:=['CAR,g2]
-        ny:=['CDR,g2]
-        it:= ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,ny)]]
-        bfMKPROGN [['L%T,g2,y],bfLp(it,body)]
-     else
-        init:=car init
-        it:= ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,y)]]
-        bfLp(it,body)
- 
-bfReduceCollect(op,y)==
-   if EQCAR (y,"COLLECT")
-   then
-     body:=y.1
-     itl:=y.2
-     a:=if EQCAR(op,"QUOTE") then CADR op else op
-     op:=bfReName a
-     init:=GET(op,"SHOETHETA")
-     bfOpReduce(op,init,body,itl)
-   else
-     a:=bfTupleConstruct (y.1)
-     bfReduce(op,a)
- 
--- delayed collect
- 
-bfDCollect(y,itl)== ["COLLECT",y,itl]
- 
-bfDTuple x== ["DTUPLE",x]
- 
-bfCollect(y,itl) ==
-      y is ["COLON",a] => bf0APPEND(a,itl)
-      y is ["TUPLE",:.] =>
-        newBody:=bfConstruct y
-        bf0APPEND(newBody,itl)
-      bf0COLLECT(y,itl)
- 
-bf0COLLECT(y,itl)==bfListReduce('CONS,y,itl)
- 
- 
-bf0APPEND(y,itl)==
-     g:=bfGenSymbol()
-     body:=['SETQ,g,['APPEND,['REVERSE,y],g]]
-     extrait:= [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
-     bfLp2(extrait,itl,body)
- 
-bfListReduce(op,y,itl)==
-     g:=bfGenSymbol()
-     body:=['SETQ,g,[op,y,g]]
-     extrait:= [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
-     bfLp2(extrait,itl,body)
- 
-bfLp1(iters,body)==
-      [vars,inits,sucs,filters,exits,value]:=bfSep bfAppend iters
-      nbody:=if null filters then body else bfAND [:filters,body]
-      value:=if null value then "NIL" else car value
-      exits:= ["COND",[bfOR exits,["RETURN",value]],
-                  ['(QUOTE T),nbody]]
-      loop := ["LOOP",exits,:sucs]
-      if vars then loop := 
-        ["LET",[[v, i] for v in vars for i in inits], loop]
-      loop
- 
-bfLp2(extrait,itl,body)==
-     EQCAR (itl,"ITERATORS")=>bfLp1(cons(extrait,CDR itl),body)
-     iters:=cdr itl
-     bfLpCross
-          ([["ITERATORS",extrait,:CDAR iters],:CDR iters],body)
- 
-bfOpReduce(op,init,y,itl)==
-     g:=bfGenSymbol()
-     body:=
-         EQ(op,"AND")=>
-                bfMKPROGN [["SETQ",g,y],
-                    ['COND, [['NOT,g],['RETURN,'NIL]]]]
-         EQ(op,"OR") =>
-                bfMKPROGN [["SETQ",g,y],
-                             ['COND, [g,['RETURN,g]]]]
-         ['SETQ,g,[op,g,y]]
-     if null init
-     then
-        g1:=bfGenSymbol()
-        init:=['CAR,g1]
-        y:=['CDR,g1]
-        extrait:= [[[g],[init],[],[],[],[g]]]
-        bfMKPROGN [['L%T,g1,y],bfLp2(extrait,itl,body)]
-     else
-        init:=car init
-        extrait:= [[[g],[init],[],[],[],[g]]]
-        bfLp2(extrait,itl,body)
- 
-bfLoop1 body == bfLp (bfIterators nil,body)
- 
-bfSegment1(lo)==     ["SEGMENT",lo,nil]
- 
-bfSegment2(lo,hi)==   ["SEGMENT",lo,hi]
- 
-bfForInBy(variable,collection,step)==
-         bfFor(variable,collection,step)
- 
-bfForin(lhs,U)==bfFor(lhs,U,1)
- 
-bfLocal(a,b)==
-         EQ(b,"FLUID")=>  compFluid a
-         EQ(b,"fluid")=>  compFluid a
-         EQ(b,"local") =>  compFluid a
-    --   $typings:=cons(["TYPE",b,a],$typings)
-         a
- 
-bfTake(n,x)==
-     null x=>x
-     n=0 => nil
-     cons(car x,bfTake(n-1,cdr x))
- 
-bfDrop(n,x)==
-     null x or n=0 =>x
-     bfDrop(n-1,cdr x)
- 
-bfDefSequence l ==  ['SEQ,: l]
- 
-bfReturnNoName a ==
-      ["RETURN",a]
- 
-bfSUBLIS(p,e)==
-  ATOM e=>bfSUBLIS1(p,e)
-  EQCAR(e,"QUOTE")=>e
-  cons(bfSUBLIS(p,car e),bfSUBLIS(p,cdr e))
- 
-+++ Returns e/p, where e is an atom.  We assume that the
-+++ DEFs form a system admitting a fix point; otherwise we may
-+++ loop forever.  That can happen only if nullary goats
-+++ are recursive -- which they are not supposed to be.
-+++ We don't enforce that restriction though.
-bfSUBLIS1(p,e)==
-   null p =>e
-   f:=CAR p
-   EQ(CAR f,e)=> bfSUBLIS(p, CDR f)
-   bfSUBLIS1(cdr p,e)
- 
-defSheepAndGoats(x)==
-    EQCAR (x,"DEF") =>
-        [def,op,args,body]:=x
-        argl:=if bfTupleP args
-              then cdr args
-              else [args]
-        if null argl
-        then
-          opassoc:=[[op,:body]]
-          [opassoc,[],[]]
-        else
-          op1:=INTERN CONCAT(PNAME $op,'",",PNAME op)
-          opassoc:=[[op,:op1]]
-          defstack:=[["DEF",op1,args,body]]
-          [opassoc,defstack,[]]
-    EQCAR (x,"SEQ") =>  defSheepAndGoatsList(cdr x)
-    [[],[],[x]]
- 
-defSheepAndGoatsList(x)==
-     if null x
-     then [[],[],[]]
-     else
-       [opassoc,defs,nondefs]    := defSheepAndGoats car x
-       [opassoc1,defs1,nondefs1] := defSheepAndGoatsList cdr x
-       [append(opassoc,opassoc1),append(defs,defs1),
-            append(nondefs,nondefs1)]
---% LET
- 
-bfLetForm(lhs,rhs) ==   ['L%T,lhs,rhs]
- 
-bfLET1(lhs,rhs) ==
-  IDENTP lhs         => bfLetForm(lhs,rhs)
-  lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
-  IDENTP rhs and not bfCONTAINED(rhs,lhs) =>
-    rhs1 := bfLET2(lhs,rhs)
-    EQCAR(rhs1,'L%T) => bfMKPROGN [rhs1,rhs]
-    EQCAR(rhs1,'PROGN) => APPEND(rhs1,[rhs])
-    if IDENTP CAR rhs1 then rhs1 := CONS(rhs1,NIL)
-    bfMKPROGN [:rhs1,rhs]
-  CONSP(rhs) and EQCAR(rhs,'L%T) and IDENTP(name := CADR rhs) =>
-    -- handle things like [a] := x := foo
-    l1 := bfLET1(name,CADDR rhs)
-    l2 := bfLET1(lhs,name)
-    EQCAR(l2,'PROGN) => bfMKPROGN [l1,:CDR l2]
-    if IDENTP CAR l2 then l2 := cons(l2,nil)
-    bfMKPROGN [l1,:l2,name]
-  g := INTERN CONCAT('"LETTMP#",STRINGIMAGE $letGenVarCounter)
-  $letGenVarCounter := $letGenVarCounter + 1
-  rhs1 := ['L%T,g,rhs]
-  let1 := bfLET1(lhs,g)
-  EQCAR(let1,'PROGN) => bfMKPROGN [rhs1,:CDR let1]
-  if IDENTP CAR let1 then let1 := CONS(let1,NIL)
-  bfMKPROGN [rhs1,:let1,g]
- 
-bfCONTAINED(x,y)==
-    EQ(x,y) => true
-    ATOM y=> false
-    bfCONTAINED(x,car y) or bfCONTAINED(x,cdr y)
- 
-bfLET2(lhs,rhs) ==
-  IDENTP lhs => bfLetForm(lhs,rhs)
-  NULL lhs   => NIL
-  lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
-  lhs is ['L%T,a,b] =>
-    a := bfLET2(a,rhs)
-    null (b := bfLET2(b,rhs)) => a
-    ATOM b => [a,b]
-    CONSP CAR b => CONS(a,b)
-    [a,b]
-  lhs is ['CONS,var1,var2] =>
-    var1 = "DOT" or (CONSP(var1) and EQCAR(var1,'QUOTE)) =>
-      bfLET2(var2,addCARorCDR('CDR,rhs))
-    l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
-    null var2 or EQ(var2,"DOT") =>l1
-    if CONSP l1 and ATOM CAR l1 then l1 := cons(l1,nil)
-    IDENTP var2 =>
-      [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))]
-    l2 := bfLET2(var2,addCARorCDR('CDR,rhs))
-    if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
-    APPEND(l1,l2)
-  lhs is ['APPEND,var1,var2] =>
-    patrev := bfISReverse(var2,var1)
-    rev := ['REVERSE,rhs]
-    g := INTERN CONCAT('"LETTMP#", STRINGIMAGE $letGenVarCounter)
-    $letGenVarCounter := $letGenVarCounter + 1
-    l2 := bfLET2(patrev,g)
-    if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
-    var1 = "DOT" => [['L%T,g,rev],:l2]
-    last l2 is ['L%T, =var1, val1] =>
-      [['L%T,g,rev],:REVERSE CDR REVERSE l2,
-       bfLetForm(var1,['NREVERSE,val1])]
-    [['L%T,g,rev],:l2,bfLetForm(var1,['NREVERSE,var1])]
-  lhs is ["EQUAL",var1] =>
-    ['COND,[["EQUAL",var1,rhs],var1]]
-  -- The original expression may be one that involves literals as 
-  -- sub-patterns, e.g.
-  --      ['SEQ, :l, ['exit, 1, x]] := item
-  -- We continue the processing as if that expression had been written
-  --      item is ['SEQ, :l, ['exit, 1, x]]
-  -- and generate appropriate codes.
-  --                  -- gdr/2007-04-02.
-  isPred :=
-    $inDefIS => bfIS1(rhs,lhs)
-    bfIS(rhs,lhs)
-  ['COND,[isPred,rhs]]
- 
- 
-bfLET(lhs,rhs) ==
-  $letGenVarCounter : local := 1
---  $inbfLet : local := true
-  bfLET1(lhs,rhs)
- 
-addCARorCDR(acc,expr) ==
-  NULL CONSP expr => [acc,expr]
-  acc = 'CAR and EQCAR(expr,'REVERSE) =>
-      ["CAR",["LAST",:CDR expr]]
- --   cons('last,CDR expr)
-  funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
-            CDAAR CDDAR CDADR CDDDR)
-  p := bfPosition(CAR expr,funs)
-  p = -1 => [acc,expr]
-  funsA := '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR CAAADR
-             CAADDR CADAAR CADDAR CADADR CADDDR)
-  funsR := '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR CDAADR
-             CDADDR CDDAAR CDDDAR CDDADR CDDDDR)
-  if acc = 'CAR then CONS(funsA.p,CDR expr)
-  else               CONS(funsR.p,CDR expr)
- 
-bfPosition(x,l) ==  bfPosn(x,l,0)
-bfPosn(x,l,n) ==
-      null l => -1
-      x=first l => n
-      bfPosn(x,rest l,n+1)
- 
---% IS
- 
-bfISApplication(op,left,right)==
-   EQ(op ,"IS")      => bfIS(left,right)
-   EQ(op ,"ISNT")    => bfNOT bfIS(left,right)
-   [op ,left,right]
- 
-bfIS(left,right)==
-    $isGenVarCounter:local :=1
-    $inDefIS :local :=true
-    bfIS1(left,right)
- 
-bfISReverse(x,a) ==
-  x is ['CONS,:.] =>
-    NULL CADDR x => ['CONS,CADR x, a]
-    y := bfISReverse(CADDR x, NIL)
-    RPLACA(CDDR y,['CONS,CADR x,a])
-    y
-  bpSpecificErrorHere '"Error in bfISReverse"
-  bpTrap()
- 
-bfIS1(lhs,rhs) ==
-  NULL rhs =>
-    ['NULL,lhs]
-  STRINGP rhs =>
-    ['EQ,lhs,['QUOTE,INTERN rhs]]
-  NUMBERP rhs =>
-    ["EQUAL",lhs,rhs]
-  ATOM rhs =>
-    ['PROGN,bfLetForm(rhs,lhs),''T]
-  rhs is ['QUOTE,a] =>
-    IDENTP a => ['EQ,lhs,rhs]
-    ["EQUAL",lhs,rhs]
-  rhs is ['L%T,c,d] =>
-    l :=
-      bfLET(c,lhs)
---    $inbfLet => bfLET1(c,lhs)
---    bfLET(c,lhs)
-    bfAND [bfIS1(lhs,d),bfMKPROGN [l,''T]]
-  rhs is ["EQUAL",a] =>
-    ["EQUAL",lhs,a]
-  CONSP lhs =>
-    g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
-    $isGenVarCounter := $isGenVarCounter + 1
-    bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)]
-  rhs is ['CONS,a,b] =>
-    a = "DOT" =>
-      NULL b =>
-        bfAND [['CONSP,lhs],
-               ['EQ,['CDR,lhs],'NIL]]
-      bfAND [['CONSP,lhs],
-             bfIS1(['CDR,lhs],b)]
-    NULL b =>
-      bfAND [['CONSP,lhs],
-             ['EQ,['CDR,lhs],'NIL],_
-             bfIS1(['CAR,lhs],a)]
-    b = "DOT" =>
-      bfAND [['CONSP,lhs],bfIS1(['CAR,lhs],a)]
-    a1 := bfIS1(['CAR,lhs],a)
-    b1 := bfIS1(['CDR,lhs],b)
-    a1 is ['PROGN,c,''T] and b1 is ['PROGN,:cls] =>
-      bfAND [['CONSP,lhs],bfMKPROGN [c,:cls]]
-    bfAND [['CONSP,lhs],a1,b1]
-  rhs is ['APPEND,a,b] =>
-    patrev := bfISReverse(b,a)
-    g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
-    $isGenVarCounter := $isGenVarCounter + 1
-    rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],''T]]
-    l2 := bfIS1(g,patrev)
-    if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
-    a = "DOT" => bfAND [rev,:l2]
-    bfAND [rev,:l2,['PROGN,bfLetForm(a,['NREVERSE,a]),''T]]
-  bpSpecificErrorHere '"bad IS code is generated"
-  bpTrap()
- 
-bfApplication(bfop, bfarg) ==
-         if bfTupleP bfarg
-         then cons(bfop,CDR bfarg)
-         else cons(bfop,[bfarg])
- 
-
-++ Token renaming.  New Boot and Old Boot differs in the set of
-++ tokens they rename.  When converting code written in Old Boot
-++ to New Boot, it is helpful to have some noise about potential
-++ divergence in semantics.  So, when compiling with --boot=old,
-++ we compute the renaming in both Old Boot and New Boot and compare
-++ the results.  If they differ, we prefer the old meaning, with some
-++ warnings.  Notice that the task is compounded by the fact the
-++ tokens in both language do not always agreee.
-++ However, to minimize the flood of false positive, we
-++ keep a list of symbols which apparently differ in meanings, but
-++ which have been verified to agree.  
-++ This is a valuable automated tool during the transition period.
-
--- return the meaning of the x in Old Boot.
-bfGetOldBootName x ==
-  a := GET(x, "OLD-BOOT") => car a
-  x
-
--- returns true if x has same meaning in both Old Boot and New Boot.
-bfSameMeaning x ==
-  GET(x, 'RENAME_-OK)
- 
--- returns the meaning of x in the appropriate Boot dialect.
-bfReName x==
-  newName :=
-    a := GET(x,"SHOERENAME") => car a
-    x
-  $translatingOldBoot and not bfSameMeaning x =>
-    oldName := bfGetOldBootName x
-    if newName ^= oldName then
-       warn [PNAME x, '" as `", PNAME newName, _
-             '"_' differs from Old Boot `", PNAME oldName, '"_'"]
-    oldName
-  newName
-
- 
-bfInfApplication(op,left,right)==
-   EQ(op,"EQUAL") => bfQ(left,right)
-   EQ(op,"/=")    => bfNOT bfQ(left,right)
-   EQ(op,">")     => bfLessp(right,left)
-   EQ(op,"<")     => bfLessp(left,right)
-   EQ(op,"<=")    => bfNOT bfLessp(right,left)
-   EQ(op,">=")    => bfNOT bfLessp(left,right)
-   EQ(op,"OR")    => bfOR [left,right]
-   EQ(op,"AND")   => bfAND [left,right]
-   [op,left,right]
- 
-bfNOT x==
-   x is ["NOT",a]=> a
-   x is ["NULL",a]=> a
-   ["NOT",x]
- 
-bfFlatten(op, x) ==
-      EQCAR(x,op) => CDR x
-      [x]
- 
-bfOR l  ==
-       null l => NIL
-       null cdr l => CAR l
-       ["OR",:[:bfFlatten("OR",c) for c in l]]
- 
-bfAND l ==
-       null l=> 'T
-       null cdr l => CAR l
-       ["AND",:[:bfFlatten("AND",c) for c in l]]
- 
- 
-defQuoteId x==  EQCAR(x,"QUOTE") and IDENTP CADR x
- 
-bfSmintable x==
-  INTEGERP x or CONSP x and
-      MEMQ(CAR x, '(SIZE LENGTH))
- 
-bfQ(l,r)==
-       if bfSmintable l or bfSmintable r
-       then  ["EQL",l,r]
-       else if defQuoteId l or defQuoteId r
-            then  ["EQ",l,r]
-            else
-              if null l
-              then ["NULL",r]
-              else if null r
-                   then ["NULL",l]
-                   else ["EQUAL",l,r]
- 
-bfLessp(l,r)==
-      if r=0
-      then ["MINUSP", l]
-      else ["<",l,r]
- 
-bfMDef (defOp,op,args,body) ==
-  argl:=if bfTupleP args then cdr args else [args]
-  [gargl,sgargl,nargl,largl]:=bfGargl argl
-  sb:=[cons(i,j) for i in nargl for j in sgargl]
-  body:= SUBLIS(sb,body)
-  sb2 := [["CONS",["QUOTE",i],j] for i in sgargl for j in largl]
-  body := ["SUBLIS",["LIST",:sb2],["QUOTE",body]]
-  lamex:= ["MLAMBDA",gargl,body]
-  def:= [op,lamex]
-  bfTuple
-     cons(shoeComp def,[:shoeComps bfDef1 d for d in $wheredefs])
- 
-bfGargl argl==
-      if null argl
-      then [[],[],[],[]]
-      else
-        [a,b,c,d]:=bfGargl cdr argl
-        if car argl="&REST"
-        then [cons(car argl,b),b,c,
-             cons(["CONS",["QUOTE","LIST"],car d],cdr d)]
-        else
-            f:=bfGenSymbol()
-            [cons(f,a),cons(f,b),cons(car argl,c),cons(f,d)]
- 
-bfDef1 [defOp,op,args,body] ==
-  argl:=if bfTupleP args then cdr args else [args]
-  [quotes,control,arglp,body]:=bfInsertLet (argl,body)
-  quotes=>shoeLAM(op,arglp,control,body)
-  [[op,["LAMBDA",arglp,body]]]
- 
-shoeLAM (op,args,control,body)==
-  margs :=bfGenSymbol()
-  innerfunc:=INTERN(CONCAT(PNAME op,",LAM"))
-  [[innerfunc,["LAMBDA",args,body]],
-     [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc],
-                    ["WRAP",margs, ["QUOTE", control]]]]]]
- 
-bfDef(defOp,op,args,body) ==
- $bfClamming =>
-          [.,op1,arg1,:body1]:=shoeComp first bfDef1 [defOp,op,args,body]
-          bfCompHash(op1,arg1,body1)
- bfTuple
-  [:shoeComps bfDef1 d for d in  cons([defOp,op,args,body],$wheredefs)]
- 
-shoeComps  x==[shoeComp def for def in x]
-shoeComp x==
-     a:=shoeCompTran CADR x
-     if EQCAR(a,"LAMBDA")
-     then ["DEFUN",CAR x,CADR a,:CDDR a]
-     else ["DEFMACRO",CAR x,CADR a,:CDDR a]
- 
-bfInsertLet(x,body)==
-   if null x
-   then [false,nil,x,body]
-   else
-      if x is ["&REST",a]
-      then if a is ["QUOTE",b]
-           then [true,"QUOTE",["&REST",b],body]
-           else [false,nil,x,body]
-      else
-       [b,norq,name1,body1]:=  bfInsertLet1 (car x,body)
-       [b1,norq1,name2,body2]:=  bfInsertLet (cdr x,body1)
-       [b or b1,cons(norq,norq1),cons(name1,name2),body2]
- 
-bfInsertLet1(y,body)==
-   if y is ["L%T",l,r]
-   then  [false,nil,l,bfMKPROGN [bfLET(r,l),body]]
-   else if IDENTP y
-        then [false,nil,y,body]
-        else
-          if y is ["BVQUOTE",b]
-          then [true,"QUOTE",b,body]
-          else
-            g:=bfGenSymbol()
-            ATOM y => [false,nil,g,body]
-            [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]]
- 
-shoeCompTran x==
-   lamtype:=CAR x
-   args   :=CADR x
-   body   :=CDDR x
-   $fluidVars:local:=nil
-   $locVars:local:=nil
-   $dollarVars:local:=nil
-   shoeCompTran1 body
-   $locVars:=SETDIFFERENCE(SETDIFFERENCE($locVars,
-                                  $fluidVars),shoeATOMs args)
-   body:=
-       if $fluidVars or $locVars or $dollarVars or $typings
-       then
-         lvars:=append($fluidVars,$locVars)
-         $fluidVars:=UNION($fluidVars,$dollarVars)
-         if null $fluidVars
-         then
-            null $typings=> shoePROG(lvars,body)
-            shoePROG(lvars,[["DECLARE",:$typings],:body])
-         else
-           fvars:=["DECLARE",["SPECIAL",:$fluidVars]]
-           null $typings => shoePROG(lvars,[fvars,:body])
-           shoePROG(lvars,[fvars,["DECLARE",:$typings],:body])
-       else shoePROG([], body)
-   fl:=shoeFluids args
-   body:=if fl
-         then
-           fvs:=["DECLARE",["SPECIAL",:fl]]
-           cons(fvs,body)
-         else body
-   [lamtype,args, :body]
-
-shoePROG(v,b)==
-    null b => [["PROG", v]]
-    [:blist,blast] := b
-    [["PROG",v,:blist,["RETURN", blast]]]
-
-shoeFluids x==
-         if null x
-         then nil
-         else if IDENTP x and bfBeginsDollar x
-              then [x]
-              else
-                if EQCAR(x,"QUOTE")
-                then []
-                else
-                  if ATOM x
-                  then nil
-                  else  append(shoeFluids car x,shoeFluids cdr x)
-shoeATOMs x==
-         if null x
-         then nil
-         else if ATOM x
-              then [x]
-              else append(shoeATOMs car x,shoeATOMs cdr x)
- 
-shoeCompTran1 x==
-    ATOM x=>
-                IDENTP x and bfBeginsDollar x=>
-                    $dollarVars:=
-                          MEMQ(x,$dollarVars)=>$dollarVars
-                          cons(x,$dollarVars)
-                nil
-    U:=car x
-    EQ(U,"QUOTE")=>nil
-    x is ["L%T",l,r]=>
-                RPLACA (x,"SETQ")
-                shoeCompTran1 r
-                IDENTP l =>
-                  not bfBeginsDollar l=>
-                    $locVars:=
-                          MEMQ(l,$locVars)=>$locVars
-                          cons(l,$locVars)
-                  $dollarVars:=
-                          MEMQ(l,$dollarVars)=>$dollarVars
-                          cons(l,$dollarVars)
-                EQCAR(l,"FLUID")=>
-                    $fluidVars:=
-                         MEMQ(CADR l,$fluidVars)=>$fluidVars
-                         cons(CADR l,$fluidVars)
-                    RPLACA (CDR x,CADR l)
-    MEMQ(U,'(PROG LAMBDA))=>
-         newbindings:=nil
-         for y in CADR x repeat
-             not MEMQ(y,$locVars)=>
-                  $locVars:=cons(y,$locVars)
-                  newbindings:=cons(y,newbindings)
-         res:=shoeCompTran1 CDDR x
-         $locVars:=[y for y in $locVars | not MEMQ(y,newbindings)]
-    shoeCompTran1 car x
-    shoeCompTran1 cdr x
- 
-bfTagged(a,b)==
-    IDENTP a =>
-         EQ(b,"FLUID") =>  bfLET(compFluid a,NIL)
-         EQ(b,"fluid") =>  bfLET(compFluid a,NIL)
-         EQ(b,"local") =>  bfLET(compFluid a,NIL)
-         $typings:=cons(["TYPE",b,a],$typings)
-         a
-    ["THE",b,a]
- 
-bfAssign(l,r)==
-   if bfTupleP l then bfSetelt(CADR l,CDDR l ,r) else bfLET(l,r)
- 
-bfSetelt(e,l,r)==
-    if null cdr l
-    then defSETELT(e,car l,r)
-    else bfSetelt(bfElt(e,car l),cdr l,r)
- 
-bfElt(expr,sel)==
-      y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
-      y=>
-         INTEGERP y => ["ELT",expr,y]
-         [y,expr]
-      ["ELT",expr,sel]
- 
-defSETELT(var,sel,expr)==
-      y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
-      y=>
-         INTEGERP y => ["SETF",["ELT",var,y],expr]
-         ["SETF",[y,var],expr]
-      ["SETF",["ELT",var,sel],expr]
- 
-bfIfThenOnly(a,b)==
-    b1:=if EQCAR (b,"PROGN") then CDR b else [b]
-    ["COND",[a,:b1]]
- 
-bfIf(a,b,c)==
-    b1:=if EQCAR (b,"PROGN") then CDR b else [b]
-    EQCAR (c,"COND") => ["COND",[a,:b1],:CDR c]
-    c1:=if EQCAR (c,"PROGN") then CDR c else [c]
-    ["COND",[a,:b1],['(QUOTE T),:c1]]
- 
-bfExit(a,b)==  ["COND",[a,["IDENTITY",b]]]
- 
-bfMKPROGN l==
-    a:=[:bfFlattenSeq c for c in tails l]
-    null a=> nil
-    null CDR a=> CAR a
-    ["PROGN",:a]
- 
-bfFlattenSeq x ==
-      null x=>NIL
-      f:=CAR x
-      ATOM f =>if CDR x then nil else [f]
-      EQCAR(f,"PROGN") =>
-              CDR x=>  [i for i in CDR f| not ATOM i]
-              CDR f
-      [f]
- 
-bfSequence l ==
-      null l=> NIL
-      transform:= [[a,b] for x in l while
-              x is ["COND",[a,["IDENTITY",b]]]]
-      no:=#transform
-      before:= bfTake(no,l)
-      aft   := bfDrop(no,l)
-      null before =>
-              null rest l =>
-                   f:=first l
-                   if EQCAR(f,"PROGN")
-                   then bfSequence CDR f
-                   else f
-              bfMKPROGN [first l,bfSequence rest l]
-      null aft => ["COND",:transform]
-      ["COND",:transform,['(QUOTE T),bfSequence aft]]
- 
-bfWhere (context,expr)==
-  [opassoc,defs,nondefs] := defSheepAndGoats context
-  a:=[[def,op,args,bfSUBLIS(opassoc,body)]
-               for d in defs  |d is [def,op,args,body]]
-  $wheredefs:=append(a,$wheredefs)
-  bfMKPROGN bfSUBLIS(opassoc,NCONC(nondefs,[expr]))
- 
---shoeReadLispString(s,n)==
---    n>= # s => nil
---    [exp,ind]:=shoeReadLisp(s,n)
---    null exp => nil
---    cons(exp,shoeReadLispString(s,ind))
- 
-bfReadLisp string==bfTuple shoeReadLispString (string,0)
-
-bfCompHash(op,argl,body) ==
-  auxfn:= INTERN CONCAT (PNAME op,'";")
-  computeFunction:= ["DEFUN",auxfn,argl,:body]
-  bfTuple [computeFunction,:bfMain(auxfn,op)]
- 
-shoeCompileTimeEvaluation x ==
-  ["EVAL-WHEN", [KEYWORD::COMPILE_-TOPLEVEL], x]
-
-shoeEVALANDFILEACTQ x==  
-  ["EVAL-WHEN", [KEYWORD::EXECUTE, KEYWORD::LOAD_-TOPLEVEL], x]
- 
-bfMain(auxfn,op)==
-  g1:= bfGenSymbol()
-  arg:=["&REST",g1]
-  computeValue := ['APPLY,["FUNCTION",auxfn],g1]
-  cacheName:= INTERN CONCAT (PNAME op,'";AL")
-  g2:= bfGenSymbol()
-  getCode:=   ['GETHASH,g1,cacheName]
-  secondPredPair:= [['SETQ,g2,getCode],g2]
-  putCode:=   ['SETF ,getCode,computeValue]
-  thirdPredPair:= ['(QUOTE T),putCode]
-  codeBody:= ['PROG,[g2],
-               ['RETURN,['COND,secondPredPair,thirdPredPair]]]
-  mainFunction:= ["DEFUN",op,arg,codeBody]
- 
-  cacheType:=     'hash_-table
-  cacheResetCode:=   ['SETQ,cacheName,['MAKE_-HASHTABLE,
-                        ["QUOTE","UEQUAL"]]]
-  cacheCountCode:= ['hashCount,cacheName]
-  cacheVector:=
-      [op,cacheName,cacheType,cacheResetCode,cacheCountCode]
-  [mainFunction,
-    shoeEVALANDFILEACTQ
-      ["SETF",["GET",
-           ["QUOTE", op],["QUOTE",'cacheInfo]],["QUOTE", cacheVector]],
-            shoeEVALANDFILEACTQ  cacheResetCode ]
- 
-bfNameOnly x==
-      if x="t"
-      then ["T"]
-      else  [x]
- 
-bfNameArgs (x,y)==
-    y:=if EQCAR(y,"TUPLE") then CDR y else [y]
-    cons(x,y)
- 
-bfStruct(name,arglist)==
-  bfTuple [bfCreateDef i for i in arglist]
- 
-bfCreateDef x==
-     if null cdr x
-     then
-       f:=car x
-       ["SETQ",f,["LIST",["QUOTE",f]]]
-     else
-       a:=[bfGenSymbol() for i in cdr x]
-       ["DEFUN",car x,a,["CONS",["QUOTE",car x],["LIST",:a]]]
- 
-bfCaseItem(x,y)==[x,y]
- 
-bfCase(x,y)==
-         g:=bfGenSymbol()
-         g1:=bfGenSymbol()
-         a:=bfLET(g,x)
-         b:=bfLET(g1,["CDR",g])
-         c:=bfCaseItems (g1,y)
-         bfMKPROGN [a,b,["CASE",["CAR", g],:c]]
- 
-bfCaseItems(g,x)==  [bfCI(g,i,j) for [i,j] in x]
- 
-bfCI(g,x,y)==
-    a:=cdr x
-    if null a
-    then [car x,y]
-    else
-       b:=[[i,bfCARCDR(j,g)] for i in a for j in 0..]
-       [car x,["LET",b,y]]
- 
-bfCARCDR (n,g)==[INTERN CONCAT ('"CA",bfDs n,'"R"),g]
- 
-bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
-
-@
-
-<<ast.clisp>>=
 (EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-ast"))
 
 (IMPORT-MODULE "includer")
@@ -1137,90 +22,99 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
 
 (DEFUN |Import| #0=(|bfVar#4|) (CONS '|Import| (LIST . #0#)))
 
-(DEFUN |TypeAlias| #0=(|bfVar#5| |bfVar#6| |bfVar#7|)
+(DEFUN |ImportSignature| #0=(|bfVar#5| |bfVar#6|)
+  (CONS '|ImportSignature| (LIST . #0#)))
+
+(DEFUN |TypeAlias| #0=(|bfVar#7| |bfVar#8| |bfVar#9|)
   (CONS '|TypeAlias| (LIST . #0#)))
 
-(DEFUN |SuffixDot| #0=(|bfVar#8|) (CONS '|SuffixDot| (LIST . #0#)))
+(DEFUN |Signature| #0=(|bfVar#10| |bfVar#11|)
+  (CONS '|Signature| (LIST . #0#)))
+
+(DEFUN |Mapping| #0=(|bfVar#12| |bfVar#13|)
+  (CONS '|Mapping| (LIST . #0#)))
 
-(DEFUN |Quote| #0=(|bfVar#9|) (CONS '|Quote| (LIST . #0#)))
+(DEFUN |SuffixDot| #0=(|bfVar#14|) (CONS '|SuffixDot| (LIST . #0#)))
 
-(DEFUN |EqualName| #0=(|bfVar#10|) (CONS '|EqualName| (LIST . #0#)))
+(DEFUN |Quote| #0=(|bfVar#15|) (CONS '|Quote| (LIST . #0#)))
 
-(DEFUN |Colon| #0=(|bfVar#11|) (CONS '|Colon| (LIST . #0#)))
+(DEFUN |EqualName| #0=(|bfVar#16|) (CONS '|EqualName| (LIST . #0#)))
 
-(DEFUN |QualifiedName| #0=(|bfVar#12| |bfVar#13|)
+(DEFUN |Colon| #0=(|bfVar#17|) (CONS '|Colon| (LIST . #0#)))
+
+(DEFUN |QualifiedName| #0=(|bfVar#18| |bfVar#19|)
   (CONS '|QualifiedName| (LIST . #0#)))
 
-(DEFUN |Bracket| #0=(|bfVar#14|) (CONS '|Bracket| (LIST . #0#)))
+(DEFUN |Bracket| #0=(|bfVar#20|) (CONS '|Bracket| (LIST . #0#)))
 
-(DEFUN |UnboundedSegment| #0=(|bfVar#15|)
+(DEFUN |UnboundedSegment| #0=(|bfVar#21|)
   (CONS '|UnboundedSegment| (LIST . #0#)))
 
-(DEFUN |BoundedSgement| #0=(|bfVar#16| |bfVar#17|)
+(DEFUN |BoundedSgement| #0=(|bfVar#22| |bfVar#23|)
   (CONS '|BoundedSgement| (LIST . #0#)))
 
-(DEFUN |Tuple| #0=(|bfVar#18|) (CONS '|Tuple| (LIST . #0#)))
+(DEFUN |Tuple| #0=(|bfVar#24|) (CONS '|Tuple| (LIST . #0#)))
 
-(DEFUN |ColonAppend| #0=(|bfVar#19| |bfVar#20|)
+(DEFUN |ColonAppend| #0=(|bfVar#25| |bfVar#26|)
   (CONS '|ColonAppend| (LIST . #0#)))
 
-(DEFUN |Is| #0=(|bfVar#21| |bfVar#22|) (CONS '|Is| (LIST . #0#)))
+(DEFUN |Is| #0=(|bfVar#27| |bfVar#28|) (CONS '|Is| (LIST . #0#)))
 
-(DEFUN |Isnt| #0=(|bfVar#23| |bfVar#24|) (CONS '|Isnt| (LIST . #0#)))
+(DEFUN |Isnt| #0=(|bfVar#29| |bfVar#30|) (CONS '|Isnt| (LIST . #0#)))
 
-(DEFUN |Reduce| #0=(|bfVar#25| |bfVar#26|)
+(DEFUN |Reduce| #0=(|bfVar#31| |bfVar#32|)
   (CONS '|Reduce| (LIST . #0#)))
 
-(DEFUN |PrefixExpr| #0=(|bfVar#27| |bfVar#28|)
+(DEFUN |PrefixExpr| #0=(|bfVar#33| |bfVar#34|)
   (CONS '|PrefixExpr| (LIST . #0#)))
 
-(DEFUN |Call| #0=(|bfVar#29| |bfVar#30|) (CONS '|Call| (LIST . #0#)))
+(DEFUN |Call| #0=(|bfVar#35| |bfVar#36|) (CONS '|Call| (LIST . #0#)))
 
-(DEFUN |InfixExpr| #0=(|bfVar#31| |bfVar#32| |bfVar#33|)
+(DEFUN |InfixExpr| #0=(|bfVar#37| |bfVar#38| |bfVar#39|)
   (CONS '|InfixExpr| (LIST . #0#)))
 
-(DEFUN |ConstantDefinition| #0=(|bfVar#34| |bfVar#35|)
+(DEFUN |ConstantDefinition| #0=(|bfVar#40| |bfVar#41|)
   (CONS '|ConstantDefinition| (LIST . #0#)))
 
-(DEFUN |Definition| #0=(|bfVar#36| |bfVar#37| |bfVar#38| |bfVar#39|)
+(DEFUN |Definition| #0=(|bfVar#42| |bfVar#43| |bfVar#44| |bfVar#45|)
   (CONS '|Definition| (LIST . #0#)))
 
-(DEFUN |Macro| #0=(|bfVar#40| |bfVar#41| |bfVar#42|)
+(DEFUN |Macro| #0=(|bfVar#46| |bfVar#47| |bfVar#48|)
   (CONS '|Macro| (LIST . #0#)))
 
-(DEFUN |SuchThat| #0=(|bfVar#43|) (CONS '|SuchThat| (LIST . #0#)))
+(DEFUN |SuchThat| #0=(|bfVar#49|) (CONS '|SuchThat| (LIST . #0#)))
 
-(DEFUN |Assignment| #0=(|bfVar#44| |bfVar#45|)
+(DEFUN |Assignment| #0=(|bfVar#50| |bfVar#51|)
   (CONS '|Assignment| (LIST . #0#)))
 
-(DEFUN |While| #0=(|bfVar#46|) (CONS '|While| (LIST . #0#)))
+(DEFUN |While| #0=(|bfVar#52|) (CONS '|While| (LIST . #0#)))
 
-(DEFUN |Until| #0=(|bfVar#47|) (CONS '|Until| (LIST . #0#)))
+(DEFUN |Until| #0=(|bfVar#53|) (CONS '|Until| (LIST . #0#)))
 
-(DEFUN |For| #0=(|bfVar#48| |bfVar#49| |bfVar#50|)
+(DEFUN |For| #0=(|bfVar#54| |bfVar#55| |bfVar#56|)
   (CONS '|For| (LIST . #0#)))
 
-(DEFUN |Exit| #0=(|bfVar#51| |bfVar#52|) (CONS '|Exit| (LIST . #0#)))
+(DEFUN |Exit| #0=(|bfVar#57| |bfVar#58|) (CONS '|Exit| (LIST . #0#)))
 
-(DEFUN |Iterators| #0=(|bfVar#53|) (CONS '|Iterators| (LIST . #0#)))
+(DEFUN |Iterators| #0=(|bfVar#59|) (CONS '|Iterators| (LIST . #0#)))
 
-(DEFUN |Cross| #0=(|bfVar#54|) (CONS '|Cross| (LIST . #0#)))
+(DEFUN |Cross| #0=(|bfVar#60|) (CONS '|Cross| (LIST . #0#)))
 
-(DEFUN |Repeat| #0=(|bfVar#55| |bfVar#56|)
+(DEFUN |Repeat| #0=(|bfVar#61| |bfVar#62|)
   (CONS '|Repeat| (LIST . #0#)))
 
-(DEFUN |Pile| #0=(|bfVar#57|) (CONS '|Pile| (LIST . #0#)))
+(DEFUN |Pile| #0=(|bfVar#63|) (CONS '|Pile| (LIST . #0#)))
 
-(DEFUN |Append| #0=(|bfVar#58|) (CONS '|Append| (LIST . #0#)))
+(DEFUN |Append| #0=(|bfVar#64|) (CONS '|Append| (LIST . #0#)))
 
-(DEFUN |Case| #0=(|bfVar#59| |bfVar#60|) (CONS '|Case| (LIST . #0#)))
+(DEFUN |Case| #0=(|bfVar#65| |bfVar#66|) (CONS '|Case| (LIST . #0#)))
 
-(DEFUN |Return| #0=(|bfVar#61|) (CONS '|Return| (LIST . #0#)))
+(DEFUN |Return| #0=(|bfVar#67|) (CONS '|Return| (LIST . #0#)))
 
-(DEFUN |Where| #0=(|bfVar#62| |bfVar#63|)
+(DEFUN |Where| #0=(|bfVar#68| |bfVar#69|)
   (CONS '|Where| (LIST . #0#)))
 
-(DEFUN |Structure| #0=(|bfVar#64| |bfVar#65|)
+(DEFUN |Structure| #0=(|bfVar#70| |bfVar#71|)
   (CONS '|Structure| (LIST . #0#)))
 
 (DEFPARAMETER |$inDefIS| NIL)
@@ -1275,14 +169,14 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
 
 (DEFUN |bfCompDef| (|x|)
   (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|
-                |bfVar#67| |bfVar#66|)
+                |bfVar#73| |bfVar#72|)
     (RETURN
       (PROGN
-        (SETQ |bfVar#66| |x|)
-        (SETQ |bfVar#67| (CDR |bfVar#66|))
-        (CASE (CAR |bfVar#66|)
+        (SETQ |bfVar#72| |x|)
+        (SETQ |bfVar#73| (CDR |bfVar#72|))
+        (CASE (CAR |bfVar#72|)
           (|ConstantDefinition|
-              (LET ((|n| (CAR |bfVar#67|)) (|e| (CADR |bfVar#67|)))
+              (LET ((|n| (CAR |bfVar#73|)) (|e| (CADR |bfVar#73|)))
                 |x|))
           (T (COND
                ((AND (CONSP |x|)
@@ -1334,22 +228,22 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
       (PROGN
         (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|))))
         (COND
-          ((LET ((|bfVar#69| NIL) (|bfVar#68| |a|) (|x| NIL))
+          ((LET ((|bfVar#75| NIL) (|bfVar#74| |a|) (|x| NIL))
              (LOOP
                (COND
-                 ((OR (ATOM |bfVar#68|)
-                      (PROGN (SETQ |x| (CAR |bfVar#68|)) NIL))
-                  (RETURN |bfVar#69|))
+                 ((OR (ATOM |bfVar#74|)
+                      (PROGN (SETQ |x| (CAR |bfVar#74|)) NIL))
+                  (RETURN |bfVar#75|))
                  ('T
                   (PROGN
-                    (SETQ |bfVar#69|
+                    (SETQ |bfVar#75|
                           (AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
                                (PROGN
                                  (SETQ |ISTMP#1| (CDR |x|))
                                  (AND (CONSP |ISTMP#1|)
                                       (EQ (CDR |ISTMP#1|) NIL)))))
-                    (COND (|bfVar#69| (RETURN |bfVar#69|))))))
-               (SETQ |bfVar#68| (CDR |bfVar#68|))))
+                    (COND (|bfVar#75| (RETURN |bfVar#75|))))))
+               (SETQ |bfVar#74| (CDR |bfVar#74|))))
            (|bfMakeCons| |a|))
           ('T (CONS 'LIST |a|)))))))
 
@@ -1519,19 +413,19 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
       (COND
         ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL))
         ('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|)))
-         (LET ((|bfVar#72| NIL) (|bfVar#70| |f|) (|i| NIL)
-               (|bfVar#71| |r|) (|j| NIL))
+         (LET ((|bfVar#78| NIL) (|bfVar#76| |f|) (|i| NIL)
+               (|bfVar#77| |r|) (|j| NIL))
            (LOOP
              (COND
-               ((OR (ATOM |bfVar#70|)
-                    (PROGN (SETQ |i| (CAR |bfVar#70|)) NIL)
-                    (ATOM |bfVar#71|)
-                    (PROGN (SETQ |j| (CAR |bfVar#71|)) NIL))
-                (RETURN (NREVERSE |bfVar#72|)))
+               ((OR (ATOM |bfVar#76|)
+                    (PROGN (SETQ |i| (CAR |bfVar#76|)) NIL)
+                    (ATOM |bfVar#77|)
+                    (PROGN (SETQ |j| (CAR |bfVar#77|)) NIL))
+                (RETURN (NREVERSE |bfVar#78|)))
                ('T
-                (SETQ |bfVar#72| (CONS (APPEND |i| |j|) |bfVar#72|))))
-             (SETQ |bfVar#70| (CDR |bfVar#70|))
-             (SETQ |bfVar#71| (CDR |bfVar#71|)))))))))
+                (SETQ |bfVar#78| (CONS (APPEND |i| |j|) |bfVar#78|))))
+             (SETQ |bfVar#76| (CDR |bfVar#76|))
+             (SETQ |bfVar#77| (CDR |bfVar#77|)))))))))
 
 (DEFUN |bfReduce| (|op| |y|)
   (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
@@ -1543,7 +437,7 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         (SETQ |init| (GET |op| 'SHOETHETA))
         (SETQ |g| (|bfGenSymbol|))
         (SETQ |g1| (|bfGenSymbol|))
-        (SETQ |body| (LIST 'SETQ |g| (LIST |op| |g1| |g|)))
+        (SETQ |body| (LIST 'SETQ |g| (LIST |op| |g| |g1|)))
         (COND
           ((NULL |init|) (SETQ |g2| (|bfGenSymbol|))
            (SETQ |init| (LIST 'CAR |g2|)) (SETQ |ny| (LIST 'CDR |g2|))
@@ -1648,25 +542,25 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         (COND
           (|vars| (SETQ |loop|
                         (LIST 'LET
-                              (LET ((|bfVar#75| NIL)
-                                    (|bfVar#73| |vars|) (|v| NIL)
-                                    (|bfVar#74| |inits|) (|i| NIL))
+                              (LET ((|bfVar#81| NIL)
+                                    (|bfVar#79| |vars|) (|v| NIL)
+                                    (|bfVar#80| |inits|) (|i| NIL))
                                 (LOOP
                                   (COND
-                                    ((OR (ATOM |bfVar#73|)
+                                    ((OR (ATOM |bfVar#79|)
                                       (PROGN
-                                        (SETQ |v| (CAR |bfVar#73|))
+                                        (SETQ |v| (CAR |bfVar#79|))
                                         NIL)
-                                      (ATOM |bfVar#74|)
+                                      (ATOM |bfVar#80|)
                                       (PROGN
-                                        (SETQ |i| (CAR |bfVar#74|))
+                                        (SETQ |i| (CAR |bfVar#80|))
                                         NIL))
-                                     (RETURN (NREVERSE |bfVar#75|)))
+                                     (RETURN (NREVERSE |bfVar#81|)))
                                     ('T
-                                     (SETQ |bfVar#75|
-                                      (CONS (LIST |v| |i|) |bfVar#75|))))
-                                  (SETQ |bfVar#73| (CDR |bfVar#73|))
-                                  (SETQ |bfVar#74| (CDR |bfVar#74|))))
+                                     (SETQ |bfVar#81|
+                                      (CONS (LIST |v| |i|) |bfVar#81|))))
+                                  (SETQ |bfVar#79| (CDR |bfVar#79|))
+                                  (SETQ |bfVar#80| (CDR |bfVar#80|))))
                               |loop|))))
         |loop|))))
 
@@ -2308,17 +1202,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         ((NULL (CDR |l|)) (CAR |l|))
         ('T
          (CONS 'OR
-               (LET ((|bfVar#77| NIL) (|bfVar#76| |l|) (|c| NIL))
+               (LET ((|bfVar#83| NIL) (|bfVar#82| |l|) (|c| NIL))
                  (LOOP
                    (COND
-                     ((OR (ATOM |bfVar#76|)
-                          (PROGN (SETQ |c| (CAR |bfVar#76|)) NIL))
-                      (RETURN (NREVERSE |bfVar#77|)))
+                     ((OR (ATOM |bfVar#82|)
+                          (PROGN (SETQ |c| (CAR |bfVar#82|)) NIL))
+                      (RETURN (NREVERSE |bfVar#83|)))
                      ('T
-                      (SETQ |bfVar#77|
+                      (SETQ |bfVar#83|
                             (APPEND (REVERSE (|bfFlatten| 'OR |c|))
-                                    |bfVar#77|))))
-                   (SETQ |bfVar#76| (CDR |bfVar#76|))))))))))
+                                    |bfVar#83|))))
+                   (SETQ |bfVar#82| (CDR |bfVar#82|))))))))))
 
 (DEFUN |bfAND| (|l|)
   (PROG ()
@@ -2328,17 +1222,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         ((NULL (CDR |l|)) (CAR |l|))
         ('T
          (CONS 'AND
-               (LET ((|bfVar#79| NIL) (|bfVar#78| |l|) (|c| NIL))
+               (LET ((|bfVar#85| NIL) (|bfVar#84| |l|) (|c| NIL))
                  (LOOP
                    (COND
-                     ((OR (ATOM |bfVar#78|)
-                          (PROGN (SETQ |c| (CAR |bfVar#78|)) NIL))
-                      (RETURN (NREVERSE |bfVar#79|)))
+                     ((OR (ATOM |bfVar#84|)
+                          (PROGN (SETQ |c| (CAR |bfVar#84|)) NIL))
+                      (RETURN (NREVERSE |bfVar#85|)))
                      ('T
-                      (SETQ |bfVar#79|
+                      (SETQ |bfVar#85|
                             (APPEND (REVERSE (|bfFlatten| 'AND |c|))
-                                    |bfVar#79|))))
-                   (SETQ |bfVar#78| (CDR |bfVar#78|))))))))))
+                                    |bfVar#85|))))
+                   (SETQ |bfVar#84| (CDR |bfVar#84|))))))))))
 
 (DEFUN |defQuoteId| (|x|)
   (PROG () (RETURN (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))))
@@ -2381,55 +1275,55 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         (SETQ |nargl| (CADDR . #0#))
         (SETQ |largl| (CADDDR . #0#))
         (SETQ |sb|
-              (LET ((|bfVar#82| NIL) (|bfVar#80| |nargl|) (|i| NIL)
-                    (|bfVar#81| |sgargl|) (|j| NIL))
+              (LET ((|bfVar#88| NIL) (|bfVar#86| |nargl|) (|i| NIL)
+                    (|bfVar#87| |sgargl|) (|j| NIL))
                 (LOOP
                   (COND
-                    ((OR (ATOM |bfVar#80|)
-                         (PROGN (SETQ |i| (CAR |bfVar#80|)) NIL)
-                         (ATOM |bfVar#81|)
-                         (PROGN (SETQ |j| (CAR |bfVar#81|)) NIL))
-                     (RETURN (NREVERSE |bfVar#82|)))
+                    ((OR (ATOM |bfVar#86|)
+                         (PROGN (SETQ |i| (CAR |bfVar#86|)) NIL)
+                         (ATOM |bfVar#87|)
+                         (PROGN (SETQ |j| (CAR |bfVar#87|)) NIL))
+                     (RETURN (NREVERSE |bfVar#88|)))
                     (#1='T
-                     (SETQ |bfVar#82| (CONS (CONS |i| |j|) |bfVar#82|))))
-                  (SETQ |bfVar#80| (CDR |bfVar#80|))
-                  (SETQ |bfVar#81| (CDR |bfVar#81|)))))
+                     (SETQ |bfVar#88| (CONS (CONS |i| |j|) |bfVar#88|))))
+                  (SETQ |bfVar#86| (CDR |bfVar#86|))
+                  (SETQ |bfVar#87| (CDR |bfVar#87|)))))
         (SETQ |body| (SUBLIS |sb| |body|))
         (SETQ |sb2|
-              (LET ((|bfVar#85| NIL) (|bfVar#83| |sgargl|) (|i| NIL)
-                    (|bfVar#84| |largl|) (|j| NIL))
+              (LET ((|bfVar#91| NIL) (|bfVar#89| |sgargl|) (|i| NIL)
+                    (|bfVar#90| |largl|) (|j| NIL))
                 (LOOP
                   (COND
-                    ((OR (ATOM |bfVar#83|)
-                         (PROGN (SETQ |i| (CAR |bfVar#83|)) NIL)
-                         (ATOM |bfVar#84|)
-                         (PROGN (SETQ |j| (CAR |bfVar#84|)) NIL))
-                     (RETURN (NREVERSE |bfVar#85|)))
+                    ((OR (ATOM |bfVar#89|)
+                         (PROGN (SETQ |i| (CAR |bfVar#89|)) NIL)
+                         (ATOM |bfVar#90|)
+                         (PROGN (SETQ |j| (CAR |bfVar#90|)) NIL))
+                     (RETURN (NREVERSE |bfVar#91|)))
                     (#1#
-                     (SETQ |bfVar#85|
+                     (SETQ |bfVar#91|
                            (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
-                                 |bfVar#85|))))
-                  (SETQ |bfVar#83| (CDR |bfVar#83|))
-                  (SETQ |bfVar#84| (CDR |bfVar#84|)))))
+                                 |bfVar#91|))))
+                  (SETQ |bfVar#89| (CDR |bfVar#89|))
+                  (SETQ |bfVar#90| (CDR |bfVar#90|)))))
         (SETQ |body|
               (LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
         (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
         (SETQ |def| (LIST |op| |lamex|))
         (|bfTuple|
             (CONS (|shoeComp| |def|)
-                  (LET ((|bfVar#87| NIL) (|bfVar#86| |$wheredefs|)
+                  (LET ((|bfVar#93| NIL) (|bfVar#92| |$wheredefs|)
                         (|d| NIL))
                     (LOOP
                       (COND
-                        ((OR (ATOM |bfVar#86|)
-                             (PROGN (SETQ |d| (CAR |bfVar#86|)) NIL))
-                         (RETURN (NREVERSE |bfVar#87|)))
+                        ((OR (ATOM |bfVar#92|)
+                             (PROGN (SETQ |d| (CAR |bfVar#92|)) NIL))
+                         (RETURN (NREVERSE |bfVar#93|)))
                         (#1#
-                         (SETQ |bfVar#87|
+                         (SETQ |bfVar#93|
                                (APPEND (REVERSE
                                         (|shoeComps| (|bfDef1| |d|)))
-                                       |bfVar#87|))))
-                      (SETQ |bfVar#86| (CDR |bfVar#86|))))))))))
+                                       |bfVar#93|))))
+                      (SETQ |bfVar#92| (CDR |bfVar#92|))))))))))
 
 (DEFUN |bfGargl| (|argl|)
   (PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -2449,13 +1343,13 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
             (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|)
                   (CONS |f| |d|)))))))))
 
-(DEFUN |bfDef1| (|bfVar#88|)
+(DEFUN |bfDef1| (|bfVar#94|)
   (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
                  |op| |defOp|)
     (RETURN
       (PROGN
-        (SETQ |defOp| (CAR |bfVar#88|))
-        (SETQ |op| (CADR . #0=(|bfVar#88|)))
+        (SETQ |defOp| (CAR |bfVar#94|))
+        (SETQ |op| (CADR . #0=(|bfVar#94|)))
         (SETQ |args| (CADDR . #0#))
         (SETQ |body| (CADDDR . #0#))
         (SETQ |argl|
@@ -2501,33 +1395,33 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
               (|bfCompHash| |op1| |arg1| |body1|)))
         ('T
          (|bfTuple|
-             (LET ((|bfVar#90| NIL)
-                   (|bfVar#89|
+             (LET ((|bfVar#96| NIL)
+                   (|bfVar#95|
                        (CONS (LIST |defOp| |op| |args| |body|)
                              |$wheredefs|))
                    (|d| NIL))
                (LOOP
                  (COND
-                   ((OR (ATOM |bfVar#89|)
-                        (PROGN (SETQ |d| (CAR |bfVar#89|)) NIL))
-                    (RETURN (NREVERSE |bfVar#90|)))
+                   ((OR (ATOM |bfVar#95|)
+                        (PROGN (SETQ |d| (CAR |bfVar#95|)) NIL))
+                    (RETURN (NREVERSE |bfVar#96|)))
                    ('T
-                    (SETQ |bfVar#90|
+                    (SETQ |bfVar#96|
                           (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|)))
-                                  |bfVar#90|))))
-                 (SETQ |bfVar#89| (CDR |bfVar#89|))))))))))
+                                  |bfVar#96|))))
+                 (SETQ |bfVar#95| (CDR |bfVar#95|))))))))))
 
 (DEFUN |shoeComps| (|x|)
   (PROG ()
     (RETURN
-      (LET ((|bfVar#92| NIL) (|bfVar#91| |x|) (|def| NIL))
+      (LET ((|bfVar#98| NIL) (|bfVar#97| |x|) (|def| NIL))
         (LOOP
           (COND
-            ((OR (ATOM |bfVar#91|)
-                 (PROGN (SETQ |def| (CAR |bfVar#91|)) NIL))
-             (RETURN (NREVERSE |bfVar#92|)))
-            ('T (SETQ |bfVar#92| (CONS (|shoeComp| |def|) |bfVar#92|))))
-          (SETQ |bfVar#91| (CDR |bfVar#91|)))))))
+            ((OR (ATOM |bfVar#97|)
+                 (PROGN (SETQ |def| (CAR |bfVar#97|)) NIL))
+             (RETURN (NREVERSE |bfVar#98|)))
+            ('T (SETQ |bfVar#98| (CONS (|shoeComp| |def|) |bfVar#98|))))
+          (SETQ |bfVar#97| (CDR |bfVar#97|)))))))
 
 (DEFUN |shoeComp| (|x|)
   (PROG (|a|)
@@ -2737,11 +1631,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
              ((MEMQ U '(PROG LAMBDA))
               (PROGN
                 (SETQ |newbindings| NIL)
-                (LET ((|bfVar#93| (CADR |x|)) (|y| NIL))
+                (LET ((|bfVar#99| (CADR |x|)) (|y| NIL))
                   (LOOP
                     (COND
-                      ((OR (ATOM |bfVar#93|)
-                           (PROGN (SETQ |y| (CAR |bfVar#93|)) NIL))
+                      ((OR (ATOM |bfVar#99|)
+                           (PROGN (SETQ |y| (CAR |bfVar#99|)) NIL))
                        (RETURN NIL))
                       (#1='T
                        (COND
@@ -2751,23 +1645,23 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
                                 (SETQ |$locVars| (CONS |y| |$locVars|))
                                 (SETQ |newbindings|
                                       (CONS |y| |newbindings|))))))))
-                    (SETQ |bfVar#93| (CDR |bfVar#93|))))
+                    (SETQ |bfVar#99| (CDR |bfVar#99|))))
                 (SETQ |res| (|shoeCompTran1| (CDDR |x|)))
                 (SETQ |$locVars|
-                      (LET ((|bfVar#95| NIL) (|bfVar#94| |$locVars|)
+                      (LET ((|bfVar#101| NIL) (|bfVar#100| |$locVars|)
                             (|y| NIL))
                         (LOOP
                           (COND
-                            ((OR (ATOM |bfVar#94|)
+                            ((OR (ATOM |bfVar#100|)
                                  (PROGN
-                                   (SETQ |y| (CAR |bfVar#94|))
+                                   (SETQ |y| (CAR |bfVar#100|))
                                    NIL))
-                             (RETURN (NREVERSE |bfVar#95|)))
+                             (RETURN (NREVERSE |bfVar#101|)))
                             (#1#
                              (AND (NULL (MEMQ |y| |newbindings|))
-                                  (SETQ |bfVar#95|
-                                        (CONS |y| |bfVar#95|)))))
-                          (SETQ |bfVar#94| (CDR |bfVar#94|)))))))
+                                  (SETQ |bfVar#101|
+                                        (CONS |y| |bfVar#101|)))))
+                          (SETQ |bfVar#100| (CDR |bfVar#100|)))))))
              (#0#
               (PROGN
                 (|shoeCompTran1| (CAR |x|))
@@ -2859,14 +1753,14 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
     (RETURN
       (PROGN
         (SETQ |a|
-              (LET ((|bfVar#96| NIL) (|c| |l|))
+              (LET ((|bfVar#102| NIL) (|c| |l|))
                 (LOOP
                   (COND
-                    ((ATOM |c|) (RETURN (NREVERSE |bfVar#96|)))
+                    ((ATOM |c|) (RETURN (NREVERSE |bfVar#102|)))
                     ('T
-                     (SETQ |bfVar#96|
+                     (SETQ |bfVar#102|
                            (APPEND (REVERSE (|bfFlattenSeq| |c|))
-                                   |bfVar#96|))))
+                                   |bfVar#102|))))
                   (SETQ |c| (CDR |c|)))))
         (COND
           ((NULL |a|) NIL)
@@ -2886,17 +1780,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
              ((EQCAR |f| 'PROGN)
               (COND
                 ((CDR |x|)
-                 (LET ((|bfVar#98| NIL) (|bfVar#97| (CDR |f|))
+                 (LET ((|bfVar#104| NIL) (|bfVar#103| (CDR |f|))
                        (|i| NIL))
                    (LOOP
                      (COND
-                       ((OR (ATOM |bfVar#97|)
-                            (PROGN (SETQ |i| (CAR |bfVar#97|)) NIL))
-                        (RETURN (NREVERSE |bfVar#98|)))
+                       ((OR (ATOM |bfVar#103|)
+                            (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL))
+                        (RETURN (NREVERSE |bfVar#104|)))
                        ('T
                         (AND (NULL (ATOM |i|))
-                             (SETQ |bfVar#98| (CONS |i| |bfVar#98|)))))
-                     (SETQ |bfVar#97| (CDR |bfVar#97|)))))
+                             (SETQ |bfVar#104| (CONS |i| |bfVar#104|)))))
+                     (SETQ |bfVar#103| (CDR |bfVar#103|)))))
                 (#0# (CDR |f|))))
              (#0# (LIST |f|)))))))))
 
@@ -2909,11 +1803,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         (#0='T
          (PROGN
            (SETQ |transform|
-                 (LET ((|bfVar#100| NIL) (|bfVar#99| |l|) (|x| NIL))
+                 (LET ((|bfVar#106| NIL) (|bfVar#105| |l|) (|x| NIL))
                    (LOOP
                      (COND
-                       ((OR (ATOM |bfVar#99|)
-                            (PROGN (SETQ |x| (CAR |bfVar#99|)) NIL)
+                       ((OR (ATOM |bfVar#105|)
+                            (PROGN (SETQ |x| (CAR |bfVar#105|)) NIL)
                             (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
                                       (PROGN
                                         (SETQ |ISTMP#1| (CDR |x|))
@@ -2948,11 +1842,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
                                                        (SETQ |b|
                                                         (CAR |ISTMP#5|))
                                                        'T))))))))))))))
-                        (RETURN (NREVERSE |bfVar#100|)))
+                        (RETURN (NREVERSE |bfVar#106|)))
                        ('T
-                        (SETQ |bfVar#100|
-                              (CONS (LIST |a| |b|) |bfVar#100|))))
-                     (SETQ |bfVar#99| (CDR |bfVar#99|)))))
+                        (SETQ |bfVar#106|
+                              (CONS (LIST |a| |b|) |bfVar#106|))))
+                     (SETQ |bfVar#105| (CDR |bfVar#105|)))))
            (SETQ |no| (LENGTH |transform|))
            (SETQ |before| (|bfTake| |no| |l|))
            (SETQ |aft| (|bfDrop| |no| |l|))
@@ -2985,12 +1879,12 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
         (SETQ |defs| (CADR . #0=(|LETTMP#1|)))
         (SETQ |nondefs| (CADDR . #0#))
         (SETQ |a|
-              (LET ((|bfVar#102| NIL) (|bfVar#101| |defs|) (|d| NIL))
+              (LET ((|bfVar#108| NIL) (|bfVar#107| |defs|) (|d| NIL))
                 (LOOP
                   (COND
-                    ((OR (ATOM |bfVar#101|)
-                         (PROGN (SETQ |d| (CAR |bfVar#101|)) NIL))
-                     (RETURN (NREVERSE |bfVar#102|)))
+                    ((OR (ATOM |bfVar#107|)
+                         (PROGN (SETQ |d| (CAR |bfVar#107|)) NIL))
+                     (RETURN (NREVERSE |bfVar#108|)))
                     ('T
                      (AND (CONSP |d|)
                           (PROGN
@@ -3009,11 +1903,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
                                        (PROGN
                                          (SETQ |body| (CAR |ISTMP#3|))
                                          'T)))))))
-                          (SETQ |bfVar#102|
+                          (SETQ |bfVar#108|
                                 (CONS (LIST |def| |op| |args|
                                        (|bfSUBLIS| |opassoc| |body|))
-                                      |bfVar#102|)))))
-                  (SETQ |bfVar#101| (CDR |bfVar#101|)))))
+                                      |bfVar#108|)))))
+                  (SETQ |bfVar#107| (CDR |bfVar#107|)))))
         (SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
         (|bfMKPROGN|
             (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
@@ -3090,16 +1984,16 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
   (PROG ()
     (RETURN
       (|bfTuple|
-          (LET ((|bfVar#104| NIL) (|bfVar#103| |arglist|) (|i| NIL))
+          (LET ((|bfVar#110| NIL) (|bfVar#109| |arglist|) (|i| NIL))
             (LOOP
               (COND
-                ((OR (ATOM |bfVar#103|)
-                     (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL))
-                 (RETURN (NREVERSE |bfVar#104|)))
+                ((OR (ATOM |bfVar#109|)
+                     (PROGN (SETQ |i| (CAR |bfVar#109|)) NIL))
+                 (RETURN (NREVERSE |bfVar#110|)))
                 ('T
-                 (SETQ |bfVar#104|
-                       (CONS (|bfCreateDef| |i|) |bfVar#104|))))
-              (SETQ |bfVar#103| (CDR |bfVar#103|))))))))
+                 (SETQ |bfVar#110|
+                       (CONS (|bfCreateDef| |i|) |bfVar#110|))))
+              (SETQ |bfVar#109| (CDR |bfVar#109|))))))))
 
 (DEFUN |bfCreateDef| (|x|)
   (PROG (|a| |f|)
@@ -3109,17 +2003,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
          (LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|))))
         ('T
          (SETQ |a|
-               (LET ((|bfVar#106| NIL) (|bfVar#105| (CDR |x|))
+               (LET ((|bfVar#112| NIL) (|bfVar#111| (CDR |x|))
                      (|i| NIL))
                  (LOOP
                    (COND
-                     ((OR (ATOM |bfVar#105|)
-                          (PROGN (SETQ |i| (CAR |bfVar#105|)) NIL))
-                      (RETURN (NREVERSE |bfVar#106|)))
+                     ((OR (ATOM |bfVar#111|)
+                          (PROGN (SETQ |i| (CAR |bfVar#111|)) NIL))
+                      (RETURN (NREVERSE |bfVar#112|)))
                      ('T
-                      (SETQ |bfVar#106|
-                            (CONS (|bfGenSymbol|) |bfVar#106|))))
-                   (SETQ |bfVar#105| (CDR |bfVar#105|)))))
+                      (SETQ |bfVar#112|
+                            (CONS (|bfGenSymbol|) |bfVar#112|))))
+                   (SETQ |bfVar#111| (CDR |bfVar#111|)))))
          (LIST 'DEFUN (CAR |x|) |a|
                (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
 
@@ -3140,22 +2034,22 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
 (DEFUN |bfCaseItems| (|g| |x|)
   (PROG (|j| |ISTMP#1| |i|)
     (RETURN
-      (LET ((|bfVar#109| NIL) (|bfVar#108| |x|) (|bfVar#107| NIL))
+      (LET ((|bfVar#115| NIL) (|bfVar#114| |x|) (|bfVar#113| NIL))
         (LOOP
           (COND
-            ((OR (ATOM |bfVar#108|)
-                 (PROGN (SETQ |bfVar#107| (CAR |bfVar#108|)) NIL))
-             (RETURN (NREVERSE |bfVar#109|)))
+            ((OR (ATOM |bfVar#114|)
+                 (PROGN (SETQ |bfVar#113| (CAR |bfVar#114|)) NIL))
+             (RETURN (NREVERSE |bfVar#115|)))
             ('T
-             (AND (CONSP |bfVar#107|)
+             (AND (CONSP |bfVar#113|)
                   (PROGN
-                    (SETQ |i| (CAR |bfVar#107|))
-                    (SETQ |ISTMP#1| (CDR |bfVar#107|))
+                    (SETQ |i| (CAR |bfVar#113|))
+                    (SETQ |ISTMP#1| (CDR |bfVar#113|))
                     (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
                          (PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
-                  (SETQ |bfVar#109|
-                        (CONS (|bfCI| |g| |i| |j|) |bfVar#109|)))))
-          (SETQ |bfVar#108| (CDR |bfVar#108|)))))))
+                  (SETQ |bfVar#115|
+                        (CONS (|bfCI| |g| |i| |j|) |bfVar#115|)))))
+          (SETQ |bfVar#114| (CDR |bfVar#114|)))))))
 
 (DEFUN |bfCI| (|g| |x| |y|)
   (PROG (|b| |a|)
@@ -3166,18 +2060,18 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
           ((NULL |a|) (LIST (CAR |x|) |y|))
           ('T
            (SETQ |b|
-                 (LET ((|bfVar#111| NIL) (|bfVar#110| |a|) (|i| NIL)
+                 (LET ((|bfVar#117| NIL) (|bfVar#116| |a|) (|i| NIL)
                        (|j| 0))
                    (LOOP
                      (COND
-                       ((OR (ATOM |bfVar#110|)
-                            (PROGN (SETQ |i| (CAR |bfVar#110|)) NIL))
-                        (RETURN (NREVERSE |bfVar#111|)))
+                       ((OR (ATOM |bfVar#116|)
+                            (PROGN (SETQ |i| (CAR |bfVar#116|)) NIL))
+                        (RETURN (NREVERSE |bfVar#117|)))
                        ('T
-                        (SETQ |bfVar#111|
+                        (SETQ |bfVar#117|
                               (CONS (LIST |i| (|bfCARCDR| |j| |g|))
-                                    |bfVar#111|))))
-                     (SETQ |bfVar#110| (CDR |bfVar#110|))
+                                    |bfVar#117|))))
+                     (SETQ |bfVar#116| (CDR |bfVar#116|))
                      (SETQ |j| (+ |j| 1)))))
            (LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
 
@@ -3190,6 +2084,3 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
     (RETURN
       (COND ((EQL |n| 0) "") ('T (CONCAT "D" (|bfDs| (- |n| 1))))))))
 
-@
-
-\end{document}
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
new file mode 100644
index 00000000..a2324315
--- /dev/null
+++ b/src/boot/strap/includer.clisp
@@ -0,0 +1,553 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-includer"))
+
+(IMPORT-MODULE "tokens")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFUN PNAME (|x|)
+  (PROG ()
+    (RETURN
+      (COND
+        ((SYMBOLP |x|) (SYMBOL-NAME |x|))
+        ((CHARACTERP |x|) (STRING |x|))
+        ('T NIL)))))
+
+(DEFUN |char| (|x|) (PROG () (RETURN (CHAR (PNAME |x|) 0))))
+
+(DEFUN EQCAR (|x| |y|)
+  (PROG () (RETURN (AND (CONSP |x|) (EQ (CAR |x|) |y|)))))
+
+(DEFUN STRINGIMAGE (|x|) (PROG () (RETURN (WRITE-TO-STRING |x|))))
+
+(DEFUN |shoeCLOSE| (|stream|) (PROG () (RETURN (CLOSE |stream|))))
+
+(DEFUN |shoeNotFound| (|fn|)
+  (PROG ()
+    (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
+
+(DEFUN |shoeReadLispString| (|s| |n|)
+  (PROG (|l|)
+    (RETURN
+      (PROGN
+        (SETQ |l| (LENGTH |s|))
+        (COND
+          ((NOT (< |n| |l|)) NIL)
+          ('T
+           (READ-FROM-STRING
+               (CONCAT '|(| (SUBSTRING |s| |n| (- |l| |n|)) '|)|))))))))
+
+(DEFUN |shoeReadLine| (|stream|)
+  (PROG () (RETURN (READ-LINE |stream| NIL NIL))))
+
+(DEFUN |shoeConsole| (|line|)
+  (PROG () (RETURN (WRITE-LINE |line| *TERMINAL-IO*))))
+
+(DEFUN |shoeSpaces| (|n|) (PROG () (RETURN (MAKE-FULL-CVEC |n| "."))))
+
+(DEFUN |SoftShoeError| (|posn| |key|)
+  (PROG ()
+    (RETURN
+      (PROGN
+        (|coreError| (LIST "in line " (STRINGIMAGE (|lineNo| |posn|))))
+        (|shoeConsole| (|lineString| |posn|))
+        (|shoeConsole|
+            (CONCAT (|shoeSpaces| (|lineCharacter| |posn|)) "|"))
+        (|shoeConsole| |key|)))))
+
+(DEFUN |bpSpecificErrorAtToken| (|tok| |key|)
+  (PROG (|a|)
+    (RETURN
+      (PROGN
+        (SETQ |a| (|shoeTokPosn| |tok|))
+        (|SoftShoeError| |a| |key|)))))
+
+(DEFUN |bpSpecificErrorHere| (|key|)
+  (PROG ()
+    (DECLARE (SPECIAL |$stok|))
+    (RETURN (|bpSpecificErrorAtToken| |$stok| |key|))))
+
+(DEFUN |bpGeneralErrorHere| ()
+  (PROG () (RETURN (|bpSpecificErrorHere| "syntax error"))))
+
+(DEFUN |bpIgnoredFromTo| (|pos1| |pos2|)
+  (PROG ()
+    (RETURN
+      (PROGN
+        (|shoeConsole|
+            (CONCAT "ignored from line "
+                    (STRINGIMAGE (|lineNo| |pos1|))))
+        (|shoeConsole| (|lineString| |pos1|))
+        (|shoeConsole|
+            (CONCAT (|shoeSpaces| (|lineCharacter| |pos1|)) "|"))
+        (|shoeConsole|
+            (CONCAT "ignored through line "
+                    (STRINGIMAGE (|lineNo| |pos2|))))
+        (|shoeConsole| (|lineString| |pos2|))
+        (|shoeConsole|
+            (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|"))))))
+
+(DEFUN |lineNo| (|p|) (PROG () (RETURN (CDAAR |p|))))
+
+(DEFUN |lineString| (|p|) (PROG () (RETURN (CAAAR |p|))))
+
+(DEFUN |lineCharacter| (|p|) (PROG () (RETURN (CDR |p|))))
+
+(DEFUN |shoePackageStartsAt| (|lines| |sz| |name| |stream|)
+  (PROG (|a|)
+    (RETURN
+      (COND
+        ((|bStreamNull| |stream|) (LIST NIL (LIST '|nullstream|)))
+        ('T
+         (PROGN
+           (SETQ |a| (CAAR |stream|))
+           (COND
+             ((AND (NOT (< (LENGTH |a|) 8))
+                   (EQUAL (SUBSTRING |a| 0 8) ")package"))
+              (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|)
+                  |sz| |name| (CDR |stream|)))
+             ((< (LENGTH |a|) |sz|)
+              (|shoePackageStartsAt| |lines| |sz| |name|
+                  (CDR |stream|)))
+             ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
+                   (< |sz| (LENGTH |a|))
+                   (NULL (|shoeIdChar| (ELT |a| |sz|))))
+              (LIST |lines| |stream|))
+             ('T
+              (|shoePackageStartsAt| |lines| |sz| |name|
+                  (CDR |stream|))))))))))
+
+(DEFUN |shoeFindLines| (|fn| |name| |a|)
+  (PROG (|b| |lines| |LETTMP#1|)
+    (RETURN
+      (COND
+        ((NULL |a|) (|shoeNotFound| |fn|) NIL)
+        (#0='T
+         (SETQ |LETTMP#1|
+               (|shoePackageStartsAt| NIL (LENGTH |name|) |name|
+                   (|shoeInclude|
+                       (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0)))))
+         (SETQ |lines| (CAR |LETTMP#1|)) (SETQ |b| (CADR |LETTMP#1|))
+         (SETQ |b| (|shoeTransform2| |b|))
+         (COND
+           ((|bStreamNull| |b|)
+            (|shoeConsole| (CONCAT |name| " not found in " |fn|)) NIL)
+           (#0#
+            (COND
+              ((NULL |lines|) (|shoeConsole| ")package not found")))
+            (APPEND (REVERSE |lines|) (CAR |b|)))))))))
+
+(DEFPARAMETER |$bStreamNil| (LIST '|nullstream|))
+
+(DEFUN |bStreamNull| (|x|)
+  (PROG (|st|)
+    (RETURN
+      (COND
+        ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
+        ('T
+         (PROGN
+           (LOOP
+             (COND
+               ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
+               ('T
+                (PROGN
+                  (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
+                  (RPLACA |x| (CAR |st|))
+                  (RPLACD |x| (CDR |st|))))))
+           (EQCAR |x| '|nullstream|)))))))
+
+(DEFUN |bMap| (|f| |x|)
+  (PROG () (RETURN (|bDelay| #'|bMap1| (LIST |f| |x|)))))
+
+(DEFUN |bMap1| (&REST |z|)
+  (PROG (|x| |f|)
+    (DECLARE (SPECIAL |$bStreamNil|))
+    (RETURN
+      (PROGN
+        (SETQ |f| (CAR |z|))
+        (SETQ |x| (CADR |z|))
+        (COND
+          ((|bStreamNull| |x|) |$bStreamNil|)
+          ('T (CONS (FUNCALL |f| (CAR |x|)) (|bMap| |f| (CDR |x|)))))))))
+
+(DEFUN |shoeFileMap| (|f| |fn|)
+  (PROG (|a|)
+    (DECLARE (SPECIAL |$bStreamNil|))
+    (RETURN
+      (PROGN
+        (SETQ |a| (|shoeInputFile| |fn|))
+        (COND
+          ((NULL |a|)
+           (PROGN
+             (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
+             |$bStreamNil|))
+          ('T
+           (PROGN
+             (|shoeConsole| (CONCAT "READING " |fn|))
+             (|shoeInclude|
+                 (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
+                     (|bIgen| 0))))))))))
+
+(DEFUN |bDelay| (|f| |x|)
+  (PROG () (RETURN (CONS '|nonnullstream| (CONS |f| |x|)))))
+
+(DEFUN |bAppend| (|x| |y|)
+  (PROG () (RETURN (|bDelay| #'|bAppend1| (LIST |x| |y|)))))
+
+(DEFUN |bAppend1| (&REST |z|)
+  (PROG ()
+    (RETURN
+      (COND
+        ((|bStreamNull| (CAR |z|))
+         (COND
+           ((|bStreamNull| (CADR |z|)) (LIST '|nullstream|))
+           (#0='T (CADR |z|))))
+        (#0# (CONS (CAAR |z|) (|bAppend| (CDAR |z|) (CADR |z|))))))))
+
+(DEFUN |bNext| (|f| |s|)
+  (PROG () (RETURN (|bDelay| #'|bNext1| (LIST |f| |s|)))))
+
+(DEFUN |bNext1| (|f| |s|)
+  (PROG (|h|)
+    (RETURN
+      (COND
+        ((|bStreamNull| |s|) (LIST '|nullstream|))
+        ('T
+         (PROGN
+           (SETQ |h| (APPLY |f| (LIST |s|)))
+           (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|)))))))))
+
+(DEFUN |bRgen| (|s|)
+  (PROG () (RETURN (|bDelay| #'|bRgen1| (LIST |s|)))))
+
+(DEFUN |bRgen1| (&REST |s|)
+  (PROG (|a|)
+    (RETURN
+      (PROGN
+        (SETQ |a| (|shoeReadLine| (CAR |s|)))
+        (COND
+          ((|shoePLACEP| |a|) (LIST '|nullstream|))
+          ('T (CONS |a| (|bRgen| (CAR |s|)))))))))
+
+(DEFUN |bIgen| (|n|)
+  (PROG () (RETURN (|bDelay| #'|bIgen1| (LIST |n|)))))
+
+(DEFUN |bIgen1| (&REST |n|)
+  (PROG ()
+    (RETURN
+      (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|))))))
+
+(DEFUN |bAddLineNumber| (|f1| |f2|)
+  (PROG () (RETURN (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|)))))
+
+(DEFUN |bAddLineNumber1| (&REST |f|)
+  (PROG (|f2| |f1|)
+    (RETURN
+      (PROGN
+        (SETQ |f1| (CAR |f|))
+        (SETQ |f2| (CADR |f|))
+        (COND
+          ((|bStreamNull| |f1|) (LIST '|nullstream|))
+          ((|bStreamNull| |f2|) (LIST '|nullstream|))
+          ('T
+           (CONS (CONS (CAR |f1|) (CAR |f2|))
+                 (|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))))))
+
+(DEFUN |shoeFileInput| (|fn|)
+  (PROG () (RETURN (|shoeFileMap| #'IDENTITY |fn|))))
+
+(DEFUN |shoePrefixLisp| (|x|) (PROG () (RETURN (CONCAT ")lisp" |x|))))
+
+(DEFUN |shoeLispFileInput| (|fn|)
+  (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLisp| |fn|))))
+
+(DEFUN |shoePrefixLine| (|x|) (PROG () (RETURN (CONCAT ")line" |x|))))
+
+(DEFUN |shoeLineFileInput| (|fn|)
+  (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLine| |fn|))))
+
+(DEFUN |shoePrefix?| (|prefix| |whole|)
+  (PROG (|good|)
+    (RETURN
+      (COND
+        ((< (LENGTH |whole|) (LENGTH |prefix|)) NIL)
+        ('T
+         (PROGN
+           (SETQ |good| T)
+           (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
+             (LOOP
+               (COND
+                 ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
+                 ('T
+                  (SETQ |good|
+                        (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
+               (SETQ |i| (+ |i| 1))
+               (SETQ |j| (+ |j| 1))))
+           (COND
+             (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
+             ('T |good|))))))))
+
+(DEFUN |shoePlainLine?| (|s|)
+  (PROG ()
+    (RETURN
+      (COND
+        ((EQL (LENGTH |s|) 0) T)
+        ('T (NOT (EQUAL (ELT |s| 0) (|char| '|)|))))))))
+
+(DEFUN |shoeSay?| (|s|) (PROG () (RETURN (|shoePrefix?| ")say" |s|))))
+
+(DEFUN |shoeEval?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")eval" |s|))))
+
+(DEFUN |shoeInclude?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")include" |s|))))
+
+(DEFUN |shoeFin?| (|s|) (PROG () (RETURN (|shoePrefix?| ")fin" |s|))))
+
+(DEFUN |shoeIf?| (|s|) (PROG () (RETURN (|shoePrefix?| ")if" |s|))))
+
+(DEFUN |shoeEndIf?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")endif" |s|))))
+
+(DEFUN |shoeElse?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")else" |s|))))
+
+(DEFUN |shoeElseIf?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")elseif" |s|))))
+
+(DEFUN |shoePackage?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")package" |s|))))
+
+(DEFUN |shoeLisp?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")lisp" |s|))))
+
+(DEFUN |shoeIncludeLisp?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")includelisp" |s|))))
+
+(DEFUN |shoeLine?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")line" |s|))))
+
+(DEFUN |shoeIncludeLines?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")includelines" |s|))))
+
+(DEFUN |shoeIncludeFunction?| (|s|)
+  (PROG () (RETURN (|shoePrefix?| ")includefunction" |s|))))
+
+(DEFUN |shoeBiteOff| (|x|)
+  (PROG (|n1| |n|)
+    (RETURN
+      (PROGN
+        (SETQ |n| (STRPOSL " " |x| 0 T))
+        (COND
+          ((NULL |n|) NIL)
+          (#0='T
+           (PROGN
+             (SETQ |n1| (STRPOSL " " |x| |n| NIL))
+             (COND
+               ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
+               (#0#
+                (LIST (SUBSTRING |x| |n| (- |n1| |n|))
+                      (SUBSTRING |x| |n1| NIL)))))))))))
+
+(DEFUN |shoeFileName| (|x|)
+  (PROG (|c| |a|)
+    (RETURN
+      (PROGN
+        (SETQ |a| (|shoeBiteOff| |x|))
+        (COND
+          ((NULL |a|) "")
+          (#0='T
+           (PROGN
+             (SETQ |c| (|shoeBiteOff| (CADR |a|)))
+             (COND
+               ((NULL |c|) (CAR |a|))
+               (#0# (CONCAT (CAR |a|) "." (CAR |c|)))))))))))
+
+(DEFUN |shoeFnFileName| (|x|)
+  (PROG (|c| |a|)
+    (RETURN
+      (PROGN
+        (SETQ |a| (|shoeBiteOff| |x|))
+        (COND
+          ((NULL |a|) (LIST "" ""))
+          (#0='T
+           (PROGN
+             (SETQ |c| (|shoeFileName| (CADR |a|)))
+             (COND
+               ((NULL |c|) (LIST (CAR |a|) ""))
+               (#0# (LIST (CAR |a|) |c|))))))))))
+
+(DEFUN |shoeFunctionFileInput| (|bfVar#2|)
+  (PROG (|fn| |fun|)
+    (RETURN
+      (PROGN
+        (SETQ |fun| (CAR |bfVar#2|))
+        (SETQ |fn| (CADR |bfVar#2|))
+        (|shoeOpenInputFile| |a| |fn|
+            (|shoeInclude|
+                (|bAddLineNumber| (|shoeFindLines| |fn| |fun| |a|)
+                    (|bIgen| 0))))))))
+
+(DEFUN |shoeInclude| (|s|)
+  (PROG () (RETURN (|bDelay| #'|shoeInclude1| (LIST |s|)))))
+
+(DEFUN |shoeInclude1| (|s|)
+  (PROG (|command| |string| |t| |h|)
+    (DECLARE (SPECIAL |$bStreamNil|))
+    (RETURN
+      (COND
+        ((|bStreamNull| |s|) |s|)
+        (#0='T
+         (PROGN
+           (SETQ |h| (CAR |s|))
+           (SETQ |t| (CDR |s|))
+           (SETQ |string| (CAR |h|))
+           (COND
+             ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
+             ((SETQ |command| (|shoeIf?| |string|))
+              (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
+             (#0#
+              (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|))))))))))
+
+(DEFUN |shoeSimpleLine| (|h|)
+  (PROG (|command| |string|)
+    (RETURN
+      (PROGN
+        (SETQ |string| (CAR |h|))
+        (COND
+          ((|shoePlainLine?| |string|) (LIST |h|))
+          ((SETQ |command| (|shoeLisp?| |string|)) (LIST |h|))
+          ((SETQ |command| (|shoeIncludeLisp?| |string|))
+           (|shoeLispFileInput| (|shoeFileName| |command|)))
+          ((SETQ |command| (|shoeIncludeFunction?| |string|))
+           (|shoeFunctionFileInput| (|shoeFnFileName| |command|)))
+          ((SETQ |command| (|shoeLine?| |string|)) (LIST |h|))
+          ((SETQ |command| (|shoeIncludeLines?| |string|))
+           (|shoeLineFileInput| (|shoeFileName| |command|)))
+          ((SETQ |command| (|shoeInclude?| |string|))
+           (|shoeFileInput| (|shoeFileName| |command|)))
+          ((SETQ |command| (|shoePackage?| |string|)) (LIST |h|))
+          ((SETQ |command| (|shoeSay?| |string|))
+           (PROGN (|shoeConsole| |command|) NIL))
+          ((SETQ |command| (|shoeEval?| |string|))
+           (PROGN (STTOMC |command|) NIL))
+          ('T (PROGN (|shoeLineSyntaxError| |h|) NIL)))))))
+
+(DEFUN |shoeThen| (|keep| |b| |s|)
+  (PROG () (RETURN (|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))))
+
+(DEFUN |shoeThen1| (|keep| |b| |s|)
+  (PROG (|b1| |keep1| |command| |string| |t| |h|)
+    (RETURN
+      (COND
+        ((|bPremStreamNull| |s|) |s|)
+        (#0='T
+         (PROGN
+           (SETQ |h| (CAR |s|))
+           (SETQ |t| (CDR |s|))
+           (SETQ |string| (CAR |h|))
+           (COND
+             ((SETQ |command| (|shoeFin?| |string|))
+              (|bPremStreamNil| |h|))
+             (#0#
+              (PROGN
+                (SETQ |keep1| (CAR |keep|))
+                (SETQ |b1| (CAR |b|))
+                (COND
+                  ((SETQ |command| (|shoeIf?| |string|))
+                   (COND
+                     ((AND |keep1| |b1|)
+                      (|shoeThen| (CONS T |keep|)
+                          (CONS (STTOMC |command|) |b|) |t|))
+                     (#0#
+                      (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+                  ((SETQ |command| (|shoeElseIf?| |string|))
+                   (COND
+                     ((AND |keep1| (NULL |b1|))
+                      (|shoeThen| (CONS T (CDR |keep|))
+                          (CONS (STTOMC |command|) (CDR |b|)) |t|))
+                     (#0#
+                      (|shoeThen| (CONS NIL (CDR |keep|))
+                          (CONS NIL (CDR |b|)) |t|))))
+                  ((SETQ |command| (|shoeElse?| |string|))
+                   (COND
+                     ((AND |keep1| (NULL |b1|))
+                      (|shoeElse| (CONS T (CDR |keep|))
+                          (CONS T (CDR |b|)) |t|))
+                     (#0#
+                      (|shoeElse| (CONS NIL (CDR |keep|))
+                          (CONS NIL (CDR |b|)) |t|))))
+                  ((SETQ |command| (|shoeEndIf?| |string|))
+                   (COND
+                     ((NULL (CDR |b|)) (|shoeInclude| |t|))
+                     (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+                  ((AND |keep1| |b1|)
+                   (|bAppend| (|shoeSimpleLine| |h|)
+                       (|shoeThen| |keep| |b| |t|)))
+                  (#0# (|shoeThen| |keep| |b| |t|))))))))))))
+
+(DEFUN |shoeElse| (|keep| |b| |s|)
+  (PROG () (RETURN (|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))))
+
+(DEFUN |shoeElse1| (|keep| |b| |s|)
+  (PROG (|keep1| |b1| |command| |string| |t| |h|)
+    (RETURN
+      (COND
+        ((|bPremStreamNull| |s|) |s|)
+        (#0='T
+         (PROGN
+           (SETQ |h| (CAR |s|))
+           (SETQ |t| (CDR |s|))
+           (SETQ |string| (CAR |h|))
+           (COND
+             ((SETQ |command| (|shoeFin?| |string|))
+              (|bPremStreamNil| |h|))
+             (#0#
+              (PROGN
+                (SETQ |b1| (CAR |b|))
+                (SETQ |keep1| (CAR |keep|))
+                (COND
+                  ((SETQ |command| (|shoeIf?| |string|))
+                   (COND
+                     ((AND |keep1| |b1|)
+                      (|shoeThen| (CONS T |keep|)
+                          (CONS (STTOMC |command|) |b|) |t|))
+                     (#0#
+                      (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+                  ((SETQ |command| (|shoeEndIf?| |string|))
+                   (COND
+                     ((NULL (CDR |b|)) (|shoeInclude| |t|))
+                     (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+                  ((AND |keep1| |b1|)
+                   (|bAppend| (|shoeSimpleLine| |h|)
+                       (|shoeElse| |keep| |b| |t|)))
+                  (#0# (|shoeElse| |keep| |b| |t|))))))))))))
+
+(DEFUN |shoeLineSyntaxError| (|h|)
+  (PROG ()
+    (RETURN
+      (PROGN
+        (|shoeConsole|
+            (CONCAT "INCLUSION SYNTAX ERROR IN LINE "
+                    (STRINGIMAGE (CDR |h|))))
+        (|shoeConsole| (CAR |h|))
+        (|shoeConsole| "LINE IGNORED")))))
+
+(DEFUN |bPremStreamNil| (|h|)
+  (PROG ()
+    (DECLARE (SPECIAL |$bStreamNil|))
+    (RETURN
+      (PROGN
+        (|shoeConsole|
+            (CONCAT "UNEXPECTED )fin IN LINE " (STRINGIMAGE (CDR |h|))))
+        (|shoeConsole| (CAR |h|))
+        (|shoeConsole| "REST OF FILE IGNORED")
+        |$bStreamNil|))))
+
+(DEFUN |bPremStreamNull| (|s|)
+  (PROG ()
+    (RETURN
+      (COND
+        ((|bStreamNull| |s|)
+         (|shoeConsole| "FILE TERMINATED BEFORE )endif") T)
+        ('T NIL)))))
+
diff --git a/src/boot/parser.boot.pamphlet b/src/boot/strap/parser.clisp
index 2ff33d38..cfc9b0fa 100644
--- a/src/boot/parser.boot.pamphlet
+++ b/src/boot/strap/parser.clisp
@@ -1,1144 +1,3 @@
-\documentclass{article}
-\usepackage{axiom}
-\usepackage{fancyvrb}
-
-\CustomVerbatimEnvironment{Grammar}{Verbatim}%
-  {frame=none,fontsize=\small,commandchars=\\\{\}}
-\newcommand{\production}[1]{{\rmfamily\itshape{#1}}}
-\newcommand{\Terminal}[1]{\ensuremath{\mathbf{#1}}}
-\newcommand{\Bar}{\ensuremath{\mid}}
-\newcommand{\Comment}[1]{-- \textrm{#1}}
-
-\title{\File{src/boot/parser.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-
-\begin{abstract}
-  This file defines the Boot grammar and parser.  The parser
-  is hand-written based on \emph{parser combinators} technology.
-\end{abstract}
-
-\tableofcontents
-\eject
-
-\section{Introduction}
-\label{sec:intro}
-
-This file defines the grammar, and implements the parser for the
-Boot language.  The parser is
-recursive descent and uses \emph{parser combinators} techniques.
-
-\section{The Parser}
-\label{sec:parser}
-
-
-\subsection{Names}
-\label{sec:parser:name}
-
-\begin{Grammar}
-   \production{Name:}
-       \Terminal{ID}
-       \production{Name} :: \Terminal{ID}
-\end{Grammar}
-
-<<Name>>=
--- A fully qualified name could be interpreted as a left reduction
--- of an '::' infix operator.  At the moment, we don't use
--- that general interpretation.
-
--- When this routine is called, a symbol is already pushed on the
--- stack.  When this routine finished execution, we have either
--- reduced a '::' and a name, or nothing.  In either case, a 
--- symbol is present on the stack.
-bpQualifiedName() ==
-  bpEqPeek "COLON-COLON" =>
-    bpNext()
-    EQCAR($stok, "ID") and bpPushId() and bpNext()
-      and bpPush bfColonColon(bpPop2(), bpPop1())
-  false
-
-bpName() ==
-  EQCAR( $stok,"ID") =>
-    bpPushId()
-    bpNext()
-    bpAnyNo function bpQualifiedName
-  false
-@
-
-
-\subsection{Constants}
-\label{sec:parser:constant}
-
-\begin{Grammar}
-   \production{Constant:}
-       \Terminal{INTEGER}
-      \Bar \Terminal{FLOAT}
-      \Bar \Terminal{LISP}
-      \Bar \Terminal{LISPEXPR}
-      \Bar \Terminal{LINE}
-      \Bar \Terminal{QUOTE} \production{S-Expression}
-      \Bar \Terminal{STRING}
-\end{Grammar}
-
-<<Constant>>=
-bpConstTok() ==
-     MEMQ(shoeTokType $stok, '(INTEGER FLOAT)) =>
-          bpPush $ttok
-          bpNext()
-     EQCAR($stok,"LISP")=> bpPush bfReadLisp $ttok and bpNext()
-     EQCAR($stok,"LISPEXP")=> bpPush $ttok and bpNext()
-     EQCAR($stok,"LINE")=> bpPush ["+LINE", $ttok] and bpNext()
-     bpEqPeek "QUOTE" =>
-          bpNext()
-          (bpSexp() or bpTrap()) and
-               bpPush bfSymbol bpPop1()
-     bpString()
-@
-
-\subsection{Wildchar}
-\label{sec:parser:dot}
-
-The dot character (\verb!.!) is used both as a selection operator and
-as wild character in patterns.
-\begin{Grammar}
-   \production{Dot:}
-       \Terminal{DOT}
-\end{Grammar}
-
-<<Dot>>=
-bpDot()== bpEqKey "DOT" and bpPush bfDot ()
-@
-
-
-\subsection{Prefix operators}
-\label{sec:parser:prefix-op}
-
-Boot has two prefix operators.  
-\begin{Grammar}
-   \production{PrefixOperator:} \textrm{one of}
-       ^   #
-\end{Grammar}
-
-<<PrefixOperator>>=
-bpPrefixOperator()==
-   EQCAR( $stok,"KEY") and
-     GET($ttok,"SHOEPRE") and bpPushId() and  bpNext()
-@
-
-\subsection{Infix operators}
-\label{sec:parser:infix-op}
-
-\begin{Grammar}
-   \production{InfixOperator:} \textrm{one of}
-       =   *   +   is   isnt   and   or   /   **   -   <   >   <=   >=   ^=
-\end{Grammar}
-
-<<InfixOperator>>=
-bpInfixOperator()==
-  EQCAR( $stok,"KEY") and
-    GET($ttok,"SHOEINF") and bpPushId() and  bpNext()
-@
-
-\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>>
-
-module '"boot-parser"
-import '"includer"
-import '"scanner"
-import '"ast"
- 
-)package "BOOTTRAN"
- 
-
-++ true when the current function definition has its parameters 
-++ written round parenthesis.
-$sawParenthesizedHead := false
-
-++ true if the current function definition has a return statement.
-$bodyHasReturn := false
-
-
-bpFirstToken()==
-      $stok:=
-          if null $inputStream
-          then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
-          else CAR $inputStream
-      $ttok:=shoeTokPart $stok
-      true
- 
-bpFirstTok()==
-      $stok:=
-          if null $inputStream
-          then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
-          else CAR $inputStream
-      $ttok:=shoeTokPart $stok
-      $bpParenCount>0 and EQCAR($stok,"KEY") =>
-             EQ($ttok,"SETTAB")=>
-                $bpCount:=$bpCount+1
-                bpNext()
-             EQ($ttok,"BACKTAB")=>
-                $bpCount:=$bpCount-1
-                bpNext()
-             EQ($ttok,"BACKSET")=>
-                bpNext()
-             true
-      true
- 
-bpNext() ==
-     $inputStream := CDR($inputStream)
-     bpFirstTok()
- 
-bpNextToken() ==
-     $inputStream := CDR($inputStream)
-     bpFirstToken()
- 
-bpState()== [$inputStream,$stack,$bpParenCount,$bpCount]
---cons($inputStream,$stack)
- 
-bpRestore(x)==
-      $inputStream:=CAR x
-      bpFirstToken()
-      $stack:=CADR x
-      $bpParenCount:=CADDR x
-      $bpCount:=CADDDR x
-      true
- 
-bpPush x==$stack:=CONS(x,$stack)
- 
-bpPushId()==
-   $stack:=CONS(bfReName $ttok,$stack)
- 
-bpPop1()==
-       a:=CAR $stack
-       $stack:=CDR $stack
-       a
- 
-bpPop2()==
-       a:=CADR $stack
-       RPLACD($stack,CDDR $stack)
-       a
- 
-bpPop3()==
-       a:=CADDR $stack
-       RPLACD(CDR $stack,CDDDR $stack)
-       a
- 
-bpIndentParenthesized f==
-    $bpCount:local:=0
-    a:=$stok
-    if bpEqPeek "OPAREN"
-    then
-      $bpParenCount:=$bpParenCount+1
-      bpNext()
-      if APPLY(f,nil) and bpFirstTok() and
-              (bpEqPeek "CPAREN" or bpParenTrap(a))
-      then
-            $bpParenCount:=$bpParenCount-1
-            bpNextToken()
-            $bpCount=0 => true
-            $inputStream:=append( bpAddTokens $bpCount,$inputStream)
-            bpFirstToken()
-            $bpParenCount=0 =>
-                     bpCancel()
-                     true
-            true
-      else if bpEqPeek "CPAREN"
-           then
-              bpPush  bfTuple []
-              $bpParenCount:=$bpParenCount-1
-              bpNextToken()
-              true
-           else bpParenTrap(a)
-    else false
- 
-bpParenthesized f==
-    a:=$stok
-    if bpEqKey "OPAREN"
-    then
-      if APPLY(f,nil) and (bpEqKey "CPAREN" or bpParenTrap(a))
-      then true
-      else if bpEqKey "CPAREN"
-           then
-              bpPush  bfTuple []
-              true
-           else bpParenTrap(a)
-    else false
- 
-bpBracket f==
-    a:=$stok
-    if bpEqKey "OBRACK"
-    then
-      if APPLY(f,nil) and (bpEqKey "CBRACK" or bpBrackTrap(a))
-      then bpPush bfBracket bpPop1 ()
-      else if bpEqKey "CBRACK"
-           then bpPush  []
-           else bpBrackTrap(a)
-    else false
- 
-bpPileBracketed f==
-              if bpEqKey "SETTAB"
-              then if bpEqKey "BACKTAB"
-                   then true
-                   else if APPLY(f,nil) and
-                            (bpEqKey "BACKTAB" or bpPileTrap())
-                        then bpPush bfPile bpPop1()
-                        else false
-              else false
- 
-bpListof(f,str1,g)==
-    if APPLY(f,nil)
-    then
-        if bpEqKey str1 and (APPLY(f,nil) or bpTrap())
-        then
-          a:=$stack
-          $stack:=nil
-          while bpEqKey str1 and (APPLY(f,nil) or bpTrap()) repeat 0
-          $stack:=cons(NREVERSE $stack,a)
-          bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
-        else
-          true
-    else false
- 
- 
--- to do ,<backset>
-bpListofFun(f,h,g)==
-    if APPLY(f,nil)
-    then
-        if APPLY(h,nil) and (APPLY(f,nil) or bpTrap())
-        then
-          a:=$stack
-          $stack:=nil
-          while APPLY(h,nil) and (APPLY(f,nil) or bpTrap()) repeat 0
-          $stack:=cons(NREVERSE $stack,a)
-          bpPush FUNCALL(g, bfListOf [bpPop3(),bpPop2(),:bpPop1()])
-        else
-          true
-    else false
- 
-bpList(f,str1,g)==
-    if APPLY(f,nil)
-    then
-        if bpEqKey str1 and (APPLY(f,nil) or bpTrap())
-        then
-          a:=$stack
-          $stack:=nil
-          while bpEqKey str1 and (APPLY(f,nil) or bpTrap()) repeat 0
-          $stack:=cons(NREVERSE $stack,a)
-          bpPush FUNCALL(g,  [bpPop3(),bpPop2(),:bpPop1()])
-        else
-          bpPush FUNCALL(g, [bpPop1()])
-    else bpPush FUNCALL(g, [])
- 
-bpOneOrMore f==
-       APPLY(f,nil)=>
-         a:=$stack
-         $stack:=nil
-         while APPLY(f,nil) repeat 0
-         $stack:=cons(NREVERSE $stack,a)
-         bpPush cons(bpPop2(),bpPop1())
-       false
- 
- 
--- s must transform the head of the stack
-bpAnyNo s==
-     while APPLY(s,nil) repeat 0
-     true
- 
- 
--- AndOr(k,p,f)= k p
-bpAndOr(keyword,p,f)==
-   bpEqKey keyword and (APPLY(p,nil) or bpTrap())
-          and bpPush FUNCALL(f, bpPop1())
- 
-bpConditional f==
-  if  bpEqKey "IF" and (bpWhere() or bpTrap()) and
-                   (bpEqKey "BACKSET" or true)
-  then
-           if bpEqKey "SETTAB"
-           then if bpEqKey "THEN"
-                then  (APPLY(f,nil) or bpTrap()) and bpElse(f) and bpEqKey "BACKTAB"
-                else  bpMissing "THEN"
-           else if bpEqKey "THEN"
-                then (APPLY(f,nil) or bpTrap()) and bpElse(f)
-                else bpMissing "then"
-  else false
- 
-bpElse(f)==
-           a:=bpState()
-           if bpBacksetElse()
-           then  (APPLY(f,nil) or bpTrap()) and
-                 bpPush bfIf(bpPop3(),bpPop2(),bpPop1())
-           else
-              bpRestore a
-              bpPush bfIfThenOnly(bpPop2(),bpPop1())
- 
-bpBacksetElse()==
-    if bpEqKey "BACKSET"
-    then bpEqKey "ELSE"
-    else bpEqKey "ELSE"
- 
-bpEqPeek s ==  EQCAR($stok,"KEY") and EQ(s,$ttok)
- 
-bpEqKey s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and bpNext()
-bpEqKeyNextTok s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and
-                  bpNextToken()
- 
-bpPileTrap()   == bpMissing  "BACKTAB"
-bpBrackTrap(x) == bpMissingMate("]",x)
-bpParenTrap(x) == bpMissingMate(")",x)
- 
-bpMissingMate(close,open)==
-   bpSpecificErrorAtToken(open, '"possibly missing mate")
-   bpMissing close
- 
-bpMissing s==
-   bpSpecificErrorHere(CONCAT(PNAME s,'" possibly missing"))
-   THROW("TRAPPOINT","TRAPPED")
- 
-bpCompMissing s == bpEqKey s or bpMissing s
- 
-bpTrap()==
-   bpGeneralErrorHere()
-   THROW("TRAPPOINT","TRAPPED")
- 
-bpRecoverTrap()==
-  bpFirstToken()
-  pos1 := shoeTokPosn $stok
-  bpMoveTo 0
-  pos2 := shoeTokPosn $stok
-  bpIgnoredFromTo(pos1, pos2)
-  bpPush  [['"pile syntax error"]]
- 
-bpListAndRecover(f)==
-   a:=$stack
-   b:=nil
-   $stack:=nil
-   done:=false
-   c:=$inputStream
-   while not done repeat
---   $trapped:local:=false
-     found:=CATCH("TRAPPOINT",APPLY(f,nil))
-     if found="TRAPPED"
-     then
-        $inputStream:=c
-        bpRecoverTrap()
-     else if not found
-          then
-            $inputStream:=c
-            bpGeneralErrorHere()
-            bpRecoverTrap()
-     if bpEqKey "BACKSET"
-     then
-        c:=$inputStream
-     else if bpEqPeek "BACKTAB"  or null $inputStream
-          then
-             done:=true
-          else
-            $inputStream:=c
-            bpGeneralErrorHere()
-            bpRecoverTrap()
-            if bpEqPeek "BACKTAB"  or null $inputStream
-            then done:=true
-            else
-                bpNext()
-                c:=$inputStream
-     b:=cons(bpPop1(),b)
-   $stack:=a
-   bpPush NREVERSE b
- 
-bpMoveTo n==
-     null $inputStream  => true
-     bpEqPeek "BACKTAB" =>
-                n=0  => true
-                bpNextToken()
-                $bpCount:=$bpCount-1
-                bpMoveTo(n-1)
-     bpEqPeek "BACKSET" =>
-                n=0  => true
-                bpNextToken()
-                bpMoveTo n
-     bpEqPeek "SETTAB"  =>
-                bpNextToken()
-                bpMoveTo(n+1)
-     bpEqPeek "OPAREN"  =>
-                bpNextToken()
-                $bpParenCount:=$bpParenCount+1
-                bpMoveTo n
-     bpEqPeek "CPAREN"  =>
-                bpNextToken()
-                $bpParenCount:=$bpParenCount-1
-                bpMoveTo n
-     bpNextToken()
-     bpMoveTo n
- 
-<<Name>>
-
-<<Constant>>
-
-++ Parse a module definitoin
-++   Module:
-++     MODULE QUOTE String
-bpModule() ==
-  bpEqKey "MODULE" =>
-    -- we really want to check that the next token is indeed
-    -- a string.  For the moment, we delay the type checking
-    -- to the Lisp compiler/interpreter.  That is likely to 
-    -- cause cryptic diagnostics.  To be fixed.
-    bpConstTok() and bpPush Module bpPop1()
-  false
-
-++ Parse a module import, or a import declaration for a foreign entity.
-++ Import:
-++    IMPORT Name for Signature
-++    IMPORT QUOTE String
-bpImport() ==
-  bpEqKey "IMPORT" =>
-    (bpName() and (bpEqKey "FOR" or bpTrap()) and bpSignature()
-       and bpPush ImportSignature(bpPop2(), bpPop1()))
-         or 
-	  -- we really want to check that the next token is indeed
-	  -- a string.  For the moment, we delay the type checking
-	  -- to the Lisp compiler/interpreter.  That is likely to 
-	  -- cause cryptic diagnostics.  To be fixed.
-	   (bpConstTok() and bpPush Import bpPop1())
-  false
-
--- Parse a type alias defnition:
---    type-alias-definition: 
---          identifier <=> logical-expression
-bpTypeAliasDefition() ==
-  (bpName() or bpTrap()) and 
-    bpEqKey "TDEF" and bpLogical() and
-      bpPush TypeAlias(bpPop2(), nil, bpPop1())
-
-++ Parse a signature declaration
-++  Signature:
-++    Name COLON Mapping
-bpSignature() ==
-  bpName() and bpEqKey "COLON" and bpMapping()
-    and bpPush Signature(bpPop2(), bpPop1())
-
-++ Parse a mapping expression
-++   Mapping:
-++      (Name | IdList) -> Name
-bpMapping() ==
-  (bpName() or bpIdList()) and bpEqKey "ARROW" and bpName()
-    and bpPush Mapping(bpPop1(), bpPop1())
-
-bpCancel()==
-    a:=bpState()
-    if bpEqKeyNextTok  "SETTAB"
-    then if bpCancel()
-         then  if bpEqKeyNextTok  "BACKTAB"
-               then true
-               else
-                   bpRestore a
-                   false
-         else
-           if bpEqKeyNextTok "BACKTAB"
-           then true
-           else
-              bpRestore a
-              false
-    else false
-bpAddTokens n==
-         n=0 => nil
-         n>0=> cons(shoeTokConstruct("KEY","SETTAB",shoeTokPosn $stok),bpAddTokens(n-1))
-         cons(shoeTokConstruct("KEY","BACKTAB",shoeTokPosn $stok),bpAddTokens(n+1))
- 
-bpExceptions()==
-     bpEqPeek "DOT" or bpEqPeek "QUOTE" or
-          bpEqPeek "OPAREN" or bpEqPeek "CPAREN" or
-             bpEqPeek "SETTAB" or bpEqPeek "BACKTAB"
-                or bpEqPeek "BACKSET"
- 
- 
-bpSexpKey()==
-      EQCAR( $stok,"KEY") and not bpExceptions()=>
-               a:=GET($ttok,"SHOEINF")
-               null a=>  bpPush $ttok and bpNext()
-               bpPush a and bpNext()
-      false
- 
-bpAnyId()==
-  bpEqKey "MINUS"  and (EQCAR($stok,"INTEGER") or bpTrap()) and
-          bpPush MINUS $ttok and bpNext() or
-             bpSexpKey() or
-                   MEMQ(shoeTokType $stok, '(ID INTEGER STRING FLOAT))
-                      and  bpPush $ttok and  bpNext()
- 
-bpSexp()==
-    bpAnyId() or
-        bpEqKey "QUOTE"  and  (bpSexp() or bpTrap())
-           and bpPush bfSymbol bpPop1() or
-               bpIndentParenthesized function bpSexp1
- 
-bpSexp1()== bpFirstTok() and
-    bpSexp() and
-     (bpEqKey "DOT" and bpSexp() and bpPush CONS (bpPop2(),bpPop1())or
-           bpSexp1() and bpPush CONS (bpPop2(),bpPop1())) or
-               bpPush nil
- 
-bpPrimary1() ==
-   bpName() or
-     bpDot() or
-      bpConstTok() or
-       bpConstruct() or
-        bpCase() or
-         bpStruct() or
-          bpPDefinition() or
-           bpBPileDefinition()
- 
-bpPrimary()==  bpFirstTok() and (bpPrimary1() or bpPrefixOperator())
- 
-<<Dot>>
- 
-<<PrefixOperator>>
- 
-<<InfixOperator>>
- 
-bpSelector()==
-            bpEqKey "DOT" and (bpPrimary()
-               and bpPush(bfElt(bpPop2(),bpPop1()))
-                  or bpPush bfSuffixDot bpPop1() )
- 
-bpOperator()==   bpPrimary() and bpAnyNo function bpSelector
- 
-bpApplication()==
-   bpPrimary() and bpAnyNo function bpSelector and
-      (bpApplication() and
-            bpPush(bfApplication(bpPop2(),bpPop1())) or true)
- 
-bpTagged()==
-      bpApplication() and
-         (bpEqKey "COLON" and (bpApplication() or bpTrap()) and
-           bpPush bfTagged(bpPop2(),bpPop1()) or true)
- 
-bpExpt()== bpRightAssoc('(POWER),function bpTagged)
- 
-bpInfKey s==
- EQCAR( $stok,"KEY") and
-   MEMBER($ttok,s) and bpPushId() and bpNext()
- 
-bpInfGeneric s== bpInfKey s and  (bpEqKey "BACKSET" or true)
- 
-bpRightAssoc(o,p)==
-    a:=bpState()
-    if APPLY(p,nil)
-    then
-       while  bpInfGeneric o and (bpRightAssoc(o,p) or bpTrap()) repeat
-             bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
-       true
-    else
-       bpRestore a
-       false
- 
-bpLeftAssoc(operations,parser)==
-    if APPLY(parser,nil)
-    then
-       while bpInfGeneric(operations) and
-         (APPLY(parser,nil) or bpTrap())
-           repeat
-             bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
-       true
-    else false
- 
-bpString()==
-     EQ(shoeTokType $stok,"STRING") and
-         bpPush(["QUOTE",INTERN $ttok]) and bpNext()
- 
-bpThetaName() ==
-        if EQCAR( $stok,"ID") and GET($ttok,"SHOETHETA")
-        then
-           bpPushId()
-           bpNext()
-        else false
- 
-bpReduceOperator()==
-         bpInfixOperator() or bpString()
-                or bpThetaName()
- 
-bpReduce()==
-     a:=bpState()
-     if bpReduceOperator() and bpEqKey "SLASH"
-     then
-        bpEqPeek "OBRACK" => (bpDConstruct() or bpTrap()) and
-                     bpPush bfReduceCollect(bpPop2(),bpPop1())
-        (bpApplication() or bpTrap()) and
-                bpPush bfReduce(bpPop2(),bpPop1())
-     else
-        bpRestore a
-        false
- 
-bpTimes()==
-    bpReduce() or bpLeftAssoc('(TIMES  SLASH),function bpExpt)
- 
-bpMinus()==
-   bpInfGeneric '(MINUS) and (bpTimes() or bpTrap())
-        and bpPush(bfApplication(bpPop2(),bpPop1()))
-          or bpTimes()
- 
-bpArith()==bpLeftAssoc('(PLUS MINUS),function bpMinus)
- 
-bpIs()==
-     bpArith() and (bpInfKey '(IS ISNT) and (bpPattern() or bpTrap())
-        and bpPush bfISApplication(bpPop2(),bpPop2(),bpPop1())
-           or true)
- 
-bpBracketConstruct(f)==
-        bpBracket f and bpPush bfConstruct bpPop1 ()
- 
-bpCompare()==
-     bpIs() and (bpInfKey  '(SHOEEQ SHOENE LT LE GT GE IN)
-        and (bpIs() or bpTrap())
-           and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
-               or true)
- 
-bpAnd()== bpLeftAssoc('(AND),function bpCompare)
- 
-
-++ Note the fact that a return statement is used in the body
-++ of current function definition.
-bpNoteReturnStmt() ==
-  $bodyHasReturn := true
-  true
-
-bpReturn()==
-         (bpEqKey "RETURN" and bpNoteReturnStmt() and
-           (bpAnd() or bpTrap()) and
-                bpPush bfReturnNoName bpPop1()) or bpAnd()
- 
- 
-bpLogical()== bpLeftAssoc('(OR),function bpReturn)
- 
-bpExpression()==
-     bpEqKey "COLON" and (bpLogical() and
-              bpPush bfApplication ("COLON",bpPop1())
-                    or bpTrap()) or bpLogical()
- 
-bpStatement()==
-  bpConditional function bpWhere or bpLoop()  or bpExpression()
- 
-bpLoop()==
-     bpIterators() and
-      (bpCompMissing "REPEAT" and
-         (bpWhere() or bpTrap()) and
-            bpPush bfLp(bpPop2(),bpPop1()))
-                or
-                  bpEqKey "REPEAT" and (bpLogical() or bpTrap()) and
-                       bpPush bfLoop1 bpPop1 ()
- 
-bpSuchThat()==bpAndOr("BAR",function bpWhere,function bfSuchthat)
- 
-bpWhile()==bpAndOr ("WHILE",function bpLogical,function bfWhile)
- 
-bpUntil()==bpAndOr ("UNTIL",function bpLogical,function bfUntil)
- 
-bpForIn()==
-  bpEqKey "FOR" and (bpVariable() or bpTrap()) and (bpCompMissing "IN")
-      and ((bpSeg()  or bpTrap()) and
-       (bpEqKey "BY" and (bpArith() or bpTrap()) and
-        bpPush bfForInBy(bpPop3(),bpPop2(),bpPop1())) or
-         bpPush bfForin(bpPop2(),bpPop1()))
- 
-bpSeg()==
-   bpArith() and
-      (bpEqKey "SEG" and
-       (bpArith() and bpPush(bfSegment2(bpPop2(),bpPop1()))
-         or bpPush(bfSegment1(bpPop1()))) or true)
- 
-bpIterator()==
-  bpForIn() or bpSuchThat() or bpWhile() or bpUntil()
- 
-bpIteratorList()==bpOneOrMore function bpIterator
-       and bpPush bfIterators bpPop1 ()
- 
-bpCrossBackSet()== bpEqKey "CROSS" and (bpEqKey "BACKSET" or true)
- 
-bpIterators()==
-         bpListofFun(function bpIteratorList,
-              function bpCrossBackSet,function bfCross)
- 
-bpAssign()==
-            a:=bpState()
-            if bpStatement()
-            then
-                 if bpEqPeek "BEC"
-                 then
-                   bpRestore a
-                   bpAssignment() or bpTrap()
-                 else true
-            else
-                 bpRestore a
-                 false
- 
-bpAssignment()==
-       bpAssignVariable() and
-         bpEqKey "BEC" and
-           (bpAssign() or bpTrap()) and
-              bpPush bfAssign (bpPop2(),bpPop1())
- 
--- should only be allowed in sequences
-bpExit()==
-     bpAssign() and (bpEqKey "EXIT" and
-         ((bpWhere() or bpTrap()) and
-            bpPush bfExit (bpPop2(),bpPop1()))
-              or true)
-
-++ returns true if the next token introduces a definition.
-bpBeginDefinition() ==
-  bpEqPeek "DEF" or 
-    $sawParenthesizedHead and bpEqPeek "COLON"
-
-bpDefinition()==
-        a:=bpState()
-        bpExit() =>
-             bpBeginDefinition() =>
-                bpRestore a
-                bpDef()
-             bpEqPeek "TDEF" =>
-                bpRestore a
-                bpTypeAliasDefition()
-             bpEqPeek "MDEF" =>
-                bpRestore a
-                bpMdef()
-             true
-        bpRestore a
-        false
- 
-bpStoreName()==
-  $op := car $stack
-  $wheredefs := nil
-  $typings := nil
-  $returnType := true		-- assume we may return anything
-  $bodyHasReturn := false
-  true
-
-bpReturnType() ==
-  -- a return type is acceptable for a function definition only
-  -- if its parameters are written in round parenthesis.  
-  -- In particular, we reject the situation `foo x:Integer == ...'
-  $sawParenthesizedHead and bpEqKey "COLON" =>
-    bpApplication() or bpTrap()
-    $returnType := bpPop1()
-    true
-  true
- 
-bpDef() ==  
-  bpName() and bpStoreName() and
-    bpDefTail() and bpPush bfCompDef bpPop1 ()
- 
-bpDDef() ==  bpName() and bpDefTail()
-
-++ Parse the remaining of a simple definition.
-bpSimpleDefinitionTail() ==
-  bpEqKey "DEF" and
-    (bpWhere() or bpTrap())
-      and bpPush ConstantDefinition(bpPop2(), bpPop1())
-
-++ Parse the remaining of a compound definition.
-bpCompoundDefinitionTail() ==
-  bpVariable()  and bpReturnType()  and
-    bpEqKey "DEF" and (bpWhere() or bpTrap())
-      and bpPush bfDefinition(bpPop3(),bpPop2(),bpPop1())
-
-
-++ Parse the remainding of a definition.  When we reach this point
-++ we know we must parse a definition and we have already parsed
-++ the name of the main operator in the definition.
-bpDefTail() ==
-  bpSimpleDefinitionTail()
-    or bpCompoundDefinitionTail()
- 
- 
-bpMDefTail()==
- --   bpEqKey "MDEF" and
- --   (bpWhere() or bpTrap())
- --     and bpPush bfMDefinition1(bpPop2(),bpPop1())
- --      or
-           (bpVariable() or bpTrap()) and
-             bpEqKey "MDEF" and (bpWhere() or bpTrap())
-                 and bpPush bfMDefinition(bpPop3(),bpPop2(),bpPop1())
- 
-bpMdef()== bpName() and bpStoreName() and bpMDefTail()
- 
-bpWhere()==
-    bpDefinition() and
-       (bpEqKey "WHERE" and (bpDefinitionItem() or bpTrap())
-           and bpPush bfWhere(bpPop1(),bpPop1()) or true)
- 
-bpDefinitionItem()==
-          a:=bpState()
-          if bpDDef()
-          then true
-          else
-             bpRestore a
-             if bpBDefinitionPileItems()
-             then true
-             else
-               bpRestore a
-               if bpPDefinitionItems()
-               then true
-               else
-                   bpRestore a
-                   bpWhere()
- 
-bpDefinitionPileItems()==
-    bpListAndRecover function bpDefinitionItem
-           and bpPush bfDefSequence bpPop1()
- 
-bpBDefinitionPileItems()== bpPileBracketed function bpDefinitionPileItems
- 
-bpSemiColonDefinition()==bpSemiListing
-    (function bpDefinitionItem,function bfDefSequence)
- 
-bpPDefinitionItems()==bpParenthesized function bpSemiColonDefinition
- 
-bpComma()== 
-  bpModule() or bpImport() or
-    bpTuple function bpWhere
- 
-bpTuple(p)==bpListofFun(p,function bpCommaBackSet,function bfTuple)
- 
-bpCommaBackSet()== bpEqKey "COMMA" and (bpEqKey "BACKSET" or true)
- 
-bpSemiColon()==bpSemiListing (function bpComma,function bfSequence)
- 
-bpSemiListing(p,f)==bpListofFun(p,function bpSemiBackSet,f)
- 
-bpSemiBackSet()== bpEqKey "SEMICOLON" and (bpEqKey "BACKSET" or true)
- 
-bpPDefinition()==  bpIndentParenthesized function bpSemiColon
- 
-bpPileItems()==
-    bpListAndRecover function bpSemiColon and bpPush bfSequence bpPop1()
- 
-bpBPileDefinition()==  bpPileBracketed function bpPileItems
- 
-bpIteratorTail()==
-     (bpEqKey "REPEAT" or true) and bpIterators()
- 
---bpExpression()==  bpLogical()
- 
-bpConstruct()==bpBracket function bpConstruction
- 
-bpConstruction()==
-     bpComma() and
-        (bpIteratorTail() and
-             bpPush bfCollect (bpPop2(),bpPop1()) or
-                bpPush bfTupleConstruct bpPop1())
- 
-bpDConstruct()==bpBracket function bpDConstruction
- 
-bpDConstruction()==
-     bpComma() and
-        (bpIteratorTail() and
-             bpPush bfDCollect (bpPop2(),bpPop1()) or
-                bpPush bfDTuple bpPop1())
- 
- 
- 
---PATTERN
- 
---bpNameOrDot() == bpName() or bpDot() or bpEqual()
- 
-bpPattern()== bpBracketConstruct function bpPatternL
-                or bpName() or bpConstTok()
- 
-bpEqual()==
-   bpEqKey "SHOEEQ" and (bpApplication() or bpConstTok() or
-                bpTrap()) and bpPush bfEqual bpPop1()
- 
-bpRegularPatternItem() ==
-   bpEqual() or
-     bpConstTok() or bpDot() or
-      bpName() and
-         ((bpEqKey "BEC" and (bpPattern() or bpTrap())
-              and bpPush bfAssign(bpPop2(),bpPop1())) or true)
-                    or bpBracketConstruct function bpPatternL
- 
-bpRegularPatternItemL()==
-      bpRegularPatternItem() and bpPush [bpPop1()]
- 
-bpRegularList()==
-       bpListof(function bpRegularPatternItemL,"COMMA",function bfAppend)
- 
-bpPatternColon()==
-     bpEqKey "COLON" and (bpRegularPatternItem() or bpTrap())
-              and bpPush [bfColon bpPop1()]
- 
- 
--- only one colon
-bpPatternL() == bpPatternList() and bpPush bfTuple bpPop1()
- 
-bpPatternList()==
-     if bpRegularPatternItemL()
-     then
-        while (bpEqKey  "COMMA" and (bpRegularPatternItemL() or
-            (bpPatternTail()
-              and bpPush append(bpPop2(),bpPop1())
-                or bpTrap();false) )) repeat
-                  bpPush append(bpPop2(),bpPop1())
-        true
-     else bpPatternTail()
- 
-bpPatternTail()==
-     bpPatternColon() and
-         (bpEqKey "COMMA" and (bpRegularList() or bpTrap())
-              and bpPush append (bpPop2(),bpPop1()) or true)
- 
--- BOUND VARIABLE
-bpRegularBVItem() ==
-  bpBVString() or
-     bpConstTok() or
-      (bpName() and
-         (bpEqKey "COLON" and (bpApplication() or bpTrap())
-            and bpPush bfTagged(bpPop2(), bpPop1()) or
-              bpEqKey "BEC" and (bpPattern() or bpTrap())
-                and bpPush bfAssign(bpPop2(),bpPop1()) or
-                  (bpEqKey "IS" and (bpPattern() or bpTrap())
-                     and bpPush bfAssign(bpPop2(),bpPop1())) or true))
-                       or bpBracketConstruct function bpPatternL
- 
-bpBVString()==
-     EQ(shoeTokType $stok,"STRING") and
-         bpPush(["BVQUOTE",INTERN $ttok]) and bpNext()
- 
-bpRegularBVItemL() ==
-      bpRegularBVItem() and bpPush [bpPop1()]
- 
-bpColonName()==
-     bpEqKey "COLON" and (bpName() or bpBVString() or bpTrap())
- 
- 
--- at most one colon at end
-bpBoundVariablelist()==
-     if bpRegularBVItemL()
-     then
-        while (bpEqKey  "COMMA" and (bpRegularBVItemL() or
-            (bpColonName()
-              and bpPush  bfColonAppend(bpPop2(),bpPop1())
-                or bpTrap();false) )) repeat
-                   bpPush append(bpPop2(),bpPop1())
-        true
-     else bpColonName() and bpPush bfColonAppend(nil,bpPop1())
- 
-
-++ Mark the start of parameter list enclosed in round parenthesis
-bpBeginParameterList() ==
-  $sawParenthesizedHead := false
-  true
-
-++ Mark the end of parameter list enclosed in round parenthesis
-bpEndParameterList() ==
-  $sawParenthesizedHead := true
-
-bpVariable()==
-  bpBeginParameterList() and
-    bpParenthesized function bpBoundVariablelist and
-       bpPush bfTupleIf bpPop1() and bpEndParameterList()
-	 or bpBracketConstruct function bpPatternL
-		or bpName() or bpConstTok()
- 
-bpAssignVariable()==
-      bpBracketConstruct function bpPatternL or bpAssignLHS()
- 
-bpAssignLHS()==
-   bpName() and (bpEqKey "COLON" and (bpApplication() or bpTrap())
-     and bpPush bfLocal(bpPop2(),bpPop1())
-        or bpEqKey "DOT" and bpList(function bpPrimary,"DOT",
-              function bfListOf)
-          and bpChecknull() and
-            bpPush bfTuple(cons(bpPop2(),bpPop1()))
-                 or true)
-bpChecknull()==
-      a:=bpPop1()
-      if null a
-      then bpTrap()
-      else bpPush a
-
-bpStruct()==
-   bpEqKey "STRUCTURE" and
-      (bpName() or bpTrap()) and
-        (bpEqKey "DEF" or bpTrap()) and
-           bpTypeList() and bpPush bfStruct(bpPop2(),bpPop1())
- 
-bpTypeList() == bpPileBracketed function bpTypeItemList
-       or bpTerm() and bpPush [bpPop1()]
- 
-bpTypeItemList() ==  bpListAndRecover function bpTerm
- 
-bpTerm() ==
-          (bpName() or bpTrap()) and
-            ((bpParenthesized function bpIdList and
-              bpPush bfNameArgs (bpPop2(),bpPop1()))
-                or bpName() and bpPush bfNameArgs(bpPop2(),bpPop1()))
-                 or bpPush(bfNameOnly bpPop1())
- 
-bpIdList()== bpTuple function bpName
- 
-bpCase()==
-      bpEqKey "CASE" and
-        (bpWhere() or bpTrap()) and
-           (bpEqKey "OF" or bpMissing "OF") and
-                 bpPiledCaseItems()
- 
-bpPiledCaseItems()==
-   bpPileBracketed function bpCaseItemList and
-       bpPush bfCase(bpPop2(),bpPop1())
-bpCaseItemList()==
-   bpListAndRecover function bpCaseItem
- 
-bpCaseItem()==
-    (bpTerm() or bpTrap()) and
-       (bpEqKey "EXIT" or bpTrap()) and
-         (bpWhere() or bpTrap()) and
-            bpPush bfCaseItem (bpPop2(),bpPop1())
-
-@
-
-
-\section{The Common Lisp translation}
-\label{sec:cl-translation}
-
-<<parser.clisp>>=
 (EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-parser"))
 
 (IMPORT-MODULE "includer")
@@ -1655,7 +514,10 @@ bpCaseItem()==
     (RETURN
       (COND
         ((|bpEqKey| 'IMPORT)
-         (AND (|bpConstTok|) (|bpPush| (|Import| (|bpPop1|)))))
+         (OR (AND (|bpName|) (OR (|bpEqKey| 'FOR) (|bpTrap|))
+                  (|bpSignature|)
+                  (|bpPush| (|ImportSignature| (|bpPop2|) (|bpPop1|))))
+             (AND (|bpConstTok|) (|bpPush| (|Import| (|bpPop1|))))))
         ('T NIL)))))
 
 (DEFUN |bpTypeAliasDefition| ()
@@ -1664,6 +526,18 @@ bpCaseItem()==
       (AND (OR (|bpName|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
            (|bpPush| (|TypeAlias| (|bpPop2|) NIL (|bpPop1|)))))))
 
+(DEFUN |bpSignature| ()
+  (PROG ()
+    (RETURN
+      (AND (|bpName|) (|bpEqKey| 'COLON) (|bpMapping|)
+           (|bpPush| (|Signature| (|bpPop2|) (|bpPop1|)))))))
+
+(DEFUN |bpMapping| ()
+  (PROG ()
+    (RETURN
+      (AND (OR (|bpName|) (|bpIdList|)) (|bpEqKey| 'ARROW) (|bpName|)
+           (|bpPush| (|Mapping| (|bpPop1|) (|bpPop1|)))))))
+
 (DEFUN |bpCancel| ()
   (PROG (|a|)
     (RETURN
@@ -2455,6 +1329,3 @@ bpCaseItem()==
            (OR (|bpWhere|) (|bpTrap|))
            (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))))
 
-@
-
-\end{document}
diff --git a/src/boot/pile.boot.pamphlet b/src/boot/strap/pile.clisp
index eaad129f..caa56d3e 100644
--- a/src/boot/pile.boot.pamphlet
+++ b/src/boot/strap/pile.clisp
@@ -1,171 +1,3 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/pile.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\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>>
-
-module '"boot-pile"
-import '"includer"
-import '"scanner"
- 
-)package "BOOTTRAN"
-shoeFirstTokPosn t== shoeTokPosn CAAR t
-shoeLastTokPosn  t== shoeTokPosn CADR t
-shoePileColumn t==CDR shoeTokPosn CAAR t
- 
--- s is a token-dq-stream
- 
-shoePileInsert (s)==
-     if bStreamNull s
-     then cons([],s)
-     else
-         toktype:=shoeTokType CAAAR s
-         if toktype ="LISP"  or toktype = "LINE"
-         then cons([car s],cdr s)
-         else
-            a:=shoePileTree(-1,s)
-            cons([a.2],a.3)
- 
-shoePileTree(n,s)==
-    if bStreamNull s
-    then [false,n,[],s]
-    else
-        [h,t]:=[car s,cdr s]
-        hh:=shoePileColumn h
-        if hh > n
-        then shoePileForests(h,hh,t)
-        else [false,n,[],s]
- 
-eqshoePileTree(n,s)==
-    if bStreamNull s
-    then [false,n,[],s]
-    else
-        [h,t]:=[car s,cdr s]
-        hh:=shoePileColumn h
-        if hh = n
-        then shoePileForests(h,hh,t)
-        else [false,n,[],s]
- 
-shoePileForest(n,s)==
-     [b,hh,h,t]:= shoePileTree(n,s)
-     if b
-     then
-       [h1,t1]:=shoePileForest1(hh,t)
-       [cons(h,h1),t1]
-     else [[],s]
- 
-shoePileForest1(n,s)==
-     [b,n1,h,t]:= eqshoePileTree(n,s)
-     if b
-     then
-       [h1,t1]:=shoePileForest1(n,t)
-       [cons(h,h1),t1]
-     else [[],s]
- 
-shoePileForests(h,n,s)==
-      [h1,t1]:=shoePileForest(n,s)
-      if bStreamNull h1
-      then [true,n,h,s]
-      else shoePileForests(shoePileCtree(h,h1),n,t1)
- 
-shoePileCtree(x,y)==dqAppend(x,shoePileCforest y)
- 
--- only enshoePiles forests with >=2 trees
- 
-shoePileCforest x==
-   if null x
-   then []
-   else if null cdr x
-        then car x
-        else
-           a:=car x
-           b:=shoePileCoagulate(a,rest x)
-           if null cdr b
-           then car b
-           else shoeEnPile shoeSeparatePiles b
- 
-shoePileCoagulate(a,b)==
-    if null b
-    then [a]
-    else
-      c:=car b
-      if EQ(shoeTokPart CAAR c,"THEN") or EQ(shoeTokPart CAAR c,"ELSE")
-      then shoePileCoagulate (dqAppend(a,c),cdr b)
-      else
-         d:=CADR a
-         e:=shoeTokPart d
-         if EQCAR(d,"KEY") and
-               (GET(e,"SHOEINF") or EQ(e,"COMMA") or EQ(e,"SEMICOLON"))
-         then shoePileCoagulate(dqAppend(a,c),cdr b)
-         else cons(a,shoePileCoagulate(c,rest b))
- 
-shoeSeparatePiles x==
-  if null x
-  then []
-  else if null cdr x
-       then car x
-       else
-         a:=car x
-         semicolon:=dqUnit
-                shoeTokConstruct("KEY", "BACKSET",shoeLastTokPosn a)
-         dqConcat [a,semicolon,shoeSeparatePiles cdr x]
- 
-shoeEnPile x==
-   dqConcat [dqUnit shoeTokConstruct("KEY","SETTAB",shoeFirstTokPosn x),
-             x, _
-             dqUnit shoeTokConstruct("KEY","BACKTAB",shoeLastTokPosn  x)]
- 
-@
-
-<<pile.clisp>>=
 (EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-pile"))
 
 (IMPORT-MODULE "includer")
@@ -320,6 +152,3 @@ shoeEnPile x==
                             (|shoeTokConstruct| 'KEY 'BACKTAB
                                 (|shoeLastTokPosn| |x|))))))))
 
-@
-
-\end{document}
diff --git a/src/boot/scanner.boot.pamphlet b/src/boot/strap/scanner.clisp
index b6bc1175..50078c3d 100644
--- a/src/boot/scanner.boot.pamphlet
+++ b/src/boot/strap/scanner.clisp
@@ -1,537 +1,3 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/scanner.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\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>>
-
-module '"boot-lexer"
-import '"tokens"
-import '"includer"
-
-)package "BOOTTRAN"
-
--- converts X to double-float.
-double x ==
-  FLOAT(x, 1.0)
- 
-dqUnit s==(a:=[s];CONS(a,a))
- 
-dqAppend(x,y)==
-    if null x
-    then y
-    else if null y
-         then x
-         else
-              RPLACD (CDR x,CAR y)
-              RPLACD (x,    CDR y)
-              x
- 
-dqConcat ld==
-    if null ld
-    then nil
-    else if null rest ld
-         then first ld
-         else dqAppend(first ld,dqConcat rest ld)
- 
-dqToList s==if null s then nil else CAR s
- 
-shoeConstructToken(ln,lp,b,n)==[b.0,b.1,:cons(lp,n)]
-shoeTokType x== CAR x
-shoeTokPart x== CADR x
-shoeTokPosn x== CDDR x
-shoeTokConstruct(x,y,z)==[x,y,:z]
- 
-shoeNextLine(s)==
-     if bStreamNull s
-     then false
-     else
-       $linepos:=s
-       $f:= CAR s
-       $r:= CDR s
-       $ln:=CAR $f
-       $n:=STRPOSL('" ",$ln,0,true)
-       $sz :=# $ln
-       null $n => true
-       QENUM($ln,$n)=shoeTAB =>
-                  a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ")
-                  $ln.$n:='" ".0
-                  $ln:=CONCAT(a,$ln)
-                  s1:=cons(cons($ln,CDR $f),$r)
-                  shoeNextLine s1
-       true
- 
-shoeLineToks(s)==
-   $f: local:=nil
-   $r:local :=nil
-   $ln:local :=nil
-   $n:local:=nil
-   $sz:local := nil
-   $floatok:local:=true
-   $linepos:local:=s
-   not shoeNextLine s =>  CONS(nil,nil)
-   null $n => shoeLineToks $r
-   fst:=QENUM($ln,0)
-   EQL(fst,shoeCLOSEPAREN)=>
-            command:=shoeLine? $ln=>
-              dq:=dqUnit shoeConstructToken
-                       ($ln,$linepos,shoeLeafLine command,0)
-              cons([dq],$r)
-            command:=shoeLisp? $ln=> shoeLispToken($r,command)
-            command:=shoePackage? $ln=>
-       --       z:=car shoeBiteOff command
-              a:=CONCAT('"(IN-PACKAGE ",command,'")")
-              dq:=dqUnit shoeConstructToken
-                       ($ln,$linepos,shoeLeafLisp a,0)
-              cons([dq],$r)
-            shoeLineToks $r
-   toks:=[]
-   while $n<$sz repeat toks:=dqAppend(toks,shoeToken())
-   null toks => shoeLineToks $r
-   cons([toks],$r)
- 
-shoeLispToken(s,string)==
-      string:=
-            # string=0 or EQL(QENUM(string,0),QENUM('";",0))=> '""
-            string
-      ln:=$ln
-      linepos:=$linepos
-      [r,:st]:=shoeAccumulateLines(s,string)
-      dq:=dqUnit shoeConstructToken(ln,linepos,shoeLeafLisp st,0)
-      cons([dq],r)
- 
-shoeAccumulateLines(s,string)==
-   not shoeNextLine s =>  CONS(s,string)
-   null $n => shoeAccumulateLines($r,string)
-   # $ln=0 => shoeAccumulateLines($r,string)
-   fst:=QENUM($ln,0)
-   EQL(fst,shoeCLOSEPAREN)=>
-            command:=shoeLisp? $ln
-            command and #command>0 =>
-                EQL(QENUM(command,0),QENUM('";",0))=>
-                            shoeAccumulateLines($r,string)
-                a:=STRPOS('";",command,0,nil)
-                a=>
-                  shoeAccumulateLines($r,
-                     CONCAT(string,SUBSTRING(command,0,a-1)))
-                shoeAccumulateLines($r,CONCAT(string,command))
-            shoeAccumulateLines($r,string)
-   CONS(s,string)
-
--- returns true if token t is closing `parenthesis'.
-shoeCloser t ==
-  MEMQ(shoeKeyWord t, '(CPAREN CBRACK))
- 
-shoeToken () ==
-      ln:=$ln
-      c:=QENUM($ln,$n)
-      linepos:=$linepos
-      n:=$n
-      ch:=$ln.$n
-      b:=
-            shoeStartsComment()          =>
-                           shoeComment()
-                           []
-            shoeStartsNegComment()       =>
-                           shoeNegComment()
-                           []
-            c=shoeLispESCAPE      =>
-                           shoeLispEscape()
-            shoePunctuation c        => shoePunct ()
-            shoeStartsId ch          => shoeWord  (false)
-            c=shoeSPACE              =>
-                           shoeSpace ()
-                           []
-            c = shoeSTRING_CHAR        => shoeString ()
-            shoeDigit ch               => shoeNumber ()
-            c=shoeESCAPE               => shoeEscape()
-            c=shoeTAB                  =>
-                                       $n:=$n+1
-                                       []
-            shoeError ()
-      null b => nil
-      dqUnit shoeConstructToken(ln,linepos,b,n)
- 
--- to pair badge and badgee
-shoeLeafId x==  ["ID",INTERN x]
- 
-shoeLeafKey x==["KEY",shoeKeyWord x]
- 
-shoeLeafInteger x==["INTEGER",shoeIntValue x]
- 
-shoeLeafFloat(a,w,e)==
-    b:=shoeIntValue CONCAT(a,w)
-    c:= double b *  EXPT(double 10, e-#w)
-    ["FLOAT",c]
- 
-shoeLeafString x  == ["STRING",x]
- 
-shoeLeafLisp x    == ["LISP",x]
-shoeLeafLispExp x    == ["LISPEXP",x]
- 
-shoeLeafLine x    == ["LINE",x]
- 
-shoeLeafComment x == ["COMMENT", x]
- 
-shoeLeafNegComment x== ["NEGCOMMENT", x]
- 
-shoeLeafError x   == ["ERROR",x]
- 
-shoeLeafSpaces x  == ["SPACES",x]
- 
-shoeLispEscape()==
-         $n:=$n+1
-         if $n>=$sz
-         then
-             SoftShoeError(cons($linepos,$n),'"lisp escape error")
-             shoeLeafError ($ln.$n)
-         else
-            a:=shoeReadLispString($ln,$n)
-            null a =>
-             SoftShoeError(cons($linepos,$n),'"lisp escape error")
-             shoeLeafError ($ln.$n)
-            [exp,n]:=a
-            null n =>
-                 $n:= $sz
-                 shoeLeafLispExp  exp
-            $n:=n
-            shoeLeafLispExp  exp
-shoeEscape()==
-         $n:=$n+1
-         a:=shoeEsc()
-         if a then shoeWord true else nil
- 
-shoeEsc()==
-     if $n>=$sz
-     then if shoeNextLine($r)
-          then
-               while null $n repeat shoeNextLine($r)
-               shoeEsc()
-               false
-          else false
-     else
-           n1:=STRPOSL('" ",$ln,$n,true)
-           if null n1
-           then
-               shoeNextLine($r)
-               while null $n repeat shoeNextLine($r)
-               shoeEsc()
-               false
-           else true
- 
-shoeStartsComment()==
-    if $n<$sz
-    then
-         if QENUM($ln,$n)=shoePLUSCOMMENT
-         then
-            www:=$n+1
-            if www>=$sz
-            then false
-            else QENUM($ln,www) = shoePLUSCOMMENT
-         else false
-    else false
- 
-shoeStartsNegComment()==
-    if $n< $sz
-    then
-         if QENUM($ln,$n)=shoeMINUSCOMMENT
-         then
-            www:=$n+1
-            if www>=$sz
-            then false
-            else QENUM($ln,www) = shoeMINUSCOMMENT
-         else false
-    else false
- 
-shoeNegComment()==
-      n:=$n
-      $n:=$sz
-      shoeLeafNegComment SUBSTRING($ln,n,nil)
- 
-shoeComment()==
-      n:=$n
-      $n:=$sz
-      shoeLeafComment SUBSTRING($ln,n,nil)
- 
-shoePunct()==
-            sss:=shoeMatch($ln,$n)
-            $n:=$n+#sss
-            shoeKeyTr sss
- 
-shoeKeyTr w==
-       if EQ(shoeKeyWord w,"DOT")
-       then if $floatok
-            then shoePossFloat(w)
-            else shoeLeafKey w
-       else
-           $floatok:=not shoeCloser w
-           shoeLeafKey w
- 
-shoePossFloat (w)==
-     if $n>=$sz or not shoeDigit $ln.$n
-     then shoeLeafKey w
-     else
-       w:=shoeInteger()
-       shoeExponent('"0",w)
- 
- 
-shoeSpace()==
-           n:=$n
-           $n:=STRPOSL('" ",$ln,$n,true)
-           $floatok:=true
-           if null $n
-           then
-              shoeLeafSpaces 0
-              $n:= # $ln
-           else shoeLeafSpaces ($n-n)
- 
-shoeString()==
-            $n:=$n+1
-            $floatok:=false
-            shoeLeafString shoeS ()
- 
-shoeS()==
-   if $n>=$sz
-   then
-     SoftShoeError(cons($linepos,$n),'"quote added")
-     '""
-   else
-           n:=$n
-           strsym :=STRPOS ('"_"",$ln,$n,nil) or $sz
-           escsym:=STRPOS ('"__"
-                          ,$ln,$n,nil)  or $sz
-           mn:=MIN(strsym,escsym)
-           if mn=$sz
-           then
-                 $n:=$sz
-                 SoftShoeError(cons($linepos,$n),'"quote added")
-                 SUBSTRING($ln,n,nil)
-           else if mn=strsym
-                then
-                   $n:=mn+1
-                   SUBSTRING($ln,n,mn-n)
-                else
-                  str:=SUBSTRING($ln,n,mn-n)
-                  $n:=mn+1
-                  a:=shoeEsc()
-                  b:=if a
-                     then
-                       str:=CONCAT(str,$ln.$n)
-                       $n:=$n+1
-                       shoeS()
-                     else shoeS()
-                  CONCAT(str,b)
- 
- 
- 
- 
-shoeIdEnd(line,n)==
-     while n<#line and shoeIdChar line.n repeat n:=n+1
-     n
- 
- 
-shoeDigit x== DIGIT_-CHAR_-P x
- 
-shoeW(b)==
-       n1:=$n
-       $n:=$n+1
-       l:=$sz
-       endid:=shoeIdEnd($ln,$n)
-       if endid=l or QENUM($ln,endid)^=shoeESCAPE
-       then
-           $n:=endid
-           [b,SUBSTRING($ln,n1,endid-n1)]
-       else
-           str:=SUBSTRING($ln,n1,endid-n1)
-           $n:=endid+1
-           a:=shoeEsc()
-           bb:=if a
-               then shoeW(true)
-               else [b,'""]   --  escape finds space or newline
-           [bb.0 or b,CONCAT(str,bb.1)]
- 
-shoeWord(esp) ==
-          aaa:=shoeW(false)
-          w:=aaa.1
-          $floatok:=false
-          if esp or aaa.0
-          then shoeLeafId w
-          else if shoeKeyWordP w
-               then
-                  $floatok:=true
-                  shoeLeafKey w
-               else shoeLeafId  w
- 
-shoeInteger()==shoeInteger1(false)
- 
-shoeInteger1(zro) ==
-       n:=$n
-       l:= $sz
-       while $n<l and shoeDigit($ln.$n) repeat $n:=$n+1
-       if $n=l or QENUM($ln,$n)^=shoeESCAPE
-       then if n=$n and zro
-            then '"0"
-            else SUBSTRING($ln,n,$n-n)
-       else
-             str:=SUBSTRING($ln,n,$n-n)
-             $n:=$n+1
-             a:=shoeEsc()
-             bb:=shoeInteger1(zro)
-             CONCAT(str,bb)
- 
-shoeIntValue(s) ==
-       ns := #s
-       ival := 0
-       for i in 0..ns-1 repeat
-           d := shoeOrdToNum ELT(s,i)
-           ival := 10*ival + d
-       ival
- 
-shoeNumber() ==
-       a := shoeInteger()
-       if $n>=$sz
-       then shoeLeafInteger a
-       else
-           if $floatok and QENUM($ln,$n)=shoeDOT
-           then
-             n:=$n
-             $n:=$n+1
-             if  $n<$sz and QENUM($ln,$n)=shoeDOT
-             then
-               $n:=n
-               shoeLeafInteger a
-             else
-               w:=shoeInteger1(true)
-               shoeExponent(a,w)
-           else shoeLeafInteger a
- 
-shoeExponent(a,w)==
-     if $n>=$sz
-     then shoeLeafFloat(a,w,0)
-     else
-        n:=$n
-        c:=QENUM($ln,$n)
-        if c=shoeEXPONENT1 or c=shoeEXPONENT2
-        then
-           $n:=$n+1
-           if $n>=$sz
-           then
-             $n:=n
-             shoeLeafFloat(a,w,0)
-           else if shoeDigit($ln.$n)
-                then
-                  e:=shoeInteger()
-                  e:=shoeIntValue e
-                  shoeLeafFloat(a,w,e)
-                else
-                  c1:=QENUM($ln,$n)
-                  if c1=shoePLUSCOMMENT or c1=shoeMINUSCOMMENT
-                  then
-                    $n:=$n+1
-                    if $n>=$sz
-                    then
-                      $n:=n
-                      shoeLeafFloat(a,w,0)
-                    else
-                      if shoeDigit($ln.$n)
-                      then
-                        e:=shoeInteger()
-                        e:=shoeIntValue e
-                        shoeLeafFloat(a,w,
-                          (if c1=shoeMINUSCOMMENT then MINUS e else e))
-                      else
-                        $n:=n
-                        shoeLeafFloat(a,w,0)
-        else shoeLeafFloat(a,w,0)
- 
-shoeError()==
-      n:=$n
-      $n:=$n+1
-      SoftShoeError(cons($linepos,n),
-        CONCAT( '"The character whose number is ",
-                STRINGIMAGE QENUM($ln,n),'" is not a Boot character"))
-      shoeLeafError ($ln.n)
- 
-shoeOrdToNum x== DIGIT_-CHAR_-P x
- 
-shoeKeyWord st   == GETHASH(st,shoeKeyTable)
- 
-shoeKeyWordP st  ==  not null GETHASH(st,shoeKeyTable)
- 
-shoeMatch(l,i)==shoeSubStringMatch(l,shoeDict,i)
- 
-shoeSubStringMatch (l,d,i)==
-       h:= QENUM(l, i)
-       u:=ELT(d,h)
-       ll:=SIZE l
-       done:=false
-       s1:='""
-       for j in 0.. SIZE u - 1 while not done repeat
-          s:=ELT(u,j)
-          ls:=SIZE s
-          done:=if ls+i > ll
-                then false
-                else
-                 eql:= true
-                 for k in 1..ls-1 while eql repeat
-                    eql:= EQL(QENUM(s,k),QENUM(l,k+i))
-                 if eql
-                 then
-                   s1:=s
-                   true
-                 else false
-       s1
- 
-shoePunctuation c== shoePun.c =1
- 
-@
-<<scanner.clisp>>=
 (EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-lexer"))
 
 (IMPORT-MODULE "tokens")
@@ -1158,6 +624,3 @@ shoePunctuation c== shoePun.c =1
 (DEFUN |shoePunctuation| (|c|)
   (PROG () (RETURN (EQL (ELT |shoePun| |c|) 1))))
 
-@
-
-\end{document}
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
new file mode 100644
index 00000000..3ce6a7c8
--- /dev/null
+++ b/src/boot/strap/tokens.clisp
@@ -0,0 +1,352 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-tokens"))
+
+(IMPORT-MODULE "initial-env")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFPARAMETER |shoeKeyWords|
+    (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
+          (LIST "cross" 'CROSS) (LIST "else" 'ELSE) (LIST "for" 'FOR)
+          (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
+          (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
+          (LIST "of" 'OF) (LIST "or" 'OR) (LIST "repeat" 'REPEAT)
+          (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE)
+          (LIST "then" 'THEN) (LIST "until" 'UNTIL)
+          (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT)
+          (LIST ":" 'COLON) (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
+          (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
+          (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS)
+          (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
+          (LIST "=" 'SHOEEQ) (LIST "^" 'NOT) (LIST "^=" 'SHOENE)
+          (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT)
+          (LIST "->" 'ARROW) (LIST ":=" 'BEC) (LIST "==" 'DEF)
+          (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN)
+          (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK)
+          (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR)
+          (LIST "'" 'QUOTE) (LIST "|" 'BAR)))
+
+(DEFUN |shoeKeyTableCons| ()
+  (PROG (|KeyTable|)
+    (RETURN
+      (PROGN
+        (SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC))
+        (LET ((|bfVar#1| |shoeKeyWords|) (|st| NIL))
+          (LOOP
+            (COND
+              ((OR (ATOM |bfVar#1|)
+                   (PROGN (SETQ |st| (CAR |bfVar#1|)) NIL))
+               (RETURN NIL))
+              ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
+            (SETQ |bfVar#1| (CDR |bfVar#1|))))
+        |KeyTable|))))
+
+(DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|))
+
+(DEFPARAMETER |shoeSPACE| (QENUM "    " 0))
+
+(DEFPARAMETER |shoeESCAPE| (QENUM "_  " 0))
+
+(DEFPARAMETER |shoeLispESCAPE| (QENUM "!  " 0))
+
+(DEFPARAMETER |shoeSTRINGCHAR| (QENUM "\"  " 0))
+
+(DEFPARAMETER |shoePLUSCOMMENT| (QENUM "+   " 0))
+
+(DEFPARAMETER |shoeMINUSCOMMENT| (QENUM "-   " 0))
+
+(DEFPARAMETER |shoeDOT| (QENUM ".   " 0))
+
+(DEFPARAMETER |shoeEXPONENT1| (QENUM "E   " 0))
+
+(DEFPARAMETER |shoeEXPONENT2| (QENUM "e   " 0))
+
+(DEFPARAMETER |shoeCLOSEPAREN| (QENUM ")   " 0))
+
+(DEFPARAMETER |shoeTAB| 9)
+
+(DEFUN |shoeInsert| (|s| |d|)
+  (PROG (|v| |k| |n| |u| |h| |l|)
+    (RETURN
+      (PROGN
+        (SETQ |l| (LENGTH |s|))
+        (SETQ |h| (QENUM |s| 0))
+        (SETQ |u| (ELT |d| |h|))
+        (SETQ |n| (LENGTH |u|))
+        (SETQ |k| 0)
+        (LOOP
+          (COND
+            ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL))
+            (#0='T (SETQ |k| (+ |k| 1)))))
+        (SETQ |v| (MAKE-VEC (+ |n| 1)))
+        (LET ((|bfVar#2| (- |k| 1)) (|i| 0))
+          (LOOP
+            (COND
+              ((> |i| |bfVar#2|) (RETURN NIL))
+              (#0# (VEC-SETELT |v| |i| (ELT |u| |i|))))
+            (SETQ |i| (+ |i| 1))))
+        (VEC-SETELT |v| |k| |s|)
+        (LET ((|bfVar#3| (- |n| 1)) (|i| |k|))
+          (LOOP
+            (COND
+              ((> |i| |bfVar#3|) (RETURN NIL))
+              (#0# (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|))))
+            (SETQ |i| (+ |i| 1))))
+        (VEC-SETELT |d| |h| |v|)
+        |s|))))
+
+(DEFUN |shoeDictCons| ()
+  (PROG (|d| |b| |a| |l|)
+    (RETURN
+      (PROGN
+        (SETQ |l| (HKEYS |shoeKeyTable|))
+        (SETQ |d|
+              (PROGN
+                (SETQ |a| (MAKE-VEC 256))
+                (SETQ |b| (MAKE-VEC 1))
+                (VEC-SETELT |b| 0 (MAKE-CVEC 0))
+                (LET ((|i| 0))
+                  (LOOP
+                    (COND
+                      ((> |i| 255) (RETURN NIL))
+                      (#0='T (VEC-SETELT |a| |i| |b|)))
+                    (SETQ |i| (+ |i| 1))))
+                |a|))
+        (LET ((|bfVar#4| |l|) (|s| NIL))
+          (LOOP
+            (COND
+              ((OR (ATOM |bfVar#4|)
+                   (PROGN (SETQ |s| (CAR |bfVar#4|)) NIL))
+               (RETURN NIL))
+              (#0# (|shoeInsert| |s| |d|)))
+            (SETQ |bfVar#4| (CDR |bfVar#4|))))
+        |d|))))
+
+(DEFPARAMETER |shoeDict| (|shoeDictCons|))
+
+(DEFUN |shoePunCons| ()
+  (PROG (|a| |listing|)
+    (RETURN
+      (PROGN
+        (SETQ |listing| (HKEYS |shoeKeyTable|))
+        (SETQ |a| (MAKE-BVEC 256))
+        (LET ((|i| 0))
+          (LOOP
+            (COND
+              ((> |i| 255) (RETURN NIL))
+              (#0='T (BVEC-SETELT |a| |i| 0)))
+            (SETQ |i| (+ |i| 1))))
+        (LET ((|bfVar#5| |listing|) (|k| NIL))
+          (LOOP
+            (COND
+              ((OR (ATOM |bfVar#5|)
+                   (PROGN (SETQ |k| (CAR |bfVar#5|)) NIL))
+               (RETURN NIL))
+              (#0#
+               (COND
+                 ((NULL (|shoeStartsId| (ELT |k| 0)))
+                  (BVEC-SETELT |a| (QENUM |k| 0) 1)))))
+            (SETQ |bfVar#5| (CDR |bfVar#5|))))
+        |a|))))
+
+(DEFPARAMETER |shoePun| (|shoePunCons|))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#6| (LIST 'NOT 'LENGTH)) (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#6|)
+                 (PROGN (SETQ |i| (CAR |bfVar#6|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET |i| 'SHOEPRE) 'T)))
+          (SETQ |bfVar#6| (CDR |bfVar#6|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#7|
+                (LIST (LIST 'SHOEEQ '=) (LIST 'TIMES '*)
+                      (LIST 'PLUS '+) (LIST 'IS '|is|)
+                      (LIST 'ISNT '|isnt|) (LIST 'AND '|and|)
+                      (LIST 'OR '|or|) (LIST 'SLASH '/)
+                      (LIST 'POWER '**) (LIST 'MINUS '-) (LIST 'LT '<)
+                      (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
+                      (LIST 'SHOENE '^=)))
+            (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#7|)
+                 (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET (CAR |i|) 'SHOEINF) (CADR |i|))))
+          (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#8|
+                (LIST (LIST '+ 0) (LIST '|gcd| 0) (LIST '|lcm| 1)
+                      (LIST 'STRCONC "") (LIST '|strconc| "")
+                      (LIST 'MAX (- 999999)) (LIST 'MIN 999999)
+                      (LIST '* 1) (LIST '|times| 1) (LIST 'CONS NIL)
+                      (LIST 'APPEND NIL) (LIST '|append| NIL)
+                      (LIST 'UNION NIL) (LIST 'UNIONQ NIL)
+                      (LIST '|union| NIL) (LIST 'NCONC NIL)
+                      (LIST '|and| 'T) (LIST '|or| NIL) (LIST 'AND 'T)
+                      (LIST 'OR NIL)))
+            (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#8|)
+                 (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET (CAR |i|) 'SHOETHETA) (CDR |i|))))
+          (SETQ |bfVar#8| (CDR |bfVar#8|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#9|
+                (LIST (LIST '|and| 'AND) (LIST '|append| 'APPEND)
+                      (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
+                      (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
+                      (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
+                      (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
+                      (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
+                      (LIST '|first| 'CAR) (LIST '|function| 'FUNCTION)
+                      (LIST '|genvar| 'GENVAR) (LIST 'IN 'MEMBER)
+                      (LIST '|is| 'IS) (LIST '|isnt| 'ISNT)
+                      (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
+                      (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
+                      (LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
+                      (LIST '|not| 'NULL) (LIST 'NOT 'NULL)
+                      (LIST '|nreverse| 'NREVERSE) (LIST '|null| 'NULL)
+                      (LIST '|or| 'OR) (LIST '|otherwise| 'T)
+                      (LIST 'PAIRP 'CONSP)
+                      (LIST '|removeDuplicates| 'REMDUP)
+                      (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
+                      (LIST '|setDifference| 'SETDIFFERENCE)
+                      (LIST '|setIntersection| 'INTERSECTION)
+                      (LIST '|setPart| 'SETELT)
+                      (LIST '|setUnion| 'UNION) (LIST '|size| 'SIZE)
+                      (LIST '|strconc| 'CONCAT)
+                      (LIST '|substitute| 'SUBST) (LIST '|take| 'TAKE)
+                      (LIST '|true| 'T) (LIST 'PLUS '+)
+                      (LIST 'MINUS '-) (LIST 'TIMES '*)
+                      (LIST 'POWER 'EXPT) (LIST 'SLASH '/)
+                      (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
+                      (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL)
+                      (LIST 'SHOENE '/=) (LIST 'T 'T$)))
+            (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#9|)
+                 (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET (CAR |i|) 'SHOERENAME) (CDR |i|))))
+          (SETQ |bfVar#9| (CDR |bfVar#9|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#10|
+                (LIST (LIST 'PLUS 'PLUS) (LIST '|and| 'AND)
+                      (LIST '|append| 'APPEND) (LIST '|apply| 'APPLY)
+                      (LIST '|atom| 'ATOM) (LIST '|brace| 'REMDUP)
+                      (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
+                      (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
+                      (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
+                      (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
+                      (LIST '|first| 'CAR) (LIST '|genvar| 'GENVAR)
+                      (LIST '|in| '|member|) (LIST '|is| 'IS)
+                      (LIST '|lastNode| 'LASTNODE) (LIST '|list| 'LIST)
+                      (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC)
+                      (LIST '|nil| 'NIL) (LIST '|not| 'NULL)
+                      (LIST 'NOT 'NULL) (LIST '|nreverse| 'NREVERSE)
+                      (LIST '|null| 'NULL) (LIST '|or| 'OR)
+                      (LIST '|otherwise| 'T)
+                      (LIST '|removeDuplicates| 'REMDUP)
+                      (LIST '|rest| 'CDR) (LIST '|return| 'RETURN)
+                      (LIST '|reverse| 'REVERSE)
+                      (LIST '|setDifference| 'SETDIFFERENCE)
+                      (LIST '|setIntersection| '|intersection|)
+                      (LIST '|setPart| 'SETELT)
+                      (LIST '|setUnion| '|union|) (LIST '|size| 'SIZE)
+                      (LIST '|strconc| 'STRCONC)
+                      (LIST '|substitute| 'MSUBST)
+                      (LIST 'SUBST 'MSUBST) (LIST '|take| 'TAKE)
+                      (LIST '|true| 'T) (LIST '|where| 'WHERE)
+                      (LIST 'TIMES 'TIMES) (LIST 'POWER 'EXPT)
+                      (LIST 'NOT 'NULL) (LIST 'SHOENE 'NEQUAL)
+                      (LIST 'MINUS 'SPADDIFFERENCE)
+                      (LIST 'SLASH 'QUOTIENT) (LIST '= 'EQUAL)
+                      (LIST 'SHOEEQ 'EQUAL) (LIST 'ASSOC '|assoc|)
+                      (LIST 'DELETE '|delete|) (LIST 'GET 'GETL)
+                      (LIST 'INTERSECTION '|intersection|)
+                      (LIST 'LAST '|last|) (LIST 'MEMBER '|member|)
+                      (LIST 'RASSOC '|rassoc|) (LIST 'READ 'VMREAD)
+                      (LIST 'READ-LINE '|read-line|)
+                      (LIST 'REDUCE 'SPADREDUCE)
+                      (LIST 'REMOVE '|remove|) (LIST 'BAR 'SUCHTHAT)
+                      (LIST 'T 'T$) (LIST 'IN '|member|)
+                      (LIST 'UNION '|union|)))
+            (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#10|)
+                 (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET (CAR |i|) 'OLD-BOOT) (CDR |i|))))
+          (SETQ |bfVar#10| (CDR |bfVar#10|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#11|
+                (LIST 'LT 'LE 'GT 'GE 'SHOENE 'TIMES 'PLUS 'MINUS
+                      '|function| 'PAIRP))
+            (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#11|)
+                 (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET |i| 'RENAME-OK) T)))
+          (SETQ |bfVar#11| (CDR |bfVar#11|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (PROG ()
+    (RETURN
+      (LET ((|bfVar#12|
+                (LIST (LIST '|setName| 0) (LIST '|setLabel| 1)
+                      (LIST '|setLevel| 2) (LIST '|setType| 3)
+                      (LIST '|setVar| 4) (LIST '|setLeaf| 5)
+                      (LIST '|setDef| 6) (LIST '|aGeneral| 4)
+                      (LIST '|aMode| 1) (LIST '|aModeSet| 3)
+                      (LIST '|aTree| 0) (LIST '|aValue| 2)
+                      (LIST '|attributes| 'CADDR)
+                      (LIST '|cacheCount| 'CADDDDR)
+                      (LIST '|cacheName| 'CADR)
+                      (LIST '|cacheReset| 'CADDDR)
+                      (LIST '|cacheType| 'CADDR) (LIST '|env| 'CADDR)
+                      (LIST '|expr| 'CAR) (LIST 'CAR 'CAR)
+                      (LIST '|mmCondition| 'CAADR) (LIST '|mmDC| 'CAAR)
+                      (LIST '|mmImplementation| 'CADADR)
+                      (LIST '|mmSignature| 'CDAR)
+                      (LIST '|mmTarget| 'CADAR) (LIST '|mode| 'CADR)
+                      (LIST '|op| 'CAR) (LIST '|opcode| 'CADR)
+                      (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR)
+                      (LIST '|sig| 'CDDR) (LIST '|source| 'CDR)
+                      (LIST '|streamCode| 'CADDDR)
+                      (LIST '|streamDef| 'CADDR)
+                      (LIST '|streamName| 'CADR) (LIST '|target| 'CAR)))
+            (|i| NIL))
+        (LOOP
+          (COND
+            ((OR (ATOM |bfVar#12|)
+                 (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+             (RETURN NIL))
+            ('T (SETF (GET (CAR |i|) 'SHOESELFUNCTION) (CADR |i|))))
+          (SETQ |bfVar#12| (CDR |bfVar#12|)))))))
+
diff --git a/src/boot/translator.boot.pamphlet b/src/boot/strap/translator.clisp
index c66ba1f2..0b849cfc 100644
--- a/src/boot/translator.boot.pamphlet
+++ b/src/boot/strap/translator.clisp
@@ -1,818 +1,3 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/translator.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-
-\begin{abstract}
-This file implement various Boot translaters.
-\end{abstract}
-\eject
-
-\tableofcontents
-\eject
-
-\section{Entry points to this module}
-
-The only entry points to this module are:
-\begin{itemize}
-\item [BOOTTOCL]
-\item [BOOTCLAM]
-\item [BOOTTOCLC]
-\item [BOOTTOMC]
-\item [EVAL-BOOT-FILE]
-\item [BO]
-\item [BOCLAM]
-\item [STOUT]
-\item [STEVAL]
-\item [STTOMC]
-\end{itemize}
-
-Calling other functions defined here, from outside of this module,
-may lead to unpredictable results.  
-
-
-We assume that we are translating a file called {\bf ``foo.boot''}
-and expect to generate a file called {\bf ``foo.clisp''}.
-
-\section{BOOTTOCLLINES}
-
-The {\bf BOOTTOCLLINES} function cleans up the function names.
-When called during system build from {\bf BOOTTOCL} the {\bf lines}
-variable has the value {\bf NIL} and the {\bf fn} variable has the
-value {\bf ``foo.boot''}.
-
-The infn variable is the input file name, {\bf ``foo.boot''}.
-
-The outfn variable is the output file name, {\bf ``foo.clisp''}.
-
-Calling {\bf shoeOpenInputFile} will create {\bf ``foo.clisp''} and
-return the string ``foo.clisp PRODUCED''.
-
-<<BOOTTOCLLINES>>= 
-BOOTTOCLLINES(lines, fn, outfn)==
-   -- The default floating point number is double-float.
-   SETQ(_*READ_-DEFAULT_-FLOAT_-FORMAT_*, 'DOUBLE_-FLOAT)
-   callingPackage := _*PACKAGE_*
-   IN_-PACKAGE '"BOOTTRAN"
-   infn:=shoeAddbootIfNec fn
-   result := shoeOpenInputFile(a,infn,
-                shoeClLines(a,fn,lines,outfn))
-   setCurrentPackage callingPackage
-   result
- 
-@
-
-\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>>
-
-module '"boot-translator"
-import '"includer"
-import '"scanner"
-import '"pile"
-import '"parser"
-import '"ast"
-
-)package "BOOTTRAN"
-
-+++ True if we are translating code written in Old Boot.
-$translatingOldBoot := false
-
-AxiomCore::%sysInit() ==
-  if cdr ASSOC(Option '"boot", %systemOptions()) = '"old"
-  then $translatingOldBoot := true
-
--- Make x, the current package
-setCurrentPackage x ==
-  SETQ(_*PACKAGE_*,x)
-
--- Compiles the input Lisp file designated by lspFileName.
-shoeCOMPILE_-FILE lspFileName ==
-  COMPILE_-FILE lspFileName
-
--- (boottocl "filename") translates the file "filename.boot" to
--- the common lisp file "filename.clisp"
- 
-BOOTTOCL(fn, out) ==
-  BOOTTOCLLINES(nil,fn, out)
- 
--- (bootclam "filename") translates the file "filename.boot" to
--- the common lisp file "filename.clisp" , producing, for each function
--- a hash table to store previously computed values indexed by argument
--- list.
- 
-BOOTCLAM(fn, out) == 
-  $bfClamming := true
-  BOOTCLAMLINES(nil,fn, out)
- 
-BOOTCLAMLINES(lines, fn, out) ==
-   BOOTTOCLLINES(lines, fn, out)
-
-<<BOOTTOCLLINES>>
-shoeClLines(a,fn,lines,outfn)==
-      if null a
-      then shoeNotFound fn
-      else
-       $GenVarCounter:local := 0
-       shoeOpenOutputFile(stream,outfn,
-         (for line in lines repeat shoeFileLine (line,stream);
-           shoeFileTrees(shoeTransformStream a,stream)))
-       outfn
- 
--- (boottoclc "filename") translates the file "filename.boot" to
--- the common lisp file "filename.clisp" with the original boot
--- code as comments
- 
-BOOTTOCLC(fn, out)==BOOTTOCLCLINES(nil, fn, out)
- 
-BOOTTOCLCLINES(lines, fn, outfn)==
-  callingPackage := _*PACKAGE_*
-  IN_-PACKAGE '"BOOTTRAN"
-  infn:=shoeAddbootIfNec fn
-  result := shoeOpenInputFile(a,infn,
-               shoeClCLines(a,fn,lines,outfn))
-  setCurrentPackage callingPackage
-  result
-  
- 
-shoeClCLines(a,fn,lines,outfn)==
-      if null a
-      then shoeNotFound fn
-      else
-       $GenVarCounter:local := 0
-       shoeOpenOutputFile(stream,outfn,
-         (for line in lines repeat shoeFileLine (line,stream);
-           shoeFileTrees(shoeTransformToFile(stream,
-               shoeInclude bAddLineNumber(bRgen a,bIgen 0)),stream)))
-       outfn
- 
--- (boottomc "filename") translates the file "filename.boot"
--- to machine code and loads it one item at a time
- 
-BOOTTOMC fn==
-   callingPackage := _*PACKAGE_*
-   IN_-PACKAGE '"BOOTTRAN"
-   $GenVarCounter:local := 0
-   infn:=shoeAddbootIfNec fn
-   result := shoeOpenInputFile(a,infn,shoeMc(a,fn))
-   setCurrentPackage callingPackage
-   result
- 
-shoeMc(a,fn)==
-   if null a
-   then shoeNotFound fn
-   else
-     shoePCompileTrees shoeTransformStream a
-     shoeConsole CONCAT(fn,'" COMPILED AND LOADED")
- 
-EVAL_-BOOT_-FILE fn ==
-   b := _*PACKAGE_*
-   IN_-PACKAGE '"BOOTTRAN"
-   infn:=shoeAddbootIfNec fn
-   outfn:=CONCAT(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*)
-   shoeOpenInputFile(a,infn,shoeClLines(a,infn,[],outfn))
-   setCurrentPackage b
-   LOAD outfn
- 
--- (boot "filename") translates the file "filename.boot"
--- and prints the result at the console
- 
-BO fn==
-     b := _*PACKAGE_*
-     IN_-PACKAGE '"BOOTTRAN"
-     $GenVarCounter:local := 0
-     infn:=shoeAddbootIfNec fn
-     shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
-     setCurrentPackage b
- 
-BOCLAM fn==
-     callingPackage := _*PACKAGE_*
-     IN_-PACKAGE '"BOOTTRAN"
-     $GenVarCounter:local := 0
-     $bfClamming:local := true
-     infn:=shoeAddbootIfNec fn
-     result := shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
-     setCurrentPackage callingPackage
-     result
- 
-shoeToConsole(a,fn)==
-     if null a
-     then shoeNotFound fn
-     else
-        shoeConsoleTrees shoeTransformToConsole
-          shoeInclude bAddLineNumber(bRgen a,bIgen 0)
- 
--- (stout "string") translates the string "string"
--- and prints the result at the console
- 
-STOUT string==   PSTOUT [string]
---   $GenVarCounter:local := 0
---   $bfClamming:local:=false
---   shoeConsoleTrees shoeTransformString [string]
- 
-STEVAL string==
-   callingPackage := _*PACKAGE_*
-   IN_-PACKAGE '"BOOTTRAN"
-   $GenVarCounter:local := 0
-   a:=  shoeTransformString [string]
-   result := 
-      bStreamPackageNull a => nil
-      fn:=stripm(CAR a,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
-      EVAL fn
-   setCurrentPackage callingPackage
-   result
- 
--- (sttomc "string") translates the string "string"
--- to common lisp, and compiles it.
- 
-STTOMC string==
-   callingPackage := _*PACKAGE_*
-   IN_-PACKAGE '"BOOTTRAN"
-   $GenVarCounter:local := 0
-   a:=  shoeTransformString [string]
-   result := 
-      bStreamPackageNull a => nil
-      shoePCompile car a
-   setCurrentPackage callingPackage
-   result
- 
- 
-shoeCompileTrees s==
-    while not bStreamNull s repeat
-         shoeCompile car s
-         s:=cdr s
- 
-shoeCompile fn==
-    fn is ['DEFUN,name,bv,:body]=>
-          COMPILE (name,['LAMBDA,bv,:body])
-    EVAL fn
- 
-shoeTransform str==
-    bNext(function shoeTreeConstruct,
-      bNext(function shoePileInsert,
-        bNext(function shoeLineToks, str)))
- 
-shoeTransformString s==
-    shoeTransform shoeInclude bAddLineNumber(s,bIgen 0)
-shoeTransformStream s==shoeTransformString bRgen s
---  shoeTransform shoeInclude bAddLineNumber(bRgen s,bIgen 0)
- 
-shoeTransformToConsole str==
-    bNext(function shoeConsoleItem,
-      bNext(function shoePileInsert,
-        bNext(function shoeLineToks, str)))
- 
-shoeTransformToFile(fn,str)==
-    bFileNext(fn,
-      bNext(function shoePileInsert,
-        bNext(function shoeLineToks, str)))
- 
-shoeConsoleItem (str)==
-        dq:=CAR str
-        shoeConsoleLines shoeDQlines dq
-        cons(shoeParseTrees dq,CDR str)
- 
-bFileNext(fn,s)==bDelay(function bFileNext1,[fn,s])
- 
-bFileNext1(fn,s)==
-      bStreamNull s=> ["nullstream"]
-      dq:=CAR s
-      shoeFileLines(shoeDQlines dq,fn)
-      bAppend(shoeParseTrees dq,bFileNext(fn,cdr s))
- 
-shoeParseTrees dq==
-        toklist := dqToList dq
-        null toklist => []
-        shoeOutParse toklist
- 
-shoeTreeConstruct (str)==
-        cons(shoeParseTrees CAR str,CDR str)
- 
-shoeDQlines dq==
-        a:= CDAAR shoeLastTokPosn dq
-        b:= CDAAR shoeFirstTokPosn dq
-        streamTake (a-b+1,CAR shoeFirstTokPosn dq)
- 
-streamTake(n,s)==
-    if bStreamNull s
-    then nil
-    else if EQL(n,0)
-         then nil
-         else cons(car s,streamTake(n-1,cdr s))
- 
-shoeFileLines (lines,fn) ==
-        shoeFileLine( '" ",fn)
-        for line in lines repeat shoeFileLine (shoeAddComment line,fn)
-        shoeFileLine ('" ",fn)
- 
-shoeConsoleLines lines ==
-        shoeConsole '" "
-        for line in lines repeat shoeConsole shoeAddComment line
-        shoeConsole '" "
- 
-shoeFileLine(x, stream) ==
-    WRITE_-LINE(x, stream)
-    x
- 
-shoeFileTrees(s,st)==
-        while not bStreamNull s repeat
-            a:=CAR s
-            if EQCAR (a,"+LINE")
-            then shoeFileLine(CADR a,st)
-            else 
-              REALLYPRETTYPRINT(a,st)
-	      TERPRI st
-            s:=CDR s
- 
- 
-shoePPtoFile(x, stream) ==
-    SHOENOTPRETTYPRINT(x, stream)
-    x
- 
-shoeConsoleTrees s ==
-    while not bStreamPackageNull s repeat
---      while not bStreamNull s repeat
-          fn:=stripm(CAR s,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
-          REALLYPRETTYPRINT fn
-          s:=CDR s
- 
-shoeAddComment l==  CONCAT('"; ",CAR l)
-
-++ Generate an import declaration for `op' as equivalent of the
-++ foreign signature `sig'.  Here, `foreign' operationally means that
-++ the entity is from the C language world. 
-genImportDeclaration(op, sig) ==
-  sig isnt ["Signature", op', m] => coreError '"invalid signature"
-  m isnt ["Mapping", t, s] => coreError '"invalid function type"
-  %hasFeature KEYWORD::GCL => 
-    if SYMBOLP s then s := [s]
-    ["DEFENTRY", op, s, [t, SYMBOL_-NAME op']]
-  fatalError '"import declaration not implemented for this Lisp"
-
-shoeOutParse stream ==
-    $inputStream :local:= stream
-    $stack:local       :=nil
-    $stok:local := nil
-    $ttok:local := nil
-    $op:local :=nil
-    $wheredefs:local:=nil
-    $typings:local:=nil
-    $returns:local :=nil
-    $bpCount:local:=0
-    $bpParenCount:local:=0
-    bpFirstTok()
-    found:=CATCH("TRAPPOINT",bpOutItem())
-    if found="TRAPPED"
-    then  nil
-    else if not bStreamNull $inputStream
-         then
-          bpGeneralErrorHere()
-          nil
-         else if null $stack
-              then
-                bpGeneralErrorHere()
-                nil
-              else CAR $stack
- 
-bpOutItem()==
-    bpComma() or bpTrap()
-    b:=bpPop1()
-    EQCAR(b,"TUPLE")=> bpPush cdr b
-    EQCAR(b,"+LINE")=> bpPush [ b ]
-    b is ["L%T",l,r] and IDENTP l =>
-                 bpPush [["DEFPARAMETER",l,r]]
-    case b of
-      Module(m) => 
-        bpPush [shoeCompileTimeEvaluation ["PROVIDE", m]]
-
-      Import(m) => 
-        bpPush [["IMPORT-MODULE", m]]
-
-      ImportSignature(x, sig) =>
-        bpPush [genImportDeclaration(x, sig)]
-
-      TypeAlias(t, args, rhs) => 
-        bpPush [["DEFTYPE", t, args, ["QUOTE", rhs]]]
-
-      ConstantDefinition(n, e) =>
-        bpPush [["DEFCONSTANT", n, e]]
-
-      otherwise =>
-        b:=shoeCompTran ["LAMBDA",["x"],b]
-        bpPush [shoeEVALANDFILEACTQ CADDR b]
- 
---shoeStartsAt (sz,name,stream)==
---   bStreamNull stream => ['nullstream]
---   a:=CAAR stream
---   if #a<sz
---   then shoeStartsAt(sz,name,CDR stream)
---   else if SUBSTRING(a,0,sz)=name and (#a>sz and not shoeIdChar(a.sz))
---        then stream
---        else shoeStartsAt(sz,name,CDR stream)
- 
---FC(name,fn)==
---   $bfClamming:local:=false
---   $GenVarCounter:local := 0
---   infn:=shoeAddbootIfNec fn
---   shoeOpenInputFile(a,infn,shoeFindName(fn,name, a))
- 
---shoeFindName(fn,name,a)==
---  shoeFindAndDoSomething(FUNCTION shoeCompile,fn,name,a)
---shoeTransform1 str==
---    bNext(function shoeTreeConstruct,
---      streamTake(1, bNext(function shoePileInsert,
---           bNext(function shoeLineToks, str))))
- 
---BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE(fun,fn,symbol)==
---   $bfClamming:local:=false
---   infn:=shoeAddbootIfNec NAMESTRING fn
---   name:=PNAME symbol
---   shoeOpenInputFile(a,infn,shoeFindAndDoSomething(fun,fn,name, a))
- 
---shoeFindAndDoSomething(fun,fn,name,a)==
---   if null a
---   then shoeNotFound fn
---   else
---      b:=shoeStartsAt(#name,name, shoeInclude
---                        bAddLineNumber(bRgen a,bIgen 0))
---      if bStreamNull b
---      then shoeConsole CONCAT (name,'" not found in ",fn)
---      else
---         $GenVarCounter:local := 0
---         shoeLoop(fun,shoeTransform1 b)
- 
---BOOT_-COMPILE_-DEFINITION_-FROM_-FILE(fn,symbol)==
---   BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE
---         (FUNCTION shoeCompile,fn,symbol)
- 
---BOOT_-EVAL_-DEFINITION_-FROM_-FILE(fn,symbol)==
---   BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE
---         (FUNCTION EVAL,fn,symbol)
- 
---BOOT_-PRINT_-DEFINITION_-FROM_-FILE(fn,symbol)==
---   BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE
---         (FUNCTION REALLYPRETTYPRINT,fn,symbol)
- 
---shoeLoop(fun, s)==
---    while not bStreamNull s repeat
---         FUNCALL(fun, car s)
---         s:=cdr s
- 
-shoeAddbootIfNec s==shoeAddStringIfNec('".boot",s)
- 
-shoeRemovebootIfNec s==shoeRemoveStringIfNec('".boot",s)
-shoeAddStringIfNec(str,s)==
-       a:=STRPOS(str,s,0,nil)
-       if null a
-       then CONCAT(s,str)
-       else s
- 
-shoeRemoveStringIfNec(str,s)==
-       a:=STRPOS(str,s,0,nil)
-       if null a
-       then s
-       else SUBSTRING(s,0,a)
- 
--- DEFUSE prints the definitions not used and the words used and
--- not defined in the input file and common lisp.
- 
-DEFUSE fn==
-  infn:=CONCAT(fn,'".boot")
-  shoeOpenInputFile(a,infn,shoeDfu(a,fn))
- 
-shoeDfu(a,fn)==
-  if null a
-  then shoeNotFound fn
-  else
-     $lispWordTable:local :=MAKE_-HASHTABLE ("EQ")
-     DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
-     $bootDefined:local :=MAKE_-HASHTABLE "EQ"
-     $bootUsed:local :=MAKE_-HASHTABLE "EQ"
-     $bootDefinedTwice:local:=nil
-     $GenVarCounter:local :=0
-     $bfClamming:local:=false
-     shoeDefUse shoeTransformStream a
-     out:=CONCAT(fn,'".defuse")
-     shoeOpenOutputFile(stream,out,shoeReport stream)
-     out
- 
-shoeReport stream==
-          shoeFileLine('"DEFINED and not USED",stream)
-          a:=[i for i in HKEYS $bootDefined | not GETHASH(i,$bootUsed)]
-          bootOut(SSORT a,stream)
-          shoeFileLine('"             ",stream)
-          shoeFileLine('"DEFINED TWICE",stream)
-          bootOut(SSORT $bootDefinedTwice,stream)
-          shoeFileLine('"             ",stream)
-          shoeFileLine('"USED and not DEFINED",stream)
-          a:=[i for i in HKEYS $bootUsed |
-                     not GETHASH(i,$bootDefined)]
-          for i in SSORT a repeat
-             b:=CONCAT(PNAME i,'" is used in ")
-             bootOutLines( SSORT GETHASH(i,$bootUsed),stream,b)
- 
-shoeDefUse(s)==
-        while not bStreamPackageNull s repeat
-            defuse([],CAR s)
-            s:=CDR s
- 
-defuse(e,x)==
-     x:=stripm(x,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
-     $used:local:=nil
-     [nee,niens]:=
-        x is ['DEFUN,name,bv,:body] => [name,['LAMBDA,bv,:body]]
-        x is ['DEFMACRO,name,bv,:body] => [name,['LAMBDA,bv,:body]]
-        x is ["EVAL_-WHEN",.,["SETQ",id,exp]]=>[id,exp]
-        x is ["SETQ",id,exp]=>[id,exp]
-        ["TOP-LEVEL", x]
-     if GETHASH(nee,$bootDefined)
-     then
-        $bootDefinedTwice:=
-               nee="TOP-LEVEL"=> $bootDefinedTwice
-               cons(nee,$bootDefinedTwice)
-     else HPUT($bootDefined,nee,true)
-     defuse1 (e,niens)
-     for i in $used repeat
-        HPUT($bootUsed,i,cons(nee,GETHASH(i,$bootUsed)))
- 
-defuse1(e,y)==
-     ATOM y =>
-         IDENTP y =>
-            $used:=
-                 MEMQ(y,e)=>$used
-                 MEMQ(y,$used)=>$used
-                 defusebuiltin y =>$used
-                 UNION([y],$used)
-         []
-     y is ["LAMBDA",a,:b]=> defuse1 (append(unfluidlist a,e),b)
-     y is ["PROG",a,:b]=>
-            [dol,ndol]:=defSeparate a
-            for i in dol repeat
-                  HPUT($bootDefined,i,true)
-            defuse1 (append(ndol,e),b)
-     y is ["QUOTE",:a] => []
-     y is ["+LINE",:a] => []
-     for i in y repeat defuse1(e,i)
- 
-defSeparate x==
-      if null x
-      then [[],[]]
-      else
-         f:=car x
-         [x1,x2]:=defSeparate cdr x
-         if bfBeginsDollar f
-         then [cons(f,x1),x2]
-         else [x1,cons(f,x2)]
-unfluidlist x==
-    NULL x => []
-    ATOM x=> [x]
-    x is ["&REST",y]=> [y]
-    cons(car x,unfluidlist cdr x)
- 
-defusebuiltin x==  GETHASH(x,$lispWordTable)
- 
-bootOut (l,outfn)==
-      for i in l repeat shoeFileLine (CONCAT ('"   ",PNAME i),outfn)
- 
-CLESSP(s1,s2)==not(SHOEGREATERP(s1,s2))
-SSORT l == SORT(l,function CLESSP)
- 
-bootOutLines(l,outfn,s)==
-  if null l
-  then shoeFileLine(s,outfn)
-  else
-     a:=PNAME car l
-     if #s +#a > 70
-     then
-          shoeFileLine(s,outfn)
-          bootOutLines(l,outfn,'" ")
-     else bootOutLines(cdr l,outfn,CONCAT(s,'" ",a))
- 
- 
--- (xref "fn") produces a cross reference listing in "fn.xref"
--- It contains each name
--- used in "fn.boot", together with a list of functions that use it.
- 
-XREF fn==
-  infn:=CONCAT(fn,'".boot")
-  shoeOpenInputFile(a,infn,shoeXref(a,fn))
- 
-shoeXref(a,fn)==
-  if null a
-  then shoeNotFound fn
-  else
-     $lispWordTable:local :=MAKE_-HASHTABLE ("EQ")
-     DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
-     $bootDefined:local :=MAKE_-HASHTABLE "EQ"
-     $bootUsed:local :=MAKE_-HASHTABLE "EQ"
-     $GenVarCounter:local :=0
-     $bfClamming:local:=false
-     shoeDefUse shoeTransformStream a
-     out:=CONCAT(fn,'".xref")
-     shoeOpenOutputFile(stream,out,shoeXReport stream)
-     out
- 
- 
-shoeXReport stream==
-          shoeFileLine('"USED and where DEFINED",stream)
-          c:=SSORT HKEYS $bootUsed
-          for i in c repeat
-             a:=CONCAT(PNAME i,'" is used in ")
-             bootOutLines( SSORT GETHASH(i,$bootUsed),stream,a)
- 
---FC (name,fn)== shoeGeneralFC(function BOOT,name,fn)
- 
-FBO (name,fn)== shoeGeneralFC(function BO,name,fn)
- 
-FEV(name,fn)== shoeGeneralFC(function EVAL_-BOOT_-FILE,name,fn)
- 
-shoeGeneralFC(f,name,fn)==
-   $bfClamming:local:=false
-   $GenVarCounter:local := 0
-   infn:=shoeAddbootIfNec fn
-   a:= shoeOpenInputFile(a,infn,shoeFindName2(fn,name, a))
-   filename:= if # name > 8 then SUBSTRING(name,0,8) else name
-   a =>  FUNCALL(f, CONCAT('"/tmp/",filename))
-   nil
- 
-shoeFindName2(fn,name,a)==
-     lines:=shoeFindLines(fn,name,a)
-     lines =>
-          filename:= if # name > 8 then SUBSTRING(name,0,8) else name
-          filename := CONCAT ('"/tmp/",filename,'".boot")
-          shoeOpenOutputFile(stream, filename,
-               for line in lines repeat shoeFileLine (line,stream))
-          true
-     false
- 
-shoeTransform2 str==
-    bNext(function shoeItem,
-      streamTake(1, bNext(function shoePileInsert,
-           bNext(function shoeLineToks, str))))
- 
-shoeItem (str)==
-        dq:=CAR str
-        cons([[CAR line for line in  shoeDQlines dq]],CDR str)
- 
---shoeLines lines ==  [CAR line for line in lines]
- 
---shoeFindAndDoSomething2(fun,fn,name,a)==
---   if null a
---   then shoeNotFound fn
---   else
---      [lines,b]:=shoePackageStartsAt([],#name,name, shoeInclude
---                        bAddLineNumber(bRgen a,bIgen 0))
---      if bStreamNull b
---      then
---           shoeConsole CONCAT (name,'" not found in ",fn)
---           []
---      else
---         if null lines
---         then shoeConsole '")package not found"
---         $GenVarCounter:local := 0
---         shoeLoopPackage(fun,shoeTransform2 b,lines)
- 
---shoeLoopPackage(fun, s,lines)==
---    while not bStreamNull s repeat
---         FUNCALL(fun, append (reverse lines,car s))
---         s:=cdr s
---    true
-stripm (x,pk,bt)==
-   ATOM x =>
-             IDENTP x =>
-                 SYMBOL_-PACKAGE x = bt => INTERN(PNAME x,pk)
-                 x
-             x
-   CONS(stripm(CAR x,pk,bt),stripm(CDR x,pk,bt))
- 
-shoePCompile  fn==
-    fn:=stripm(fn,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
-    fn is ['DEFUN,name,bv,:body]=>
-          COMPILE (name,['LAMBDA,bv,:body])
-    EVAL fn
- 
-FC(name,fn)==
-   $GenVarCounter:local := 0
-   infn:=shoeAddbootIfNec fn
-   shoeOpenInputFile(a,infn,shoeFindName(fn,name, a))
- 
-shoeFindName(fn,name,a)==
-     lines:=shoeFindLines(fn,name,a)
-     shoePCompileTrees shoeTransformString lines
- 
-shoePCompileTrees s==
-    while not bStreamPackageNull s repeat
-         REALLYPRETTYPRINT shoePCompile car s
-         s:=cdr s
- 
-bStreamPackageNull s==
-         a := _*PACKAGE_*
-         IN_-PACKAGE '"BOOTTRAN"
-         b:=bStreamNull s
-         setCurrentPackage a
-         b
- 
-PSTTOMC string==
-   $GenVarCounter:local := 0
-   shoePCompileTrees shoeTransformString string
- 
-BOOTLOOP ()==
-    a:=READ_-LINE()
-    #a=0=>
-         WRITE_-LINE '"Boot Loop; to exit type ] "
-         BOOTLOOP()
-    b:=shoePrefix? ('")console",a)
-    b =>
-         stream:= _*TERMINAL_-IO_*
-         PSTTOMC bRgen stream
-         BOOTLOOP()
-    a.0='"]".0 => nil
-    PSTTOMC [a]
-    BOOTLOOP()
- 
-BOOTPO ()==
-    a:=READ_-LINE()
-    #a=0=>
-         WRITE_-LINE '"Boot Loop; to exit type ] "
-         BOOTPO()
-    b:=shoePrefix? ('")console",a)
-    b =>
-         stream:= _*TERMINAL_-IO_*
-         PSTOUT bRgen stream
-         BOOTPO()
-    a.0='"]".0 => nil
-    PSTOUT [a]
-    BOOTPO()
- 
-PSTOUT string==
-   callingPackage := _*PACKAGE_*
-   IN_-PACKAGE '"BOOTTRAN"
-   $GenVarCounter:local := 0
-   result := shoeConsoleTrees shoeTransformString string
-   setCurrentPackage callingPackage
-   result
-
-
-defaultBootToLispFile file ==
-  CONCAT(shoeRemovebootIfNec file,'".clisp")
-
-translateBootFile(progname, options, file) ==
-  outFile := getOutputPathname(options)
-  BOOTTOCL(file, ENOUGH_-NAMESTRING outFile)
-
-compileBootHandler(progname, options, file) ==
-  intFile := BOOTTOCL(file, defaultBootToLispFile file)
-  intFile => 
-    objFile := compileLispHandler(progname, options, intFile)
-    DELETE_-FILE intFile
-    objFile
-  nil
-
-associateRequestWithFileType(Option '"translate", '"boot", 
-                             function translateBootFile)
-associateRequestWithFileType(Option '"compile", '"boot", 
-                             function compileBootHandler)
-@
-
-<<translator.clisp>>=
 (EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-translator"))
 
 (IMPORT-MODULE "includer")
@@ -1219,6 +404,44 @@ associateRequestWithFileType(Option '"compile", '"boot",
 (DEFUN |shoeAddComment| (|l|)
   (PROG () (RETURN (CONCAT "; " (CAR |l|)))))
 
+(DEFUN |genImportDeclaration| (|op| |sig|)
+  (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+    (RETURN
+      (COND
+        ((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|Signature|)
+                   (PROGN
+                     (SETQ |ISTMP#1| (CDR |sig|))
+                     (AND (CONSP |ISTMP#1|)
+                          (PROGN
+                            (SETQ |op'| (CAR |ISTMP#1|))
+                            (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                            (AND (CONSP |ISTMP#2|)
+                                 (EQ (CDR |ISTMP#2|) NIL)
+                                 (PROGN
+                                   (SETQ |m| (CAR |ISTMP#2|))
+                                   #0='T)))))))
+         (|coreError| "invalid signature"))
+        ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|Mapping|)
+                   (PROGN
+                     (SETQ |ISTMP#1| (CDR |m|))
+                     (AND (CONSP |ISTMP#1|)
+                          (PROGN
+                            (SETQ |t| (CAR |ISTMP#1|))
+                            (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                            (AND (CONSP |ISTMP#2|)
+                                 (EQ (CDR |ISTMP#2|) NIL)
+                                 (PROGN
+                                   (SETQ |s| (CAR |ISTMP#2|))
+                                   #0#)))))))
+         (|coreError| "invalid function type"))
+        ((|%hasFeature| :GCL)
+         (PROGN
+           (COND ((SYMBOLP |s|) (SETQ |s| (LIST |s|))))
+           (LIST 'DEFENTRY |op| |s| (LIST |t| (SYMBOL-NAME |op'|)))))
+        ('T
+         (|fatalError|
+             "import declaration not implemented for this Lisp"))))))
+
 (DEFUN |shoeOutParse| (|stream|)
   (PROG (|$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs|
             |$op| |$ttok| |$stok| |$stack| |$inputStream| |found|)
@@ -1280,6 +503,11 @@ associateRequestWithFileType(Option '"compile", '"boot",
                (|Import|
                    (LET ((|m| (CAR |bfVar#6|)))
                      (|bpPush| (LIST (LIST 'IMPORT-MODULE |m|)))))
+               (|ImportSignature|
+                   (LET ((|x| (CAR |bfVar#6|))
+                         (|sig| (CADR |bfVar#6|)))
+                     (|bpPush|
+                         (LIST (|genImportDeclaration| |x| |sig|)))))
                (|TypeAlias|
                    (LET ((|t| (CAR |bfVar#6|))
                          (|args| (CADR |bfVar#6|))
@@ -1926,6 +1154,3 @@ associateRequestWithFileType(Option '"compile", '"boot",
       (|associateRequestWithFileType| (|Option| "compile") "boot"
           #'|compileBootHandler|))))
 
-@
-
-\end{document}
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
new file mode 100644
index 00000000..a64c6d56
--- /dev/null
+++ b/src/boot/tokens.boot
@@ -0,0 +1,411 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+module '"boot-tokens"
+import '"initial-env"
+
+)package "BOOTTRAN"
+
+++ Table of Boot keywords and their token name.
+shoeKeyWords := [  _
+            ['"and","AND"] , _
+            ['"by", "BY" ], _
+            ['"case","CASE"] , _
+            ['"cross","CROSS"] , _
+            ['"else", "ELSE"] , _
+            ['"for",  "FOR"] , _
+            ['"if", "IF"], _
+            ['"import", "IMPORT"], _
+            ['"in",  "IN" ], _
+            ['"is", "IS"], _
+            ['"isnt", "ISNT"] , _
+            ['"module", "MODULE"], _
+            ['"of",   "OF"] , _
+            ['"or",   "OR"] , _
+            ['"repeat", "REPEAT"] , _
+            ['"return", "RETURN"], _
+            ['"structure", "STRUCTURE"], _
+            ['"then",  "THEN"], _
+            ['"until",  "UNTIL"], _
+            ['"where",  "WHERE"], _
+            ['"while",  "WHILE"], _
+            ['".", "DOT"], _
+            ['":", "COLON"], _
+            ['"::", "COLON-COLON"], _
+            ['",", "COMMA"], _
+            ['";", "SEMICOLON"], _
+            ['"*", "TIMES"], _
+            ['"**", "POWER"], _
+            ['"/",  "SLASH"], _
+            ['"+", "PLUS"], _
+            ['"-", "MINUS"], _
+            ['"<", "LT"], _
+            ['">", "GT"] , _
+            ['"<=","LE" ], _
+            ['">=","GE" ], _
+            ['"=", "SHOEEQ"], _
+            ['"^", "NOT"], _
+            ['"^=","SHOENE" ], _
+            ['"..","SEG" ], _
+            ['"#", "LENGTH"], _
+            ['"=>","EXIT" ], _
+            ['"->", "ARROW"],_
+            ['":=", "BEC"], _
+            ['"==", "DEF"], _
+            ['"==>","MDEF" ], _
+            ['"<=>", "TDEF"], _
+            ['"(", "OPAREN"], _
+            ['")", "CPAREN"], _
+            ['"(|", "OBRACK"], _
+            ['"|)", "CBRACK"], _
+            ['"[", "OBRACK"], _
+            ['"]", "CBRACK"], _
+            ['"suchthat","BAR"], _
+            ['"'", "QUOTE"], _
+            ['"|", "BAR"]                          ]
+ 
+
+ 
+shoeKeyTableCons()==
+   KeyTable:=MAKE_-HASHTABLE("CVEC")
+   for st in shoeKeyWords repeat
+      HPUT(KeyTable,CAR st,CADR st)
+   KeyTable
+ 
+shoeKeyTable:=shoeKeyTableCons()
+ 
+shoeSPACE       := QENUM('"    ", 0)
+ 
+shoeESCAPE      := QENUM('"__  ", 0)
+shoeLispESCAPE      := QENUM('"!  ", 0)
+ 
+shoeSTRING_CHAR := QENUM('"_"  ", 0)
+ 
+shoePLUSCOMMENT := QENUM('"+   ", 0)
+ 
+shoeMINUSCOMMENT:= QENUM('"-   ", 0)
+ 
+shoeDOT         := QENUM('".   ", 0)
+ 
+shoeEXPONENT1   := QENUM('"E   ", 0)
+ 
+shoeEXPONENT2   := QENUM('"e   ", 0)
+ 
+shoeCLOSEPAREN  := QENUM('")   ", 0)
+ 
+--shoeCLOSEANGLE  := QENUM('">   ", 0)
+shoeTAB := 9
+ 
+shoeInsert(s,d) ==
+      l := #s
+      h := QENUM(s,0)
+      u := ELT(d,h)
+      n := #u
+      k:=0
+      while l <= #(ELT(u,k)) repeat
+          k:=k+1
+      v := MAKE_-VEC(n+1)
+      for i in 0..k-1 repeat VEC_-SETELT(v,i,ELT(u,i))
+      VEC_-SETELT(v,k,s)
+      for i in k..n-1 repeat VEC_-SETELT(v,i+1,ELT(u,i))
+      VEC_-SETELT(d,h,v)
+      s
+ 
+shoeDictCons()==
+      l:= HKEYS shoeKeyTable
+      d :=
+          a:=MAKE_-VEC(256)
+          b:=MAKE_-VEC(1)
+          VEC_-SETELT(b,0,MAKE_-CVEC 0)
+          for i in 0..255 repeat VEC_-SETELT(a,i,b)
+          a
+      for s in l repeat shoeInsert(s,d)
+      d
+ 
+shoeDict:=shoeDictCons()
+ 
+ 
+shoePunCons()==
+    listing := HKEYS shoeKeyTable
+    a:=MAKE_-BVEC 256
+    for i in 0..255 repeat BVEC_-SETELT(a,i,0)
+    for k in listing repeat
+       if not shoeStartsId k.0
+       then BVEC_-SETELT(a,QENUM(k,0),1)
+    a
+ 
+shoePun:=shoePunCons()
+
+++ List of prefix operators. 
+for i in [ _
+             "NOT", _
+--           "COLON", _
+--           "SHOEEQ", _
+             "LENGTH"  _
+                     ] _
+       repeat SETF (GET(i,'SHOEPRE),'T)
+ 
+++ List of infix operators.
+for i in [      _
+        ["SHOEEQ"    ,"="], _
+        ["TIMES"    ,"*"], _
+        ["PLUS" ,"+"], _
+        ["IS"   ,"is"], _
+        ["ISNT" ,"isnt"], _
+        ["AND"  ,"and"], _
+        ["OR"   ,"or"], _
+        ["SLASH"    ,"/"], _
+        ["POWER"   ,"**"], _
+        ["MINUS"    ,"-"], _
+        ["LT"    ,"<"], _
+        ["GT"    ,">"], _
+        ["LE"   ,"<="], _
+        ["GE"   ,">="], _
+        ["SHOENE"  ,"^="] _
+                   ]_
+       repeat SETF (GET(CAR i,'SHOEINF),CADR i)
+ 
+
+++ List of monoid operations and their neutral elements.
+++ Note that `CONS' is not a monoid operations but support
+++ right reduction. 
+for i in [ _
+      ["+",         0] , _
+      ["gcd",       0] , _
+      ["lcm",       1] , _
+      ["STRCONC", '""] , _
+      ["strconc", '""] , _
+      ["MAX", -999999] , _
+      ["MIN",  999999] , _
+      ["*",         1] , _
+      ["times",         1] , _
+      ["CONS",    NIL] , _
+      ["APPEND",  NIL] , _
+      ["append",  NIL] , _
+      ["UNION",   NIL] , _
+      ["UNIONQ",  NIL] , _
+      ["union",   NIL] , _
+      ["NCONC",   NIL] , _
+      ["and",      'T] , _
+      ["or",      NIL] , _
+      ["AND",      'T] , _
+      ["OR",      NIL]   _
+                         ]
+ 
+       repeat SETF (GET(CAR i,'SHOETHETA),CDR i)
+for i in [ _
+  ["and",          "AND"]  , _
+  ["append",    "APPEND"]  , _
+  ["apply",      "APPLY"]  , _
+  ["atom",        "ATOM"]  , _
+  ["car",          "CAR"]  , _
+  ["cdr",          "CDR"]  , _
+  ["cons",        "CONS"]  , _
+  ["copy",        "COPY"]  , _
+  ["croak",      "CROAK"]  , _
+  ["drop",        "DROP"]  , _
+  ["exit",        "EXIT"]  , _
+  ["false",        'NIL]   , _
+  ["first",        "CAR"]  , _
+  ["function","FUNCTION"] , _
+  ["genvar",    "GENVAR"]  , _
+  ["IN",        "MEMBER"]  , _
+  ["is",            "IS"]  , _
+  ["isnt",        "ISNT"]  , _
+  ["lastNode",    "LAST"]  , _
+  ["LAST",        "last"] , _
+  ["list",        "LIST"]  , _
+--  ["member",        "MEMBER"]  , _
+  ["mkpf",        "MKPF"]  , _
+  ["nconc",      "NCONC"]  , _
+  ["nil"           ,NIL ]  , _
+  ["not",         "NULL"]  , _
+  ["NOT",         "NULL"]  , _
+  ["nreverse", "NREVERSE"]  , _
+  ["null",        "NULL"]  , _
+  ["or",            "OR"]  , _
+  ["otherwise",      "T"]  , _
+  ["PAIRP",      "CONSP"]  , _
+  ["removeDuplicates", "REMDUP"]  , _
+  ["rest",         "CDR"]  , _
+  ["reverse",  "REVERSE"]  , _
+  ["setDifference", "SETDIFFERENCE"]  , _
+  ["setIntersection", "INTERSECTION"]  , _
+  ["setPart",   "SETELT"]  , _
+  ["setUnion",   "UNION"]  , _
+  ["size",        "SIZE"]  , _
+  ["strconc",  "CONCAT"]  , _
+  ["substitute", "SUBST"]  , _
+  ["take",        "TAKE"]  , _
+  ["true",           "T"]  , _
+  ["PLUS",           "+"]  , _
+  ["MINUS",     "-"]  , _
+  ["TIMES",          "*"]  , _
+  ["POWER",          "EXPT"]  , _
+  ["SLASH",       "/"]  , _
+  ["LT",              "<"], _
+  ["GT",              ">"] , _
+  ["LE",             "<="], _
+  ["GE",              ">="], _
+  ["SHOEEQ",        "EQUAL"], _
+  ["SHOENE",        "/="], _
+  ["T",               "T$"]   _
+                                ]
+       repeat SETF (GET(CAR i,'SHOERENAME),CDR i)
+
+-- For code written in `Old Boot', we would like to warn about
+-- the difference in renaming.
+for i in [ _
+  ["PLUS", "PLUS"], _
+  ["and", "AND"], _
+  ["append", "APPEND"], _
+  ["apply", "APPLY"], _
+  ["atom", "ATOM"], _
+  ["brace", "REMDUP"], _
+  ["car", "CAR"], _
+  ["cdr", "CDR"], _
+  ["cons", "CONS"], _
+  ["copy", "COPY"], _
+  ["croak", "CROAK"], _
+  ["drop", "DROP"], _
+  ["exit", "EXIT"], _
+  ["false", "NIL"], _
+  ["first", "CAR"], _
+  ["genvar", "GENVAR"], _
+  ["in", "member"], _
+  ["is", "IS"], _
+  ["lastNode", "LASTNODE"], _
+  ["list", "LIST"], _
+  ["mkpf", "MKPF"], _
+  ["nconc", "NCONC"], _
+  ["nil", "NIL"], _
+  ["not", "NULL"], _
+  ["NOT", "NULL"], _
+  ["nreverse", "NREVERSE"], _
+  ["null", "NULL"], _
+  ["or", "OR"], _
+  ["otherwise", "T"], _
+  ["removeDuplicates", "REMDUP"], _
+  ["rest", "CDR"], _
+  ["return", "RETURN"], _
+  ["reverse", "REVERSE"], _
+  ["setDifference", "SETDIFFERENCE"], _
+  ["setIntersection", "intersection"], _
+  ["setPart", "SETELT"], _
+  ["setUnion", "union"], _
+  ["size", "SIZE"], _
+  ["strconc", "STRCONC"], _
+  ["substitute", "MSUBST"], _
+  ["SUBST", "MSUBST"], _
+  ["take", "TAKE"], _
+  ["true", "T"], _
+  ["where", "WHERE"], _
+  ["TIMES", "TIMES"], _
+  ["POWER", "EXPT"], _
+  ["NOT", "NULL"], _
+  ["SHOENE", "NEQUAL"], _
+  ["MINUS", "SPADDIFFERENCE"], _
+  ["SLASH", "QUOTIENT"], _
+  ["=", "EQUAL"], _
+  ["SHOEEQ", "EQUAL"], _
+  ["ASSOC",  "assoc"], _
+  ["DELETE", "delete"], _
+  ["GET", "GETL"], _
+  ["INTERSECTION", "intersection"], _
+  ["LAST", "last"], _
+  ["MEMBER", "member"], _
+  ["RASSOC", "rassoc"], _
+  ["READ", "VMREAD"], _
+  ["READ-LINE", "read-line"], _
+  ["REDUCE", "SPADREDUCE"], _
+  ["REMOVE", "remove"], _
+  ["BAR", "SUCHTHAT"], _
+  ["T", "T$"], _
+  ["IN", "member"], _
+  ["UNION", "union"]_
+                     ]
+  repeat SETF (GET(CAR i,'OLD_-BOOT),CDR i)
+
+-- The following difference in renaming are verified to be OK.
+for i in [ _
+  "LT", "LE", _
+  "GT", "GE", _
+  "SHOENE", _
+  "TIMES", "PLUS", _
+  "MINUS", "function",_
+  "PAIRP"
+   ]
+  repeat SETF(GET(i, 'RENAME_-OK), true)
+
+  
+ 
+for i in [ _
+  ["setName",               0] , _
+  ["setLabel",              1] , _
+  ["setLevel",              2] , _
+  ["setType",               3] , _
+  ["setVar",                4] , _
+  ["setLeaf",               5] , _
+  ["setDef",                6] , _
+  ["aGeneral",              4] , _
+  ["aMode",                 1] , _
+  ["aModeSet",              3] , _
+  ["aTree",                 0] , _
+  ["aValue",                2] , _
+  ["attributes",       "CADDR"] , _
+  ["cacheCount",     "CADDDDR"] , _
+  ["cacheName",         "CADR"] , _
+  ["cacheReset",      "CADDDR"] , _
+  ["cacheType",        "CADDR"] , _
+  ["env",              "CADDR"] , _
+  ["expr",               "CAR"] , _
+  ["CAR",                "CAR"] , _
+  ["mmCondition",      "CAADR"] , _
+  ["mmDC",              "CAAR"] , _
+  ["mmImplementation","CADADR"] , _
+  ["mmSignature",       "CDAR"] , _
+  ["mmTarget",         "CADAR"] , _
+  ["mode",              "CADR"] , _
+  ["op",                 "CAR"] , _
+  ["opcode",            "CADR"] , _
+  ["opSig",             "CADR"] , _
+  ["CDR",               "CDR"] , _
+  ["sig",               "CDDR"] , _
+  ["source",             "CDR"] , _
+  ["streamCode",      "CADDDR"] , _
+  ["streamDef",        "CADDR"] , _
+  ["streamName",        "CADR"] , _
+  ["target",             "CAR"]  _
+                             ] _
+       repeat SETF (GET(CAR i,'SHOESELFUNCTION),CADR i)
diff --git a/src/boot/tokens.boot.pamphlet b/src/boot/tokens.boot.pamphlet
deleted file mode 100644
index bb4d7ec2..00000000
--- a/src/boot/tokens.boot.pamphlet
+++ /dev/null
@@ -1,897 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/boot/tokens.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-
-\begin{abstract}
-\end{abstract}
-
-\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.
-@
-
-
-\section{Key words}
-\label{sec:boot:key-words}
-
-The following tokens are reserved as Boot key words:
-\begin{center}
-\begin{tabular}{lllllll}
-  \Code{and} & \Code{by} & \Code{case} & 
-  \Code{cross} & \Code{else} &  \Code{for} & \Code{if} 
-  \\ 
-  \Code{import} & \Code{in} & \Code{is} & 
-  \Code{isnt} & \Code{module} &  \Code{of} & \Code{or}
-  \\
-  \Code{repeat} &\Code{return} & \Code{structure} & 
-  \Code{then} & \Code{until} & \Code{where} & \Code{while}
-  \\
-   \Code{.} & \Code{:} & \Code{::} & 
-   \Code{,} & \Code{;} & \Code{*} & \Code{**}
-  \\
-   \Code{/} & \Code{+} & \Code{-} & 
-   \Code{<} &  \Code{>} & \Code{<=} & \Code{>=}
-  \\
-   \Code{=} & \Code{\^} & \verb!\^=! &
-   \Code{..} &  \Code{\#} & \Code{=>} & \Code{:=}
-  \\
-   \Code{==} & \Code{==>} & \Code{(} & 
-    \Code{)} &  \Code{[} &  \Code{]} & \Code{'}
-  \\	     
-  \Code{|}
-\end{tabular}
-\end{center}
-
-
-\section{Prefix operators}
-\label{sec:boot:prefix-ops}
-
-The following key words designate prefix operators
-\begin{center}
-  \begin{tabular}{ll}
-    \Code{not} & \Code{\#}
-  \end{tabular}
-\end{center}
-
-
-\section{Infix operators}
-\label{sec:boot:infix-ops}
-
-The following key words designate infix operators
-\begin{center}
-  \begin{tabular}{llllll}
-    \Code{=} & \Code{*} & \Code{+} & \Code{is} & \Code{isnt} & \Code{and}
-    \\
-    \Code{or} & \Code{/} & \Code{**} &  \Code{-} & \Code{<} & \Code{>}
-    \\
-    & \Code{<=} & \Code{>=} & \verb!^=!
-  \end{tabular}
-\end{center}
-
-
-\section{Monoid operations and reduction}
-\label{sec:boot:monoid-ops}
-
-Some Boot standard operations are monoid functions, therefore
-usable as operand to the reduction functional.  We list below
-all such Boot standard operations, along with their neutral elements.
-\begin{center}
-  \begin{tabular}{|ll|ll|ll|}
-    \hline
-    Operation & Unit & Operation & Unit & Operation & Unit
-    \\
-    \hline
-    \Code{+} & \Code{0} & 
-    \Code{gdc} & \Code{0} &
-    \Code{lcm} & \Code{1}
-    \\
-    \Code{STRCONC} & \Code{""} &
-    \Code{strconc} & \Code{""} &
-    \Code{MAX} & \Code{-999999}
-    \\
-    \Code{MIN} & \Code{999999} &
-    \Code{*} & \Code{1} &
-    \Code{times} & \Code{1}
-    \\
-    \Code{CONS} & \Code{nil} &
-    \Code{APPEND} & \Code{nil} & 
-    \Code{append} & \Code{nil} 
-    \\
-    \Code{UNION} & \Code{nil} &
-    \Code{UNIONQ} & \Code{nil} & 
-    \Code{union} & \Code{nil}
-    \\
-    \Code{NCONC} & \Code{nil} &
-    \Code{and} & \Code{true} &
-    \Code{or} & \Code{false}
-    \\
-    \Code{AND} & \Code{true} &
-    \Code{OR} & \Code{false} &
-    \\
-    \hline
-  \end{tabular}
-\end{center}
-
-Note that \Code{CONS} is not a monoid operation; it however supports
-right reduction.
-
-
-
-
-\section{Putting everything together}
-
-<<*>>=
-<<license>>
-
-module '"boot-tokens"
-import '"initial-env"
-
-)package "BOOTTRAN"
-
-shoeKeyWords := [  _
-            ['"and","AND"] , _
-            ['"by", "BY" ], _
-            ['"case","CASE"] , _
-            ['"cross","CROSS"] , _
-            ['"else", "ELSE"] , _
-            ['"for",  "FOR"] , _
-            ['"if", "IF"], _
-	    ['"import", "IMPORT"], _
-            ['"in",  "IN" ], _
-            ['"is", "IS"], _
-            ['"isnt", "ISNT"] , _
-            ['"module", "MODULE"], _
-            ['"of",   "OF"] , _
-            ['"or",   "OR"] , _
-            ['"repeat", "REPEAT"] , _
-            ['"return", "RETURN"], _
-            ['"structure", "STRUCTURE"], _
-            ['"then",  "THEN"], _
-            ['"until",  "UNTIL"], _
-            ['"where",  "WHERE"], _
-            ['"while",  "WHILE"], _
-            ['".", "DOT"], _
-            ['":", "COLON"], _
-            ['"::", "COLON-COLON"], _
-            ['",", "COMMA"], _
-            ['";", "SEMICOLON"], _
-            ['"*", "TIMES"], _
-            ['"**", "POWER"], _
-            ['"/",  "SLASH"], _
-            ['"+", "PLUS"], _
-            ['"-", "MINUS"], _
-            ['"<", "LT"], _
-            ['">", "GT"] , _
-            ['"<=","LE" ], _
-            ['">=","GE" ], _
-            ['"=", "SHOEEQ"], _
-            ['"^", "NOT"], _
-            ['"^=","SHOENE" ], _
-            ['"..","SEG" ], _
-            ['"#", "LENGTH"], _
-            ['"=>","EXIT" ], _
-            ['"->", "ARROW"],_
-            ['":=", "BEC"], _
-            ['"==", "DEF"], _
-            ['"==>","MDEF" ], _
-	    ['"<=>", "TDEF"], _
-            ['"(", "OPAREN"], _
-            ['")", "CPAREN"], _
-            ['"(|", "OBRACK"], _
-            ['"|)", "CBRACK"], _
-            ['"[", "OBRACK"], _
-            ['"]", "CBRACK"], _
-            ['"suchthat","BAR"], _
-            ['"'", "QUOTE"], _
-            ['"|", "BAR"]                          ]
- 
-
- 
-shoeKeyTableCons()==
-   KeyTable:=MAKE_-HASHTABLE("CVEC")
-   for st in shoeKeyWords repeat
-      HPUT(KeyTable,CAR st,CADR st)
-   KeyTable
- 
-shoeKeyTable:=shoeKeyTableCons()
- 
-shoeSPACE       := QENUM('"    ", 0)
- 
-shoeESCAPE      := QENUM('"__  ", 0)
-shoeLispESCAPE      := QENUM('"!  ", 0)
- 
-shoeSTRING_CHAR := QENUM('"_"  ", 0)
- 
-shoePLUSCOMMENT := QENUM('"+   ", 0)
- 
-shoeMINUSCOMMENT:= QENUM('"-   ", 0)
- 
-shoeDOT         := QENUM('".   ", 0)
- 
-shoeEXPONENT1   := QENUM('"E   ", 0)
- 
-shoeEXPONENT2   := QENUM('"e   ", 0)
- 
-shoeCLOSEPAREN  := QENUM('")   ", 0)
- 
---shoeCLOSEANGLE  := QENUM('">   ", 0)
-shoeTAB := 9
- 
-shoeInsert(s,d) ==
-      l := #s
-      h := QENUM(s,0)
-      u := ELT(d,h)
-      n := #u
-      k:=0
-      while l <= #(ELT(u,k)) repeat
-          k:=k+1
-      v := MAKE_-VEC(n+1)
-      for i in 0..k-1 repeat VEC_-SETELT(v,i,ELT(u,i))
-      VEC_-SETELT(v,k,s)
-      for i in k..n-1 repeat VEC_-SETELT(v,i+1,ELT(u,i))
-      VEC_-SETELT(d,h,v)
-      s
- 
-shoeDictCons()==
-      l:= HKEYS shoeKeyTable
-      d :=
-          a:=MAKE_-VEC(256)
-          b:=MAKE_-VEC(1)
-          VEC_-SETELT(b,0,MAKE_-CVEC 0)
-          for i in 0..255 repeat VEC_-SETELT(a,i,b)
-          a
-      for s in l repeat shoeInsert(s,d)
-      d
- 
-shoeDict:=shoeDictCons()
- 
- 
-shoePunCons()==
-    listing := HKEYS shoeKeyTable
-    a:=MAKE_-BVEC 256
-    for i in 0..255 repeat BVEC_-SETELT(a,i,0)
-    for k in listing repeat
-       if not shoeStartsId k.0
-       then BVEC_-SETELT(a,QENUM(k,0),1)
-    a
- 
-shoePun:=shoePunCons()
- 
-for i in [ _
-             "NOT", _
---           "COLON", _
---           "SHOEEQ", _
-             "LENGTH"  _
-                     ] _
-       repeat SETF (GET(i,'SHOEPRE),'T)
- 
-for i in [      _
-        ["SHOEEQ"    ,"="], _
-        ["TIMES"    ,"*"], _
-        ["PLUS" ,"+"], _
-        ["IS"   ,"is"], _
-        ["ISNT" ,"isnt"], _
-        ["AND"  ,"and"], _
-        ["OR"   ,"or"], _
-        ["SLASH"    ,"/"], _
-        ["POWER"   ,"**"], _
-        ["MINUS"    ,"-"], _
-        ["LT"    ,"<"], _
-        ["GT"    ,">"], _
-        ["LE"   ,"<="], _
-        ["GE"   ,">="], _
-        ["SHOENE"  ,"^="] _
-                   ]_
-       repeat SETF (GET(CAR i,'SHOEINF),CADR i)
- 
- 
-for i in [ _
-      ["+",         0] , _
-      ["gcd",       0] , _
-      ["lcm",       1] , _
-      ["STRCONC", '""] , _
-      ["strconc", '""] , _
-      ["MAX", -999999] , _
-      ["MIN",  999999] , _
-      ["*",         1] , _
-      ["times",         1] , _
-      ["CONS",    NIL] , _
-      ["APPEND",  NIL] , _
-      ["append",  NIL] , _
-      ["UNION",   NIL] , _
-      ["UNIONQ",  NIL] , _
-      ["union",   NIL] , _
-      ["NCONC",   NIL] , _
-      ["and",      'T] , _
-      ["or",      NIL] , _
-      ["AND",      'T] , _
-      ["OR",      NIL]   _
-                         ]
- 
-       repeat SETF (GET(CAR i,'SHOETHETA),CDR i)
-for i in [ _
-  ["and",          "AND"]  , _
-  ["append",    "APPEND"]  , _
-  ["apply",      "APPLY"]  , _
-  ["atom",        "ATOM"]  , _
-  ["car",          "CAR"]  , _
-  ["cdr",          "CDR"]  , _
-  ["cons",        "CONS"]  , _
-  ["copy",        "COPY"]  , _
-  ["croak",      "CROAK"]  , _
-  ["drop",        "DROP"]  , _
-  ["exit",        "EXIT"]  , _
-  ["false",        'NIL]   , _
-  ["first",        "CAR"]  , _
-  ["function","FUNCTION"] , _
-  ["genvar",    "GENVAR"]  , _
-  ["IN",        "MEMBER"]  , _
-  ["is",            "IS"]  , _
-  ["isnt",        "ISNT"]  , _
-  ["lastNode",    "LAST"]  , _
-  ["LAST",        "last"] , _
-  ["list",        "LIST"]  , _
---  ["member",        "MEMBER"]  , _
-  ["mkpf",        "MKPF"]  , _
-  ["nconc",      "NCONC"]  , _
-  ["nil"           ,NIL ]  , _
-  ["not",         "NULL"]  , _
-  ["NOT",         "NULL"]  , _
-  ["nreverse", "NREVERSE"]  , _
-  ["null",        "NULL"]  , _
-  ["or",            "OR"]  , _
-  ["otherwise",      "T"]  , _
-  ["PAIRP",      "CONSP"]  , _
-  ["removeDuplicates", "REMDUP"]  , _
-  ["rest",         "CDR"]  , _
-  ["reverse",  "REVERSE"]  , _
-  ["setDifference", "SETDIFFERENCE"]  , _
-  ["setIntersection", "INTERSECTION"]  , _
-  ["setPart",   "SETELT"]  , _
-  ["setUnion",   "UNION"]  , _
-  ["size",        "SIZE"]  , _
-  ["strconc",  "CONCAT"]  , _
-  ["substitute", "SUBST"]  , _
-  ["take",        "TAKE"]  , _
-  ["true",           "T"]  , _
-  ["PLUS",           "+"]  , _
-  ["MINUS",     "-"]  , _
-  ["TIMES",          "*"]  , _
-  ["POWER",          "EXPT"]  , _
-  ["SLASH",       "/"]  , _
-  ["LT",              "<"], _
-  ["GT",              ">"] , _
-  ["LE",             "<="], _
-  ["GE",              ">="], _
-  ["SHOEEQ",        "EQUAL"], _
-  ["SHOENE",        "/="], _
-  ["T",               "T$"]   _
-                                ]
-       repeat SETF (GET(CAR i,'SHOERENAME),CDR i)
-
--- For code written in `Old Boot', we would like to warn about
--- the difference in renaming.
-for i in [ _
-  ["PLUS", "PLUS"], _
-  ["and", "AND"], _
-  ["append", "APPEND"], _
-  ["apply", "APPLY"], _
-  ["atom", "ATOM"], _
-  ["brace", "REMDUP"], _
-  ["car", "CAR"], _
-  ["cdr", "CDR"], _
-  ["cons", "CONS"], _
-  ["copy", "COPY"], _
-  ["croak", "CROAK"], _
-  ["drop", "DROP"], _
-  ["exit", "EXIT"], _
-  ["false", "NIL"], _
-  ["first", "CAR"], _
-  ["genvar", "GENVAR"], _
-  ["in", "member"], _
-  ["is", "IS"], _
-  ["lastNode", "LASTNODE"], _
-  ["list", "LIST"], _
-  ["mkpf", "MKPF"], _
-  ["nconc", "NCONC"], _
-  ["nil", "NIL"], _
-  ["not", "NULL"], _
-  ["NOT", "NULL"], _
-  ["nreverse", "NREVERSE"], _
-  ["null", "NULL"], _
-  ["or", "OR"], _
-  ["otherwise", "T"], _
-  ["removeDuplicates", "REMDUP"], _
-  ["rest", "CDR"], _
-  ["return", "RETURN"], _
-  ["reverse", "REVERSE"], _
-  ["setDifference", "SETDIFFERENCE"], _
-  ["setIntersection", "intersection"], _
-  ["setPart", "SETELT"], _
-  ["setUnion", "union"], _
-  ["size", "SIZE"], _
-  ["strconc", "STRCONC"], _
-  ["substitute", "MSUBST"], _
-  ["SUBST", "MSUBST"], _
-  ["take", "TAKE"], _
-  ["true", "T"], _
-  ["where", "WHERE"], _
-  ["TIMES", "TIMES"], _
-  ["POWER", "EXPT"], _
-  ["NOT", "NULL"], _
-  ["SHOENE", "NEQUAL"], _
-  ["MINUS", "SPADDIFFERENCE"], _
-  ["SLASH", "QUOTIENT"], _
-  ["=", "EQUAL"], _
-  ["SHOEEQ", "EQUAL"], _
-  ["ASSOC",  "assoc"], _
-  ["DELETE", "delete"], _
-  ["GET", "GETL"], _
-  ["INTERSECTION", "intersection"], _
-  ["LAST", "last"], _
-  ["MEMBER", "member"], _
-  ["RASSOC", "rassoc"], _
-  ["READ", "VMREAD"], _
-  ["READ-LINE", "read-line"], _
-  ["REDUCE", "SPADREDUCE"], _
-  ["REMOVE", "remove"], _
-  ["BAR", "SUCHTHAT"], _
-  ["T", "T$"], _
-  ["IN", "member"], _
-  ["UNION", "union"]_
-                     ]
-  repeat SETF (GET(CAR i,'OLD_-BOOT),CDR i)
-
--- The following difference in renaming are verified to be OK.
-for i in [ _
-  "LT", "LE", _
-  "GT", "GE", _
-  "SHOENE", _
-  "TIMES", "PLUS", _
-  "MINUS", "function",_
-  "PAIRP"
-   ]
-  repeat SETF(GET(i, 'RENAME_-OK), true)
-
-  
- 
-for i in [ _
-  ["setName",               0] , _
-  ["setLabel",              1] , _
-  ["setLevel",              2] , _
-  ["setType",               3] , _
-  ["setVar",                4] , _
-  ["setLeaf",               5] , _
-  ["setDef",                6] , _
-  ["aGeneral",              4] , _
-  ["aMode",                 1] , _
-  ["aModeSet",              3] , _
-  ["aTree",                 0] , _
-  ["aValue",                2] , _
-  ["attributes",       "CADDR"] , _
-  ["cacheCount",     "CADDDDR"] , _
-  ["cacheName",         "CADR"] , _
-  ["cacheReset",      "CADDDR"] , _
-  ["cacheType",        "CADDR"] , _
-  ["env",              "CADDR"] , _
-  ["expr",               "CAR"] , _
-  ["CAR",                "CAR"] , _
-  ["mmCondition",      "CAADR"] , _
-  ["mmDC",              "CAAR"] , _
-  ["mmImplementation","CADADR"] , _
-  ["mmSignature",       "CDAR"] , _
-  ["mmTarget",         "CADAR"] , _
-  ["mode",              "CADR"] , _
-  ["op",                 "CAR"] , _
-  ["opcode",            "CADR"] , _
-  ["opSig",             "CADR"] , _
-  ["CDR",               "CDR"] , _
-  ["sig",               "CDDR"] , _
-  ["source",             "CDR"] , _
-  ["streamCode",      "CADDDR"] , _
-  ["streamDef",        "CADDR"] , _
-  ["streamName",        "CADR"] , _
-  ["target",             "CAR"]  _
-                             ] _
-       repeat SETF (GET(CAR i,'SHOESELFUNCTION),CADR i)
-@
-
-<<tokens.clisp>>=
-(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-tokens"))
-
-(IMPORT-MODULE "initial-env")
-
-(IN-PACKAGE "BOOTTRAN")
-
-(DEFPARAMETER |shoeKeyWords|
-    (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
-          (LIST "cross" 'CROSS) (LIST "else" 'ELSE) (LIST "for" 'FOR)
-          (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
-          (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
-          (LIST "of" 'OF) (LIST "or" 'OR) (LIST "repeat" 'REPEAT)
-          (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE)
-          (LIST "then" 'THEN) (LIST "until" 'UNTIL)
-          (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT)
-          (LIST ":" 'COLON) (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
-          (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
-          (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS)
-          (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
-          (LIST "=" 'SHOEEQ) (LIST "^" 'NOT) (LIST "^=" 'SHOENE)
-          (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT)
-          (LIST ":=" 'BEC) (LIST "==" 'DEF) (LIST "==>" 'MDEF)
-          (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN)
-          (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK) (LIST "[" 'OBRACK)
-          (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR) (LIST "'" 'QUOTE)
-          (LIST "|" 'BAR)))
-
-(DEFUN |shoeKeyTableCons| ()
-  (PROG (|KeyTable|)
-    (RETURN
-      (PROGN
-        (SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC))
-        (LET ((|bfVar#1| |shoeKeyWords|) (|st| NIL))
-          (LOOP
-            (COND
-              ((OR (ATOM |bfVar#1|)
-                   (PROGN (SETQ |st| (CAR |bfVar#1|)) NIL))
-               (RETURN NIL))
-              ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
-            (SETQ |bfVar#1| (CDR |bfVar#1|))))
-        |KeyTable|))))
-
-(DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|))
-
-(DEFPARAMETER |shoeSPACE| (QENUM "    " 0))
-
-(DEFPARAMETER |shoeESCAPE| (QENUM "_  " 0))
-
-(DEFPARAMETER |shoeLispESCAPE| (QENUM "!  " 0))
-
-(DEFPARAMETER |shoeSTRINGCHAR| (QENUM "\"  " 0))
-
-(DEFPARAMETER |shoePLUSCOMMENT| (QENUM "+   " 0))
-
-(DEFPARAMETER |shoeMINUSCOMMENT| (QENUM "-   " 0))
-
-(DEFPARAMETER |shoeDOT| (QENUM ".   " 0))
-
-(DEFPARAMETER |shoeEXPONENT1| (QENUM "E   " 0))
-
-(DEFPARAMETER |shoeEXPONENT2| (QENUM "e   " 0))
-
-(DEFPARAMETER |shoeCLOSEPAREN| (QENUM ")   " 0))
-
-(DEFPARAMETER |shoeTAB| 9)
-
-(DEFUN |shoeInsert| (|s| |d|)
-  (PROG (|v| |k| |n| |u| |h| |l|)
-    (RETURN
-      (PROGN
-        (SETQ |l| (LENGTH |s|))
-        (SETQ |h| (QENUM |s| 0))
-        (SETQ |u| (ELT |d| |h|))
-        (SETQ |n| (LENGTH |u|))
-        (SETQ |k| 0)
-        (LOOP
-          (COND
-            ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL))
-            (#0='T (SETQ |k| (+ |k| 1)))))
-        (SETQ |v| (MAKE-VEC (+ |n| 1)))
-        (LET ((|bfVar#2| (- |k| 1)) (|i| 0))
-          (LOOP
-            (COND
-              ((> |i| |bfVar#2|) (RETURN NIL))
-              (#0# (VEC-SETELT |v| |i| (ELT |u| |i|))))
-            (SETQ |i| (+ |i| 1))))
-        (VEC-SETELT |v| |k| |s|)
-        (LET ((|bfVar#3| (- |n| 1)) (|i| |k|))
-          (LOOP
-            (COND
-              ((> |i| |bfVar#3|) (RETURN NIL))
-              (#0# (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|))))
-            (SETQ |i| (+ |i| 1))))
-        (VEC-SETELT |d| |h| |v|)
-        |s|))))
-
-(DEFUN |shoeDictCons| ()
-  (PROG (|d| |b| |a| |l|)
-    (RETURN
-      (PROGN
-        (SETQ |l| (HKEYS |shoeKeyTable|))
-        (SETQ |d|
-              (PROGN
-                (SETQ |a| (MAKE-VEC 256))
-                (SETQ |b| (MAKE-VEC 1))
-                (VEC-SETELT |b| 0 (MAKE-CVEC 0))
-                (LET ((|i| 0))
-                  (LOOP
-                    (COND
-                      ((> |i| 255) (RETURN NIL))
-                      (#0='T (VEC-SETELT |a| |i| |b|)))
-                    (SETQ |i| (+ |i| 1))))
-                |a|))
-        (LET ((|bfVar#4| |l|) (|s| NIL))
-          (LOOP
-            (COND
-              ((OR (ATOM |bfVar#4|)
-                   (PROGN (SETQ |s| (CAR |bfVar#4|)) NIL))
-               (RETURN NIL))
-              (#0# (|shoeInsert| |s| |d|)))
-            (SETQ |bfVar#4| (CDR |bfVar#4|))))
-        |d|))))
-
-(DEFPARAMETER |shoeDict| (|shoeDictCons|))
-
-(DEFUN |shoePunCons| ()
-  (PROG (|a| |listing|)
-    (RETURN
-      (PROGN
-        (SETQ |listing| (HKEYS |shoeKeyTable|))
-        (SETQ |a| (MAKE-BVEC 256))
-        (LET ((|i| 0))
-          (LOOP
-            (COND
-              ((> |i| 255) (RETURN NIL))
-              (#0='T (BVEC-SETELT |a| |i| 0)))
-            (SETQ |i| (+ |i| 1))))
-        (LET ((|bfVar#5| |listing|) (|k| NIL))
-          (LOOP
-            (COND
-              ((OR (ATOM |bfVar#5|)
-                   (PROGN (SETQ |k| (CAR |bfVar#5|)) NIL))
-               (RETURN NIL))
-              (#0#
-               (COND
-                 ((NULL (|shoeStartsId| (ELT |k| 0)))
-                  (BVEC-SETELT |a| (QENUM |k| 0) 1)))))
-            (SETQ |bfVar#5| (CDR |bfVar#5|))))
-        |a|))))
-
-(DEFPARAMETER |shoePun| (|shoePunCons|))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#6| (LIST 'NOT 'LENGTH)) (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#6|)
-                 (PROGN (SETQ |i| (CAR |bfVar#6|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET |i| 'SHOEPRE) 'T)))
-          (SETQ |bfVar#6| (CDR |bfVar#6|)))))))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#7|
-                (LIST (LIST 'SHOEEQ '=) (LIST 'TIMES '*)
-                      (LIST 'PLUS '+) (LIST 'IS '|is|)
-                      (LIST 'ISNT '|isnt|) (LIST 'AND '|and|)
-                      (LIST 'OR '|or|) (LIST 'SLASH '/)
-                      (LIST 'POWER '**) (LIST 'MINUS '-) (LIST 'LT '<)
-                      (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
-                      (LIST 'SHOENE '^=)))
-            (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#7|)
-                 (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET (CAR |i|) 'SHOEINF) (CADR |i|))))
-          (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#8|
-                (LIST (LIST '+ 0) (LIST '|gcd| 0) (LIST '|lcm| 1)
-                      (LIST 'STRCONC "") (LIST '|strconc| "")
-                      (LIST 'MAX (- 999999)) (LIST 'MIN 999999)
-                      (LIST '* 1) (LIST '|times| 1) (LIST 'CONS NIL)
-                      (LIST 'APPEND NIL) (LIST '|append| NIL)
-                      (LIST 'UNION NIL) (LIST 'UNIONQ NIL)
-                      (LIST '|union| NIL) (LIST 'NCONC NIL)
-                      (LIST '|and| 'T) (LIST '|or| NIL) (LIST 'AND 'T)
-                      (LIST 'OR NIL)))
-            (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#8|)
-                 (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET (CAR |i|) 'SHOETHETA) (CDR |i|))))
-          (SETQ |bfVar#8| (CDR |bfVar#8|)))))))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#9|
-                (LIST (LIST '|and| 'AND) (LIST '|append| 'APPEND)
-                      (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
-                      (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
-                      (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
-                      (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
-                      (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
-                      (LIST '|first| 'CAR) (LIST '|function| 'FUNCTION)
-                      (LIST '|genvar| 'GENVAR) (LIST 'IN 'MEMBER)
-                      (LIST '|is| 'IS) (LIST '|isnt| 'ISNT)
-                      (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
-                      (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
-                      (LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
-                      (LIST '|not| 'NULL) (LIST 'NOT 'NULL)
-                      (LIST '|nreverse| 'NREVERSE) (LIST '|null| 'NULL)
-                      (LIST '|or| 'OR) (LIST '|otherwise| 'T)
-                      (LIST 'PAIRP 'CONSP)
-                      (LIST '|removeDuplicates| 'REMDUP)
-                      (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
-                      (LIST '|setDifference| 'SETDIFFERENCE)
-                      (LIST '|setIntersection| 'INTERSECTION)
-                      (LIST '|setPart| 'SETELT)
-                      (LIST '|setUnion| 'UNION) (LIST '|size| 'SIZE)
-                      (LIST '|strconc| 'CONCAT)
-                      (LIST '|substitute| 'SUBST) (LIST '|take| 'TAKE)
-                      (LIST '|true| 'T) (LIST 'PLUS '+)
-                      (LIST 'MINUS '-) (LIST 'TIMES '*)
-                      (LIST 'POWER 'EXPT) (LIST 'SLASH '/)
-                      (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
-                      (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL)
-                      (LIST 'SHOENE '/=) (LIST 'T 'T$)))
-            (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#9|)
-                 (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET (CAR |i|) 'SHOERENAME) (CDR |i|))))
-          (SETQ |bfVar#9| (CDR |bfVar#9|)))))))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#10|
-                (LIST (LIST 'PLUS 'PLUS) (LIST '|and| 'AND)
-                      (LIST '|append| 'APPEND) (LIST '|apply| 'APPLY)
-                      (LIST '|atom| 'ATOM) (LIST '|brace| 'REMDUP)
-                      (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
-                      (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
-                      (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
-                      (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
-                      (LIST '|first| 'CAR) (LIST '|genvar| 'GENVAR)
-                      (LIST '|in| '|member|) (LIST '|is| 'IS)
-                      (LIST '|lastNode| 'LASTNODE) (LIST '|list| 'LIST)
-                      (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC)
-                      (LIST '|nil| 'NIL) (LIST '|not| 'NULL)
-                      (LIST 'NOT 'NULL) (LIST '|nreverse| 'NREVERSE)
-                      (LIST '|null| 'NULL) (LIST '|or| 'OR)
-                      (LIST '|otherwise| 'T)
-                      (LIST '|removeDuplicates| 'REMDUP)
-                      (LIST '|rest| 'CDR) (LIST '|return| 'RETURN)
-                      (LIST '|reverse| 'REVERSE)
-                      (LIST '|setDifference| 'SETDIFFERENCE)
-                      (LIST '|setIntersection| '|intersection|)
-                      (LIST '|setPart| 'SETELT)
-                      (LIST '|setUnion| '|union|) (LIST '|size| 'SIZE)
-                      (LIST '|strconc| 'STRCONC)
-                      (LIST '|substitute| 'MSUBST)
-                      (LIST 'SUBST 'MSUBST) (LIST '|take| 'TAKE)
-                      (LIST '|true| 'T) (LIST '|where| 'WHERE)
-                      (LIST 'TIMES 'TIMES) (LIST 'POWER 'EXPT)
-                      (LIST 'NOT 'NULL) (LIST 'SHOENE 'NEQUAL)
-                      (LIST 'MINUS 'SPADDIFFERENCE)
-                      (LIST 'SLASH 'QUOTIENT) (LIST '= 'EQUAL)
-                      (LIST 'SHOEEQ 'EQUAL) (LIST 'ASSOC '|assoc|)
-                      (LIST 'DELETE '|delete|) (LIST 'GET 'GETL)
-                      (LIST 'INTERSECTION '|intersection|)
-                      (LIST 'LAST '|last|) (LIST 'MEMBER '|member|)
-                      (LIST 'RASSOC '|rassoc|) (LIST 'READ 'VMREAD)
-                      (LIST 'READ-LINE '|read-line|)
-                      (LIST 'REDUCE 'SPADREDUCE)
-                      (LIST 'REMOVE '|remove|) (LIST 'BAR 'SUCHTHAT)
-                      (LIST 'T 'T$) (LIST 'IN '|member|)
-                      (LIST 'UNION '|union|)))
-            (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#10|)
-                 (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET (CAR |i|) 'OLD-BOOT) (CDR |i|))))
-          (SETQ |bfVar#10| (CDR |bfVar#10|)))))))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#11|
-                (LIST 'LT 'LE 'GT 'GE 'SHOENE 'TIMES 'PLUS 'MINUS
-                      '|function| 'PAIRP))
-            (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#11|)
-                 (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET |i| 'RENAME-OK) T)))
-          (SETQ |bfVar#11| (CDR |bfVar#11|)))))))
-
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
-  (PROG ()
-    (RETURN
-      (LET ((|bfVar#12|
-                (LIST (LIST '|setName| 0) (LIST '|setLabel| 1)
-                      (LIST '|setLevel| 2) (LIST '|setType| 3)
-                      (LIST '|setVar| 4) (LIST '|setLeaf| 5)
-                      (LIST '|setDef| 6) (LIST '|aGeneral| 4)
-                      (LIST '|aMode| 1) (LIST '|aModeSet| 3)
-                      (LIST '|aTree| 0) (LIST '|aValue| 2)
-                      (LIST '|attributes| 'CADDR)
-                      (LIST '|cacheCount| 'CADDDDR)
-                      (LIST '|cacheName| 'CADR)
-                      (LIST '|cacheReset| 'CADDDR)
-                      (LIST '|cacheType| 'CADDR) (LIST '|env| 'CADDR)
-                      (LIST '|expr| 'CAR) (LIST 'CAR 'CAR)
-                      (LIST '|mmCondition| 'CAADR) (LIST '|mmDC| 'CAAR)
-                      (LIST '|mmImplementation| 'CADADR)
-                      (LIST '|mmSignature| 'CDAR)
-                      (LIST '|mmTarget| 'CADAR) (LIST '|mode| 'CADR)
-                      (LIST '|op| 'CAR) (LIST '|opcode| 'CADR)
-                      (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR)
-                      (LIST '|sig| 'CDDR) (LIST '|source| 'CDR)
-                      (LIST '|streamCode| 'CADDDR)
-                      (LIST '|streamDef| 'CADDR)
-                      (LIST '|streamName| 'CADR) (LIST '|target| 'CAR)))
-            (|i| NIL))
-        (LOOP
-          (COND
-            ((OR (ATOM |bfVar#12|)
-                 (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
-             (RETURN NIL))
-            ('T (SETF (GET (CAR |i|) 'SHOESELFUNCTION) (CADR |i|))))
-          (SETQ |bfVar#12| (CDR |bfVar#12|)))))))
-
-@
-\eject
-
-\section*{Acknowledgment}
-Gabriel Dos Reis contributed initial documentation of this pamphlet.
-
-\end{document}
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
new file mode 100644
index 00000000..0fc79fa0
--- /dev/null
+++ b/src/boot/translator.boot
@@ -0,0 +1,751 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+
+module '"boot-translator"
+import '"includer"
+import '"scanner"
+import '"pile"
+import '"parser"
+import '"ast"
+
+)package "BOOTTRAN"
+
++++ True if we are translating code written in Old Boot.
+$translatingOldBoot := false
+
+AxiomCore::%sysInit() ==
+  if cdr ASSOC(Option '"boot", %systemOptions()) = '"old"
+  then $translatingOldBoot := true
+
+-- Make x, the current package
+setCurrentPackage x ==
+  SETQ(_*PACKAGE_*,x)
+
+-- Compiles the input Lisp file designated by lspFileName.
+shoeCOMPILE_-FILE lspFileName ==
+  COMPILE_-FILE lspFileName
+
+-- (boottocl "filename") translates the file "filename.boot" to
+-- the common lisp file "filename.clisp"
+ 
+BOOTTOCL(fn, out) ==
+  BOOTTOCLLINES(nil,fn, out)
+ 
+-- (bootclam "filename") translates the file "filename.boot" to
+-- the common lisp file "filename.clisp" , producing, for each function
+-- a hash table to store previously computed values indexed by argument
+-- list.
+ 
+BOOTCLAM(fn, out) == 
+  $bfClamming := true
+  BOOTCLAMLINES(nil,fn, out)
+ 
+BOOTCLAMLINES(lines, fn, out) ==
+   BOOTTOCLLINES(lines, fn, out)
+
+BOOTTOCLLINES(lines, fn, outfn)==
+   -- The default floating point number is double-float.
+   SETQ(_*READ_-DEFAULT_-FLOAT_-FORMAT_*, 'DOUBLE_-FLOAT)
+   callingPackage := _*PACKAGE_*
+   IN_-PACKAGE '"BOOTTRAN"
+   infn:=shoeAddbootIfNec fn
+   result := shoeOpenInputFile(a,infn,
+                shoeClLines(a,fn,lines,outfn))
+   setCurrentPackage callingPackage
+   result
+ 
+shoeClLines(a,fn,lines,outfn)==
+      if null a
+      then shoeNotFound fn
+      else
+       $GenVarCounter:local := 0
+       shoeOpenOutputFile(stream,outfn,
+         (for line in lines repeat shoeFileLine (line,stream);
+           shoeFileTrees(shoeTransformStream a,stream)))
+       outfn
+ 
+-- (boottoclc "filename") translates the file "filename.boot" to
+-- the common lisp file "filename.clisp" with the original boot
+-- code as comments
+ 
+BOOTTOCLC(fn, out)==BOOTTOCLCLINES(nil, fn, out)
+ 
+BOOTTOCLCLINES(lines, fn, outfn)==
+  callingPackage := _*PACKAGE_*
+  IN_-PACKAGE '"BOOTTRAN"
+  infn:=shoeAddbootIfNec fn
+  result := shoeOpenInputFile(a,infn,
+               shoeClCLines(a,fn,lines,outfn))
+  setCurrentPackage callingPackage
+  result
+  
+ 
+shoeClCLines(a,fn,lines,outfn)==
+      if null a
+      then shoeNotFound fn
+      else
+       $GenVarCounter:local := 0
+       shoeOpenOutputFile(stream,outfn,
+         (for line in lines repeat shoeFileLine (line,stream);
+           shoeFileTrees(shoeTransformToFile(stream,
+               shoeInclude bAddLineNumber(bRgen a,bIgen 0)),stream)))
+       outfn
+ 
+-- (boottomc "filename") translates the file "filename.boot"
+-- to machine code and loads it one item at a time
+ 
+BOOTTOMC fn==
+   callingPackage := _*PACKAGE_*
+   IN_-PACKAGE '"BOOTTRAN"
+   $GenVarCounter:local := 0
+   infn:=shoeAddbootIfNec fn
+   result := shoeOpenInputFile(a,infn,shoeMc(a,fn))
+   setCurrentPackage callingPackage
+   result
+ 
+shoeMc(a,fn)==
+   if null a
+   then shoeNotFound fn
+   else
+     shoePCompileTrees shoeTransformStream a
+     shoeConsole CONCAT(fn,'" COMPILED AND LOADED")
+ 
+EVAL_-BOOT_-FILE fn ==
+   b := _*PACKAGE_*
+   IN_-PACKAGE '"BOOTTRAN"
+   infn:=shoeAddbootIfNec fn
+   outfn:=CONCAT(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*)
+   shoeOpenInputFile(a,infn,shoeClLines(a,infn,[],outfn))
+   setCurrentPackage b
+   LOAD outfn
+ 
+-- (boot "filename") translates the file "filename.boot"
+-- and prints the result at the console
+ 
+BO fn==
+     b := _*PACKAGE_*
+     IN_-PACKAGE '"BOOTTRAN"
+     $GenVarCounter:local := 0
+     infn:=shoeAddbootIfNec fn
+     shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
+     setCurrentPackage b
+ 
+BOCLAM fn==
+     callingPackage := _*PACKAGE_*
+     IN_-PACKAGE '"BOOTTRAN"
+     $GenVarCounter:local := 0
+     $bfClamming:local := true
+     infn:=shoeAddbootIfNec fn
+     result := shoeOpenInputFile(a,infn,shoeToConsole(a,fn))
+     setCurrentPackage callingPackage
+     result
+ 
+shoeToConsole(a,fn)==
+     if null a
+     then shoeNotFound fn
+     else
+        shoeConsoleTrees shoeTransformToConsole
+          shoeInclude bAddLineNumber(bRgen a,bIgen 0)
+ 
+-- (stout "string") translates the string "string"
+-- and prints the result at the console
+ 
+STOUT string==   PSTOUT [string]
+--   $GenVarCounter:local := 0
+--   $bfClamming:local:=false
+--   shoeConsoleTrees shoeTransformString [string]
+ 
+STEVAL string==
+   callingPackage := _*PACKAGE_*
+   IN_-PACKAGE '"BOOTTRAN"
+   $GenVarCounter:local := 0
+   a:=  shoeTransformString [string]
+   result := 
+      bStreamPackageNull a => nil
+      fn:=stripm(CAR a,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
+      EVAL fn
+   setCurrentPackage callingPackage
+   result
+ 
+-- (sttomc "string") translates the string "string"
+-- to common lisp, and compiles it.
+ 
+STTOMC string==
+   callingPackage := _*PACKAGE_*
+   IN_-PACKAGE '"BOOTTRAN"
+   $GenVarCounter:local := 0
+   a:=  shoeTransformString [string]
+   result := 
+      bStreamPackageNull a => nil
+      shoePCompile car a
+   setCurrentPackage callingPackage
+   result
+ 
+ 
+shoeCompileTrees s==
+    while not bStreamNull s repeat
+         shoeCompile car s
+         s:=cdr s
+ 
+shoeCompile fn==
+    fn is ['DEFUN,name,bv,:body]=>
+          COMPILE (name,['LAMBDA,bv,:body])
+    EVAL fn
+ 
+shoeTransform str==
+    bNext(function shoeTreeConstruct,
+      bNext(function shoePileInsert,
+        bNext(function shoeLineToks, str)))
+ 
+shoeTransformString s==
+    shoeTransform shoeInclude bAddLineNumber(s,bIgen 0)
+shoeTransformStream s==shoeTransformString bRgen s
+--  shoeTransform shoeInclude bAddLineNumber(bRgen s,bIgen 0)
+ 
+shoeTransformToConsole str==
+    bNext(function shoeConsoleItem,
+      bNext(function shoePileInsert,
+        bNext(function shoeLineToks, str)))
+ 
+shoeTransformToFile(fn,str)==
+    bFileNext(fn,
+      bNext(function shoePileInsert,
+        bNext(function shoeLineToks, str)))
+ 
+shoeConsoleItem (str)==
+        dq:=CAR str
+        shoeConsoleLines shoeDQlines dq
+        cons(shoeParseTrees dq,CDR str)
+ 
+bFileNext(fn,s)==bDelay(function bFileNext1,[fn,s])
+ 
+bFileNext1(fn,s)==
+      bStreamNull s=> ["nullstream"]
+      dq:=CAR s
+      shoeFileLines(shoeDQlines dq,fn)
+      bAppend(shoeParseTrees dq,bFileNext(fn,cdr s))
+ 
+shoeParseTrees dq==
+        toklist := dqToList dq
+        null toklist => []
+        shoeOutParse toklist
+ 
+shoeTreeConstruct (str)==
+        cons(shoeParseTrees CAR str,CDR str)
+ 
+shoeDQlines dq==
+        a:= CDAAR shoeLastTokPosn dq
+        b:= CDAAR shoeFirstTokPosn dq
+        streamTake (a-b+1,CAR shoeFirstTokPosn dq)
+ 
+streamTake(n,s)==
+    if bStreamNull s
+    then nil
+    else if EQL(n,0)
+         then nil
+         else cons(car s,streamTake(n-1,cdr s))
+ 
+shoeFileLines (lines,fn) ==
+        shoeFileLine( '" ",fn)
+        for line in lines repeat shoeFileLine (shoeAddComment line,fn)
+        shoeFileLine ('" ",fn)
+ 
+shoeConsoleLines lines ==
+        shoeConsole '" "
+        for line in lines repeat shoeConsole shoeAddComment line
+        shoeConsole '" "
+ 
+shoeFileLine(x, stream) ==
+    WRITE_-LINE(x, stream)
+    x
+ 
+shoeFileTrees(s,st)==
+        while not bStreamNull s repeat
+            a:=CAR s
+            if EQCAR (a,"+LINE")
+            then shoeFileLine(CADR a,st)
+            else 
+              REALLYPRETTYPRINT(a,st)
+              TERPRI st
+            s:=CDR s
+ 
+ 
+shoePPtoFile(x, stream) ==
+    SHOENOTPRETTYPRINT(x, stream)
+    x
+ 
+shoeConsoleTrees s ==
+    while not bStreamPackageNull s repeat
+--      while not bStreamNull s repeat
+          fn:=stripm(CAR s,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
+          REALLYPRETTYPRINT fn
+          s:=CDR s
+ 
+shoeAddComment l==  CONCAT('"; ",CAR l)
+
+++ Generate an import declaration for `op' as equivalent of the
+++ foreign signature `sig'.  Here, `foreign' operationally means that
+++ the entity is from the C language world. 
+genImportDeclaration(op, sig) ==
+  sig isnt ["Signature", op', m] => coreError '"invalid signature"
+  m isnt ["Mapping", t, s] => coreError '"invalid function type"
+  %hasFeature KEYWORD::GCL => 
+    if SYMBOLP s then s := [s]
+    ["DEFENTRY", op, s, [t, SYMBOL_-NAME op']]
+  fatalError '"import declaration not implemented for this Lisp"
+
+shoeOutParse stream ==
+    $inputStream :local:= stream
+    $stack:local       :=nil
+    $stok:local := nil
+    $ttok:local := nil
+    $op:local :=nil
+    $wheredefs:local:=nil
+    $typings:local:=nil
+    $returns:local :=nil
+    $bpCount:local:=0
+    $bpParenCount:local:=0
+    bpFirstTok()
+    found:=CATCH("TRAPPOINT",bpOutItem())
+    if found="TRAPPED"
+    then  nil
+    else if not bStreamNull $inputStream
+         then
+          bpGeneralErrorHere()
+          nil
+         else if null $stack
+              then
+                bpGeneralErrorHere()
+                nil
+              else CAR $stack
+ 
+bpOutItem()==
+    bpComma() or bpTrap()
+    b:=bpPop1()
+    EQCAR(b,"TUPLE")=> bpPush cdr b
+    EQCAR(b,"+LINE")=> bpPush [ b ]
+    b is ["L%T",l,r] and IDENTP l =>
+                 bpPush [["DEFPARAMETER",l,r]]
+    case b of
+      Module(m) => 
+        bpPush [shoeCompileTimeEvaluation ["PROVIDE", m]]
+
+      Import(m) => 
+        bpPush [["IMPORT-MODULE", m]]
+
+      ImportSignature(x, sig) =>
+        bpPush [genImportDeclaration(x, sig)]
+
+      TypeAlias(t, args, rhs) => 
+        bpPush [["DEFTYPE", t, args, ["QUOTE", rhs]]]
+
+      ConstantDefinition(n, e) =>
+        bpPush [["DEFCONSTANT", n, e]]
+
+      otherwise =>
+        b:=shoeCompTran ["LAMBDA",["x"],b]
+        bpPush [shoeEVALANDFILEACTQ CADDR b]
+ 
+--shoeStartsAt (sz,name,stream)==
+--   bStreamNull stream => ['nullstream]
+--   a:=CAAR stream
+--   if #a<sz
+--   then shoeStartsAt(sz,name,CDR stream)
+--   else if SUBSTRING(a,0,sz)=name and (#a>sz and not shoeIdChar(a.sz))
+--        then stream
+--        else shoeStartsAt(sz,name,CDR stream)
+ 
+--FC(name,fn)==
+--   $bfClamming:local:=false
+--   $GenVarCounter:local := 0
+--   infn:=shoeAddbootIfNec fn
+--   shoeOpenInputFile(a,infn,shoeFindName(fn,name, a))
+ 
+--shoeFindName(fn,name,a)==
+--  shoeFindAndDoSomething(FUNCTION shoeCompile,fn,name,a)
+--shoeTransform1 str==
+--    bNext(function shoeTreeConstruct,
+--      streamTake(1, bNext(function shoePileInsert,
+--           bNext(function shoeLineToks, str))))
+ 
+--BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE(fun,fn,symbol)==
+--   $bfClamming:local:=false
+--   infn:=shoeAddbootIfNec NAMESTRING fn
+--   name:=PNAME symbol
+--   shoeOpenInputFile(a,infn,shoeFindAndDoSomething(fun,fn,name, a))
+ 
+--shoeFindAndDoSomething(fun,fn,name,a)==
+--   if null a
+--   then shoeNotFound fn
+--   else
+--      b:=shoeStartsAt(#name,name, shoeInclude
+--                        bAddLineNumber(bRgen a,bIgen 0))
+--      if bStreamNull b
+--      then shoeConsole CONCAT (name,'" not found in ",fn)
+--      else
+--         $GenVarCounter:local := 0
+--         shoeLoop(fun,shoeTransform1 b)
+ 
+--BOOT_-COMPILE_-DEFINITION_-FROM_-FILE(fn,symbol)==
+--   BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE
+--         (FUNCTION shoeCompile,fn,symbol)
+ 
+--BOOT_-EVAL_-DEFINITION_-FROM_-FILE(fn,symbol)==
+--   BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE
+--         (FUNCTION EVAL,fn,symbol)
+ 
+--BOOT_-PRINT_-DEFINITION_-FROM_-FILE(fn,symbol)==
+--   BOOT_-DO_-SOMETHING_-TO_-DEFINITION_-FROM_-FILE
+--         (FUNCTION REALLYPRETTYPRINT,fn,symbol)
+ 
+--shoeLoop(fun, s)==
+--    while not bStreamNull s repeat
+--         FUNCALL(fun, car s)
+--         s:=cdr s
+ 
+shoeAddbootIfNec s==shoeAddStringIfNec('".boot",s)
+ 
+shoeRemovebootIfNec s==shoeRemoveStringIfNec('".boot",s)
+shoeAddStringIfNec(str,s)==
+       a:=STRPOS(str,s,0,nil)
+       if null a
+       then CONCAT(s,str)
+       else s
+ 
+shoeRemoveStringIfNec(str,s)==
+       a:=STRPOS(str,s,0,nil)
+       if null a
+       then s
+       else SUBSTRING(s,0,a)
+ 
+-- DEFUSE prints the definitions not used and the words used and
+-- not defined in the input file and common lisp.
+ 
+DEFUSE fn==
+  infn:=CONCAT(fn,'".boot")
+  shoeOpenInputFile(a,infn,shoeDfu(a,fn))
+ 
+shoeDfu(a,fn)==
+  if null a
+  then shoeNotFound fn
+  else
+     $lispWordTable:local :=MAKE_-HASHTABLE ("EQ")
+     DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
+     $bootDefined:local :=MAKE_-HASHTABLE "EQ"
+     $bootUsed:local :=MAKE_-HASHTABLE "EQ"
+     $bootDefinedTwice:local:=nil
+     $GenVarCounter:local :=0
+     $bfClamming:local:=false
+     shoeDefUse shoeTransformStream a
+     out:=CONCAT(fn,'".defuse")
+     shoeOpenOutputFile(stream,out,shoeReport stream)
+     out
+ 
+shoeReport stream==
+          shoeFileLine('"DEFINED and not USED",stream)
+          a:=[i for i in HKEYS $bootDefined | not GETHASH(i,$bootUsed)]
+          bootOut(SSORT a,stream)
+          shoeFileLine('"             ",stream)
+          shoeFileLine('"DEFINED TWICE",stream)
+          bootOut(SSORT $bootDefinedTwice,stream)
+          shoeFileLine('"             ",stream)
+          shoeFileLine('"USED and not DEFINED",stream)
+          a:=[i for i in HKEYS $bootUsed |
+                     not GETHASH(i,$bootDefined)]
+          for i in SSORT a repeat
+             b:=CONCAT(PNAME i,'" is used in ")
+             bootOutLines( SSORT GETHASH(i,$bootUsed),stream,b)
+ 
+shoeDefUse(s)==
+        while not bStreamPackageNull s repeat
+            defuse([],CAR s)
+            s:=CDR s
+ 
+defuse(e,x)==
+     x:=stripm(x,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
+     $used:local:=nil
+     [nee,niens]:=
+        x is ['DEFUN,name,bv,:body] => [name,['LAMBDA,bv,:body]]
+        x is ['DEFMACRO,name,bv,:body] => [name,['LAMBDA,bv,:body]]
+        x is ["EVAL_-WHEN",.,["SETQ",id,exp]]=>[id,exp]
+        x is ["SETQ",id,exp]=>[id,exp]
+        ["TOP-LEVEL", x]
+     if GETHASH(nee,$bootDefined)
+     then
+        $bootDefinedTwice:=
+               nee="TOP-LEVEL"=> $bootDefinedTwice
+               cons(nee,$bootDefinedTwice)
+     else HPUT($bootDefined,nee,true)
+     defuse1 (e,niens)
+     for i in $used repeat
+        HPUT($bootUsed,i,cons(nee,GETHASH(i,$bootUsed)))
+ 
+defuse1(e,y)==
+     ATOM y =>
+         IDENTP y =>
+            $used:=
+                 MEMQ(y,e)=>$used
+                 MEMQ(y,$used)=>$used
+                 defusebuiltin y =>$used
+                 UNION([y],$used)
+         []
+     y is ["LAMBDA",a,:b]=> defuse1 (append(unfluidlist a,e),b)
+     y is ["PROG",a,:b]=>
+            [dol,ndol]:=defSeparate a
+            for i in dol repeat
+                  HPUT($bootDefined,i,true)
+            defuse1 (append(ndol,e),b)
+     y is ["QUOTE",:a] => []
+     y is ["+LINE",:a] => []
+     for i in y repeat defuse1(e,i)
+ 
+defSeparate x==
+      if null x
+      then [[],[]]
+      else
+         f:=car x
+         [x1,x2]:=defSeparate cdr x
+         if bfBeginsDollar f
+         then [cons(f,x1),x2]
+         else [x1,cons(f,x2)]
+unfluidlist x==
+    NULL x => []
+    ATOM x=> [x]
+    x is ["&REST",y]=> [y]
+    cons(car x,unfluidlist cdr x)
+ 
+defusebuiltin x==  GETHASH(x,$lispWordTable)
+ 
+bootOut (l,outfn)==
+      for i in l repeat shoeFileLine (CONCAT ('"   ",PNAME i),outfn)
+ 
+CLESSP(s1,s2)==not(SHOEGREATERP(s1,s2))
+SSORT l == SORT(l,function CLESSP)
+ 
+bootOutLines(l,outfn,s)==
+  if null l
+  then shoeFileLine(s,outfn)
+  else
+     a:=PNAME car l
+     if #s +#a > 70
+     then
+          shoeFileLine(s,outfn)
+          bootOutLines(l,outfn,'" ")
+     else bootOutLines(cdr l,outfn,CONCAT(s,'" ",a))
+ 
+ 
+-- (xref "fn") produces a cross reference listing in "fn.xref"
+-- It contains each name
+-- used in "fn.boot", together with a list of functions that use it.
+ 
+XREF fn==
+  infn:=CONCAT(fn,'".boot")
+  shoeOpenInputFile(a,infn,shoeXref(a,fn))
+ 
+shoeXref(a,fn)==
+  if null a
+  then shoeNotFound fn
+  else
+     $lispWordTable:local :=MAKE_-HASHTABLE ("EQ")
+     DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true))
+     $bootDefined:local :=MAKE_-HASHTABLE "EQ"
+     $bootUsed:local :=MAKE_-HASHTABLE "EQ"
+     $GenVarCounter:local :=0
+     $bfClamming:local:=false
+     shoeDefUse shoeTransformStream a
+     out:=CONCAT(fn,'".xref")
+     shoeOpenOutputFile(stream,out,shoeXReport stream)
+     out
+ 
+ 
+shoeXReport stream==
+          shoeFileLine('"USED and where DEFINED",stream)
+          c:=SSORT HKEYS $bootUsed
+          for i in c repeat
+             a:=CONCAT(PNAME i,'" is used in ")
+             bootOutLines( SSORT GETHASH(i,$bootUsed),stream,a)
+ 
+--FC (name,fn)== shoeGeneralFC(function BOOT,name,fn)
+ 
+FBO (name,fn)== shoeGeneralFC(function BO,name,fn)
+ 
+FEV(name,fn)== shoeGeneralFC(function EVAL_-BOOT_-FILE,name,fn)
+ 
+shoeGeneralFC(f,name,fn)==
+   $bfClamming:local:=false
+   $GenVarCounter:local := 0
+   infn:=shoeAddbootIfNec fn
+   a:= shoeOpenInputFile(a,infn,shoeFindName2(fn,name, a))
+   filename:= if # name > 8 then SUBSTRING(name,0,8) else name
+   a =>  FUNCALL(f, CONCAT('"/tmp/",filename))
+   nil
+ 
+shoeFindName2(fn,name,a)==
+     lines:=shoeFindLines(fn,name,a)
+     lines =>
+          filename:= if # name > 8 then SUBSTRING(name,0,8) else name
+          filename := CONCAT ('"/tmp/",filename,'".boot")
+          shoeOpenOutputFile(stream, filename,
+               for line in lines repeat shoeFileLine (line,stream))
+          true
+     false
+ 
+shoeTransform2 str==
+    bNext(function shoeItem,
+      streamTake(1, bNext(function shoePileInsert,
+           bNext(function shoeLineToks, str))))
+ 
+shoeItem (str)==
+        dq:=CAR str
+        cons([[CAR line for line in  shoeDQlines dq]],CDR str)
+ 
+--shoeLines lines ==  [CAR line for line in lines]
+ 
+--shoeFindAndDoSomething2(fun,fn,name,a)==
+--   if null a
+--   then shoeNotFound fn
+--   else
+--      [lines,b]:=shoePackageStartsAt([],#name,name, shoeInclude
+--                        bAddLineNumber(bRgen a,bIgen 0))
+--      if bStreamNull b
+--      then
+--           shoeConsole CONCAT (name,'" not found in ",fn)
+--           []
+--      else
+--         if null lines
+--         then shoeConsole '")package not found"
+--         $GenVarCounter:local := 0
+--         shoeLoopPackage(fun,shoeTransform2 b,lines)
+ 
+--shoeLoopPackage(fun, s,lines)==
+--    while not bStreamNull s repeat
+--         FUNCALL(fun, append (reverse lines,car s))
+--         s:=cdr s
+--    true
+stripm (x,pk,bt)==
+   ATOM x =>
+             IDENTP x =>
+                 SYMBOL_-PACKAGE x = bt => INTERN(PNAME x,pk)
+                 x
+             x
+   CONS(stripm(CAR x,pk,bt),stripm(CDR x,pk,bt))
+ 
+shoePCompile  fn==
+    fn:=stripm(fn,_*PACKAGE_*,FIND_-PACKAGE '"BOOTTRAN")
+    fn is ['DEFUN,name,bv,:body]=>
+          COMPILE (name,['LAMBDA,bv,:body])
+    EVAL fn
+ 
+FC(name,fn)==
+   $GenVarCounter:local := 0
+   infn:=shoeAddbootIfNec fn
+   shoeOpenInputFile(a,infn,shoeFindName(fn,name, a))
+ 
+shoeFindName(fn,name,a)==
+     lines:=shoeFindLines(fn,name,a)
+     shoePCompileTrees shoeTransformString lines
+ 
+shoePCompileTrees s==
+    while not bStreamPackageNull s repeat
+         REALLYPRETTYPRINT shoePCompile car s
+         s:=cdr s
+ 
+bStreamPackageNull s==
+         a := _*PACKAGE_*
+         IN_-PACKAGE '"BOOTTRAN"
+         b:=bStreamNull s
+         setCurrentPackage a
+         b
+ 
+PSTTOMC string==
+   $GenVarCounter:local := 0
+   shoePCompileTrees shoeTransformString string
+ 
+BOOTLOOP ()==
+    a:=READ_-LINE()
+    #a=0=>
+         WRITE_-LINE '"Boot Loop; to exit type ] "
+         BOOTLOOP()
+    b:=shoePrefix? ('")console",a)
+    b =>
+         stream:= _*TERMINAL_-IO_*
+         PSTTOMC bRgen stream
+         BOOTLOOP()
+    a.0='"]".0 => nil
+    PSTTOMC [a]
+    BOOTLOOP()
+ 
+BOOTPO ()==
+    a:=READ_-LINE()
+    #a=0=>
+         WRITE_-LINE '"Boot Loop; to exit type ] "
+         BOOTPO()
+    b:=shoePrefix? ('")console",a)
+    b =>
+         stream:= _*TERMINAL_-IO_*
+         PSTOUT bRgen stream
+         BOOTPO()
+    a.0='"]".0 => nil
+    PSTOUT [a]
+    BOOTPO()
+ 
+PSTOUT string==
+   callingPackage := _*PACKAGE_*
+   IN_-PACKAGE '"BOOTTRAN"
+   $GenVarCounter:local := 0
+   result := shoeConsoleTrees shoeTransformString string
+   setCurrentPackage callingPackage
+   result
+
+
+defaultBootToLispFile file ==
+  CONCAT(shoeRemovebootIfNec file,'".clisp")
+
+translateBootFile(progname, options, file) ==
+  outFile := getOutputPathname(options)
+  BOOTTOCL(file, ENOUGH_-NAMESTRING outFile)
+
+compileBootHandler(progname, options, file) ==
+  intFile := BOOTTOCL(file, defaultBootToLispFile file)
+  intFile => 
+    objFile := compileLispHandler(progname, options, intFile)
+    DELETE_-FILE intFile
+    objFile
+  nil
+
+associateRequestWithFileType(Option '"translate", '"boot", 
+                             function translateBootFile)
+associateRequestWithFileType(Option '"compile", '"boot", 
+                             function compileBootHandler)