"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
Object subclass:#ReadEvalPrintLoop
instanceVariableNames:'inputStream outputStream errorStream compiler prompt
doChunkFormat traceFlag timingFlag profilingFlag printFlag
exitAction currentDirectory lastEditedClass lastEditedSelector
editorCommand'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
!
!ReadEvalPrintLoop class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
A simple read-eval-print loop for non-GUI or stscript operation.
Invoked, for example if stx is started with a --repl argument.
A line starting with '?' shows the usage message.
Lines starting with '#' are directives:
#exit - exit the rep-loop
type '?' to see more.
The input can be in one of two formats:
1) traditional chunk format (bang-separated chunks, bangs duplicated)
this is the traditional fileIn format, as generated by fileOut from the browser
2) interactive line mode. Chunks are any number of lines up to either an empty line or
a line ending in a period. This is more useful for an interactive REPL, where statements/expressions
are entered linewise by a user.
The input can is switched to non-chunk format whenever a line with a '#' in the first column appears.
Try it (but only if you have a console):
Smalltalk readEvalPrintLoop
[Author:]
Claus Gittinger
"
! !
!ReadEvalPrintLoop methodsFor:'accessing'!
compiler:something
"assign a compiler to use;could be used to change the language"
compiler := something.
!
doChunkFormat
"true if currently reading chunk format"
^ doChunkFormat ? true
"Created: / 07-12-2006 / 18:24:04 / cg"
!
doChunkFormat:aBoolean
"enable/disable chunk format"
doChunkFormat := aBoolean.
"Created: / 07-12-2006 / 18:24:04 / cg"
!
editorCommand
|editor|
(editor := editorCommand) isNil ifTrue:[
editor := OperatingSystem getEnvironment:'STX_EDITOR'.
editor isNil ifTrue:[
editor := OperatingSystem getEnvironment:'EDITOR'.
editor isNil ifTrue:[
OperatingSystem isMSWINDOWSlike ifTrue:[
editor := 'notepad'.
] ifFalse:[
editor := 'vi'.
].
].
].
].
^ editor
"Created: / 08-11-2016 / 22:45:22 / cg"
!
error:aStream
"assign an error stream"
errorStream := aStream.
"Created: / 07-12-2006 / 17:33:39 / cg"
!
errorStream
"return the current error stream"
errorStream notNil ifTrue:[^ errorStream].
^ Processor activeProcess stderr
"Created: / 07-12-2006 / 19:12:27 / cg"
!
input:aStream
"assign an input stream"
inputStream := aStream asLineNumberReadStream.
"Modified: / 07-12-2006 / 17:33:31 / cg"
!
inputStream
"get the current input stream"
inputStream notNil ifTrue:[^ inputStream].
^ Processor activeProcess stdin
"Created: / 07-12-2006 / 19:12:13 / cg"
!
output:aStream
"assign an output stream"
outputStream := aStream.
"Created: / 07-12-2006 / 17:27:48 / cg"
!
outputStream
"return the current output stream"
outputStream notNil ifTrue:[^ outputStream].
^ Processor activeProcess stdout
"Created: / 07-12-2006 / 19:12:27 / cg"
!
prompt:aString
"set the prompt"
prompt := aString.
! !
!ReadEvalPrintLoop methodsFor:'compiler interface-error handling'!
correctableError:message position:pos1 to:pos2 from:aCompiler
"compiler notifies us of an error - ignore it"
^ false "/ no correction
!
correctableSelectorWarning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ false
!
correctableWarning:message position:pos1 to:pos2 from:aCompiler
"compiler notifies us of an error - ignore it"
^ false
"Created: / 02-11-2010 / 13:29:22 / cg"
!
error:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ false
!
unusedVariableWarning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ false
!
warning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ self
! !
!ReadEvalPrintLoop methodsFor:'directives'!
cmd_clear:lineStream
self cmd_setOrClear:lineStream to:false
"Created: / 07-12-2006 / 19:04:50 / cg"
!
cmd_debug:lineStream
MiniDebugger enter.
!
cmd_edit:lineStream
"edit a class or selector in an external editor"
|errStream classOrMethodName cls methodName selector
code isNewClass editFullClass tmpFile modifiedTime|
errStream := self errorStream.
isNewClass := editFullClass := false.
lineStream skipSeparators.
lineStream atEnd ifTrue:[
cls := lastEditedClass.
methodName := lastEditedSelector.
] ifFalse:[
classOrMethodName := lineStream
upToElementForWhich:[:ch |
ch isLetterOrDigit not and:[ch ~~ $_]
].
"/
(classOrMethodName isUppercaseFirst) ifTrue:[
(cls := Smalltalk classNamed:classOrMethodName) isNil ifTrue:[
errStream show:'edit: no such class: ',classOrMethodName,' ; create (y/n)? '.
(self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
isNewClass := true.
code :=
'"/ change the code as required, then save and exit the editor.
"/ To cancel this edit, leave the editor WITHOUT saving.
"/
Object
subclass:#%1
instanceVariableNames:''''
classVariableNames:''''
poolDictionaries:''''
category:''user classes''
' bindWith:classOrMethodName.
] ifFalse:[
lineStream skipSeparators.
lineStream atEnd ifFalse:[
methodName := lineStream upToSeparator.
].
].
] ifFalse:[
methodName := classOrMethodName
].
].
isNewClass ifFalse:[
cls := cls ? lastEditedClass.
cls isNil ifTrue:[
errStream showCR:'edit usage:'.
errStream showCR:' #edit className selector'.
errStream showCR:' #edit className '.
errStream showCR:' #edit selector (class as in previous edit)'.
errStream showCR:' #edit (class/method as in previous edit)'.
^ self.
].
lastEditedClass := cls.
lastEditedSelector := methodName.
methodName isNil ifTrue:[
editFullClass := true.
code := cls source asString
] ifFalse:[
((selector := methodName asSymbolIfInterned) isNil
or:[ (cls implements:selector) not]) ifTrue:[
errStream show:('"',methodName,'" is a new method; create (y/n)? ').
(self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
code :=
'"/ change the code as required, then save and exit the editor.
"/ To cancel this edit, leave the editor WITHOUT saving.
%1
"this is a new method"
self halt
' bindWith:methodName.
] ifFalse:[
code := (cls compiledMethodAt:selector) source.
].
].
].
[
|ok cmd|
tmpFile := Filename newTemporary.
tmpFile contents:code.
modifiedTime := tmpFile modificationTime.
cmd := '%1 "%2"'.
OperatingSystem isUNIXlike ifTrue:[
cmd := '%1 "%2" </dev/tty'.
].
ok := OperatingSystem
executeCommand:(cmd bindWith:(self editorCommand) with:tmpFile pathName)
inputFrom:Stdin
outputTo:Stdout
errorTo:Stderr
auxFrom:nil
environment:nil
inDirectory:nil
lineWise:false
newPgrp:false
showWindow:true
onError:[:status | false].
(ok and:[tmpFile modificationTime ~= modifiedTime]) ifTrue:[
isNewClass ifTrue:[
Compiler evaluate:tmpFile contentsOfEntireFile.
errStream showCR:'Class (re)defined.'
] ifFalse:[
editFullClass ifTrue:[
tmpFile fileIn.
errStream showCR:'Class (re)compiled.'
] ifFalse:[
cls compile:tmpFile contentsOfEntireFile classified:'*as yet uncategorized'.
errStream showCR:'Method (re)compiled.'
].
].
] ifFalse:[
errStream showCR:'No change.'
].
] ensure:[
tmpFile notNil ifTrue:[
tmpFile remove
]
].
"
Smalltalk readEvalPrintLoop
self new
input:Stdin;
cmd_edit:'MyClass foo' readStream
"
"Modified: / 08-11-2016 / 22:46:12 / cg"
!
cmd_exit:lineStream
exitAction value
"Created: / 07-12-2006 / 18:55:46 / cg"
!
cmd_help:lineStream
self errorStream
nextPutAll:
'Everything entered up to an empty line or a line ending in "." is called a "chunk" and evaluated.
Lines starting with "#" are commands to the read-eval-print interpreter.
Valid commands are:
#help ............... this text
#exit ............... exit interpreter loop
#use <package>....... use (load) a package
stx:libwidg .............. GUI package
stx:libtool .............. IDE tool package
stx:goodies/regex ........ regex package
stx:goodies/petitparser .. peg parser package
#read <filename>..... read another script or source file
#show <what> ........ show info
variables .......... interpreter variables
processes .......... processes
memory ............. memory usage
flags .............. flags
modules ............ loaded modules
packages ........... available packages to load
all ................ all of the above
#set/clear <flag> ... set or clear a flag
trace .............. tracing execution
timing ............. timing execution
profiling .......... show execution profile
chunkFormat ........ traditional bang chunk format input mode
editor ............. command used with #edit directive
#debug ................. enter a MiniDebugger
#edit <what> ........ open an external editor
class .............. on a class
class selector ..... on a method
<empty> ............ on previously edited method/last class
The MiniDebugger (if entered) shows its own help with "?".
'
"Created: / 07-12-2006 / 18:54:20 / cg"
"Modified: / 08-11-2016 / 22:53:53 / cg"
!
cmd_read:lineStream
|filename newInput savedPrompt savedPrint savedInput savedCurrentDirectory savedDoChunkFormat|
lineStream skipSeparators.
filename := lineStream upToEnd withoutSeparators.
filename isNil ifTrue:[
self errorStream showCR:'? which file?'.
^ self.
].
filename := filename withoutSeparators.
filename isEmpty ifTrue:[
self errorStream showCR:'? which file?'.
^ self.
].
currentDirectory := currentDirectory ? (Filename currentDirectory).
filename := filename asFilename.
filename isAbsolute ifFalse:[
filename := currentDirectory construct:filename.
].
StreamError ignoreIn:[
newInput := filename readStream.
].
newInput isNil ifTrue:[
self errorStream showCR:('Could not find file: "',filename pathName,'"').
^ self.
].
[
savedCurrentDirectory := currentDirectory.
savedDoChunkFormat := doChunkFormat.
savedInput := inputStream.
savedPrint := printFlag.
savedPrompt := prompt.
currentDirectory := filename directory.
inputStream := newInput.
self
basicReadEvalPrintLoopWithInput:newInput
output:outputStream
error:errorStream
compiler:(compiler ? Compiler ? Parser)
prompt:false
print:false.
] ensure:[
newInput close.
doChunkFormat := savedDoChunkFormat.
currentDirectory := savedCurrentDirectory.
inputStream := savedInput.
printFlag := savedPrint.
prompt := savedPrompt.
].
!
cmd_set:lineStream
self cmd_setOrClear:lineStream to:true
"Modified: / 07-12-2006 / 19:04:46 / cg"
!
cmd_setOrClear:lineStream to:aBoolean
|what|
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
what notNil ifTrue:[
(what startsWith:'tra') ifTrue:[
traceFlag := aBoolean.
^ self.
].
(what startsWith:'tim') ifTrue:[
timingFlag := aBoolean.
^ self.
].
(what startsWith:'pro') ifTrue:[
profilingFlag := aBoolean.
^ self.
].
(what startsWith:'chunk') ifTrue:[
doChunkFormat := aBoolean.
^ self.
].
(what startsWith:'edi') ifTrue:[
aBoolean ifTrue:[
"/ set editor cmd
lineStream skipSeparators.
editorCommand := lineStream upToEnd.
] ifFalse:[
editorCommand := nil.
].
^ self.
].
].
self errorStream showCR:'? which flag ?'.
"Modified: / 08-11-2016 / 22:49:17 / cg"
!
cmd_show:lineStream
|errStream what showAll ok|
errStream := self errorStream.
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
ok := false.
what notNil ifTrue:[
showAll := (what startsWith:'all').
(showAll or:[ what startsWith:'var' ]) ifTrue:[
showAll ifTrue:[ errStream showCR:'Variables:'; showCR:'----------' ].
self showVariables.
ok := true.
].
(showAll or:[ what startsWith:'proc' ]) ifTrue:[
showAll ifTrue:[ errStream cr; showCR:'Threads:'; showCR:'--------' ].
MiniDebugger basicNew showProcesses.
ok := true.
].
("showAll or:[" what startsWith:'pack' "]") ifTrue:[
showAll ifTrue:[ errStream cr; showCR:'Available Packages:'; showCR:'--------' ].
self showPackages.
ok := true.
].
(showAll or:[ what startsWith:'mod' ]) ifTrue:[
showAll ifTrue:[ errStream cr; showCR:'Modules:'; showCR:'--------' ].
self showModules.
ok := true.
].
(showAll or:[ what startsWith:'mem' ]) ifTrue:[
|allMem|
showAll ifTrue:[ errStream cr; showCR:'Memory:'; showCR:'-------' ].
"/ allMem := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
"/ + ObjectMemory newSpaceUsed.
errStream
"/ showCR:('overall: ',(allMem // 1024) printString,' Kb');
showCR:('used : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
showCR:('free : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
show:('minorGC: ',(ObjectMemory scavengeCount) printString);
showCR:(' majorGC: ',(ObjectMemory garbageCollectCount) printString).
ok := true.
].
(showAll or:[ what startsWith:'flag' ]) ifTrue:[
showAll ifTrue:[ errStream cr; showCR:'Flags:'; showCR:'------' ].
errStream
showCR:('trace : ',(traceFlag ? false) printString);
showCR:('timing: ',(timingFlag ? false) printString);
showCR:('profiling: ',(profilingFlag ? false) printString);
showCR:('chunkFormat: ',(doChunkFormat ? false) printString);
showCR:('editor: ',self editorCommand printString).
ok := true.
].
].
ok ifFalse:[
errStream showCR:'? show what ?'.
].
"
self basicNew cmd_show:'packages' readStream
"
"Modified: / 08-11-2016 / 22:46:51 / cg"
!
cmd_use:lineStream
|pkg|
lineStream skipSeparators.
pkg := lineStream upToEnd.
pkg isNil ifTrue:[
self errorStream showCR:'? which package?'.
^ self.
].
pkg := pkg withoutSeparators.
pkg isEmpty ifTrue:[
self errorStream showCR:'? which package?'.
^ self.
].
[
Smalltalk loadPackage:pkg.
] on:PackageLoadError do:[:ex|
"/ allow for some shortcuts...
(pkg includes:$:) ifTrue:[
self errorStream showCR:('Failed to load package: "',pkg,'"').
] ifFalse:[
"/ try stx standard package
pkg := 'stx:', pkg.
ex restart.
].
].
"Created: / 07-12-2006 / 19:07:56 / cg"
!
directive:line
|s cmd|
s := line readStream.
s next. "/ skip the hash
s peek == $!! ifTrue:[
"/ skip shebang line
^ self.
].
s skipSeparators.
cmd := s nextAlphaNumericWord.
cmd notNil ifTrue:[
AbortAllOperationRequest handle:[:ex |
self errorStream showCR:('Directive aborted: ', ex description)
] do:[
Error handle:[:ex |
self errorStream showCR:('Caught in directive: ', ex description).
ex suspendedContext fullPrintAll.
] do:[
ControlInterrupt handle:[:ex |
MiniDebugger enter.
"/ self errorStream showCR:('Ignored in directive: ', ex description).
"/ ex reject.
"/ ex proceed.
] do:[
self
perform:('cmd_',cmd) asMutator with:s
ifNotUnderstood:[
self errorStream
show:'?? invalid command: '; show:cmd;
showCR:'. Type "#help" for help.'
].
].
].
].
].
"Created: / 07-12-2006 / 18:49:17 / cg"
"Modified: / 08-11-2016 / 21:59:16 / cg"
!
showModules
|errStream printModule|
errStream := self errorStream.
printModule :=
[:mod |
errStream
show:' ';
show:(mod package "libraryName");
showCR:' (',(mod type),')'.
].
errStream nextPutLine:'builtIn:'.
((ObjectMemory binaryModuleInfo
reject:[:m | m dynamic])
asSortedCollection:[:a :b | a name < b name]) do:printModule.
errStream nextPutLine:'dynamic:'.
((ObjectMemory binaryModuleInfo
select:[:m | m dynamic])
asSortedCollection:[:a :b | a name < b name]) do:printModule.
"
ReadEvalPrintLoop basicNew showModules
"
!
showPackages
|all|
all := Set new.
Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
all add:packageID
].
all := all asOrderedCollection sort.
all do:[:eachPackage |
self errorStream show:eachPackage.
(Smalltalk isPackageLoaded:eachPackage) ifTrue:[
self errorStream show:' (loaded)'.
].
self errorStream cr.
].
"
ReadEvalPrintLoop basicNew showPackages
ReadEvalPrintLoop basicNew showModules
"
!
showVariables
Workspace notNil ifTrue:[
Workspace workspaceVariables keys asOrderedCollection sort do:[:nm |
|holder|
holder := Workspace workspaceVariables at:nm.
self errorStream
show:nm;
show:' -> ';
showCR:holder value printString.
].
].
"
ReadEvalPrintLoop basicNew showVariables
"
! !
!ReadEvalPrintLoop methodsFor:'evaluation'!
basicReadEvalPrintLoopWithInput:input output:output error:error
compiler:compilerClass prompt:prompt print:doPrint
"{ Pragma: +optSpace }"
"the core of the interpreter loop; extracted and parametrized, so it can be called recursive
for included scripts.
If chunkFormat is true, chunks are read.
Otherwise, lines up to an empty line (or EOF) or a line ending in '.' are read.
A '#' character appearing in the first column of the first line turns off chunkmode,
which allows for convenient shell scripts containing a #/bin/stx as the first line."
exitAction := [^ self].
[
|lines chunk|
prompt notNil ifTrue:[
error show:prompt.
].
input atEnd ifTrue:[
doPrint ifTrue:[ error cr ].
^ self.
].
input peek == $# ifTrue:[
self doChunkFormat:false.
].
self doChunkFormat ifTrue:[
input skipSeparators.
chunk := input nextChunk.
] ifFalse:[
lines := OrderedCollection new.
[
|line|
line := input nextLine.
line notEmptyOrNil ifTrue:[
line = '?' ifTrue:[
self cmd_help:nil.
prompt notNil ifTrue:[
error show:prompt.
].
] ifFalse:[
(line startsWith:'#') ifTrue:[
self directive:line.
prompt notNil ifTrue:[
error show:prompt.
].
] ifFalse:[
lines add:line.
]
]
].
line notEmptyOrNil and:[(line endsWith:$.) not].
] whileTrue.
chunk := lines asStringWith:Character cr.
].
(chunk notEmptyOrNil
and:[chunk withoutSeparators notEmpty
and:[chunk withoutSeparators ~= '.']]
) ifTrue:[
"abortAll is handled, but not asked for here!!"
AbortAllOperationRequest handle:[:ex |
error nextPutLine:('Evaluation aborted: ', ex description)
] do:[
(Error, ControlInterrupt) handle:[:ex |
prompt isNil ifTrue:[
ex reject
].
MiniDebugger enterWithMessage:(ex errorString) mayProceed:true.
ex mayProceed ifTrue:[
ex proceed.
].
error showCR:('Evaluation aborted: ', ex description).
ex return.
] do:[
|value ms us|
profilingFlag == true ifTrue:[
MessageTally spyDetailedOn:[
value := (compilerClass new requestor:self)
evaluate:chunk
compile:true.
].
doPrint ifTrue:[
value printOn:output. output cr.
output flush.
].
] ifFalse:[
us := Time microsecondsToRun:[
value := (compilerClass new requestor:self)
evaluate:chunk compile:true.
].
doPrint ifTrue:[
value printOn:output. output cr.
].
timingFlag == true ifTrue:[
'execution time: ' printOn:error.
us < 1000 ifTrue:[
us < 1 ifTrue:[
'too small to measure (<1us)' printOn:error.
] ifFalse:[
us printOn:output. 'us' printOn:error.
]
] ifFalse:[
((us / 1000) asFixedPoint:2) printOn:output. 'ms' printOn:error.
].
error cr.
].
].
Workspace notNil ifTrue:[
Workspace rememberResultAsWorkspaceVariable:value.
].
].
].
].
] loop.
"
Smalltalk readEvalPrintLoop.
(ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
"
"Created: / 07-12-2006 / 17:27:21 / cg"
"Modified: / 08-11-2016 / 22:41:47 / cg"
!
readEvalPrintLoop
"{ Pragma: +optSpace }"
"simple read-eval-print loop for non-graphical Minitalk.
If the chunkFormat-argument is true, chunks are read.
Otherwise, lines up to an empty line (or EOF) are read.
A '#' character appearing in the first column of the first line
switches to chunkmode."
ControlInterrupt handle:[:ex |
self errorStream showCR:('Caught: ', ex description).
self inputStream atEnd ifTrue:[
ex return.
].
MiniDebugger enter.
ex proceed.
"/ ex restart.
] do:[
|input output error compilerClass|
"/ re-evaluate these in the loop, so they can be changed dynamically
input := self inputStream.
output := self outputStream.
error := self errorStream.
compilerClass := compiler ? Compiler ? Parser.
compilerClass isNil ifTrue:[
error showCR:('oops - no Compiler class found').
^ self.
].
StreamError handle:[:ex |
(input isOpen not or:[input atEnd]) ifTrue:[
error showCR:'EOF on input'.
ex return.
].
(output isOpen not) ifTrue:[
error showCR:'no output'.
].
(error isOpen not) ifTrue:[
].
] do:[
input signalAtEnd:true.
self
basicReadEvalPrintLoopWithInput:input output:output error:error
compiler:compilerClass prompt:prompt print:(printFlag ? true).
]
].
"/ self errorStream showCR:('done.').
"
Stdin atEnd
Stdin clearEOF
Smalltalk readEvalPrintLoop
(ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
"
"Created: / 07-12-2006 / 17:27:21 / cg"
"Modified: / 08-11-2016 / 22:42:21 / cg"
! !
!ReadEvalPrintLoop methodsFor:'queries'!
autoDefineVariables
"when evaluating with --eval, auto define any variables"
^ #workspace
! !
!ReadEvalPrintLoop class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !