diff options
Diffstat (limited to 'src/boot/includer.boot.pamphlet')
| -rw-r--r-- | src/boot/includer.boot.pamphlet | 1226 |
1 files changed, 0 insertions, 1226 deletions
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} |