aboutsummaryrefslogtreecommitdiff
path: root/src/interp/i-toplev.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
committerdos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
commitab8cc85adde879fb963c94d15675783f2cf4b183 (patch)
treec202482327f474583b750b2c45dedfc4e4312b1d /src/interp/i-toplev.boot.pamphlet
downloadopen-axiom-ab8cc85adde879fb963c94d15675783f2cf4b183.tar.gz
Initial population.
Diffstat (limited to 'src/interp/i-toplev.boot.pamphlet')
-rw-r--r--src/interp/i-toplev.boot.pamphlet360
1 files changed, 360 insertions, 0 deletions
diff --git a/src/interp/i-toplev.boot.pamphlet b/src/interp/i-toplev.boot.pamphlet
new file mode 100644
index 00000000..665c6371
--- /dev/null
+++ b/src/interp/i-toplev.boot.pamphlet
@@ -0,0 +1,360 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp i-toplev.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\begin{verbatim}
+This file contains the top-most code for receiving parser output,
+calling the analysis routines and printing the result output. It
+also contains several flavors of routines that start the interpreter
+from LISP.
+\end{verbatim}
+\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>>
+
+--% Top Level Interpreter Code
+
+-- When $QuiteCommand is true Spad will not produce any output from
+-- a top level command
+SETANDFILEQ($QuietCommand, NIL)
+-- When $ProcessInteractiveValue is true, we don't want the value printed
+-- or recorded.
+SETANDFILEQ($ProcessInteractiveValue, NIL)
+SETANDFILEQ($HTCompanionWindowID, NIL)
+
+--% Starting the interpreter from LISP
+
+spadpo() ==
+ -- starts the interpreter but only displays parsed input
+ $PrintOnly: local:= true
+ spad()
+
+start(:l) ==
+ -- The function start begins the interpreter process, reading in
+ -- the profile and printing start-up messages.
+ $PrintCompilerMessageIfTrue: local
+ $inLispVM : local := nil
+ if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"interpreter"])
+ initializeTimedNames($interpreterTimedNames,$interpreterTimedClasses)
+ statisticsInitialization()
+ $InteractiveFrame := makeInitialModemapFrame()
+ initializeSystemCommands()
+ initializeInterpreterFrameRing()
+ SETQ(ERROROUTSTREAM,
+ DEFIOSTREAM('((DEVICE . CONSOLE)(MODE . OUTPUT)),80,0))
+ setOutputAlgebra "%initialize%"
+ loadExposureGroupData()
+ if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"database"])
+ mkLowerCaseConTable()
+ if not $ruleSetsInitialized then initializeRuleSets()
+ if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"constructors"])
+ makeConstructorsAutoLoad()
+ GCMSG(NIL)
+ SETQ($IOindex,1)
+ if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"history"])
+ initHist()
+ if functionp 'addtopath then addtopath CONCAT($SPADROOT,'"bin")
+ SETQ($CURRENT_-DIRECTORY,_*DEFAULT_-PATHNAME_-DEFAULTS_*)
+ if null(l) then
+ if $displayStartMsgs then
+ sayKeyedMsg("S2IZ0053",[namestring ['_.axiom,'input]])
+ readSpadProfileIfThere()
+ if $displayStartMsgs then spadStartUpMsgs()
+ if $OLDLINE then
+ SAY fillerSpaces($LINELENGTH,'"=")
+ sayKeyedMsg("S2IZ0050",[namestring ['axiom,'input]])
+ if $OLDLINE ^= 'END__UNIT
+ then
+ centerAndHighlight($OLDLINE,$LINELENGTH,'" ")
+ sayKeyedMsg("S2IZ0051",NIL)
+ else sayKeyedMsg("S2IZ0052",NIL)
+ SAY fillerSpaces($LINELENGTH,'"=")
+ TERPRI()
+ $OLDLINE := NIL
+ $superHash := MAKE_-HASHTABLE('UEQUAL)
+ if null l then runspad()
+ 'EndOfSpad
+
+readSpadProfileIfThere() ==
+ -- reads SPADPROF INPUT if it exists
+ file := ['_.axiom,'input]
+ MAKE_-INPUT_-FILENAME file =>
+ SETQ(_/EDITFILE,file)
+ _/RQ ()
+ NIL
+
+--% Parser Output --> Interpreter
+
+processInteractive(form, posnForm) ==
+ -- Top-level dispatcher for the interpreter. It sets local variables
+ -- and then calls processInteractive1 to do most of the work.
+ -- This function receives the output from the parser.
+
+ initializeTimedNames($interpreterTimedNames,$interpreterTimedClasses)
+
+ $op: local:= (form is [op,:.] => op; form) --name of operator
+ $Coerce: local := NIL
+ $compErrorMessageStack:local
+ $freeVars : local := NIL
+ $mapList:local := NIL --list of maps being type analyzed
+ $compilingMap:local:= NIL --true when compiling a map
+ $compilingLoop:local:= NIL --true when compiling a loop body
+ $interpOnly: local := NIL --true when in interpret only mode
+ $whereCacheList: local := NIL --maps compiled because of where
+ $timeGlobalName: local := '$compTimeSum --see incrementTimeSum
+ $StreamFrame: local := nil --used in printing streams
+ $declaredMode: local := NIL --Weak type propagation for symbols
+ $localVars:local := NIL --list of local variables in function
+ $analyzingMapList:local := NIL --names of maps currently being
+ --analyzed
+ $lastLineInSEQ: local := true --see evalIF and friends
+ $instantCoerceCount: local := 0
+ $instantCanCoerceCount: local := 0
+ $instantMmCondCount: local := 0
+ $defaultFortVar:= 'X --default FORTRAN variable name
+ $fortVar : local := --variable name for FORTRAN output
+ $defaultFortVar
+ $minivector: local := NIL
+ $minivectorCode: local := NIL
+ $minivectorNames: local := NIL
+ $domPvar: local := NIL
+ $inRetract: local := NIL
+ object := processInteractive1(form, posnForm)
+ --object := ERRORSET(LIST('processInteractive1,LIST('QUOTE,form),LIST('QUOTE,posnForm)),'t,'t)
+ if not($ProcessInteractiveValue) then
+ if $reportInstantiations = true then
+ reportInstantiations()
+ CLRHASH $instantRecord
+ writeHistModesAndValues()
+ updateHist()
+ object
+
+processInteractive1(form, posnForm) ==
+ -- calls the analysis and output printing routines
+ $e : local := $InteractiveFrame
+ recordFrame 'system
+
+ startTimingProcess 'analysis
+ object := interpretTopLevel(form, posnForm)
+ stopTimingProcess 'analysis
+
+ startTimingProcess 'print
+ if not($ProcessInteractiveValue) then
+ recordAndPrint(objValUnwrap object,objMode object)
+ recordFrame 'normal
+ stopTimingProcess 'print
+
+--spadtestValueHook(objValUnwrap object, objMode object)
+
+ object
+
+--% Result Output Printing
+
+recordAndPrint(x,md) ==
+ -- Prints out the value x which is of type m, and records the changes
+ -- in environment $e into $InteractiveFrame
+ -- $printAnyIfTrue is documented in setvart.boot. controlled with )se me any
+ if md = '(Any) and $printAnyIfTrue then
+ md' := first x
+ x' := rest x
+ else
+ x' := x
+ md' := md
+ $outputMode: local := md --used by DEMO BOOT
+ mode:= (md=$EmptyMode => quadSch(); md)
+ if (md ^= $Void) or $printVoidIfTrue then
+ if null $collectOutput then TERPRI $algebraOutputStream
+ if $QuietCommand = false then
+ output(x',md')
+ putHist('%,'value,objNewWrap(x,md),$e)
+ if $printTimeIfTrue or $printTypeIfTrue then printTypeAndTime(x',md')
+ if $printStorageIfTrue then printStorage()
+ if $printStatisticsSummaryIfTrue then printStatisticsSummary()
+ if FIXP $HTCompanionWindowID then mkCompanionPage md
+ $mkTestFlag = true => recordAndPrintTest md
+ $runTestFlag =>
+ $mkTestOutputType := md
+ 'done
+ 'done
+
+printTypeAndTime(x,m) == --m is the mode/type of the result
+ $saturn => printTypeAndTimeSaturn(x, m)
+ printTypeAndTimeNormal(x, m)
+
+printTypeAndTimeNormal(x,m) ==
+ -- called only if either type or time is to be displayed
+ if m is ['Union, :argl] then
+ x' := retract(objNewWrap(x,m))
+ m' := objMode x'
+ m := ['Union, :[arg for arg in argl | sameUnionBranch(arg, m')], '"..."]
+ if $printTimeIfTrue then
+ timeString := makeLongTimeString($interpreterTimedNames,
+ $interpreterTimedClasses)
+ $printTimeIfTrue and $printTypeIfTrue =>
+ $collectOutput =>
+ $outputLines := [msgText("S2GL0012", [m]), :$outputLines]
+ sayKeyedMsg("S2GL0014",[m,timeString])
+ $printTimeIfTrue =>
+ $collectOutput => nil
+ sayKeyedMsg("S2GL0013",[timeString])
+ $printTypeIfTrue =>
+ $collectOutput =>
+ $outputLines := [justifyMyType msgText("S2GL0012", [m]), :$outputLines]
+ sayKeyedMsg("S2GL0012",[m])
+
+printTypeAndTimeSaturn(x, m) ==
+ -- header
+ if $printTimeIfTrue then
+ timeString := makeLongTimeString($interpreterTimedNames,
+ $interpreterTimedClasses)
+ else
+ timeString := '""
+ if $printTypeIfTrue then
+ typeString := form2StringAsTeX devaluate m
+ else
+ typeString := '""
+ if $printTypeIfTrue then
+ printAsTeX('"\axPrintType{")
+ if CONSP typeString then
+ MAPC(FUNCTION printAsTeX, typeString)
+ else
+ printAsTeX(typeString)
+ printAsTeX('"}")
+ if $printTimeIfTrue then
+ printAsTeX('"\axPrintTime{")
+ printAsTeX(timeString)
+ printAsTeX('"}")
+
+printAsTeX(x) == PRINC(x, $texOutputStream)
+
+sameUnionBranch(uArg, m) ==
+ uArg is [":", ., t] => t = m
+ uArg = m
+
+msgText(key, args) ==
+ msg := segmentKeyedMsg getKeyedMsg key
+ msg := substituteSegmentedMsg(msg,args)
+ msg := flowSegmentedMsg(msg,$LINELENGTH,$MARGIN)
+ APPLY(function CONCAT, [STRINGIMAGE x for x in CDAR msg])
+
+justifyMyType(t) ==
+ len := #t
+ len > $LINELENGTH => t
+ CONCAT(fillerSpaces($LINELENGTH-len), t)
+
+typeTimePrin x ==
+ $highlightDelta: local:= 0
+ maprinSpecial(x,0,79)
+
+printStorage() ==
+ $collectOutput => nil
+ storeString :=
+ makeLongSpaceString($interpreterTimedNames, $interpreterTimedClasses)
+ sayKeyedMsg("S2GL0016",[storeString])
+
+printStatisticsSummary() ==
+ $collectOutput => nil
+ summary := statisticsSummary()
+ sayKeyedMsg("S2GL0017",[summary])
+
+--% Interpreter Middle-Level Driver + Utilities
+
+interpretTopLevel(x, posnForm) ==
+ -- Top level entry point from processInteractive1. Sets up catch
+ -- for a thrown result
+ savedTimerStack := COPY $timedNameStack
+ c := CATCH('interpreter,interpret(x, posnForm))
+ while savedTimerStack ^= $timedNameStack repeat
+ stopTimingProcess peekTimedName()
+ c = 'tryAgain => interpretTopLevel(x, posnForm)
+ c
+
+interpret(x, :restargs) ==
+ posnForm := if PAIRP restargs then CAR restargs else restargs
+ --type analyzes and evaluates expression x, returns object
+ $env:local := [[NIL]]
+ $eval:local := true --generate code-- don't just type analyze
+ $genValue:local := true --evaluate all generated code
+ interpret1(x,nil,posnForm)
+
+interpret1(x,rootMode,posnForm) ==
+ -- dispatcher for the type analysis routines. type analyzes and
+ -- evaluates the expression x in the rootMode (if non-nil)
+ -- which may be $EmptyMode. returns an object if evaluating, and a
+ -- modeset otherwise
+
+ -- create the attributed tree
+
+ node := mkAtreeWithSrcPos(x, posnForm)
+ if rootMode then putTarget(node,rootMode)
+
+ -- do type analysis and evaluation of expression. The real guts
+
+ modeSet:= bottomUp node
+ not $eval => modeSet
+ newRootMode := (null rootMode => first modeSet ; rootMode)
+ argVal := getArgValue(node, newRootMode)
+ argVal and not $genValue => objNew(argVal, newRootMode)
+ argVal and (val:=getValue node) => interpret2(val,newRootMode,posnForm)
+ keyedSystemError("S2IS0053",[x])
+
+interpret2(object,m1,posnForm) ==
+ -- this is the late interpretCoerce. I removed the call to
+ -- coerceInteractive, so it only does the JENKS cases ALBI
+ m1=$ThrowAwayMode => object
+ x := objVal object
+ m := objMode object
+ m=$EmptyMode =>
+ x is [op,:.] and op in '(MAP STREAM) => objNew(x,m1)
+ m1 = $EmptyMode => objNew(x,m)
+ systemErrorHere '"interpret2"
+ m1 =>
+ if (ans := coerceInteractive(object,m1)) then ans
+ else throwKeyedMsgCannotCoerceWithValue(x,m,m1)
+ object
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}