diff options
Diffstat (limited to 'src/boot/includer.boot.pamphlet')
| -rw-r--r-- | src/boot/includer.boot.pamphlet | 1224 |
1 files changed, 1224 insertions, 0 deletions
diff --git a/src/boot/includer.boot.pamphlet b/src/boot/includer.boot.pamphlet new file mode 100644 index 00000000..803d5666 --- /dev/null +++ b/src/boot/includer.boot.pamphlet @@ -0,0 +1,1224 @@ +\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 == + error [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)== + error ['"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 (|error| (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 + (|error| (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|))))))))) + +(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) + (DEFPARAMETER |$bStreamNil| (LIST '|nullstream|))) + +(DEFUN |bStreamNull| (|x|) + (PROG (|st|) + (RETURN + (COND + ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T) + ('T + (PROGN + ((LAMBDA () + (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|) + (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|) + (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) + ((LAMBDA (|bfVar#1| |i| |j|) + (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)))) + (- (LENGTH |prefix|) 1) 0 0) + (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|) + (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 () + (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} |