aboutsummaryrefslogtreecommitdiff
path: root/src/interp/i-syscmd.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-11-07 20:54:59 +0000
committerdos-reis <gdr@axiomatics.org>2007-11-07 20:54:59 +0000
commit4edaea6cff2d604009b8f2723a9436b0fc97895d (patch)
treeeb5d3765b2e4f131610571cf5f15eef53419fca0 /src/interp/i-syscmd.boot.pamphlet
parent45ce0071c30e84b72e4c603660285fa6a462e7f7 (diff)
downloadopen-axiom-4edaea6cff2d604009b8f2723a9436b0fc97895d.tar.gz
remove more pamphlets
Diffstat (limited to 'src/interp/i-syscmd.boot.pamphlet')
-rw-r--r--src/interp/i-syscmd.boot.pamphlet3203
1 files changed, 0 insertions, 3203 deletions
diff --git a/src/interp/i-syscmd.boot.pamphlet b/src/interp/i-syscmd.boot.pamphlet
deleted file mode 100644
index 37eb1209..00000000
--- a/src/interp/i-syscmd.boot.pamphlet
+++ /dev/null
@@ -1,3203 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/i-syscmd.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-
-\begin{verbatim}
-This file contains the BOOT code for the Axiom system command
-and synonym processing facility. The code for )trace is in the file
-TRACE BOOT. The list of system commands is $SYSCOMMANDS which is
-initialized in SETQ LISP.
-
-\end{verbatim}
-
-\section{Filenames change}
-
-It appears that probe-file is now case-sensitive. In order to get around
-this we include the file extensions in both upper and lower case in the
-search lists. Lower case names are preferred.
-
-\section{handleNoParseCommands}
-
-The system commands given by the global variable
-[[|$noParseCommands|]]\cite{1} require essentially no
-preprocessing/parsing of their arguments. Here we dispatch the
-functions which implement these commands.
-
-There are four standard commands which receive arguments -- [[lisp]],
-[[synonym]], [[system]] and [[boot]]. There are five standard commands
-which do not receive arguments -- [[quit]], [[fin]], [[pquit]],
-[[credits]] and [[copyright]]. As these commands do not necessarily
-exhaust those mentioned in [[|$noParseCommands|]], we provide a
-generic dispatch based on two conventions: commands which do not
-require an argument name themselves, those which do have their names
-prefixed by [[np]].
-
-<<handleNoParseCommands>>=
-handleNoParseCommands(unab, string) ==
- string := stripSpaces string
- spaceIndex := SEARCH('" ", string)
- unab = "lisp" =>
- if (null spaceIndex) then
- sayKeyedMsg("S2IV0005", NIL)
- nil
- else nplisp(stripLisp string)
- unab = "boot" =>
- if (null spaceIndex) then
- sayKeyedMsg("S2IV0005", NIL)
- nil
- else npboot(SUBSEQ(string, spaceIndex+1))
- unab = "system" =>
- if (null spaceIndex) then
- sayKeyedMsg("S2IV0005", NIL)
- nil
- else npsystem(unab, string)
- unab = "synonym" =>
- npsynonym(unab, (null spaceIndex => '""; SUBSEQ(string, spaceIndex+1)))
- null spaceIndex =>
- FUNCALL unab
- member(unab, '( quit _
- fin _
- pquit _
- credits _
- copyright )) =>
- sayKeyedMsg("S2IV0005", NIL)
- nil
- funName := INTERN CONCAT('"np",STRING unab)
- FUNCALL(funName, SUBSEQ(string, spaceIndex+1))
-
-@
-\section{TRUENAME change}
-This change was made to make the open source Axiom work with the
-new aldor compiler.z
-This used to read:
-\begin{verbatim}
- STRCONC(TRUENAME(STRCONC(GETENV('"AXIOM"),'"/compiler/bin/")),"axiomxl ", asharpArgs, '" ", namestring args)
-\end{verbatim}
-but now reads:
-<<remove TRUENAME>>=
- STRCONC(STRCONC(GETENV('"ALDORROOT"),'"/bin/"),_
- "aldor ", asharpArgs, '" ", namestring args)
-@
-Notice that we've introduced the [[ALDORROOT]] shell variable.
-This will have to be pushed down from the top level Makefile.
-
-\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>>
-
-import '"i-object"
-)package "BOOT"
-
---% Utility Variable Initializations
-
-$cacheAlist := nil
-$compileRecurrence := true
-$errorReportLevel := 'warning
-$sourceFileTypes := '(INPUT SPAD BOOT LISP LISP370 META)
-
-$SYSCOMMANDS := [CAR x for x in $systemCommands]
-
-UNDERBAR == '"__"
-
-
-$whatOptions := '( _
- operations _
- categories _
- domains _
- packages _
- commands _
- synonyms _
- things _
- )
-
-$clearOptions := '( _
- modes _
- operations _
- properties _
- types _
- values _
- )
-
-$displayOptions := '( _
- abbreviations _
- all _
- macros _
- modes _
- names _
- operations _
- properties _
- types _
- values _
- )
-
-$countAssoc := '( (cache countCache) )
-
---% Top level system command
-
-initializeSystemCommands() ==
- l := $systemCommands
- $SYSCOMMANDS := NIL
- while l repeat
- $SYSCOMMANDS := CONS(CAAR l, $SYSCOMMANDS)
- l := CDR l
- $SYSCOMMANDS := NREVERSE $SYSCOMMANDS
-
-systemCommand [[op,:argl],:options] ==
- $options: local:= options
- $e:local := $CategoryFrame
- fun := selectOptionLC(op,$SYSCOMMANDS,'commandError)
- argl and (argl.0 = '_?) and fun ^= 'synonym =>
- helpSpad2Cmd [fun]
- fun := selectOption(fun,commandsForUserLevel $systemCommands,
- 'commandUserLevelError)
- FUNCALL(fun, argl)
-
-commandsForUserLevel l == --[a for [a,:b] in l | satisfiesUserLevel(a)]
- c := nil
- for [a,:b] in l repeat
- satisfiesUserLevel b => c := [a,:c]
- reverse c
-
-synonymsForUserLevel l ==
- -- l is a list of synonyms, and this returns a sublist of applicable
- -- synonyms at the current user level.
- $UserLevel = 'development => l
- nl := NIL
- for syn in reverse l repeat
- cmd := STRING2ID_-N(CDR syn,1)
- null selectOptionLC(cmd,commandsForUserLevel
- $systemCommands,NIL) => nil
- nl := [syn,:nl]
- nl
-
-satisfiesUserLevel x ==
- x = 'interpreter => true
- $UserLevel = 'interpreter => false
- x = 'compiler => true
- $UserLevel = 'compiler => false
- true
-
-unAbbreviateKeyword x ==
- x' :=selectOptionLC(x,$SYSCOMMANDS,'commandErrorIfAmbiguous)
- if not x' then
- x' := 'system
- SETQ(LINE, CONCAT('")system ", SUBSTRING(LINE, 1, #LINE-1)))
- $currentLine := LINE
- selectOption(x',commandsForUserLevel $systemCommands,
- 'commandUserLevelError)
-
-hasOption(al,opt) ==
- optPname:= PNAME opt
- found := NIL
- for pair in al while not found repeat
- stringPrefix?(PNAME CAR pair,optPname) => found := pair
- found
-
-selectOptionLC(x,l,errorFunction) ==
- selectOption(DOWNCASE object2Identifier x,l,errorFunction)
-
-selectOption(x,l,errorFunction) ==
- member(x,l) => x --exact spellings are always OK
- null IDENTP x =>
- errorFunction => FUNCALL(errorFunction,x,u)
- nil
- u := [y for y in l | stringPrefix?(PNAME x,PNAME y)]
- u is [y] => y
- errorFunction => FUNCALL(errorFunction,x,u)
- nil
-
-terminateSystemCommand() == TERSYSCOMMAND()
-
-commandUserLevelError(x,u) == userLevelErrorMessage("command",x,u)
-
-optionUserLevelError(x,u) == userLevelErrorMessage("option",x,u)
-
-userLevelErrorMessage(kind,x,u) ==
- null u =>
- sayKeyedMsg("S2IZ0007",[$UserLevel,kind])
- terminateSystemCommand()
- commandAmbiguityError(kind,x,u)
-
-commandError(x,u) == commandErrorMessage("command",x,u)
-
-optionError(x,u) == commandErrorMessage("option",x,u)
-
-commandErrorIfAmbiguous(x, u) ==
- null u => nil
- SETQ($OLDLINE, LINE)
- commandAmbiguityError("command", x, u)
-
-commandErrorMessage(kind,x,u) ==
- SETQ ($OLDLINE,LINE)
- null u =>
- sayKeyedMsg("S2IZ0008",[kind,x])
- terminateSystemCommand()
- commandAmbiguityError(kind,x,u)
-
-commandAmbiguityError(kind,x,u) ==
- sayKeyedMsg("S2IZ0009",[kind,x])
- for a in u repeat sayMSG ['" ",:bright a]
- terminateSystemCommand()
-
---% Utility for access to original command line
-
-getSystemCommandLine() ==
- p := STRPOS('")",$currentLine,0,NIL)
- line := if p then SUBSTRING($currentLine,p,NIL) else $currentLine
- maxIndex:= MAXINDEX line
- for i in 0..maxIndex while (line.i^=" ") repeat index:= i
- if index=maxIndex then line := '""
- else line := SUBSTRING(line,index+2,nil)
- line
-
------------- start of commands ------------------------------------------
-
---% )abbreviations
-
-abbreviations l == abbreviationsSpad2Cmd l
-
-abbreviationsSpad2Cmd l ==
- null l => helpSpad2Cmd '(abbreviations)
- abopts := '(query domain category package remove)
-
- quiet := nil
- for [opt] in $options repeat
- opt := selectOptionLC(opt,'(quiet),'optionError)
- opt = 'quiet => quiet := true
-
- l is [opt,:al] =>
- key := opOf CAR al
- type := selectOptionLC(opt,abopts,'optionError)
- type is 'query =>
- null al => listConstructorAbbreviations()
- constructor := abbreviation?(key) => abbQuery(constructor)
- abbQuery(key)
- type is 'remove =>
- DELDATABASE(key,'ABBREVIATION)
- ODDP SIZE al => sayKeyedMsg("S2IZ0002",[type])
- repeat
- null al => return 'fromLoop
- [a,b,:al] := al
- mkUserConstructorAbbreviation(b,a,type)
- SETDATABASE(b,'ABBREVIATION,a)
- SETDATABASE(b,'CONSTRUCTORKIND,type)
- null quiet =>
- sayKeyedMsg("S2IZ0001",[a,type,opOf b])
- nil
- nil
-
-listConstructorAbbreviations() ==
- x := UPCASE queryUserKeyedMsg("S2IZ0056",NIL)
- MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
- whatSpad2Cmd '(categories)
- whatSpad2Cmd '(domains)
- whatSpad2Cmd '(packages)
- sayKeyedMsg("S2IZ0057",NIL)
-
---% )clear
-
-clear l == clearSpad2Cmd l
-
-clearSpad2Cmd l ==
- -- new version which changes the environment and updates history
- $clearExcept: local := nil
- if $options then $clearExcept :=
- "and"/[selectOptionLC(opt,'(except),'optionError) =
- 'except for [opt,:.] in $options]
- null l =>
- optList:= "append"/[['%l,'" ",x] for x in $clearOptions]
- sayKeyedMsg("S2IZ0010",[optList])
- arg := selectOptionLC(first l,'(all completely scaches),NIL)
- arg = 'all => clearCmdAll()
- arg = 'completely => clearCmdCompletely()
- arg = 'scaches => clearCmdSortedCaches()
- $clearExcept => clearCmdExcept(l)
- clearCmdParts(l)
- updateCurrentInterpreterFrame()
-
-clearCmdSortedCaches() ==
- $lookupDefaults: local := false
- for [.,.,:domain] in HGET($ConstructorCache,'SortedCache) repeat
- pair := compiledLookupCheck('clearCache,[$Void],domain)
- SPADCALL pair
-
-clearCmdCompletely() ==
- clearCmdAll()
- $localExposureData := COPY_-SEQ $localExposureDataDefault
- $xdatabase := NIL
- $CatOfCatDatabase := NIL
- $DomOfCatDatabase := NIL
- $JoinOfCatDatabase := NIL
- $JoinOfDomDatabase := NIL
- $attributeDb := NIL
- $functionTable := NIL
- sayKeyedMsg("S2IZ0013",NIL)
- clearClams()
- clearConstructorCaches()
- $existingFiles := MAKE_-HASHTABLE 'UEQUAL
- sayKeyedMsg("S2IZ0014",NIL)
- RECLAIM()
- sayKeyedMsg("S2IZ0015",NIL)
- NIL
-
-clearCmdAll() ==
- clearCmdSortedCaches()
- ------undo special variables------
- $frameRecord := nil
- $previousBindings := nil
- $variableNumberAlist := nil
- untraceMapSubNames _/TRACENAMES
- $InteractiveFrame := LIST LIST NIL
- resetInCoreHist()
- if $useInternalHistoryTable
- then $internalHistoryTable := NIL
- else deleteFile histFileName()
- $IOindex := 1
- updateCurrentInterpreterFrame()
- $currentLine := '")clear all" --restored 3/94; needed for undo (RDJ)
- clearMacroTable()
- if $frameMessages then sayKeyedMsg("S2IZ0011",[$interpreterFrameName])
- else sayKeyedMsg("S2IZ0012",NIL)
-
-clearCmdExcept(l is [opt,:vl]) ==
- --clears elements of vl of all options EXCEPT opt
- for option in $clearOptions |
- ^stringPrefix?(object2String opt,object2String option)
- repeat clearCmdParts [option,:vl]
-
-clearCmdParts(l is [opt,:vl]) ==
- -- clears the bindings indicated by opt of all variables in vl
-
- option:= selectOptionLC(opt,$clearOptions,'optionError)
- option:= INTERN PNAME option
-
- -- the option can be plural but the key in the alist is sometimes
- -- singular
-
- option :=
- option = 'types => 'mode
- option = 'modes => 'mode
- option = 'values => 'value
- option
-
- null vl => sayKeyedMsg("S2IZ0055",NIL)
- pmacs := getParserMacroNames()
- imacs := getInterpMacroNames()
- if vl='(all) then
- vl := ASSOCLEFT CAAR $InteractiveFrame
- vl := REMDUP(append(vl, pmacs))
- $e : local := $InteractiveFrame
- for x in vl repeat
- clearDependencies(x,true)
- if option='properties and x in pmacs then clearParserMacro(x)
- if option='properties and x in imacs and ^(x in pmacs) then
- sayMessage ['" You cannot clear the definition of the system-defined macro ",
- fixObjectForPrinting x,"."]
- p1 := assoc(x,CAAR $InteractiveFrame) =>
- option='properties =>
- if isMap x then
- (lm := get(x,'localModemap,$InteractiveFrame)) =>
- PAIRP lm => untraceMapSubNames [CADAR lm]
- NIL
- for p2 in CDR p1 repeat
- prop:= CAR p2
- recordOldValue(x,prop,CDR p2)
- recordNewValue(x,prop,NIL)
- SETF(CAAR $InteractiveFrame,deleteAssoc(x,CAAR $InteractiveFrame))
- p2:= assoc(option,CDR p1) =>
- recordOldValue(x,option,CDR p2)
- recordNewValue(x,option,NIL)
- RPLACD(p2,NIL)
- nil
-
---% )close
-
-queryClients () ==
- -- Returns the number of active scratchpad clients
- sockSendInt($SessionManager, $QueryClients)
- sockGetInt $SessionManager
-
-
-close args ==
- $saturn =>
- sayErrorly('"Obsolete system command", _
- ['" The )close system command is obsolete in this version of AXIOM.",
- '" Please use Close from the File menu instead."])
- quiet:local:= false
- null $SpadServer =>
- throwKeyedMsg('"S2IZ0071", [])
- numClients := queryClients()
- numClients > 1 =>
- sockSendInt($SessionManager, $CloseClient)
- sockSendInt($SessionManager, $currentFrameNum)
- closeInterpreterFrame(NIL)
- for [opt,:.] in $options repeat
- fullopt := selectOptionLC(opt, '(quiet), 'optionError)
- fullopt = 'quiet =>
- quiet:=true
- quiet =>
- sockSendInt($SessionManager, $CloseClient)
- sockSendInt($SessionManager, $currentFrameNum)
- closeInterpreterFrame(NIL)
- x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil)
- MEMQ(STRING2ID_-N(x,1), '(YES Y)) =>
- BYE()
- nil
-
---% )constructor
-
-constructor args ==
- sayMessage '" Not implemented yet."
- NIL
-
---% )compiler
-
-compiler args ==
- $newConlist: local := nil --reset by compDefineLisplib and astran
- null args and null $options and null _/EDITFILE => helpSpad2Cmd '(compiler)
- if null args then args := [_/EDITFILE]
-
- -- first see if the user has explicitly specified the compiler
- -- to use.
-
- optlist := '(new old translate constructor)
- haveNew := nil
- haveOld := nil
- for opt in $options while ^(haveNew and haveOld) repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optlist,nil)
- fullopt = 'new => haveNew := true
- fullopt = 'translate => haveOld := true
- fullopt = 'constructor => haveOld := true
- fullopt = 'old => haveOld := true
-
- haveNew and haveOld => throwKeyedMsg("S2IZ0081", nil)
-
- af := pathname args
- aft := pathnameType af
--- Whats this for? MCD/PAB 21-9-95
--- if haveNew and (null(aft) or (aft = '"")) then
--- af := pathname [af, '"as"]
--- aft = '"as"
--- if haveOld and (null(aft) or (aft = '"")) then
--- af := pathname [af, '"spad"]
--- aft = '"spad"
-
- haveNew or (aft = '"as") =>
- not (af1 := $FINDFILE (af, '(as))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpCmd [af1]
- haveOld or (aft = '"spad") =>
- not (af1 := $FINDFILE (af, '(spad))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileSpad2Cmd [af1]
- aft = '"lsp" =>
- not (af1 := $FINDFILE (af, '(lsp))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpLispCmd [af1]
- aft = '"NRLIB" =>
- not (af1 := $FINDFILE (af, '(NRLIB))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileSpadLispCmd [af1]
- aft = '"ao" =>
- not (af1 := $FINDFILE (af, '(ao))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpCmd [af1]
- aft = '"al" => -- archive library of .ao files
- not (af1 := $FINDFILE (af, '(al))) =>
- throwKeyedMsg("S2IL0003",[NAMESTRING af])
- compileAsharpArchiveCmd [af1]
-
- -- see if we something with the appropriate file extension
- -- lying around
-
- af1 := $FINDFILE (af, '(as spad ao asy))
-
- af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1]
- af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1]
-
- -- maybe /EDITFILE has some stuff that can help us
- ef := pathname _/EDITFILE
- ef := mergePathnames(af,ef)
-
- ef = af => throwKeyedMsg("S2IZ0039", nil)
- af := ef
-
- pathnameType(af) = '"as" => compileAsharpCmd args
- pathnameType(af) = '"ao" => compileAsharpCmd args
- pathnameType(af) = '"spad" => compileSpad2Cmd args
-
- -- see if we something with the appropriate file extension
- -- lying around
- af1 := $FINDFILE (af, '(as spad ao asy))
-
- af1 and pathnameType(af1) = '"as" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"ao" => compileAsharpCmd [af1]
- af1 and pathnameType(af1) = '"spad" => compileSpad2Cmd [af1]
- af1 and pathnameType(af1) = '"asy" => compileAsharpArchiveCmd [af1]
-
- throwKeyedMsg("S2IZ0039", nil)
-
-compileAsharpCmd args ==
- compileAsharpCmd1 args
- terminateSystemCommand()
- spadPrompt()
-
-compileAsharpCmd1 args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .as or .ao
-
- path := pathname args
- pathType := pathnameType path
- (pathType ^= '"as") and (pathType ^= '"ao") => throwKeyedMsg("S2IZ0083", nil)
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- SETQ(_/EDITFILE, path)
- updateSourceFiles path
-
- optList := '( _
- new _
- old _
- translate _
- onlyargs _
- moreargs _
- quiet _
- nolispcompile _
- noquiet _
- library _
- nolibrary _
- )
-
- beQuiet := false -- be verbose here
- doLibrary := true -- so a )library after compilation
- doCompileLisp := true -- do compile generated lisp code
-
- moreArgs := NIL
- onlyArgs := NIL
-
- for opt in $options repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optList,nil)
-
- fullopt = 'new => nil
- fullopt = 'old => error "Internal error: compileAsharpCmd got )old"
- fullopt = 'translate => error "Internal error: compileAsharpCmd got )translate"
-
- fullopt = 'quiet => beQuiet := true
- fullopt = 'noquiet => beQuiet := false
-
- fullopt = 'nolispcompile => doCompileLisp := false
-
- fullopt = 'moreargs => moreArgs := optargs
- fullopt = 'onlyargs => onlyArgs := optargs
-
- fullopt = 'library => doLibrary := true
- fullopt = 'nolibrary => doLibrary := false
-
- throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
-
- tempArgs :=
- pathType = '"ao" =>
- -- want to strip out -Fao
- (p := STRPOS('"-Fao", $asharpCmdlineFlags, 0, NIL)) =>
- p = 0 => SUBSTRING($asharpCmdlineFlags, 5, NIL)
- STRCONC(SUBSTRING($asharpCmdlineFlags, 0, p), '" ",
- SUBSTRING($asharpCmdlineFlags, p+5, NIL))
- $asharpCmdlineFlags
- $asharpCmdlineFlags
-
- asharpArgs :=
- onlyArgs =>
- s := ""
- for a in onlyArgs repeat
- s := STRCONC(s, '" ", object2String a)
- s
- moreArgs =>
- s := tempArgs
- for a in moreArgs repeat
- s := STRCONC(s, '" ", object2String a)
- s
- tempArgs
-
- if ^beQuiet then sayKeyedMsg("S2IZ0038A",[namestring args, asharpArgs])
-
- command :=
-<<remove TRUENAME>>
- rc := OBEY command
-
- if (rc = 0) and doCompileLisp then
- lsp := fnameMake('".", pathnameName args, '"lsp")
- if fnameReadable?(lsp) then
- if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
- compileFileQuietly(lsp)
- else
- sayKeyedMsg("S2IL0003", [namestring lsp])
-
- if rc = 0 and doLibrary then
- -- do we need to worry about where the compilation output went?
- if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
- withAsharpCmd [ pathnameName path ]
- else if ^beQuiet then
- sayKeyedMsg("S2IZ0084", nil)
-
- extendLocalLibdb $newConlist
-
-compileAsharpArchiveCmd args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .al. We also assume that
- -- the name is fully qualified.
-
- path := pathname args
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- -- here is the plan:
- -- 1. extract the file name and try to make a directory based
- -- on that name.
- -- 2. cd to that directory and ar x the .al file
- -- 3. for each .ao file that shows up, compile it
- -- 4. delete the generated .ao files
-
- -- First try to make the directory in the current directory
-
- dir := fnameMake('".", pathnameName path, '"axldir")
- exists := PROBE_-FILE dir
- isDir := directoryp namestring dir
- exists and isDir ^= 1=>
- throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
-
- if isDir ^= 1 then
- cmd := STRCONC('"mkdir ", namestring dir)
- rc := OBEY cmd
- rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
-
- curDir := $CURRENT_-DIRECTORY
-
- -- cd to that directory and try to unarchive the .al file
-
- cd [ object2Identifier namestring dir ]
-
- cmd := STRCONC( '"ar x ", namestring path )
- rc := OBEY cmd
- rc ^= 0 =>
- cd [ object2Identifier namestring curDir ]
- throwKeyedMsg("S2IL0028",[namestring dir, namestring args])
-
- -- Look for .ao files
-
- asos := DIRECTORY '"*.ao"
- null asos =>
- cd [ object2Identifier namestring curDir ]
- throwKeyedMsg("S2IL0029",[namestring dir, namestring args])
-
- -- Compile the .ao files
-
- for aso in asos repeat
- compileAsharpCmd1 [ namestring aso ]
-
- -- Reset the current directory
-
- cd [ object2Identifier namestring curDir ]
-
- terminateSystemCommand()
- spadPrompt()
-
-compileAsharpLispCmd args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .lsp
-
- path := pathname args
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- optList := '( _
- quiet _
- noquiet _
- library _
- nolibrary _
- )
-
- beQuiet := false -- be verbose here
- doLibrary := true -- so a )library after compilation
-
- for opt in $options repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optList,nil)
-
- fullopt = 'quiet => beQuiet := true
- fullopt = 'noquiet => beQuiet := false
-
- fullopt = 'library => doLibrary := true
- fullopt = 'nolibrary => doLibrary := false
-
- throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
-
- lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path)
- if fnameReadable?(lsp) then
- if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
- compileFileQuietly(lsp)
- else
- sayKeyedMsg("S2IL0003", [namestring lsp])
-
- if doLibrary then
- -- do we need to worry about where the compilation output went?
- if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
- withAsharpCmd [ pathnameName path ]
- else if ^beQuiet then
- sayKeyedMsg("S2IZ0084", nil)
- terminateSystemCommand()
- spadPrompt()
-
-compileSpadLispCmd args ==
- -- Assume we entered from the "compiler" function, so args ^= nil
- -- and is a file with file extension .NRLIB
-
- path := pathname fnameMake(first args, '"code", '"lsp")
- ^PROBE_-FILE path => throwKeyedMsg("S2IL0003",[namestring args])
-
- optList := '( _
- quiet _
- noquiet _
- library _
- nolibrary _
- )
-
- beQuiet := false -- be verbose here
- doLibrary := true -- so a )library after compilation
-
- for opt in $options repeat
- [optname,:optargs] := opt
- fullopt := selectOptionLC(optname,optList,nil)
-
- fullopt = 'quiet => beQuiet := true
- fullopt = 'noquiet => beQuiet := false
-
- fullopt = 'library => doLibrary := true
- fullopt = 'nolibrary => doLibrary := false
-
- throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
-
- lsp := fnameMake(pathnameDirectory path, pathnameName path, pathnameType path)
- if fnameReadable?(lsp) then
- if ^beQuiet then sayKeyedMsg("S2IZ0089", [namestring lsp])
- --compileFileQuietly(lsp)
- RECOMPILE_-LIB_-FILE_-IF_-NECESSARY lsp
- else
- sayKeyedMsg("S2IL0003", [namestring lsp])
-
- if doLibrary then
- -- do we need to worry about where the compilation output went?
- if ^beQuiet then sayKeyedMsg("S2IZ0090", [ pathnameName path ])
- LOCALDATABASE([ pathnameName first args ],[])
- else if ^beQuiet then
- sayKeyedMsg("S2IZ0084", nil)
- terminateSystemCommand()
- spadPrompt()
-
-withAsharpCmd args ==
- $options: local := nil
- LOCALDATABASE(args, $options)
-
---% )copyright -- display copyright notice
-
-summary l ==
- OBEY STRCONC ('"cat ", systemRootDirectory(),'"/lib/summary")
-
-copyright () ==
- OBEY STRCONC ('"cat ", systemRootDirectory(),'"/lib/copyright")
-
---% )credits -- display credit list
-
-CREDITS := '(
- "An alphabetical listing of contributors to AXIOM (to October, 2006):"
- "Cyril Alberga Roy Adler Christian Aistleitner"
- "Richard Anderson George Andrews"
- "Henry Baker Stephen Balzac Yurij Baransky"
- "David R. Barton Gerald Baumgartner Gilbert Baumslag"
- "Fred Blair Vladimir Bondarenko Mark Botch"
- "Alexandre Bouyer Peter A. Broadbery Martin Brock"
- "Manuel Bronstein Florian Bundschuh Luanne Burns"
- "William Burge"
- "Quentin Carpent Robert Caviness Bruce Char"
- "Cheekai Chin David V. Chudnovsky Gregory V. Chudnovsky"
- "Josh Cohen Christophe Conil Don Coppersmith"
- "George Corliss Robert Corless Gary Cornell"
- "Meino Cramer Claire Di Crescenzo"
- "Timothy Daly Sr. Timothy Daly Jr. James H. Davenport"
- "Jean Della Dora Gabriel Dos Reis Michael Dewar"
- "Claire DiCrescendo Sam Dooley Lionel Ducos"
- "Martin Dunstan Brian Dupee Dominique Duval"
- "Robert Edwards Heow Eide-Goodman Lars Erickson"
- "Richard Fateman Bertfried Fauser Stuart Feldman"
- "Brian Ford Albrecht Fortenbacher George Frances"
- "Constantine Frangos Timothy Freeman Korrinn Fu"
- "Marc Gaetano Rudiger Gebauer Kathy Gerber"
- "Patricia Gianni Holger Gollan Teresa Gomez-Diaz"
- "Laureano Gonzalez-Vega Stephen Gortler Johannes Grabmeier"
- "Matt Grayson James Griesmer Vladimir Grinberg"
- "Oswald Gschnitzer Jocelyn Guidry"
- "Steve Hague Vilya Harvey Satoshi Hamaguchi"
- "Martin Hassner Waldek Hebisch Ralf Hemmecke"
- "Henderson Antoine Hersen"
- "Pietro Iglio"
- "Richard Jenks"
- "Kai Kaminski Grant Keady Tony Kennedy"
- "Paul Kosinski Klaus Kusche Bernhard Kutzler"
- "Larry Lambe Frederic Lehobey Michel Levaud"
- "Howard Levy Rudiger Loos Michael Lucks"
- "Richard Luczak"
- "Camm Maguire Bob McElrath Michael McGettrick"
- "Ian Meikle David Mentre Victor S. Miller"
- "Gerard Milmeister Mohammed Mobarak H. Michael Moeller"
- "Michael Monagan Marc Moreno-Maza Scott Morrison"
- "Mark Murray"
- "William Naylor C. Andrew Neff John Nelder"
- "Godfrey Nolan Arthur Norman Jinzhong Niu"
- "Michael O'Connor Kostas Oikonomou"
- "Julian A. Padget Bill Page Susan Pelzel"
- "Michel Petitot Didier Pinchon Jose Alfredo Portes"
- "Claude Quitte"
- "Norman Ramsey Michael Richardson Renaud Rioboo"
- "Jean Rivlin Nicolas Robidoux Simon Robinson"
- "Michael Rothstein Martin Rubey"
- "Philip Santas Alfred Scheerhorn William Schelter"
- "Gerhard Schneider Martin Schoenert Marshall Schor"
- "Frithjof Schulze Fritz Schwarz Nick Simicich"
- "William Sit Elena Smirnova Jonathan Steinbach"
- "Christine Sundaresan Robert Sutor Moss E. Sweedler"
- "Eugene Surowitz"
- "James Thatcher Balbir Thomas Mike Thomas"
- "Dylan Thurston Barry Trager Themos T. Tsikas"
- "Gregory Vanuxem"
- "Bernhard Wall Stephen Watt Jaap Weel"
- "Juergen Weiss M. Weller Mark Wegman"
- "James Wen Thorsten Werther Michael Wester"
- "John M. Wiley Berhard Will Clifton J. Williamson"
- "Stephen Wilson Shmuel Winograd Robert Wisbauer"
- "Sandra Wityak Waldemar Wiwianka Knut Wolf"
- "Clifford Yapp David Yun"
- "Richard Zippel Evelyn Zoernack Bruno Zuercher"
- "Dan Zwillinger"
- )
-
-credits() ==
- for i in CREDITS repeat
- PRINC(i)
- TERPRI()
-
---% )display
-
-display l == displaySpad2Cmd l
-
-displaySpad2Cmd l ==
- $e: local := $EmptyEnvironment
- l is [opt,:vl] and opt ^= "?" =>
- option := selectOptionLC(opt,$displayOptions,'optionError) =>
-
- -- the option may be given in the plural but the property in
- -- the alist is sometimes singular
-
- option :=
- option = 'all =>
- l := ['properties]
- 'properties
- (option = 'modes) or (option = 'types) =>
- l := ['type, :vl]
- 'type
- option = 'values =>
- l := ['value, :vl]
- 'value
- option
-
- option = 'abbreviations =>
- null vl => listConstructorAbbreviations()
- for v in vl repeat abbQuery(opOf v)
-
- option = 'operations => displayOperations vl
- option = 'macros => displayMacros vl
- option = 'names => displayWorkspaceNames()
- displayProperties(option,l)
- optList:= [:['%l,'" ",x] for x in $displayOptions]
- msg := [:bright '" )display",'"keyword arguments are",
- :bright optList,'%l,'" or abbreviations thereof."]
- sayMessage msg
-
-displayMacros names ==
- imacs := getInterpMacroNames()
- pmacs := getParserMacroNames()
- macros :=
- null names => APPEND (imacs, pmacs)
- names
- macros := REMDUP macros
-
- null macros => sayBrightly '" There are no Axiom macros."
-
- -- first do user defined ones
-
- first := true
- for macro in macros repeat
- macro in pmacs =>
- if first then
- sayBrightly ['%l,'"User-defined macros:"]
- first := NIL
- displayParserMacro macro
- macro in imacs => 'iterate
- sayBrightly ([" ",'%b, macro, '%d, " is not a known Axiom macro."])
-
- -- now system ones
-
- first := true
- for macro in macros repeat
- macro in imacs =>
- macro in pmacs => 'iterate
- if first then
- sayBrightly ['%l,'"System-defined macros:"]
- first := NIL
- displayMacro macro
- macro in pmacs => 'iterate
- NIL
-
-getParserMacroNames() ==
- REMDUP [CAR mac for mac in getParserMacros()]
-
---------------------> NEW DEFINITION (override in patches.lisp.pamphlet)
-clearParserMacro(macro) ==
- -- first see if it is one
- not IFCDR assoc(macro, ($pfMacros)) => NIL
- $pfMacros := REMALIST($pfMacros, macro)
-
-displayMacro name ==
- m := isInterpMacro name
- null m =>
- sayBrightly ['" ",:bright name,'"is not an interpreter macro."]
- -- $op is needed in the output routines.
- $op : local := STRCONC('"macro ",object2String name)
- [args,:body] := m
- args :=
- null args => nil
- null rest args => first args
- ['Tuple,:args]
- mathprint ['MAP,[args,:body]]
-
-displayWorkspaceNames() ==
- imacs := getInterpMacroNames()
- pmacs := getParserMacroNames()
- sayMessage '"Names of User-Defined Objects in the Workspace:"
- names := MSORT append(getWorkspaceNames(),pmacs)
- if null names
- then sayBrightly " * None *"
- else sayAsManyPerLineAsPossible [object2String x for x in names]
- imacs := SETDIFFERENCE(imacs,pmacs)
- if imacs then
- sayMessage '"Names of System-Defined Objects in the Workspace:"
- sayAsManyPerLineAsPossible [object2String x for x in imacs]
-
-
-getWorkspaceNames() ==
- NMSORT [n for [n,:.] in CAAR $InteractiveFrame |
- (n ^= "--macros--" and n^= "--flags--")]
-
-displayOperations l ==
- null l =>
- x := UPCASE queryUserKeyedMsg("S2IZ0058",NIL)
- if MEMQ(STRING2ID_-N(x,1),'(Y YES))
- then for op in allOperations() repeat reportOpSymbol op
- else sayKeyedMsg("S2IZ0059",NIL)
- nil
- for op in l repeat reportOpSymbol op
-
-interpFunctionDepAlists() ==
- $e : local := $InteractiveFrame
- deps := getFlag "$dependencies"
- $dependentAlist := [[NIL,:NIL]]
- $dependeeAlist := [[NIL,:NIL]]
- for [dependee,dependent] in deps repeat
- $dependentAlist := PUTALIST($dependentAlist,dependee,
- CONS(dependent,GETALIST($dependentAlist,dependee)))
- $dependeeAlist := PUTALIST($dependeeAlist,dependent,
- CONS(dependee,GETALIST($dependeeAlist,dependent)))
-
-fixObjectForPrinting(v) ==
- v' := object2Identifier v
- EQ(v',"%") => '"\%"
- v' in $msgdbPrims => STRCONC('"\",PNAME v')
- v
-
-displayProperties(option,l) ==
- $dependentAlist : local
- $dependeeAlist : local
- [opt,:vl]:= (l or ['properties])
- imacs := getInterpMacroNames()
- pmacs := getParserMacroNames()
- macros := REMDUP append(imacs, pmacs)
- if vl is ['all] or null vl then
- vl := MSORT append(getWorkspaceNames(),macros)
- if $frameMessages then sayKeyedMsg("S2IZ0065",[$interpreterFrameName])
- null vl =>
- null $frameMessages => sayKeyedMsg("S2IZ0066",NIL)
- sayKeyedMsg("S2IZ0067",[$interpreterFrameName])
- interpFunctionDepAlists()
- for v in vl repeat
- isInternalMapName(v) => 'iterate
- pl := getIProplist(v)
- option = 'flags => getAndSay(v,"flags")
- option = 'value => displayValue(v,getI(v,'value),nil)
- option = 'condition => displayCondition(v,getI(v,"condition"),nil)
- option = 'mode => displayMode(v,getI(v,'mode),nil)
- option = 'type => displayType(v,getI(v,'value),nil)
- option = 'properties =>
- v = "--flags--" => nil
- pl is [['cacheInfo,:.],:.] => nil
- v1 := fixObjectForPrinting(v)
- sayMSG ['"Properties of",:bright prefix2String v1,'":"]
- null pl =>
- v in pmacs =>
- sayMSG '" This is a user-defined macro."
- displayParserMacro v
- isInterpMacro v =>
- sayMSG '" This is a system-defined macro."
- displayMacro v
- sayMSG '" none"
- propsSeen:= nil
- for [prop,:val] in pl | ^MEMQ(prop,propsSeen) and val repeat
- prop in '(alias generatedCode IS_-GENSYM mapBody localVars) =>
- nil
- prop = 'condition =>
- displayCondition(prop,val,true)
- prop = 'recursive =>
- sayMSG '" This is recursive."
- prop = 'isInterpreterFunction =>
- sayMSG '" This is an interpreter function."
- sayFunctionDeps v where
- sayFunctionDeps x ==
- if dependents := GETALIST($dependentAlist,x) then
- null rest dependents =>
- sayMSG ['" The following function or rule ",
- '"depends on this:",:bright first dependents]
- sayMSG
- '" The following functions or rules depend on this:"
- msg := ["%b",'" "]
- for y in dependents repeat msg := ['" ",y,:msg]
- sayMSG [:nreverse msg,"%d"]
- if dependees := GETALIST($dependeeAlist,x) then
- null rest dependees =>
- sayMSG ['" This depends on the following function ",
- '"or rule:",:bright first dependees]
- sayMSG
- '" This depends on the following functions or rules:"
- msg := ["%b",'" "]
- for y in dependees repeat msg := ['" ",y,:msg]
- sayMSG [:nreverse msg,"%d"]
- prop = 'isInterpreterRule =>
- sayMSG '" This is an interpreter rule."
- sayFunctionDeps v
- prop = 'localModemap =>
- displayModemap(v,val,true)
- prop = 'mode =>
- displayMode(prop,val,true)
- prop = 'value =>
- val => displayValue(v,val,true)
- sayMSG ['" ",prop,'": ",val]
- propsSeen:= [prop,:propsSeen]
- sayKeyedMsg("S2IZ0068",[option])
- terminateSystemCommand()
-
-displayModemap(v,val,giveVariableIfNil) ==
- for mm in val repeat g(v,mm,giveVariableIfNil) where
- g(v,mm,giveVariableIfNil) ==
- [[local,:signature],fn,:.]:= mm
- local='interpOnly => nil
- varPart:= (giveVariableIfNil => nil; ['" of",:bright v])
- prefix:= [" Compiled function type",:varPart,": "]
- sayBrightly concat(prefix,formatSignature signature)
-
-displayMode(v,mode,giveVariableIfNil) ==
- null mode => nil
- varPart:= (giveVariableIfNil => nil; [" of",:bright fixObjectForPrinting v])
- sayBrightly concat(" Declared type or mode",
- varPart,": ",prefix2String mode)
-
-displayCondition(v,condition,giveVariableIfNil) ==
- varPart:= (giveVariableIfNil => nil; [" of",:bright v])
- condPart:= condition or 'true
- sayBrightly concat(" condition",varPart,": ",pred2English condPart)
-
-getAndSay(v,prop) ==
- val:= getI(v,prop) => sayMSG [" ",val,'%l]
- sayMSG [" none",'%l]
-
-displayType($op,u,omitVariableNameIfTrue) ==
- null u =>
- sayMSG ['" Type of value of ",
- fixObjectForPrinting PNAME $op,'": (none)"]
- type := prefix2String objMode(u)
- if ATOM type then type := [type]
- sayMSG concat ['" Type of value of ",fixObjectForPrinting PNAME $op,'": ",:type]
- NIL
-
-displayValue($op,u,omitVariableNameIfTrue) ==
- null u => sayMSG [" Value of ",fixObjectForPrinting PNAME $op,'": (none)"]
- expr := objValUnwrap(u)
- expr is [op,:.] and (op = 'MAP) or objMode(u) = $EmptyMode =>
- displayRule($op,expr)
- label:=
- omitVariableNameIfTrue =>
- rhs := '"): "
- '"Value (has type "
- rhs := '": "
- STRCONC('"Value of ", PNAME $op,'": ")
- labmode := prefix2String objMode(u)
- if ATOM labmode then labmode := [labmode]
- GETDATABASE(expr,'CONSTRUCTORKIND) = 'domain =>
- sayMSG concat('" ",label,labmode,rhs,form2String expr)
- mathprint ['CONCAT,label,:labmode,rhs,
- outputFormat(expr,objMode(u))]
- NIL
-
---% )edit
-
-edit l == editSpad2Cmd l
-
-editSpad2Cmd l ==
- l:=
- null l => _/EDITFILE
- CAR l
- l := pathname l
- oldDir := pathnameDirectory l
- fileTypes :=
- pathnameType l => [pathnameType l]
- $UserLevel = 'interpreter => '("input" "INPUT" "spad" "SPAD")
- $UserLevel = 'compiler => '("input" "INPUT" "spad" "SPAD")
- '("input" "INPUT" "spad" "SPAD" "boot" "BOOT" "lisp" "LISP" "meta" "META")
- ll :=
- oldDir = '"" => pathname $FINDFILE (pathnameName l, fileTypes)
- l
- l := pathname ll
- SETQ(_/EDITFILE,l)
- rc := editFile l
- updateSourceFiles l
- rc
-
---% )help
-
-help l == helpSpad2Cmd l
-
-helpSpad2Cmd args ==
- -- try to use new stuff first
- if newHelpSpad2Cmd(args) then return nil
-
- sayKeyedMsg("S2IZ0025",[args])
- nil
-
-newHelpSpad2Cmd args ==
- if null args then args := ["?"]
- # args > 1 =>
- sayKeyedMsg("S2IZ0026",NIL)
- true
- sarg := PNAME first args
- if sarg = '"?" then args := ['help]
- else if sarg = '"%" then args := ['history]
- else if sarg = '"%%" then args := ['history]
- arg := selectOptionLC(first args,$SYSCOMMANDS,nil)
- if null arg then arg := first args
- if arg = 'compiler then arg := 'compile
-
- -- see if new help file exists
-
- narg := PNAME arg
- null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => NIL
-
- $useFullScreenHelp =>
- OBEY STRCONC('"$AXIOM/lib/SPADEDIT ",namestring helpFile)
- true
-
- filestream := MAKE_-INSTREAM(helpFile)
- repeat
- line := read_-line(filestream,false)
- NULL line =>
- SHUT filestream
- return true
- SAY line
- true
-
---%
---% )frame
---%
-
-$frameRecord := nil --Initial setting for frame record
-$previousBindings := nil
-
-frame l == frameSpad2Cmd l
-
-frameName(frame) == CAR frame
-
-frameNames() == [frameName f for f in $interpreterFrameRing]
-
-frameEnvironment fname ==
- -- extracts the environment portion of a frame
- -- if fname is not a valid frame name then the empty environment
- -- is returned
- fname = frameName first $interpreterFrameRing => $InteractiveFrame
- ifr := rest $interpreterFrameRing
- e := LIST LIST NIL
- while ifr repeat
- [f,:ifr] := ifr
- if fname = frameName f then
- e := CADR f
- ifr := NIL
- e
-
-frameSpad2Cmd args ==
- frameArgs := '(drop import last names new next)
- $options => throwKeyedMsg("S2IZ0016",['")frame"])
- null(args) => helpSpad2Cmd ['frame]
- arg := selectOptionLC(first args,frameArgs,'optionError)
- args := rest args
- if args is [a] then args := a
- if ATOM args then args := object2Identifier args
- arg = 'drop =>
- args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args])
- closeInterpreterFrame(args)
- arg = "import" => importFromFrame args
- arg = "last" => previousInterpreterFrame()
- arg = "names" => displayFrameNames()
- arg = "new" =>
- args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args])
- addNewInterpreterFrame(args)
- arg = "next" => nextInterpreterFrame()
-
- NIL
-
-addNewInterpreterFrame(name) ==
- null name => throwKeyedMsg("S2IZ0018",NIL)
- updateCurrentInterpreterFrame()
- -- see if we already have one by that name
- for f in $interpreterFrameRing repeat
- name = frameName(f) => throwKeyedMsg("S2IZ0019",[name])
- initHistList()
- $interpreterFrameRing := CONS(emptyInterpreterFrame(name),
- $interpreterFrameRing)
- updateFromCurrentInterpreterFrame()
- _$ERASE histFileName()
-
-emptyInterpreterFrame(name) ==
- LIST(name, -- frame name
- LIST LIST NIL, -- environment
- 1, -- $IOindex
- $HiFiAccess, -- $HiFiAccess
- $HistList, -- $HistList
- $HistListLen, -- $HistListLen
- $HistListAct, -- $HistListAct
- $HistRecord, -- $HistRecord
- NIL, -- $internalHistoryTable
- COPY_-SEQ $localExposureDataDefault -- $localExposureData
- )
-
-closeInterpreterFrame(name) ==
- -- if name = NIL then it means the current frame
- null rest $interpreterFrameRing =>
- name and (name ^= $interpreterFrameName) =>
- throwKeyedMsg("S2IZ0020",[$interpreterFrameName])
- throwKeyedMsg("S2IZ0021",NIL)
- if null name then $interpreterFrameRing := rest $interpreterFrameRing
- else -- find the frame
- found := nil
- ifr := NIL
- for f in $interpreterFrameRing repeat
- found or (name ^= frameName(f)) => ifr := CONS(f,ifr)
- found := true
- not found => throwKeyedMsg("S2IZ0022",[name])
- _$ERASE makeHistFileName(name)
- $interpreterFrameRing := nreverse ifr
- updateFromCurrentInterpreterFrame()
-
-previousInterpreterFrame() ==
- updateCurrentInterpreterFrame()
- null rest $interpreterFrameRing => NIL -- nothing to do
- [:b,l] := $interpreterFrameRing
- $interpreterFrameRing := NCONC2([l],b)
- updateFromCurrentInterpreterFrame()
-
-nextInterpreterFrame() ==
- updateCurrentInterpreterFrame()
- null rest $interpreterFrameRing => NIL -- nothing to do
- $interpreterFrameRing :=
- NCONC2(rest $interpreterFrameRing,[first $interpreterFrameRing])
- updateFromCurrentInterpreterFrame()
-
-
-createCurrentInterpreterFrame() ==
- LIST($interpreterFrameName, -- frame name
- $InteractiveFrame, -- environment
- $IOindex, -- $IOindex
- $HiFiAccess, -- $HiFiAccess
- $HistList, -- $HistList
- $HistListLen, -- $HistListLen
- $HistListAct, -- $HistListAct
- $HistRecord, -- $HistRecord
- $internalHistoryTable, -- $internalHistoryTable
- $localExposureData -- $localExposureData
- )
-
-
-updateFromCurrentInterpreterFrame() ==
- [$interpreterFrameName, _
- $InteractiveFrame, _
- $IOindex, _
- $HiFiAccess, _
- $HistList, _
- $HistListLen, _
- $HistListAct, _
- $HistRecord, _
- $internalHistoryTable, _
- $localExposureData _
- ] := first $interpreterFrameRing
- if $frameMessages then
- sayMessage ['" Current interpreter frame is called",:bright
- $interpreterFrameName]
- NIL
-
-
-updateCurrentInterpreterFrame() ==
- RPLACA($interpreterFrameRing,createCurrentInterpreterFrame())
- updateFromCurrentInterpreterFrame()
- NIL
-
-initializeInterpreterFrameRing() ==
- $interpreterFrameName := 'initial
- $interpreterFrameRing := [emptyInterpreterFrame($interpreterFrameName)]
- updateFromCurrentInterpreterFrame()
- NIL
-
-
-changeToNamedInterpreterFrame(name) ==
- updateCurrentInterpreterFrame()
- frame := findFrameInRing(name)
- null frame => NIL
- $interpreterFrameRing := [frame,:NREMOVE($interpreterFrameRing, frame)]
- updateFromCurrentInterpreterFrame()
-
-makeInitialModemapFrame() == COPY $InitialModemapFrame
-
-findFrameInRing(name) ==
- val := NIL
- for frame in $interpreterFrameRing repeat
- CAR frame = name =>
- val := frame
- return frame
- val
-
-displayFrameNames() ==
- fs := "append"/[ ['%l,'" ",:bright frameName f] for f in
- $interpreterFrameRing]
- sayKeyedMsg("S2IZ0024",[fs])
-
-importFromFrame args ==
- -- args should have the form [frameName,:varNames]
- if args and atom args then args := [args]
- null args => throwKeyedMsg("S2IZ0073",NIL)
- [fname,:args] := args
- not member(fname,frameNames()) =>
- throwKeyedMsg("S2IZ0074",[fname])
- fname = frameName first $interpreterFrameRing =>
- throwKeyedMsg("S2IZ0075",NIL)
- fenv := frameEnvironment fname
- null args =>
- x := UPCASE queryUserKeyedMsg("S2IZ0076",[fname])
- MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
- vars := NIL
- for [v,:props] in CAAR fenv repeat
- v = "--macros" =>
- for [m,:.] in props repeat vars := cons(m,vars)
- vars := cons(v,vars)
- importFromFrame [fname,:vars]
- sayKeyedMsg("S2IZ0077",[fname])
- for v in args repeat
- plist := GETALIST(CAAR fenv,v)
- plist =>
- -- remove anything with the same name in the current frame
- clearCmdParts ['propert,v]
- for [prop,:val] in plist repeat
- putHist(v,prop,val,$InteractiveFrame)
- (m := get("--macros--",v,fenv)) =>
- putHist("--macros--",v,m,$InteractiveFrame)
- sayKeyedMsg("S2IZ0079",[v,fname])
- sayKeyedMsg("S2IZ0078",[fname])
-
-
-
---% )history
-
-++ vm/370 filename type component
-SETANDFILEQ($historyFileType,'axh)
-
-++ vm/370 filename name component
-SETANDFILEQ($oldHistoryFileName,'last)
-SETANDFILEQ($internalHistoryTable,NIL)
-
-++ t means keep history in core
-SETANDFILEQ($useInternalHistoryTable, true)
-
-history l ==
- l or null $options => sayKeyedMsg("S2IH0006",NIL)
- historySpad2Cmd()
-
-
-makeHistFileName(fname) ==
- makePathname(fname,$historyFileType,$historyDirectory)
-
-oldHistFileName() ==
- makeHistFileName($oldHistoryFileName)
-
-histFileName() ==
- makeHistFileName($interpreterFrameName)
-
-
-histInputFileName(fn) ==
- null fn =>
- makePathname($interpreterFrameName,'INPUT,$historyDirectory)
- makePathname(fn,'INPUT,$historyDirectory)
-
-
-initHist() ==
- $useInternalHistoryTable => initHistList()
- oldFile := oldHistFileName()
- newFile := histFileName()
- -- see if history directory is writable
- histFileErase oldFile
- if MAKE_-INPUT_-FILENAME newFile then $REPLACE(oldFile,newFile)
- $HiFiAccess:= 'T
- initHistList()
-
-initHistList() ==
- -- creates $HistList as a circular list of length $HistListLen
- -- and $HistRecord
- $HistListLen:= 20
- $HistList:= LIST NIL
- li:= $HistList
- for i in 1..$HistListLen repeat li:= CONS(NIL,li)
- RPLACD($HistList,li)
- $HistListAct:= 0
- $HistRecord:= NIL
-
-historySpad2Cmd() ==
- -- history is a system command which can call resetInCoreHist
- -- and changeHistListLen, and restore last session
- histOptions:=
- '(on off yes no change reset restore write save show file memory)
- opts:= [ [selectOptionLC(opt,histOptions,'optionError),:optargs]
- for [opt,:optargs] in $options]
- for [opt,:optargs] in opts repeat
- opt in '(on yes) =>
- $HiFiAccess => sayKeyedMsg("S2IH0007",NIL)
- $IOindex = 1 => -- haven't done anything yet
- $HiFiAccess:= 'T
- initHistList()
- sayKeyedMsg("S2IH0008",NIL)
- x := UPCASE queryUserKeyedMsg("S2IH0009",NIL)
- MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
- histFileErase histFileName()
- $HiFiAccess:= 'T
- $options := nil
- clearSpad2Cmd '(all)
- sayKeyedMsg("S2IH0008",NIL)
- initHistList()
- sayKeyedMsg("S2IH0010",NIL)
- opt in '(off no) =>
- null $HiFiAccess => sayKeyedMsg("S2IH0011",NIL)
- $HiFiAccess:= NIL
- disableHist()
- sayKeyedMsg("S2IH0012",NIL)
- opt = 'file => setHistoryCore NIL
- opt = 'memory => setHistoryCore true
- opt = 'reset => resetInCoreHist()
- opt = 'save => saveHistory optargs
- opt = 'show => showHistory optargs
- opt = 'change => changeHistListLen first optargs
- opt = 'restore => restoreHistory optargs
- opt = 'write => writeInputLines(optargs,1)
- 'done
-
-
-setHistoryCore inCore ==
- inCore = $useInternalHistoryTable =>
- sayKeyedMsg((inCore => "S2IH0030"; "S2IH0029"),NIL)
- not $HiFiAccess =>
- $useInternalHistoryTable := inCore
- inCore => sayKeyedMsg("S2IH0032",NIL)
- sayKeyedMsg("S2IH0031",NIL)
- inCore =>
- $internalHistoryTable := NIL
- if $IOindex ^= 0 then
- -- actually put something in there
- l := LENGTH RKEYIDS histFileName()
- for i in 1..l repeat
- vec:= UNWIND_-PROTECT(readHiFi(i),disableHist())
- $internalHistoryTable := CONS([i,:vec],$internalHistoryTable)
- histFileErase histFileName()
- $useInternalHistoryTable := true
- sayKeyedMsg("S2IH0032",NIL)
- $HiFiAccess:= 'NIL
- histFileErase histFileName()
- str := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]]
- for [n,:rec] in reverse $internalHistoryTable repeat
- SPADRWRITE(object2Identifier n,rec,str)
- RSHUT str
- $HiFiAccess:= 'T
- $internalHistoryTable := NIL
- $useInternalHistoryTable := NIL
- sayKeyedMsg("S2IH0031",NIL)
-
-
-writeInputLines(fn,initial) ==
- -- writes all input lines into file histInputFileName()
- not $HiFiAccess => sayKeyedMsg("S2IH0013",NIL) -- history not on
- null fn =>
- throwKeyedMsg("S2IH0038", nil) -- missing file name
- maxn := 72
- breakChars := [" ","+"]
- for i in initial..$IOindex - 1 repeat
- vecl := CAR readHiFi i
- if STRINGP vecl then vecl := [vecl]
- for vec in vecl repeat
- n := SIZE vec
- while n > maxn repeat
- -- search backwards for a blank
- done := nil
- for j in 1..maxn while ^done repeat
- k := 1 + maxn - j
- MEMQ(vec.k,breakChars) =>
- svec := STRCONC(SUBSTRING(vec,0,k+1),UNDERBAR)
- lineList := [svec,:lineList]
- done := true
- vec := SUBSTRING(vec,k+1,NIL)
- n := SIZE vec
- -- in case we can't find a breaking point
- if ^done then n := 0
- lineList := [vec,:lineList]
- file := histInputFileName(fn)
- histFileErase file
- inp:= DEFIOSTREAM(['(MODE . OUTPUT),['FILE,:file]],255,0)
- for x in removeUndoLines NREVERSE lineList repeat WRITE_-LINE(x,inp)
- -- see file "undo" for definition of removeUndoLines
- if fn ^= 'redo then sayKeyedMsg("S2IH0014",[namestring file])
- SHUT inp
- NIL
-
-
-resetInCoreHist() ==
- -- removes all pointers from $HistList
- $HistListAct:= 0
- for i in 1..$HistListLen repeat
- $HistList:= CDR $HistList
- RPLACA($HistList,NIL)
-
-changeHistListLen(n) ==
- -- changes the length of $HistList. n must be nonnegative
- NULL INTEGERP n => sayKeyedMsg("S2IH0015",[n])
- dif:= n-$HistListLen
- $HistListLen:= n
- l:= CDR $HistList
- if dif > 0 then
- for i in 1..dif repeat l:= CONS(NIL,l)
- if dif < 0 then
- for i in 1..-dif repeat l:= CDR l
- if $HistListAct > n then $HistListAct:= n
- RPLACD($HistList,l)
- 'done
-
-updateHist() ==
- -- updates the history file and calls updateInCoreHist
- null $IOindex => nil
- startTimingProcess 'history
- updateInCoreHist()
- if $HiFiAccess then
- UNWIND_-PROTECT(writeHiFi(),disableHist())
- $HistRecord:= NIL
- $IOindex:= $IOindex+1
- updateCurrentInterpreterFrame()
- $mkTestInputStack := nil
- $currentLine := nil
- stopTimingProcess 'history
-
-updateInCoreHist() ==
- -- updates $HistList and $IOindex
- $HistList:= CDR($HistList)
- RPLACA($HistList,NIL)
- if $HistListAct < $HistListLen then $HistListAct:= $HistListAct+1
-
-putHist(x,prop,val,e) ==
- -- records new value to $HistRecord and old value to $HistList
- -- then put is called with e
- if not (x='%) then recordOldValue(x,prop,get(x,prop,e))
- if $HiFiAccess then recordNewValue(x,prop,val)
- putIntSymTab(x,prop,val,e)
-
-histFileErase file ==
- --OBEY STRCONC('"rm -rf ", file)
- PROBE_-FILE(file) and DELETE_-FILE(file)
-
-
-
-recordNewValue(x,prop,val) ==
- startTimingProcess 'history
- recordNewValue0(x,prop,val)
- stopTimingProcess 'history
-
-recordNewValue0(x,prop,val) ==
- -- writes (prop . val) into $HistRecord
- -- updateHist writes this stuff out into the history file
- p1:= ASSQ(x,$HistRecord) =>
- p2:= ASSQ(prop,CDR p1) =>
- RPLACD(p2,val)
- RPLACD(p1,CONS(CONS(prop,val),CDR p1))
- p:= CONS(x,list CONS(prop,val))
- $HistRecord:= CONS(p,$HistRecord)
-
-recordOldValue(x,prop,val) ==
- startTimingProcess 'history
- recordOldValue0(x,prop,val)
- stopTimingProcess 'history
-
-recordOldValue0(x,prop,val) ==
- -- writes (prop . val) into $HistList
- p1:= ASSQ(x,CAR $HistList) =>
- not ASSQ(prop,CDR p1) =>
- RPLACD(p1,CONS(CONS(prop,val),CDR p1))
- p:= CONS(x,list CONS(prop,val))
- RPLACA($HistList,CONS(p,CAR $HistList))
-
-undoInCore(n) ==
- -- undoes the last n>0 steps using $HistList
- -- resets $InteractiveFrame
- li:= $HistList
- for i in n..$HistListLen repeat li:= CDR li
- undoChanges(li)
- n:= $IOindex-n-1
- n>0 and
- $HiFiAccess =>
- vec:= CDR UNWIND_-PROTECT(readHiFi(n),disableHist())
- val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and
- CDR p1
- sayKeyedMsg("S2IH0019",[n])
- $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame)
- updateHist()
-
-undoChanges(li) ==
- -- undoes all changes of list 'li'
- if not CDR li = $HistList then undoChanges CDR li
- for p1 in CAR li repeat
- x:= CAR p1
- for p2 in CDR p1 repeat
- putHist(x,CAR p2,CDR p2,$InteractiveFrame)
-
-undoFromFile(n) ==
- -- makes a clear and redoes all the assignments until step n
- for [x,:varl] in CAAR $InteractiveFrame repeat
- for p in varl repeat
- [prop,:val]:= p
- val =>
- if not (x='%) then recordOldValue(x,prop,val)
- if $HiFiAccess then recordNewValue(x,prop,val)
- RPLACD(p,NIL)
- for i in 1..n repeat
- vec:= UNWIND_-PROTECT(CDR readHiFi(i),disableHist())
- for p1 in vec repeat
- x:= CAR p1
- for p2 in CDR p1 repeat
- $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame)
- val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and CDR p1
- $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame)
- updateHist()
-
-saveHistory(fn) ==
- $seen: local := MAKE_-HASHTABLE 'EQ
- not $HiFiAccess => sayKeyedMsg("S2IH0016",NIL)
- not $useInternalHistoryTable and
- null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",NIL)
- null fn =>
- throwKeyedMsg("S2IH0037", nil)
- savefile := makeHistFileName(fn)
- inputfile := histInputFileName(fn)
- writeInputLines(fn,1)
- histFileErase savefile
-
- if $useInternalHistoryTable
- then
- saveStr := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:savefile]]
- for [n,:rec] in reverse $internalHistoryTable repeat
- val := SPADRWRITE0(object2Identifier n,rec,saveStr)
- val = 'writifyFailed =>
- sayKeyedMsg("S2IH0035", [n, inputfile]) -- unable to save step
- RSHUT saveStr
- sayKeyedMsg("S2IH0018",[namestring(savefile)]) -- saved hist file named
- nil
-
-restoreHistory(fn) ==
- -- uses fn $historyFileType to recover an old session
- -- if fn = NIL, then use $oldHistoryFileName
- if null fn then fn' := $oldHistoryFileName
- else if fn is [fn'] and IDENTP(fn') then fn' := fn'
- else throwKeyedMsg("S2IH0023",[fn'])
- restfile := makeHistFileName(fn')
- null MAKE_-INPUT_-FILENAME restfile =>
- sayKeyedMsg("S2IH0024",[namestring(restfile)]) -- no history file
-
- -- if clear is changed to be undoable, this should be a reset-clear
- $options: local := nil
- clearSpad2Cmd '(all)
-
- curfile := histFileName()
- histFileErase curfile
- _$FCOPY(restfile,curfile)
-
- l:= LENGTH RKEYIDS curfile
- $HiFiAccess:= 'T
- oldInternal := $useInternalHistoryTable
- $useInternalHistoryTable := NIL
- if oldInternal then $internalHistoryTable := NIL
- for i in 1..l repeat
- vec:= UNWIND_-PROTECT(readHiFi(i),disableHist())
- if oldInternal then $internalHistoryTable :=
- CONS([i,:vec],$internalHistoryTable)
- LINE:= CAR vec
- for p1 in CDR vec repeat
- x:= CAR p1
- for p2 in CDR p1 repeat
- $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame)
- updateInCoreHist()
- $e := $InteractiveFrame
- for [a,:.] in CAAR $InteractiveFrame repeat
- get(a,'localModemap,$InteractiveFrame) =>
- rempropI(a,'localModemap)
- rempropI(a,'localVars)
- rempropI(a,'mapBody)
- $IOindex:= l+1
- $useInternalHistoryTable := oldInternal
- sayKeyedMsg("S2IH0025",[namestring(restfile)])
- clearCmdSortedCaches()
- nil
-
-
--- the following used to be the show command when that was used to
--- show history.
-showHistory(arg) ==
- -- arg can be of form
- -- NIL show at most last 20 input lines
- -- (n) show at most last n input lines
- -- (lit) where lit is an abbreviation for 'input or 'both
- -- if 'input, same as NIL
- -- if 'both, show last 5 input and outputs
- -- (n lit) show last n input lines + last n output lines
- -- if lit expands to 'both
- $evalTimePrint: local:= 0
- $printTimeSum: local:= 0
- -- ugh!!! these are needed for timedEvaluateStream
- -- displays the last n steps, default n=20
- not $HiFiAccess => sayKeyedMsg("S2IH0026",['show])
- showInputOrBoth := 'input
- n := 20
- nset := nil
- if arg then
- arg1 := CAR arg
- if INTEGERP arg1 then
- n := arg1
- nset := true
- KDR arg => arg1 := CADR arg
- arg1 := NIL
- arg1 =>
- arg2 := selectOptionLC(arg1,'(input both),nil)
- if arg2
- then ((showInputOrBoth := arg2) = 'both) and (null nset) => n:= 5
- else sayMSG
- concat('" ",bright arg1,'"is an invalid argument.")
- if n >= $IOindex then n:= $IOindex-1
- mini:= $IOindex-n
- maxi:= $IOindex-1
- showInputOrBoth = 'both =>
- UNWIND_-PROTECT(showInOut(mini,maxi),setIOindex(maxi+1))
- showInput(mini,maxi)
-
-setIOindex(n) ==
- -- set $IOindex to n
- $IOindex:= n
-
-showInput(mini,maxi) ==
- -- displays all input lines from mini to maxi
- for ind in mini..maxi repeat
- vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist())
- if ind<10 then TAB 2 else if ind<100 then TAB 1
- l := CAR vec
- STRINGP l =>
- sayMSG ['" [",ind,'"] ",CAR vec]
- sayMSG ['" [",ind,'"] " ]
- for ln in l repeat
- sayMSG ['" ", ln]
-
-showInOut(mini,maxi) ==
- -- displays all steps from mini to maxi
- for ind in mini..maxi repeat
- vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist())
- sayMSG [CAR vec]
- Alist:= ASSQ('%,CDR vec) =>
- triple:= CDR ASSQ('value,CDR Alist)
- $IOindex:= ind
- spadPrint(objValUnwrap triple,objMode triple)
-
-fetchOutput(n) ==
- -- result is the output of step n
- (n = -1) and (val := getI("%",'value)) => val
- $HiFiAccess =>
- n:=
- n < 0 => $IOindex+n
- n
- n >= $IOindex => throwKeyedMsg("S2IH0001",[n])
- n < 1 => throwKeyedMsg("S2IH0002",[n])
- vec:= UNWIND_-PROTECT(readHiFi(n),disableHist())
- Alist:= ASSQ('%,CDR vec) =>
- val:= CDR ASSQ('value,CDR Alist) => val
- throwKeyedMsg("S2IH0003",[n])
- throwKeyedMsg("S2IH0003",[n])
- throwKeyedMsg("S2IH0004",NIL)
-
-readHiFi(n) ==
- -- reads the file using index n
- if $useInternalHistoryTable
- then
- pair := assoc(n,$internalHistoryTable)
- ATOM pair => keyedSystemError("S2IH0034",NIL)
- vec := QCDR pair
- else
- HiFi:= RDEFIOSTREAM ['(MODE . INPUT),['FILE,:histFileName()]]
- vec:= SPADRREAD(object2Identifier n,HiFi)
- RSHUT HiFi
- vec
-
-writeHiFi() ==
- -- writes the information of the current step out to history file
- if $useInternalHistoryTable
- then
- $internalHistoryTable := CONS([$IOindex,$currentLine,:$HistRecord],
- $internalHistoryTable)
- else
- HiFi:= RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]]
- SPADRWRITE(object2Identifier $IOindex, CONS($currentLine,$HistRecord),HiFi)
- RSHUT HiFi
-
-disableHist() ==
- -- disables the history mechanism if an error occurred in the protected
- -- piece of code
- not $HiFiAccess => histFileErase histFileName()
- NIL
-
-writeHistModesAndValues() ==
- for [a,:.] in CAAR $InteractiveFrame repeat
- x := get(a,'value,$InteractiveFrame) =>
- putHist(a,'value,x,$InteractiveFrame)
- x := get(a,'mode,$InteractiveFrame) =>
- putHist(a,'mode,x,$InteractiveFrame)
- NIL
-
-SPADRREAD(vec, stream) ==
- dewritify rread(vec, stream, nil)
-
---% Lisplib output transformations
--- Some types of objects cannot be saved by LISP/VM in lisplibs.
--- These functions transform an object to a writable form and back.
--- SMW
-SPADRWRITE(vec, item, stream) ==
- val := SPADRWRITE0(vec, item, stream)
- val = 'writifyFailed =>
- throwKeyedMsg("S2IH0036", nil) -- cannot save value to file
- item
-
-SPADRWRITE0(vec, item, stream) ==
- val := safeWritify item
- val = 'writifyFailed => val
- rwrite(vec, val, stream)
- item
-
-safeWritify ob ==
- CATCH('writifyTag, writify ob)
-
-writify ob ==
- not ScanOrPairVec(function(unwritable?), ob) => ob
- $seen: local := MAKE_-HASHTABLE 'EQ
- $writifyComplained: local := false
-
- writifyInner ob where
- writifyInner ob ==
- null ob => nil
- (e := HGET($seen, ob)) => e
-
- PAIRP ob =>
- qcar := QCAR ob
- qcdr := QCDR ob
- (name := spadClosure? ob) =>
- d := writifyInner QCDR ob
- nob := ['WRITIFIED_!_!, 'SPADCLOSURE, d, name]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- (ob is ['LAMBDA_-CLOSURE, ., ., x, :.]) and x =>
- THROW('writifyTag, 'writifyFailed)
- nob := CONS(qcar, qcdr)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- qcar := writifyInner qcar
- qcdr := writifyInner qcdr
- QRPLACA(nob, qcar)
- QRPLACD(nob, qcdr)
- nob
- VECP ob =>
- isDomainOrPackage ob =>
- d := mkEvalable devaluate ob
- nob := ['WRITIFIED_!_!, 'DEVALUATED, writifyInner d]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- n := QVMAXINDEX ob
- nob := MAKE_-VEC(n+1)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- for i in 0..n repeat
- QSETVELT(nob, i, writifyInner QVELT(ob,i))
- nob
- ob = 'WRITIFIED_!_! =>
- ['WRITIFIED_!_!, 'SELF]
- -- In CCL constructors are also compiled functions, so we
- -- need this line:
- constructor? ob => ob
- COMPILED_-FUNCTION_-P ob =>
- THROW('writifyTag, 'writifyFailed)
- HASHTABLEP ob =>
- nob := ['WRITIFIED_!_!]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- keys := HKEYS ob
- QRPLACD(nob,
- ['HASHTABLE,
- HASHTABLE_-CLASS ob,
- writifyInner keys,
- [writifyInner HGET(ob,k) for k in keys]])
- nob
- PLACEP ob =>
- nob := ['WRITIFIED_!_!, 'PLACE]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- -- The next three types cause an error on de-writifying.
- -- Create an object of the right shape, nonetheless.
- READTABLEP ob =>
- THROW('writifyTag, 'writifyFailed)
- -- Default case: return the object itself.
- STRINGP ob =>
- EQ(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM]
- EQ(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM]
- ob
- FLOATP ob =>
- ob = READ_-FROM_-STRING STRINGIMAGE ob => ob
- ['WRITIFIED_!_!, 'FLOAT, ob,:
- MULTIPLE_-VALUE_-LIST INTEGER_-DECODE_-FLOAT ob]
- ob
-
-
-unwritable? ob ==
- PAIRP ob or VECP ob => false -- first for speed
- COMPILED_-FUNCTION_-P ob or HASHTABLEP ob => true
- PLACEP ob or READTABLEP ob => true
- FLOATP ob => true
- false
-
--- Create a full isomorphic object which can be saved in a lisplib.
--- Note that dewritify(writify(x)) preserves UEQUALity of hashtables.
--- HASHTABLEs go both ways.
--- READTABLEs cannot presently be transformed back.
-
-writifyComplain s ==
- $writifyComplained = true => nil
- $writifyComplained := true
- sayKeyedMsg("S2IH0027",[s])
-
-spadClosure? ob ==
- fun := QCAR ob
- not (name := BPINAME fun) => nil
- vec := QCDR ob
- not VECP vec => nil
- name
-
-dewritify ob ==
- (not ScanOrPairVec(function is?, ob)
- where is? a == a = 'WRITIFIED_!_!) => ob
-
- $seen: local := MAKE_-HASHTABLE 'EQ
-
- dewritifyInner ob where
- dewritifyInner ob ==
- null ob => nil
- e := HGET($seen, ob) => e
-
- PAIRP ob and CAR ob = 'WRITIFIED_!_! =>
- type := ob.1
- type = 'SELF =>
- 'WRITIFIED_!_!
- type = 'BPI =>
- oname := ob.2
- f :=
- INTP oname => EVAL GENSYMMER oname
- SYMBOL_-FUNCTION oname
- not COMPILED_-FUNCTION_-P f =>
- error '"A required BPI does not exist."
- #ob > 3 and HASHEQ f ^= ob.3 =>
- error '"A required BPI has been redefined."
- HPUT($seen, ob, f)
- f
- type = 'HASHTABLE =>
- nob := MAKE_-HASHTABLE ob.2
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- for k in ob.3 for e in ob.4 repeat
- HPUT(nob, dewritifyInner k, dewritifyInner e)
- nob
- type = 'DEVALUATED =>
- nob := EVAL dewritifyInner ob.2
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- type = 'SPADCLOSURE =>
- vec := dewritifyInner ob.2
- name := ob.3
- not FBOUNDP name =>
- error STRCONC('"undefined function: ", SYMBOL_-NAME name)
- nob := CONS(SYMBOL_-FUNCTION name, vec)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- type = 'PLACE =>
- nob := VMREAD MAKE_-INSTREAM NIL
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- type = 'READTABLE =>
- error '"Cannot de-writify a read table."
- type = 'NULLSTREAM => $NullStream
- type = 'NONNULLSTREAM => $NonNullStream
- type = 'FLOAT =>
- [fval, signif, expon, sign] := CDDR ob
- fval := SCALE_-FLOAT( FLOAT(signif, fval), expon)
- sign<0 => -fval
- fval
- error '"Unknown type to de-writify."
-
- PAIRP ob =>
- qcar := QCAR ob
- qcdr := QCDR ob
- nob := CONS(qcar, qcdr)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- QRPLACA(nob, dewritifyInner qcar)
- QRPLACD(nob, dewritifyInner qcdr)
- nob
- VECP ob =>
- n := QVMAXINDEX ob
- nob := MAKE_-VEC(n+1)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- for i in 0..n repeat
- QSETVELT(nob, i, dewritifyInner QVELT(ob,i))
- nob
- -- Default case: return the object itself.
- ob
-
-ScanOrPairVec(f, ob) ==
- $seen: local := MAKE_-HASHTABLE 'EQ
-
- CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where
- ScanOrInner(f, ob) ==
- HGET($seen, ob) => nil
- PAIRP ob =>
- HPUT($seen, ob, true)
- ScanOrInner(f, QCAR ob)
- ScanOrInner(f, QCDR ob)
- nil
- VECP ob =>
- HPUT($seen, ob, true)
- for i in 0..#ob-1 repeat ScanOrInner(f, ob.i)
- nil
- FUNCALL(f, ob) =>
- THROW('ScanOrPairVecAnswer, true)
- nil
-
-
-
-
-
---% )load
-
-load args == loadSpad2Cmd args
-
-loadSpad2Cmd args ==
- sayKeyedMsg("S2IU0003", nil)
- NIL
--- load1(args,$forceDatabaseUpdate)
-
---load1(args,$forceDatabaseUpdate) == -- $ var is now local
--- null args => helpSpad2Cmd '(load)
--- loadfun := 'loadLib
--- justWondering := nil
--- compiler := 'old
--- doExpose := true
--- $forceDatabaseUpdate := true -- BMT request, 5/14/90
--- for [opt,:.] in $options repeat
--- fullopt := selectOptionLC(opt,
--- '(cond update query new noexpose noupdate),
--- 'optionError)
--- fullopt = 'cond => loadfun := 'loadLibIfNotLoaded
--- fullopt = 'query => justWondering := true
--- fullopt = 'update => $forceDatabaseUpdate := true
--- fullopt = 'noexpose => doExpose := false
--- fullopt = 'noupdate => $forceDatabaseUpdate := false
--- if $forceDatabaseUpdate then clearClams()
--- for lib in args repeat
--- lib := object2Identifier lib
--- justWondering =>
--- GETL(lib,'LOADED) => sayKeyedMsg("S2IZ0028",[lib])
--- sayKeyedMsg("S2IZ0029",[lib])
--- null GETDATABASE(lib,'OBJECT) and
--- null (lib := GETDATABASE(lib,'CONSTRUCTOR)) =>
--- sayKeyedMsg("S2IL0020", [namestring [lib,$spadLibFT,"*"]])
--- null FUNCALL(loadfun,lib) =>
--- sayKeyedMsg("S2IZ0029",[lib])
--- sayKeyedMsg("S2IZ0028",[lib])
--- if doExpose and
--- not isExposedConstructor(lib) then
--- setExposeAddConstr([lib])
--- 'EndOfLoad
-
-reportCount () ==
- centerAndHighlight(" Current Count Settings ",$LINELENGTH,specialChar 'hbar)
- SAY " "
- sayBrightly [:bright " cache",fillerSpaces(30,'".")," ",$cacheCount]
- if $cacheAlist then
- for [a,:b] in $cacheAlist repeat
- aPart:= linearFormatName a
- n:= sayBrightlyLength aPart
- sayBrightly concat(" ",aPart," ",fillerSpaces(32-n,'".")," ",b)
- SAY " "
- sayBrightly [:bright " stream",fillerSpaces(29,'".")," ",$streamCount]
-
---% )quit
-
-pquit() == pquitSpad2Cmd()
-
-pquitSpad2Cmd() ==
- $saturn =>
- sayErrorly('"Obsolete system command", _
- ['" The )pquit system command is obsolete in this version of AXIOM.",
- '" Please select Exit from the File Menu instead."])
- $quitCommandType :local := 'protected
- quitSpad2Cmd()
-
-quit() == quitSpad2Cmd()
-
-quitSpad2Cmd() ==
- $saturn =>
- sayErrorly('"Obsolete system command", _
- ['" The )quit system command is obsolete in this version of AXIOM.",
- '" Please select Exit from the File Menu instead."])
- $quitCommandType ^= 'protected => leaveScratchpad()
- x := UPCASE queryUserKeyedMsg("S2IZ0031",NIL)
- MEMQ(STRING2ID_-N(x,1),'(Y YES)) => leaveScratchpad()
- sayKeyedMsg("S2IZ0032",NIL)
- TERSYSCOMMAND ()
-
-leaveScratchpad () == BYE()
-
---% )read
-
-read l == readSpad2Cmd l
-
-readSpad2Cmd l ==
- ---$saturn =>
- --- sayErrorly('"Obsolete system command", _
- --- ['" The )read system command is obsolete in this version of AXIOM.",
- --- '" Please use Open from the File menu instead."])
- $InteractiveMode : local := true
- quiet := nil
- ifthere := nil
- for [opt,:.] in $options repeat
- fullopt := selectOptionLC(opt,'(quiet test ifthere),'optionError)
- fullopt = 'ifthere => ifthere := true
- fullopt = 'quiet => quiet := true
-
- ef := pathname _/EDITFILE
- if pathnameTypeId(ef) = 'SPAD then
- ef := makePathname(pathnameName ef,'"*",'"*")
- if l then
- l := mergePathnames(pathname l,ef)
- else
- l := ef
- devFTs := '("input" "INPUT" "boot" "BOOT" "lisp" "LISP")
- fileTypes :=
- $UserLevel = 'interpreter => '("input" "INPUT")
- $UserLevel = 'compiler => '("input" "INPUT")
- devFTs
- ll := $FINDFILE (l, fileTypes)
- if null ll then
- ifthere => return nil -- be quiet about it
- throwKeyedMsg("S2IL0003",[namestring l])
- ll := pathname ll
- ft := pathnameType ll
- upft := UPCASE ft
- null member(upft,fileTypes) =>
- fs := namestring l
- member(upft,devFTs) => throwKeyedMsg("S2IZ0033",[fs])
- throwKeyedMsg("S2IZ0034",[fs])
- SETQ(_/EDITFILE,ll)
- if upft = '"BOOT" then $InteractiveMode := nil
- _/READ(ll,quiet)
-
---% )savesystem
-savesystem l ==
- #l ^= 1 or not(SYMBOLP CAR l) => helpSpad2Cmd '(savesystem)
- SPAD_-SAVE SYMBOL_-NAME CAR l
-
---% )show
-
-show l == showSpad2Cmd l
-
-showSpad2Cmd l ==
- l = [NIL] => helpSpad2Cmd '(show)
- $showOptions : local := '(attributes operations)
- if null $options then $options := '((operations))
- $e : local := $InteractiveFrame
- $env : local := $InteractiveFrame
- l is [constr] =>
- constr in '(Union Record Mapping) =>
- constr = 'Record =>
- sayKeyedMsg("S2IZ0044R",[constr, '")show Record(a: Integer, b: String)"])
- constr = 'Mapping =>
- sayKeyedMsg("S2IZ0044M",NIL)
- sayKeyedMsg("S2IZ0045T",[constr, '")show Union(a: Integer, b: String)"])
- sayKeyedMsg("S2IZ0045U",[constr, '")show Union(Integer, String)"])
- constr is ['Mapping, :.] =>
- sayKeyedMsg("S2IZ0044M",NIL)
- reportOperations(constr,constr)
- reportOperations(l,l)
-
-reportOperations(oldArg,u) ==
- -- u might be an uppercased version of oldArg
- $env:local := [[NIL]]
- $eval:local := true --generate code-- don't just type analyze
- $genValue:local := true --evaluate all generated code
- null u => nil
- $doNotAddEmptyModeIfTrue: local:= true
- u = $quadSymbol =>
- sayBrightly ['" mode denotes", :bright '"any", "type"]
- u = "%" =>
- sayKeyedMsg("S2IZ0063",NIL)
- sayKeyedMsg("S2IZ0064",NIL)
- u isnt ['Record,:.] and u isnt ['Union,:.] and
- null(isNameOfType u) and u isnt ['typeOf,.] =>
- if ATOM oldArg then oldArg := [oldArg]
- sayKeyedMsg("S2IZ0063",NIL)
- for op in oldArg repeat
- sayKeyedMsg("S2IZ0062",[opOf op])
- (v := isDomainValuedVariable u) => reportOpsFromUnitDirectly0 v
- unitForm:=
- atom u => opOf unabbrev u
- unabbrev u
- atom unitForm => reportOpsFromLisplib0(unitForm,u)
- unitForm' := evaluateType unitForm
- tree := mkAtree removeZeroOneDestructively unitForm
- (unitForm' := isType tree) => reportOpsFromUnitDirectly0 unitForm'
- sayKeyedMsg("S2IZ0041",[unitForm])
-
-reportOpsFromUnitDirectly0 D ==
- $useEditorForShowOutput =>
- reportOpsFromUnitDirectly1 D
- reportOpsFromUnitDirectly D
-
-reportOpsFromUnitDirectly1 D ==
- showFile := pathname ['SHOW,'LISTING,$listingDirectory]
- _$ERASE showFile
- $sayBrightlyStream : fluid :=
- DEFIOSTREAM([['FILE,:showFile], '(MODE . OUTPUT)],255,0)
- sayShowWarning()
- reportOpsFromUnitDirectly D
- SHUT $sayBrightlyStream
- editFile showFile
-
-sayShowWarning() ==
- sayBrightly
- '"Warning: this is a temporary file and will be deleted the next"
- sayBrightly
- '" time you use )show. Rename it and FILE if you wish to"
- sayBrightly
- '" save the contents."
- sayBrightly '""
-
-reportOpsFromLisplib0(unitForm,u) ==
- $useEditorForShowOutput => reportOpsFromLisplib1(unitForm,u)
- reportOpsFromLisplib(unitForm,u)
-
-reportOpsFromLisplib1(unitForm,u) ==
- showFile := pathname ['SHOW,'LISTING,$listingDirectory]
- _$ERASE showFile
- $sayBrightlyStream : fluid :=
- DEFIOSTREAM([['FILE,:showFile], '(MODE . OUTPUT)],255,0)
- sayShowWarning()
- reportOpsFromLisplib(unitForm,u)
- SHUT $sayBrightlyStream
- editFile showFile
-
-reportOpsFromUnitDirectly unitForm ==
- isRecordOrUnion := unitForm is [a,:.] and a in '(Record Union)
- unit:= evalDomain unitForm
- top:= CAR unitForm
- kind:= GETDATABASE(top,'CONSTRUCTORKIND)
-
- sayBrightly concat('%b,formatOpType unitForm,
- '%d,'"is a",'%b,kind,'%d, '"constructor.")
- if not isRecordOrUnion then
- abb := GETDATABASE(top,'ABBREVIATION)
- sourceFile := GETDATABASE(top,'SOURCEFILE)
- sayBrightly ['" Abbreviation for",:bright top,'"is",:bright abb]
- verb :=
- isExposedConstructor top => '"is"
- '"is not"
- sayBrightly ['" This constructor",:bright verb,
- '"exposed in this frame."]
- sayBrightly ['" Issue",:bright STRCONC('")edit ",
- namestring sourceFile),'"to see algebra source code for",
- :bright abb,'%l]
-
- for [opt] in $options repeat
- opt := selectOptionLC(opt,$showOptions,'optionError)
- opt = 'attributes =>
- centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar)
- isRecordOrUnion =>
- sayBrightly '" Records and Unions have no attributes."
- sayBrightly '""
- attList:= REMDUP MSORT [x for [x,:.] in unit.2]
- say2PerLine [formatAttribute x for x in attList]
- NIL
- opt = 'operations =>
- $commentedOps: local := 0
- --new form is (<op> <signature> <slotNumber> <condition> <kind>)
- centerAndHighlight('"Operations",$LINELENGTH,specialChar 'hbar)
- sayBrightly '""
- if isRecordOrUnion
- then
- constructorFunction:= GETL(top,"makeFunctionList") or
- systemErrorHere '"reportOpsFromUnitDirectly"
- [funlist,.]:= FUNCALL(constructorFunction,"$",unitForm,
- $CategoryFrame)
- sigList := REMDUP MSORT [[[a,b],true,[c,0,1]] for
- [a,b,c] in funlist]
- else
- sigList:= REMDUP MSORT getOplistForConstructorForm unitForm
- say2PerLine [formatOperation(x,unit) for x in sigList]
- if $commentedOps ^= 0 then
- sayBrightly
- ['"Functions that are not yet implemented are preceded by",
- :bright '"--"]
- sayBrightly '""
- NIL
-
-reportOpsFromLisplib(op,u) ==
- null(fn:= constructor? op) => sayKeyedMsg("S2IZ0054",[u])
- argml :=
- (s := getConstructorSignature op) => KDR s
- NIL
- typ:= GETDATABASE(op,'CONSTRUCTORKIND)
- nArgs:= #argml
- argList:= KDR GETDATABASE(op,'CONSTRUCTORFORM)
- functorForm:= [op,:argList]
- argml:= EQSUBSTLIST(argList,$FormalMapVariableList,argml)
- functorFormWithDecl:= [op,:[[":",a,m] for a in argList for m in argml]]
- sayBrightly concat(bright form2StringWithWhere functorFormWithDecl,
- '" is a",bright typ,'"constructor")
- sayBrightly ['" Abbreviation for",:bright op,'"is",:bright fn]
- verb :=
- isExposedConstructor op => '"is"
- '"is not"
- sayBrightly ['" This constructor",:bright verb,
- '"exposed in this frame."]
- sourceFile := GETDATABASE(op,'SOURCEFILE)
- sayBrightly ['" Issue",:bright STRCONC('")edit ",
- namestring sourceFile),
- '"to see algebra source code for",:bright fn,'%l]
-
- for [opt] in $options repeat
- opt := selectOptionLC(opt,$showOptions,'optionError)
- opt = 'layout =>
- dc1 fn
- opt = 'views => sayBrightly ['"To get",:bright '"views",
- '"you must give parameters of constructor"]
- opt = 'attributes =>
- centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar)
- sayBrightly '""
- attList:= REMDUP MSORT [x for [x,:.] in
- GETDATABASE(op,'ATTRIBUTES)]
- null attList => sayBrightly
- concat('%b,form2String functorForm,'%d,"has no attributes.",'%l)
- say2PerLine [formatAttribute x for x in attList]
- NIL
- opt = 'operations => displayOperationsFromLisplib functorForm
- nil
-
-displayOperationsFromLisplib form ==
- [name,:argl] := form
- kind := GETDATABASE(name,'CONSTRUCTORKIND)
- centerAndHighlight('"Operations",$LINELENGTH,specialChar 'hbar)
- opList:= GETDATABASE(name,'OPERATIONALIST)
- null opList => reportOpsFromUnitDirectly form
- opl:=REMDUP MSORT EQSUBSTLIST(argl,$FormalMapVariableList,opList)
- ops:= nil
- for x in opl repeat
- ops := [:ops,:formatOperationAlistEntry(x)]
- say2PerLine ops
- nil
-
---% )spool
-
-clearHighlight() ==
- $saveHighlight := $highlightAllowed
- $highlightAllowed := false
- $saveSpecialchars := $specialCharacters
- setOutputCharacters ["plain"]
-
-resetHighlight() ==
- $highlightAllowed := $saveHighlight
- $specialCharacters := $saveSpecialchars
-
-spool filename ==
- null filename =>
- DRIBBLE()
- TERPRI()
- resetHighlight()
- PROBE_-FILE car filename =>
- systemError CONCAT('"file ", STRING car filename, '" already exists")
- DRIBBLE car filename
- TERPRI()
- clearHighlight()
-
---% )synonym
-
-synonym(:l) == synonymSpad2Cmd() -- always passed a null list
-
-synonymSpad2Cmd() ==
- line := getSystemCommandLine()
- if line = '"" then printSynonyms(NIL)
- else
- pair := processSynonymLine line
- if $CommandSynonymAlist then
- PUTALIST($CommandSynonymAlist,CAR pair, CDR pair)
- else $CommandSynonymAlist := [pair]
- terminateSystemCommand()
-
-processSynonymLine line ==
- key := STRING2ID_-N (line, 1)
- value := removeKeyFromLine line where
- removeKeyFromLine line ==
- line := dropLeadingBlanks line
- mx := MAXINDEX line
- for i in 0..mx repeat
- line.i = " " =>
- return (for j in (i+1)..mx repeat
- line.j ^= " " => return (SUBSTRING (line, j, nil)))
- [key, :value]
-
-
---%
---% )undo
---%
-
-$undoFlag := true --Default setting for undo is "on"
-
-
-undo(l) ==
---undo takes one option ")redo" which simply reads "redo.input",
--- a file created by every normal )undo command (see below)
- undoWhen := 'after
- if $options is [[key]] then
- stringPrefix?(s := PNAME key,'"redo") =>
- $options := nil --clear $options so that "read" won't see them
- read '(redo_.input)
- not stringPrefix?(s,'"before") =>
- userError '"only option to undo is _")redo_""
- undoWhen := 'before
- n :=
- null l => -1
- first l
- if IDENTP n then
- n := PARSE_-INTEGER PNAME n
- if not FIXP n then userError '"undo argument must be an integer"
- $InteractiveFrame := undoSteps(undoCount n,undoWhen)
- nil
-
-recordFrame(systemNormal) ==
- null $undoFlag => nil --do nothing if facility is turned off
- currentAlist := KAR $frameRecord
- delta := diffAlist(CAAR $InteractiveFrame,$previousBindings)
- if systemNormal = 'system then
- null delta => return nil --do not record
- delta := ['systemCommand,:delta]
- $frameRecord := [delta,:$frameRecord]
- $previousBindings := --copy all but the individual properties
- [CONS(CAR x,[CONS(CAR y,CDR y) for y in CDR x]) for x in CAAR $InteractiveFrame]
- first $frameRecord
-
-diffAlist(new,old) ==
---record only those properties which are different
- for (pair := [name,:proplist]) in new repeat
- -- name has an entry both in new and old world
- -- (1) if the old world had no proplist for that variable, then
- -- record NIL as the value of each new property
- -- (2) if the old world does have a proplist for that variable, then
- -- a) for each property with a value: give the old value
- -- b) for each property missing: give NIL as the old value
- oldPair := ASSQ(name,old) =>
- null (oldProplist := CDR oldPair) =>
- --record old values of new properties as NIL
- acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
- deltas := nil
- for (propval := [prop,:val]) in proplist repeat
- null (oldPropval := assoc(prop,oldProplist)) => --missing property
- deltas := [[prop],:deltas]
- EQ(CDR oldPropval,val) => 'skip
- deltas := [oldPropval,:deltas]
- deltas => acc := [[name,:NREVERSE deltas],:acc]
- acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
---record properties absent on new list (say, from a )cl all)
- for (oldPair := [name,:r]) in old repeat
- r and null LASSQ(name,new) =>
- acc := [oldPair,:acc]
- -- name has an entry both in new and old world
- -- (1) if the new world has no proplist for that variable
- -- (a) if the old world does, record the old proplist
- -- (b) if the old world does not, record nothing
- -- (2) if the new world has a proplist for that variable, it has
- -- been handled by the first loop.
- res := NREVERSE acc
- if BOUNDP '$reportUndo and $reportUndo then reportUndo res
- res
-
-reportUndo acc ==
- for [name,:proplist] in acc repeat
- sayBrightly STRCONC("Properties of ",PNAME name,'" ::")
- curproplist := LASSOC(name,CAAR $InteractiveFrame)
- for [prop,:value] in proplist repeat
- sayBrightlyNT ['" ",prop,'" was: "]
- pp value
- sayBrightlyNT ['" ",prop,'" is: "]
- pp LASSOC(prop,curproplist)
-
-clearFrame() ==
- clearCmdAll()
- $frameRecord := nil
- $previousBindings := nil
-
-
---=======================================================================
--- Undoing previous m commands
---=======================================================================
-undoCount(n) == --computes the number of undo's, given $IOindex
---pp ["IOindex = ",$IOindex]
- m :=
- n >= 0 => $IOindex - n - 1
- -n
- m >= $IOindex => userError STRCONC('"Magnitude of undo argument must be less than step number (",STRINGIMAGE $IOindex,'").")
- m
-
-
-undoSteps(m,beforeOrAfter) ==
--- undoes m previous commands; if )before option, then undo one extra at end
---Example: if $IOindex now is 6 and m = 2 then general layout of $frameRecord,
--- after the call to recordFrame below will be:
--- (<change for systemcommands>
--- (<change for #5> <change for system commands>
--- (<change for #4> <change for system commands>
--- (<change for #3> <change for system commands>
--- <change for #2> <change for system commands>
--- <change for #1> <change for system commands>) where system
--- command entries are optional and identified by (systemCommand . change).
--- For a ")undo 3 )after", m = 2 and undoStep swill restore the environment
--- up to, but not including <change for #3>.
--- An "undo 3 )before" will additionally restore <change for #3>.
--- Thus, the later requires one extra undo at the end.
- writeInputLines('redo,$IOindex - m)
- recordFrame('normal) --do NOT mark this as a system command change
- --do this undo FIRST (i=0 case)
- env := COPY CAAR $InteractiveFrame
- for i in 0..m for framelist in tails $frameRecord repeat
- env := undoSingleStep(first framelist,env)
- framelist is [.,['systemCommand,:systemDelta],:.] =>
--- pp '"===============> AHA <============="
- framelist := rest framelist --undoing system commands given
- env := undoSingleStep(systemDelta,env) -- before command line
- lastTailSeen := framelist
- if beforeOrAfter = 'before then --do one additional undo for )before
- env := undoSingleStep(first rest lastTailSeen,env)
- $frameRecord := rest $frameRecord --flush the effect of extra recordFrame
- $InteractiveFrame := LIST LIST env
-
-
-undoSingleStep(changes,env) ==
---Each change is a name-proplist pair. For each change:
--- (1) if there exists a proplist in env, then for each prop-value change:
--- (a) if the prop exists in env, RPLAC in the change value
--- (b) otherwise, CONS it onto the front of prop-values for that name
--- (2) add change to the front of env
--- pp '"----Undoing 1 step--------"
--- pp changes
- for (change := [name,:changeList]) in changes repeat
- if LASSOC('localModemap,changeList) then
- changeList := undoLocalModemapHack changeList
- pairlist := ASSQ(name,env) =>
- proplist := CDR pairlist =>
- for (pair := [prop,:value]) in changeList repeat
- node := ASSQ(prop,proplist) => RPLACD(node,value)
- RPLACD(proplist,[CAR proplist,:CDR proplist])
- RPLACA(proplist,pair)
- RPLACD(pairlist,changeList)
- env := [change,:env]
- env
-
-undoLocalModemapHack changeList ==
- [newPair for (pair := [name,:value]) in changeList | newPair] where newPair() ==
- name = 'localModemap => [name]
- pair
-
-removeUndoLines u == --called by writeInputLines
- xtra :=
- STRINGP $currentLine => [$currentLine]
- REVERSE $currentLine
- xtra := [x for x in xtra | not stringPrefix?('")history",x)]
- u := [:u, :xtra]
- not (or/[stringPrefix?('")undo",x) for x in u]) => u
- --(1) reverse the list
- --(2) walk down the (reversed) list: when >n appears remove:
- -- (a) system commands
- -- (b) if n > 0: (replace n by n-1; remove a command; repeat (a-b))
- savedIOindex := $IOindex --save value
- $IOindex := 1
- for y in tails u repeat
- (x := first y).0 = char '_) =>
- stringPrefix?('")undo",s := trimString x) => --parse "undo )option"
- s1 := trimString SUBSTRING(s,5,nil)
- if s1 ^= '")redo" then
- m := charPosition(char '_),s1,0)
- code :=
- m < MAXINDEX s1 => s1.(m + 1)
- char 'a
- s2 := trimString SUBSTRING(s1,0,m)
- n :=
- s1 = '")redo" => 0
- s2 ^= '"" => undoCount PARSE_-INTEGER s2
- -1
- RPLACA(y,CONCAT('">",code,STRINGIMAGE n))
- nil
- $IOindex := $IOindex + 1 --referenced by undoCount
- acc := nil
- for y in tails NREVERSE u repeat
- (x := first y).0 = char '_> =>
- code := x . 1 --code = a,b, or r
- n := PARSE_-INTEGER SUBSTRING(x,2,nil) --n = number of undo steps
- y := rest y --kill >n line
- while y repeat
- c := first y
- c.0 = char '_) or c.0 = char '_> => y := rest y --kill system commands
- n = 0 => return nil --including undos
- n := n - 1
- y := rest y --kill command
- y and code^= char 'b => acc := [c,:acc] --add last unless )before
- acc := [x,:acc]
- $IOindex := savedIOindex
- acc
-
-
-
-
---% )what
-
-
-what l == whatSpad2Cmd l
-
-whatSpad2Cmd l ==
- $e:local := $EmptyEnvironment
- null l => reportWhatOptions()
- [key0,:args] := l
- key := selectOptionLC(key0,$whatOptions,nil)
- null key => sayKeyedMsg("S2IZ0043",NIL)
- args := [fixpat p for p in args] where
- fixpat x ==
- x is [x',:.] => DOWNCASE x'
- DOWNCASE x
- key = 'things =>
- for opt in $whatOptions repeat
- not MEMQ(opt,'(things)) => whatSpad2Cmd [opt,:args]
- key = 'categories =>
- filterAndFormatConstructors('category,'"Categories",args)
- key = 'commands =>
- whatCommands(args)
- key = 'domains =>
- filterAndFormatConstructors('domain,'"Domains",args)
- key = 'operations =>
- apropos args
- key = 'packages =>
- filterAndFormatConstructors('package,'"Packages",args)
- key = 'synonyms =>
- printSynonyms(args)
-
-filterAndFormatConstructors(constrType,label,patterns) ==
- centerAndHighlight(label,$LINELENGTH,specialChar 'hbar)
- l := filterListOfStringsWithFn(patterns,whatConstructors constrType,
- function CDR)
- if patterns then
- null l =>
- sayMessage ['" No ",label,'" with names matching patterns:",
- '%l,'" ",'%b,:blankList patterns,'%d]
- sayMessage [label,'" with names matching patterns:",
- '%l,'" ",'%b,:blankList patterns,'%d]
- l => pp2Cols l
-
-whatConstructors constrType ==
- -- here constrType should be one of 'category, 'domain, 'package
- MSORT [CONS(GETDATABASE(con,'ABBREVIATION), STRING(con))
- for con in allConstructors()
- | GETDATABASE(con,'CONSTRUCTORKIND) = constrType]
-
-apropos l ==
- -- l is a list of operation name fragments
- -- this displays all operation names containing these fragments
- ops :=
- null l => allOperations()
- filterListOfStrings([(DOWNCASE STRINGIMAGE p) for p in l],allOperations())
- ops =>
- sayMessage '"Operations whose names satisfy the above pattern(s):"
- sayAsManyPerLineAsPossible MSORT ops
- sayKeyedMsg("S2IF0011",[first ops])
- sayMessage '" There are no operations containing those patterns"
- NIL
-
-
-printSynonyms(patterns) ==
- centerAndHighlight("System Command Synonyms",$LINELENGTH,specialChar 'hbar)
- ls := filterListOfStringsWithFn(patterns, [[STRINGIMAGE a,:b]
- for [a,:b] in synonymsForUserLevel $CommandSynonymAlist],
- function CAR)
- printLabelledList(ls,'"user",'"synonyms",'")",patterns)
- nil
-
-printLabelledList(ls,label1,label2,prefix,patterns) ==
- -- prefix goes before each element on each side of the list, eg,
- -- ")"
- null ls =>
- null patterns =>
- sayMessage ['" No ",label1,'"-defined ",label2,'" in effect."]
- sayMessage ['" No ",label1,'"-defined ",label2,'" satisfying patterns:",
- '%l,'" ",'%b,:blankList patterns,'%d]
- if patterns then
- sayMessage [label1,'"-defined ",label2,'" satisfying patterns:",
- '%l,'" ",'%b,:blankList patterns,'%d]
- for [syn,:comm] in ls repeat
- if SUBSTRING(syn,0,1) = '"|" then syn := SUBSTRING(syn,1,NIL)
- if syn = '"%i" then syn := '"%i "
- wid := MAX(30 - (entryWidth syn),1)
- sayBrightly concat('%b,prefix,syn,'%d,
- fillerSpaces(wid,'"."),'" ",prefix,comm)
- sayBrightly '""
-
-whatCommands(patterns) ==
- label := STRCONC("System Commands for User Level: ",
- STRINGIMAGE $UserLevel)
- centerAndHighlight(label,$LINELENGTH,specialChar 'hbar)
- l := filterListOfStrings(patterns,
- [(STRINGIMAGE a) for a in commandsForUserLevel $systemCommands])
- if patterns then
- null l =>
- sayMessage ['"No system commands at this level matching patterns:",
- '%l,'" ",'%b,:blankList patterns,'%d]
- sayMessage ['"System commands at this level matching patterns:",
- '%l,'" ",'%b,:blankList patterns,'%d]
- if l then
- sayAsManyPerLineAsPossible l
- SAY " "
- patterns => nil -- don't be so verbose
- sayKeyedMsg("S2IZ0046",NIL)
- nil
-
-reportWhatOptions() ==
- optList1:= "append"/[['%l,'" ",x] for x in $whatOptions]
- sayBrightly
- ['%b,'" )what",'%d,'"argument keywords are",'%b,:optList1,'%d,'%l,
- '" or abbreviations thereof.",'%l,
- '%l,'" Issue",'%b,'")what ?",'%d,'"for more information."]
-
-filterListOfStrings(patterns,names) ==
- -- names and patterns are lists of strings
- -- returns: list of strings in names that contains any of the strings
- -- in patterns
- (null patterns) or (null names) => names
- names' := NIL
- for name in reverse names repeat
- satisfiesRegularExpressions(name,patterns) =>
- names' := [name,:names']
- names'
-
-filterListOfStringsWithFn(patterns,names,fn) ==
- -- names and patterns are lists of strings
- -- fn is something like CAR or CADR
- -- returns: list of strings in names that contains any of the strings
- -- in patterns
- (null patterns) or (null names) => names
- names' := NIL
- for name in reverse names repeat
- satisfiesRegularExpressions(FUNCALL(fn,name),patterns) =>
- names' := [name,:names']
- names'
-
-satisfiesRegularExpressions(name,patterns) ==
- -- this is a first cut
- nf := true
- dname := DOWNCASE COPY name
- for pattern in patterns while nf repeat
- -- use @ as a wildcard
- STRPOS(pattern,dname,0,'"@") => nf := nil
- null nf
-
---% )with ... defined in daase.lisp (boot won't parse it)
-
---% )workfiles
-
-workfiles l == workfilesSpad2Cmd l
-
-workfilesSpad2Cmd args ==
- args => throwKeyedMsg("S2IZ0047",NIL)
- deleteFlag := nil
- for [type,:.] in $options repeat
- type1 := selectOptionLC(type,'(boot lisp meta delete),nil)
- null type1 => throwKeyedMsg("S2IZ0048",[type])
- type1 = 'delete => deleteFlag := true
- for [type,:flist] in $options repeat
- type1 := selectOptionLC(type,'(boot lisp meta delete),nil)
- type1 = 'delete => nil
- for file in flist repeat
- fl := pathname [file,type1,'"*"]
- deleteFlag => SETQ($sourceFiles,delete(fl,$sourceFiles))
- null (MAKE_-INPUT_-FILENAME fl) => sayKeyedMsg("S2IZ0035",[namestring fl])
- updateSourceFiles fl
- SAY " "
- centerAndHighlight(" User-specified work files ",$LINELENGTH,specialChar 'hbar)
- SAY " "
- null $sourceFiles => SAY '" no files specified"
- SETQ($sourceFiles,SORTBY('pathnameType,$sourceFiles))
- for fl in $sourceFiles repeat sayBrightly [" " ,namestring fl]
-
---% )zsystemdevelopment
-
-zsystemdevelopment l == zsystemDevelopmentSpad2Cmd l
-
-zsystemDevelopmentSpad2Cmd l == zsystemdevelopment1 (l,$InteractiveMode)
-
-zsystemdevelopment1(l,im) ==
- $InteractiveMode : local := im
- fromopt := nil
- -- cycle through once to see if )from is mentioned
- for [opt,:optargs] in $options repeat
- opt1 := selectOptionLC(opt,'(from),nil)
- opt1 = 'from => fromopt := [['FROM,:optargs]]
- for [opt,:optargs] in $options repeat
- if null optargs then optargs := l
- newopt := APPEND(optargs,fromopt)
- opt1 := selectOptionLC(opt,'(from),nil)
- opt1 = 'from => nil
- opt = "c" => _/D_,1 (newopt ,_/COMP(),NIL,NIL)
- opt = "d" => _/D_,1 (newopt ,'DEFINE,NIL,NIL)
- opt = "dt" => _/D_,1 (newopt ,'DEFINE,NIL,true)
- opt = "ct" => _/D_,1 (newopt ,_/COMP(),NIL,true)
- opt = "ctl" => _/D_,1 (newopt ,_/COMP(),NIL,'TRACELET)
- opt = "ec" => _/D_,1 (newopt ,_/COMP(),true,NIL)
- opt = "ect" => _/D_,1 (newopt ,_/COMP(),true,true)
- opt = "e" => _/D_,1 (newopt ,NIL,true,NIL)
- opt = "version" => version()
- opt = "pause" =>
- conStream := DEFIOSTREAM ('((DEVICE . CONSOLE) (QUAL . V)),120,0)
- NEXT conStream
- SHUT conStream
- opt = "update" or opt = "patch" =>
- $InteractiveMode := nil
- upf := [KAR optargs or _/VERSION, KADR optargs or _/WSNAME,
- KADDR optargs or '_*]
- fun := (opt = "patch" => '_/UPDATE_-LIB_-1; '_/UPDATE_-1)
- CATCH('FILENAM, FUNCALL(fun, upf))
- sayMessage '" Update/patch is completed."
- null optargs =>
- sayBrightly ['" An argument is required for",:bright opt]
- sayMessage ['" Unknown option:",:bright opt," ",'%l,
- '" Available options are", _
- :bright '"c ct e ec ect cls pause update patch compare record"]
-
---% Synonym File Reader
-
---------------------> NEW DEFINITION (override in util.lisp.pamphlet)
-processSynonyms() ==
- p := STRPOS('")",LINE,0,NIL)
- fill := '""
- if p
- then
- line := SUBSTRING(LINE,p,NIL)
- if p > 0 then fill := SUBSTRING(LINE,0,p)
- else
- p := 0
- line := LINE
- to := STRPOS ('" ", line, 1, nil)
- if to then to := to - 1
- synstr := SUBSTRING (line, 1, to)
- syn := STRING2ID_-N (synstr, 1)
- null (fun := LASSOC (syn, $CommandSynonymAlist)) => NIL
- to := STRPOS('")",fun,1,NIL)
- if to and to ^= SIZE(fun)-1 then
- opt := STRCONC('" ",SUBSTRING(fun,to,NIL))
- fun := SUBSTRING(fun,0,to-1)
- else opt := '" "
- if (SIZE synstr) > (SIZE fun) then
- for i in (SIZE fun)..(SIZE synstr) repeat
- fun := CONCAT (fun, '" ")
--- $currentLine := STRCONC(fill,RPLACSTR(line, 1, SIZE synstr, fun),opt)
- cl := STRCONC(fill,RPLACSTR(line, 1, SIZE synstr, fun),opt)
- SETQ(LINE,cl)
- SETQ(CHR,LINE.(p+1))
- processSynonyms ()
-
--- functions for interfacing to system commands from algebra code
--- common lisp dependent
-
-tabsToBlanks s ==
- k := charPosition($charTab,s,0)
- n := #s
- k < n =>
- k = 0 => tabsToBlanks SUBSTRING(s,1,nil)
- STRCONC(SUBSTRING(s,0,k),$charBlank, tabsToBlanks SUBSTRING(s,k + 1,nil))
- s
-
-doSystemCommand string ==
- string := CONCAT('")", EXPAND_-TABS string)
- LINE: fluid := string
- processSynonyms()
- string := LINE
- string:=SUBSTRING(string,1,nil)
- string = '"" => nil
- tok:=getFirstWord(string)
- tok =>
- unab := unAbbreviateKeyword tok
- member(unab, $noParseCommands) =>
- handleNoParseCommands(unab, string)
- optionList := splitIntoOptionBlocks string
- member(unab, $tokenCommands) =>
- handleTokensizeSystemCommands(unab, optionList)
- handleParsedSystemCommands(unab, optionList)
- nil
- nil
-
-<<handleNoParseCommands>>
-
-npboot str ==
- sex := string2BootTree str
- FORMAT(true, '"~&~S~%", sex)
- $ans := EVAL sex
- FORMAT(true, '"~&Value = ~S~%", $ans)
-
-stripLisp str ==
- found := false
- strIndex := 0
- lispStr := '"lisp"
- for c0 in 0..#str-1 for c1 in 0..#lispStr-1 repeat
- (char str.c0) ^= (char lispStr.c1) =>
- return nil
- strIndex := c0+1
- SUBSEQ(str, strIndex)
-
-
-nplisp str ==
- $ans := EVAL READ_-FROM_-STRING str
- FORMAT(true, '"~&Value = ~S~%", $ans)
-
-npsystem(unab, str) ==
- spaceIndex := SEARCH('" ", str)
- null spaceIndex =>
- sayKeyedMsg('"S2IZ0080", [str])
- sysPart := SUBSEQ(str, 0, spaceIndex)
- -- The following is a hack required by the fact that unAbbreviateKeyword
- -- returns the word "system" for unknown words
- null SEARCH(sysPart, STRING unab) =>
- sayKeyedMsg('"S2IZ0080", [sysPart])
- command := SUBSEQ(str, spaceIndex+1)
- OBEY command
-
-npsynonym(unab, str) ==
- npProcessSynonym(str)
-
-tokenSystemCommand(unabr, tokList) ==
- systemCommand tokList
-
-tokTran tok ==
- STRINGP tok =>
- #tok = 0 => nil
- isIntegerString tok => READ_-FROM_-STRING tok
- STRING tok.0 = '"_"" =>
- SUBSEQ(tok, 1, #tok-1)
- INTERN tok
- tok
-
-isIntegerString tok ==
- for i in 0..#tok-1 repeat
- val := DIGIT_-CHAR_-P tok.i
- not val => return nil
- val
-
-splitIntoOptionBlocks str ==
- inString := false
- optionBlocks := nil
- blockStart := 0
- parenCount := 0
- for i in 0..#str-1 repeat
- STRING str.i = '"_"" =>
- inString := not inString
- if STRING str.i = '"(" and not inString
- then parenCount := parenCount + 1
- if STRING str.i = '")" and not inString
- then parenCount := parenCount - 1
- STRING str.i = '")" and not inString and parenCount = -1 =>
- block := stripSpaces SUBSEQ(str, blockStart, i)
- blockList := [block, :blockList]
- blockStart := i+1
- parenCount := 0
- blockList := [stripSpaces SUBSEQ(str, blockStart), :blockList]
- nreverse blockList
-
-dumbTokenize str ==
- -- split into tokens delimted by spaces, taking quoted strings into account
- inString := false
- tokenList := nil
- tokenStart := 0
- previousSpace := false
- for i in 0..#str-1 repeat
- STRING str.i = '"_"" =>
- inString := not inString
- previousSpace := false
- STRING str.i = '" " and not inString =>
- previousSpace => nil
- token := stripSpaces SUBSEQ(str, tokenStart, i)
- tokenList := [token, :tokenList]
- tokenStart := i+1
- previousSpace := true
- previousSpace := false
- tokenList := [stripSpaces SUBSEQ(str, tokenStart), :tokenList]
- nreverse tokenList
-
-handleParsedSystemCommands(unabr, optionList) ==
- restOptionList := [dumbTokenize opt for opt in CDR optionList]
- parcmd := [parseSystemCmd CAR optionList,
- :[[tokTran tok for tok in opt] for opt in restOptionList]]
- systemCommand parcmd
-
-parseSystemCmd opt ==
- spaceIndex := SEARCH('" ", opt)
- spaceIndex =>
- commandString := stripSpaces SUBSEQ(opt, 0, spaceIndex)
- argString := stripSpaces SUBSEQ(opt, spaceIndex)
- command := tokTran commandString
- pform := parseFromString argString
- [command, pform]
- [tokTran tok for tok in dumbTokenize opt]
-
---------------------> NEW DEFINITION (override in osyscmd.boot.pamphlet)
-parseFromString(s) ==
- $useNewParser =>
- ncParseFromString s
- $InteractiveMode :local := true
- $BOOT: local := NIL
- $SPAD: local := true
- $e:local := $InteractiveFrame
- string2SpadTree s
-
-handleTokensizeSystemCommands(unabr, optionList) ==
- optionList := [dumbTokenize opt for opt in optionList]
- parcmd := [[tokTran tok for tok in opt] for opt in optionList]
- parcmd => tokenSystemCommand(unabr, parcmd)
-
-getFirstWord string ==
- spaceIndex := SEARCH('" ", string)
- null spaceIndex => string
- stripSpaces SUBSEQ(string, 0, spaceIndex)
-
-ltrace l == trace l
-
---------------------> NEW DEFINITION (see intint.lisp.pamphlet)
-stripSpaces str ==
- STRING_-TRIM([char '" "], str)
-
-npProcessSynonym(str) ==
- if str = '"" then printSynonyms(NIL)
- else
- pair := processSynonymLine str
- if $CommandSynonymAlist then
- PUTALIST($CommandSynonymAlist,CAR pair, CDR pair)
- else $CommandSynonymAlist := [pair]
- terminateSystemCommand()
-
-
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} [[src/interp/setq.lisp.pamphlet]]
-\end{thebibliography}
-\end{document}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 06:27:00 +0000