ReadEvalPrintLoop.st
author Stefan Vogel <sv@exept.de>
Mon, 22 Jun 2015 11:33:37 +0200
branchexpecco_2_7_5_branch
changeset 18499 b132ac7c9d6a
parent 16565 a5b29e04df8b
child 18120 e3a375d5f6a8
child 19379 9bbc68ce23a6
permissions -rw-r--r--
GLIBC 2.12 compatibility

"
 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' }"

Object subclass:#ReadEvalPrintLoop
	instanceVariableNames:'inputStream outputStream errorStream compiler prompt
		doChunkFormat traceFlag timingFlag printFlag exitAction
		currentDirectory'
	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

    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.
"
! !

!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"
!

error:aStream
    "assign an error stream"

    errorStream := aStream.

    "Created: / 07-12-2006 / 17:33:39 / cg"
!

errorStream
    "return the current error stream"

    ^ errorStream ? Stderr

    "Created: / 07-12-2006 / 19:11:56 / 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 ? 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 outpt stream"

    ^ outputStream ? 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_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
    #set/clear <flag> ... set or clear a flag
	trace .............. tracing execution
	timing ............. timing execution
	chunkFormat ........ traditional bang chunk format input mode

The MiniDebugger (if entered) shows its own help with "?".
'

    "Created: / 07-12-2006 / 18:54:20 / cg"
!

cmd_read:lineStream
    |filename newInput savedPrompt savedPrint savedInput savedCurrentDirectory|

    lineStream skipSeparators.
    filename := lineStream upToEnd withoutSeparators.
    filename isNil ifTrue:[
	'? which file?' errorPrintCR.
	^ self.
    ].
    filename := filename withoutSeparators.
    filename isEmpty ifTrue:[
	'? which file?' errorPrintCR.
	^ self.
    ].

    filename := filename asFilename.
    filename isAbsolute ifFalse:[
	filename := currentDirectory construct:filename.
    ].

    newInput := filename readStream.
    newInput isNil ifTrue:[
	('Could not find file: "',filename,'"') errorPrintCR.
	^ self.
    ].

    [
	savedCurrentDirectory := currentDirectory.
	savedInput := inputStream.
	savedPrint := printFlag.
	savedPrompt := prompt.

	currentDirectory := filename directory.
	inputStream := newInput.

	self
	    basicReadEvalPrintLoopWithInput:newInput
	    output:outputStream
	    error:errorStream
	    compiler:compiler
	    prompt:false
	    print:false.
    ] ensure:[
	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:'chunk') ifTrue:[
	    doChunkFormat := aBoolean.
	    ^ self.
	].
    ].
    self errorStream nextPutLine:'? which flag ?'.

    "Modified: / 07-12-2006 / 19:13:34 / cg"
!

cmd_show:lineStream
    |errStream what all printModule|

"
 self basicNew cmd_show:'packages' readStream
"
    errStream := self errorStream.

    lineStream skipSeparators.
    what := lineStream nextAlphaNumericWord.
    what notNil ifTrue:[
	(what startsWith:'var') ifTrue:[
	    Workspace notNil ifTrue:[
		Workspace workspaceVariables keysAndValuesDo:[:nm :h |
		    errStream nextPutAll:nm; nextPutAll:' -> '; nextPutLine:h value.
		].
	    ].
	    ^ self.
	].
	(what startsWith:'proc') ifTrue:[
	    MiniDebugger basicNew showProcesses.
	    ^ self.
	].
	(what startsWith:'mod') ifTrue:[
	    printModule :=
		[:mod |
		    errStream
			nextPutAll:'  ';
			nextPutAll:(mod package "libraryName");
			nextPutLine:' (',(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.

	    ^ self.
	].
	(what startsWith:'mem') ifTrue:[
	    all := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
					     + ObjectMemory newSpaceUsed.
	    errStream
		nextPutLine:('overall: ',(all // 1024) printString,' Kb');
		nextPutLine:('in use : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
		nextPutLine:('free   : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
		nextPutLine:('minorGC: ',(ObjectMemory scavengeCount) printString);
		nextPutLine:('majorGC: ',(ObjectMemory garbageCollectCount) printString).
	    ^ self.
	].
	(what startsWith:'flag') ifTrue:[
	    errStream
		nextPutLine:('trace :      ',traceFlag printString);
		nextPutLine:('timing:      ',timingFlag printString);
		nextPutLine:('chunkFormat: ',doChunkFormat printString).
	    ^ self.
	].
    ].

    errStream nextPutLine:'? show what ?'.

    "Modified: / 07-12-2011 / 22:15:07 / cg"
!

cmd_use:lineStream
    |pkg|

    lineStream skipSeparators.
    pkg := lineStream upToEnd.
    pkg isNil ifTrue:[
	'? which package?' errorPrintCR.
	^ self.
    ].
    pkg := pkg withoutSeparators.
    pkg isEmpty ifTrue:[
	'? which package?' errorPrintCR.
	^ self.
    ].

    [
	Smalltalk loadPackage:pkg.
    ] on:PackageLoadError do:[:ex|
	"/ allow for some shortcuts...
	(pkg includes:$:) ifTrue:[
	    self errorStream nextPutLine:('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 skipSeparators.

    cmd := s nextAlphaNumericWord.
    cmd notNil ifTrue:[
	self
	    perform:('cmd_',cmd) asMutator with:s
	    ifNotUnderstood:[
		self errorStream
		    nextPutAll:'?? invalid command: ';
		    nextPutAll:cmd;
		    nextPutAll:'. Type "#help" for help.';
		    cr.
	    ].
    ].

    "Created: / 07-12-2006 / 18:49:17 / cg"
! !

!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."

    [
	|lines chunk|

	prompt notNil ifTrue:[
	    error nextPutAll:prompt.
	].

	input atEnd 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 nextPutAll:prompt.
			].
		    ] ifFalse:[
			(line startsWith:'#') ifTrue:[
			    self directive:line.
			    prompt notNil ifTrue:[
				error nextPutAll:prompt.
			    ].
			] ifFalse:[
			    lines add:line.
			]
		    ]
		].
		line notEmptyOrNil and:[(line endsWith:$.) not].
	    ] whileTrue.
	    chunk := lines asStringWith:Character cr.
	].

	(chunk notEmptyOrNil and:[chunk withoutSeparators notEmpty]) 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 nextPutLine:('Evaluation aborted: ', ex description).
		    ex return.
		] do:[
		    |value ms us|

		    ms := Time millisecondsToRun:[
			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.
			ms < 1 ifTrue:[
			    us < 1 ifTrue:[
				'too small to measure (<1us)' printOn:error.
			    ] ifFalse:[
				us printOn:output. 'us' printOn:error.
			    ]
			] ifFalse:[
			    ms printOn:output. 'ms' printOn:error.
			].
			error cr.
		    ].
		    Workspace notNil ifTrue:[
			Workspace workspaceVariableAt:'_$$' put:value.
		    ].
		].
	    ].
	].
    ] loop.

    "
     (ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
    "

    "Created: / 07-12-2006 / 17:27:21 / cg"
    "Modified: / 06-12-2011 / 15:29:03 / 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."

    exitAction := [^ self].

    ControlInterrupt handle:[:ex |
	self errorStream nextPutLine:('Caught: ', ex description).
	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:[
	    self errorStream nextPutLine:('oops - no Compiler class found').
	    ^ self.
	].
	self
	    basicReadEvalPrintLoopWithInput:input output:output error:error
	    compiler:compilerClass prompt:prompt print:(printFlag ? true).
    ]

    "
     (ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
    "

    "Created: / 07-12-2006 / 17:27:21 / cg"
    "Modified: / 06-12-2011 / 15:29:03 / cg"
! !

!ReadEvalPrintLoop methodsFor:'queries'!

autoDefineVariables
    "when evaluating with --eval, auto define any variables"

    ^ #workspace
! !

!ReadEvalPrintLoop class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ReadEvalPrintLoop.st,v 1.54 2014-06-10 10:41:05 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/ReadEvalPrintLoop.st,v 1.54 2014-06-10 10:41:05 cg Exp $'
! !