" shell.st -- a tiny jolt shell "

{ import: Object }

Shell : Object()

"Object setRestart: aBlock []" "Remove comment when debug"
{ import: Recovery } "Comment out when debug"

Shell main
[
    OS arguments isEmpty ifTrue: [^ self evalStdIn].
    OS arguments do: [ :each | self parseArgument: each].
]

Shell parseArgument: aString
[
    | file |
    (Options parseOption: aString) ifTrue: [^self].
    (CompilerOptions parseOption: aString) ifTrue: [^self].
    aString = '-' ifTrue: [^self evalStdIn].
    file := (File openIfPresent: aString)
        ifFalse: [File open: Options libdir, '/', aString].
    file isNil ifTrue: [^ self error: aString, ': No such file or directory'].
    self eval: file readStream to: SinkStream.
]

Shell evalStdIn [[self eval: StdIn readStream to: StdOut] repeat]

Shell eval: readStream to: writeStream
[
    | expr result outer |
    outer := ColaParser.
    ColaParser := ColaFunctionGrammar parserOn: readStream.      "xxx NOT REENTRANT! xxx"

    self setRestart: [^nil].
    [expr := ColaParser next]
	whileTrue: [
"        Options verbose ifTrue: [expr println]."
        result := expr eval.
        writeStream nextPutAll: result printString; cr].
    ColaParser := outer.
]

"--------------------------------------------------------------------------------"

{ import: Object }

{ import: Expression }
{ import: Compiler }
{ import: CodeGenerator }
{ import: CodeGenerator-local }
{ import: Options }

{ import: ColaGrammar }
{ import: Parser }

{ import: ParsingExpression-printing }

ColaParser := [ nil ]

_object __doesNotUnderstand: aSelector "TODO"
[
    | _cName _cSelector |
    _cName := self _debugName.
    _cSelector := aSelector _stringValue.
    {
	fprintf(stderr, "\n");
	fputs(_backtrace(), stderr);
	fprintf(stderr, "\n%s does not understand '%s'\n\n", (char *)v__cName, (char *)v__cSelector);
    }.
    ColaParser backtrace.
    {
	exit(1);
    }
]

Object __error: reason "TODO"
[
    StdErr cr.
    StdErr backtrace.
    StdErr cr; nextPutAll: reason; cr; cr.
    ColaParser backtrace.
    { exit(1); }.
]

Grammar translate: aCompiler
[
"
    ^(Expression
	  with: #send
	  with: (Expression with: #quote with: #parse:)
	  with: (Expression with: #quote with: self)
	  with: (Expression with: #quote with: ColaParser))
	translate: aCompiler
"
    ^(Expression
	  with: #'apply-grammar'
	  with: self
	  with: ColaParser)
	translate: aCompiler
"
    ^(Expression with: #quote with: self)
	translate: aCompiler
"
]

Grammar parse: aParser
[
    ^startRule ifTrue: [(startRule parse: aParser) ifTrue: [aParser result]]
]

Grammar match: anObject
[
    ^startRule ifTrue: [startRule match: anObject]
]

ParsingExpression match: anObject
[
    | parser |
    parser := Parser on: anObject.
    "StdOut nextPutAll: 'MATCH '; println: anObject."
    ^(self parse: parser) ifTrue: [parser result]
]

"[Shell new main]"