aboutsummaryrefslogtreecommitdiff
path: root/src/interp/int-top.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-10-19 04:46:50 +0000
committerdos-reis <gdr@axiomatics.org>2007-10-19 04:46:50 +0000
commitd34a01104fa6d8156a29d0e5d810e12823cba02d (patch)
tree3f208e01e8def08a2cad9c70091e23597a816552 /src/interp/int-top.boot.pamphlet
parent50e8b4a4c699b3a783aa400a62f021c129ff4305 (diff)
downloadopen-axiom-d34a01104fa6d8156a29d0e5d810e12823cba02d.tar.gz
remove more pamphlets
Diffstat (limited to 'src/interp/int-top.boot.pamphlet')
-rw-r--r--src/interp/int-top.boot.pamphlet550
1 files changed, 0 insertions, 550 deletions
diff --git a/src/interp/int-top.boot.pamphlet b/src/interp/int-top.boot.pamphlet
deleted file mode 100644
index 9e86d4a1..00000000
--- a/src/interp/int-top.boot.pamphlet
+++ /dev/null
@@ -1,550 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp int-top.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{intloopReadConsole}
-
-This is the top level loop when reading from the input console. This
-function calls itself after processing the current line. Because of
-this it is important that the underlying common lisp supports
-tail-recursion.
-
-Normally we never really exit this function.
-
-We read a string from the input. The serverReadLine\cite{1} function
-is a special readline function that handles communication with the
-session manager code, which is a separate process running in parallel.
-In the usual case it just returns the current string.
-
-If the user enters a blank line ([[#a=]]) then just put up another prompt
-and then tail-recursively call [[intloopReadConsole]].
-
-If the user has set [[$DALYMODE]] to true and the new line starts with
-an open parenthesis then the input is assumed to be a lisp expression
-and is evaluated by the underlying common lisp. This is useful if you
-are doing a lot of debugging. Commands can also be executed in the
-underlying common lisp by using the [[)lisp]] command. In either case we
-tail-recursively call [[intloopReadConsole]].
-
-If the user typed [[)fin]] then we exit the loop and drop into the
-underlying common lisp. You can use the [[(restart)]] function call
-to return to the top level loop.
-
-If the input line starts with a close parenthesis we parse the
-input line as a command rather than an expression. We execute the command
-and then tail-recursively call [[intloopReadConsole]].
-
-If the input line contains a trailing underscore, which is the standard
-end-of-line escape character, then we continue to read the line by
-tail-recursively calling [[intloopReadConsole]].
-
-If none of the above conditions occur we simply evaluate the input line
-and then tail-recursively call [[intloopReadConsole]].
-
-However, there was a small bug in the test for the system command
-[[)fin]]. Originally, the test took the form:
-\begin{verbatim}
- intloopPrefix?('")fin",a) => []
-\end{verbatim}
-This test was flawed in two ways. First, it would match {\sl any}
-command beginning with [[)fin]]. Second, it would {\sl only} match
-names beginning with [[)fin]], although [[)fi]] is an acceptable
-abbreviation for this command. The improved test takes the form:
-\begin{verbatim}
- pfx := stripSpaces intloopPrefix?('")fi",a)
- pfx and ((pfx = '")fi") or (pfx = '")fin")) => []
-\end{verbatim}
-
-\section{intloopPrefix?}
-The [[intloopPrefix?(prefix, whole)]] function simply tests if the string
-[[prefix]] is a prefix of the string [[whole]]. The original
-implementation discounts {\sl any} whitespace in [[whole]] in deciding a
-match, when a more sensible behavior would be to discount only leading
-whitespace.
-
-Moreover, the function SUBSTRING\cite{2} was being improperly called.
-The reason why this improper call had gone undetected is that
-generally [[intloopPrefix?]] is invoked with a prefix string of length
-one -- hence the start position for the substring would generally
-begin at index [[spaces]] (which is what we want).
-
-The original code read:
-\begin{verbatim}
-intloopPrefix?(prefix,whole) ==
- #prefix > #whole => false
- good:=true
- spaces := 0
- i := 0
- len := #prefix
- wlen := #whole
- for j in 0.. while (good and i < len and j < wlen) repeat
- good:= (prefix.i = whole.j) or (whole.j = char " ")
- if prefix.i = whole.j then i := i+1
- if whole.j = char " " then spaces := spaces + 1
- spaces = wlen => nil
- if good then SUBSTRING(whole,#prefix+spaces-1,nil) else good
-
-\end{verbatim}
-
-The improved version of [[inloopPrefix?(prefix, whole)]] returns the
-string [[whole]] sans leading whitespace if the match succeeds, else nil.
-
-<<intloopPrefix?>>=
-intloopPrefix?(prefix,whole) ==
- #prefix > #whole => false
- good := true
- leading := true
- spaces := 0
- i := 0
- len := #prefix
- wlen := #whole
- for j in 0.. while (good and i < len and j < wlen) repeat
- good := (prefix.i = whole.j) or (leading and (whole.j = char " "))
- if prefix.i = whole.j then i := i+1
- if (whole.j = char " ") and leading then
- spaces := spaces + 1
- else leading := false
- spaces = wlen => nil
- if good then SUBSTRING(whole,spaces,nil) else good
-
-@
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
--- - Redistributions of source code must retain the above copyright
--- notice, this list of conditions and the following disclaimer.
---
--- - Redistributions in binary form must reproduce the above copyright
--- notice, this list of conditions and the following disclaimer in
--- the documentation and/or other materials provided with the
--- distribution.
---
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--- names of its contributors may be used to endorse or promote products
--- derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
-)package "BOOT"
-
-ncParseAndInterpretString s ==
- processInteractive(packageTran parseFromString s, nil)
-
-ncParseFromString s ==
- zeroOneTran packageTran CATCH("SPAD_READER", parseFromString s)
-
-ncINTERPFILE(file, echo) ==
- savedEcho := $EchoLines
- savedReadingFile := $ReadingFile
- $EchoLines: fluid := echo
- $ReadingFile: fluid := true
- result := SpadInterpretFile file
- $EchoLines := savedEcho
- $ReadingFile := savedReadingFile
- result
-
-ncGetFunction(op, dom, sig) ==
- applyInPackage(function getNCfunction,_
- [rePackageTran(op, '"boot"),_
- rePackageTran(dom, '"boot"),_
- rePackageTran(sig, '"boot")],_
- '"BOOT")
-
-applyInPackage(fun, args, package) ==
- savedPackage := _*PACKAGE_*
- SETQ(_*PACKAGE_*, FIND_-PACKAGE package)
- result := apply(fun, args)
- SETQ(_*PACKAGE_*, savedPackage)
- result
-
-ncSetCurrentLine l ==
- setCurrentLine l
-
-
---% INTERPRETER TOP LEVEL
-
-spad() ==
- -- starts the interpreter but does not read in profiles, etc.
- $PrintCompilerMessageIfTrue: local
- $inLispVM : local := nil
- setOutputAlgebra "%initialize%"
- runspad()
- 'EndOfSpad
-
-runspad() ==
- mode:='restart
- while mode='restart repeat
- resetStackLimits()
- CATCH($quitTag, CATCH('coerceFailure,
- mode:=CATCH('top__level, ncTopLevel())))
-
-ncTopLevel() ==
--- Top-level read-parse-eval-print loop for the interpreter. Uses
--- the Bill Burge's parser.
- IN_-STREAM: fluid := CURINSTREAM
- _*EOF_*: fluid := NIL
- $InteractiveMode :fluid := true
- $BOOT: fluid := NIL
- $NEWSPAD: fluid := true
- $SPAD: fluid := true
- $e:fluid := $InteractiveFrame
- ncIntLoop()
-
-
-ncIntLoop() ==
- CURINSTREAM : local := _*STANDARD_-OUTPUT_*
- CUROUTSTREAM : local := _*STANDARD_-INPUT_*
- intloop()
-
-
-intloop () ==
- mode := $intRestart
- while mode = $intRestart repeat
- resetStackLimits()
- mode := CATCH($intTopLevel,
- SpadInterpretStream(1, ["TIM", "DALY", "?"], true))
-
-
-SpadInterpretStream(str, source, interactive?) ==
- $fn : local := source
- pile? := not interactive?
- $libQuiet : local := not interactive?
- $newcompMode : local := false
--- following seems useless and causes ccl package problems
--- $InteractiveMode : local := false
-
- $newcompErrorCount: local := 0 -- SMW Feb 2/90.
- -- Used in highComplete, ncHardError etc.
-
- $okToExecuteMachineCode: local := true -- set false on error
- $inclAssertions: local := ["AIX", "CommonLisp"] -- Jan 28/90
-
-
- $lastPos : local := $nopos ------------>!!!
- $erMsgToss : local := false --------------->!!!
- $ncMsgList : local := nil
-
- $systemCommandFunction : local := function InterpExecuteSpadSystemCommand
- $shoeReadLineFunction : local := function serverReadLine
- $promptMsg : local := 'S2CTP023
-
- interactive? =>
- PRINC(MKPROMPT())
- intloopReadConsole('"", str)
- []
- intloopInclude (source,0)
- []
-
- -----------------------------------------------------------------
-
-intloopReadConsole(b, n)==
- a:= serverReadLine(_*STANDARD_-INPUT_*)
- not STRINGP a => leaveScratchpad()
- #a=0 =>
- PRINC(MKPROMPT())
- intloopReadConsole('"", n)
- $DALYMODE and intloopPrefix?('"(",a) =>
- intnplisp(a)
- PRINC(MKPROMPT())
- intloopReadConsole('"",n)
- pfx := stripSpaces intloopPrefix?('")fi",a)
- pfx and ((pfx = '")fi") or (pfx = '")fin")) => []
- b = '"" and (d := intloopPrefix?('")", a)) =>
- setCurrentLine d
- c := ncloopCommand(d,n)
- PRINC(MKPROMPT())
- intloopReadConsole('"", c)
- a:=CONCAT(b,a)
- ncloopEscaped a => intloopReadConsole(SUBSEQ(a, 0, (LENGTH a) - 1),n)
- c := intloopProcessString(a, n)
- PRINC(MKPROMPT())
- intloopReadConsole('"", c)
-
-<<intloopPrefix?>>
-
-intloopProcess(n,interactive,s)==
- StreamNull s => n
- [lines,ptree]:=CAR s
- pfAbSynOp?(ptree,"command")=>
- if interactive then setCurrentLine tokPart ptree
- FUNCALL($systemCommandFunction, tokPart ptree)
- intloopProcess(n ,interactive ,CDR s)
- intloopProcess(intloopSpadProcess(n,lines,ptree,interactive)
- ,interactive ,CDR s)
-
-intloopEchoParse s==
- [dq,stream]:=CAR s
- [lines,rest]:=ncloopDQlines(dq,$lines)
- setCurrentLine(mkLineList(lines))
- if $EchoLines then ncloopPrintLines lines
- $lines:=rest
- cons([[lines,npParse dqToList dq]],CDR s)
-
-intloopInclude0(st, name, n) ==
- $lines:local:=incStream(st,name)
- intloopProcess(n,false,
- next(function intloopEchoParse,
- next(function insertpile,
- next(function lineoftoks,$lines))))
-
-intloopInclude(name, n) ==
- WITH_-OPEN_-FILE(st name, intloopInclude0(st, name, n))
-
-intloopInclude1(name,n) ==
- a:=ncloopIncFileName name
- a => intloopInclude(a,n)
- n
-
-intloopProcessString(s,n) ==
- setCurrentLine s
- intloopProcess(n,true,
- next(function ncloopParse,
- next(function lineoftoks,incString s)))
-
-$pfMacros := []
-
-intloopSpadProcess(stepNo,lines,ptree,interactive?)==
- $stepNo:local := stepNo
- $currentCarrier := cc := ['carrier]
- ncPutQ(cc, 'stepNumber, stepNo)
- ncPutQ(cc, 'messages, $ncMsgList)
- ncPutQ(cc, 'lines, lines)
- $ncMsgList := nil
- result := CatchAsCan(flung, Catch("SpadCompileItem",
- CATCH($intCoerceFailure, CATCH($intSpadReader,
- interp(cc, ptree, interactive?))))) where
-
- interp(cc, ptree, interactive?) ==
- ncConversationPhase(function phParse, [cc, ptree])
- ncConversationPhase(function phMacro, [cc])
- ncConversationPhase(function phIntReportMsgs,[cc, interactive?])
- ncConversationPhase(function phInterpret, [cc])
-
- #ncEltQ(cc, 'messages) ^= 0 => ncError()
-
- intSetNeedToSignalSessionManager()
- $prevCarrier := $currentCarrier
- result = 'ncEnd => stepNo
- result = 'ncError => stepNo
- result = 'ncEndItem => stepNo
- stepNo+1
-
-phInterpret carrier ==
- ptree := ncEltQ(carrier, 'ptree)
- val := intInterpretPform(ptree)
- ncPutQ(carrier, 'value, val)
-
-
---% phReportMsgs: carrier[lines,messages,..]-> carrier[lines,messages,..]
-phIntReportMsgs(carrier, interactive?) ==
- $erMsgToss => 'OK
- lines := ncEltQ(carrier, 'lines)
- msgs := ncEltQ(carrier, 'messages)
- nerr := #msgs
- ncPutQ(carrier, 'ok?, nerr = 0)
- nerr = 0 => 'OK
- processMsgList(msgs, lines)
- intSayKeyedMsg ('S2CTP010,[nerr])
- 'OK
-
-mkLineList lines ==
- l := [CDR line for line in lines | nonBlank CDR line]
- #l = 1 => CAR l
- l
-
-nonBlank str ==
- value := false
- for i in 0..MAXINDEX str repeat
- str.i ^= char " " =>
- value := true
- return value
- value
-
-ncloopCommand (line,n) ==
- a:=ncloopPrefix?('")include",line)=>
- ncloopInclude1( a,n)
- FUNCALL($systemCommandFunction,line)
- n
-
-ncloopEscaped x==
- esc :=false
- done:=false
- for i in (# x) - 1 .. 0 by -1 while not done repeat
- done:=
- x.i='" ".0 =>false
- x.i='"__".0=>
- esc:=true
- true
- true
- esc
-
-ncloopDQlines (dq,stream)==
- StreamNull stream
- a:= poGlobalLinePosn tokPosn CADR dq
- b:= poGlobalLinePosn CAAR stream
- streamChop (a-b+1,stream)
-
-streamChop(n,s)==
- if StreamNull s
- then [nil,nil]
- else if EQL(n,0)
- then [nil,s]
- else
- [a,b]:= streamChop(n-1,cdr s)
- line:=car s
- c:=ncloopPrefix?('")command",CDR line)
- d:= cons(car line,if c then c else cdr line)
- [cons(d,a),b]
-
-ncloopPrintLines lines ==
- for line in lines repeat WRITE_-LINE CDR line
- WRITE_-LINE '" "
-
-ncloopIncFileName string==
- fn := incFileName string
- not fn =>
- WRITE_-LINE (CONCAT(string, '" not found"))
- []
- fn
-
-ncloopParse s==
- [dq,stream]:=CAR s
- [lines,rest]:=ncloopDQlines(dq,stream)
- cons([[lines,npParse dqToList dq]],CDR s)
-
-ncloopInclude0(st, name, n) ==
- $lines:local := incStream(st, name)
- ncloopProcess(n,false,
- next(function ncloopEchoParse,
- next(function insertpile,
- next(function lineoftoks,$lines))))
-
-ncloopInclude(name, n) ==
- WITH_-OPEN_-FILE(st name, ncloopInclude0(st, name, n))
-
-ncloopInclude1(name,n) ==
- a:=ncloopIncFileName name
- a => ncloopInclude(a,n)
- n
-
-incString s== incRenumber incLude(0,[s],0,['"strings"] ,[Top])
-
-ncError() ==
- THROW("SpadCompileItem",'ncError)
-
---% Compilation Carriers
--- This data structure is used to carry information between phases.
-
---% phParse: carrier[tokens,...] -> carrier[ptree, tokens,...]
---)line (defun pretty (x) (boottran::reallyprettyprint x))
---)line (defun packagetran (x) (boot::|packageTran|))
-phParse(carrier,ptree) ==
- phBegin 'Parsing
- if $ncmParse then
- nothing
- intSayKeyedMsg ('S2CTP003,[%pform ptree])
- ncPutQ(carrier, 'ptree, ptree)
- 'OK
-
-
---% phMacro: carrier[ptree,...] -> carrier[ptree, ptreePremacro,...]
-phMacro carrier ==
- phBegin 'Macroing
- ptree := ncEltQ(carrier, 'ptree)
- ncPutQ(carrier, 'ptreePremacro, ptree)
-
- ptree := macroExpanded ptree
- if $ncmMacro then
- intSayKeyedMsg ('S2CTP007,[%pform ptree] )
-
- ncPutQ(carrier, 'ptree, ptree)
- 'OK
-
---% phReportMsgs: carrier[lines,messages,..]-> carrier[lines,messages,..]
-phReportMsgs(carrier, interactive?) ==
- $erMsgToss => 'OK
- lines := ncEltQ(carrier, 'lines)
- msgs := ncEltQ(carrier, 'messages)
- nerr := #msgs
- ncPutQ(carrier, 'ok?, nerr = 0)
- interactive? and nerr = 0 => 'OK
- processMsgList(msgs, lines)
- intSayKeyedMsg ('S2CTP010,[nerr])
- 'OK
-
-ncConversationPhase(fn, args) ==
- carrier := first args
-
- $ncMsgList: local := []
- $convPhase: local := 'NoPhase
-
- UNWIND_-PROTECT( APPLY(fn, args), wrapup(carrier) ) where
- wrapup(carrier) ==
- for m in $ncMsgList repeat
- ncPutQ(carrier, 'messages, [m, :ncEltQ(carrier, 'messages)])
-
-ncloopPrefix?(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
-
-phBegin id ==
- $convPhase := id
- if $ncmPhase then intSayKeyedMsg('S2CTP021,[id])
-
-PullAndExecuteSpadSystemCommand stream ==
- ExecuteSpadSystemCommand CAR stream
- CDR stream
-
-ExecuteSpadSystemCommand string ==
- FUNCALL($systemCommandFunction, string)
-
-
-clearMacroTable() ==
- $pfMacros := nil
-
-getParserMacros() ==
- $pfMacros
-
-displayParserMacro m ==
- m := ASSQ(m, $pfMacros)
- null m => nil
- pfPrintSrcLines CADDR m
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} [[src/interp/server.boot.pamphlet]]
-\bibitem{2} [[src/interp/vmlisp.lisp.pamphlet]]
-\end{thebibliography}
-\end{document}