\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}