'From OLPC2.0 of ''24 October 2006'' [latest update: #1463] on 21 July 2007 at 12:56:34 am'! "Change Set: Joy Date: 21 July 2007 Author: Takashi Yamamiya A minimal Joy interpreter. JoyShell open. "! MTokenizer subclass: #JoyMScanner instanceVariableNames: 'reservedCharacterMemo reservedCharacterNextPos integerConstantMemo integerConstantNextPos escapedCharacterMemo escapedCharacterNextPos numberMemo numberNextPos ordinaryCharacterMemo ordinaryCharacterNextPos stringConstantMemo stringConstantNextPos atomicSymbolMemo atomicSymbolNextPos digitMemo digitNextPos letterMemo letterNextPos tokenMemo tokenNextPos characterConstantMemo characterConstantNextPos tokenizeMemo tokenizeNextPos whitespaceMemo whitespaceNextPos' classVariableNames: '' poolDictionaries: '' category: 'Joy'! !JoyMScanner commentStamp: 'tak 7/17/2007 13:59' prior: 0! A Joy scanner based on http://www.latrobe.edu.au/philosophy/phimvt/joy/j09imp.html#TOC_2. ! Object subclass: #JoyParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Joy'! StringHolder subclass: #JoyShell instanceVariableNames: 'interpreter transcript isRunning' classVariableNames: '' poolDictionaries: '' category: 'Joy'! !JoyShell commentStamp: 'tak 7/14/2007 19:14' prior: 0! JoyShell open! TestCase subclass: #JoyTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Joy'! !JoyTest commentStamp: 'tak 7/14/2007 18:08' prior: 0! self buildSuite run! Object subclass: #LinearJoy instanceVariableNames: 'stack tokens output dictionary' classVariableNames: '' poolDictionaries: '' category: 'Joy'! !LinearJoy commentStamp: 'tak 7/21/2007 00:52' prior: 0! A tiny "Linear" Joy interpreter. Linear Joy uses only one stack. There are no implicit stack copy. Joy new eval: '3 4 +.' Structure: stack OrderedCollection -- a stack tokens OrderedCollection -- tokens to be executed. output OrderedCollection -- is hold output data temporary. dictionary IdentityDictionary -- a symbol table ! LinearJoy subclass: #Joy instanceVariableNames: 'context return' classVariableNames: '' poolDictionaries: '' category: 'Joy'! !Joy commentStamp: '' prior: 0! A tiny traditional Joy interpreter. Joy new eval: '1 2 +.' Structure: context Joy -- Current context. return Joy -- Return context. ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/17/2007 16:00'! atomicSymbol ::= "any printing character which is not a reserved character or a digit or the single or double quote character" "JoyMScanner match: 'test' with: #atomicSymbol" "JoyMScanner match: 'hello123=_-' with: #atomicSymbol" "JoyMScanner match: '*' with: #atomicSymbol" :a ( | | $= | $_ | $- )*:s `(a asString, (String newFrom: s)) asSymbol`! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 17:50'! characterConstant ::= "JoyMScanner match: '''c''' with: #characterConstant" $' ( | ):c $' `c`! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 17:46'! digit ::= ($0..9):h! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 17:47'! escapedCharacter ::= "JoyMScanner match: '\''' with: #escapedCharacter" "JoyMScanner match: '\065' with: #escapedCharacter" $\ ($n `Character lf` | $t `Character tab` | $b `Character value: 7` | $r `Character cr` | $f `Character value: 12` | $' `$'` | $" `$"` | :a :b :c `Character value: (a digitValue * 100) + (b digitValue * 10) + c digitValue`)! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 16:58'! integerConstant ::= "JoyMScanner match: '-1034' with: #integerConstant" ($- `-1` | `1`):s ($0..9):h ($0..9)*:t `(t inject: h digitValue into: [:subtotal :next | subtotal * 10 + next digitValue ]) * s`! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/17/2007 15:59'! letter ::= "JoyMScanner match: '*' with: #letter" ~ ~ ~ ! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 17:38'! ordinaryCharacter ::= "JoyMScanner match: 'a' with: #ordinaryCharacter" ~$\ ~$" ! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/17/2007 15:43'! reservedCharacter ::= "JoyMScanner match: '[' with: #reservedCharacter" ($[ | $] | ${ | $} | $; | $.):c `c asString asSymbol` ! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 17:39'! stringConstant ::= "JoyMScanner match: '""hello world""' with: #stringConstant" $" ( | )*:s $" `String newFrom: s`! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/16/2007 17:49'! token ::= | | | | ! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/17/2007 15:33'! tokenize ::= "JoyMScanner match: 'test' with: #tokenize" "JoyMScanner match: '""hello world""' with: #tokenize" "JoyMScanner match: 'test ""hello world"" 123' with: #tokenize" ( )* ! ! !JoyMScanner methodsFor: 'productions' stamp: 'tak 7/17/2007 15:33'! whitespace ::= ()*! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 16:00'! initializeatomicSymbol atomicSymbolMemo _ Array new: stream size + 1 withAll: Untried. atomicSymbolNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializecharacterConstant characterConstantMemo _ Array new: stream size + 1 withAll: Untried. characterConstantNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializedigit digitMemo _ Array new: stream size + 1 withAll: Untried. digitNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializeescapedCharacter escapedCharacterMemo _ Array new: stream size + 1 withAll: Untried. escapedCharacterNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/18/2007 11:09'! initializeintegerConstant integerConstantMemo _ Array new: stream size + 1 withAll: Untried. integerConstantNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:59'! initializeletter letterMemo _ Array new: stream size + 1 withAll: Untried. letterNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/16/2007 17:42'! initializenumber numberMemo _ Array new: stream size + 1 withAll: Untried. numberNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializeordinaryCharacter ordinaryCharacterMemo _ Array new: stream size + 1 withAll: Untried. ordinaryCharacterNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:43'! initializereservedCharacter reservedCharacterMemo _ Array new: stream size + 1 withAll: Untried. reservedCharacterNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializestringConstant stringConstantMemo _ Array new: stream size + 1 withAll: Untried. stringConstantNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 23:50'! initializetoken tokenMemo _ Array new: stream size + 1 withAll: Untried. tokenNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializetokenize tokenizeMemo _ Array new: stream size + 1 withAll: Untried. tokenizeNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'initializers' stamp: 'meta-auto 7/17/2007 15:33'! initializewhitespace whitespaceMemo _ Array new: stream size + 1 withAll: Untried. whitespaceNextPos _ Array new: stream size + 1! ! !JoyMScanner methodsFor: 'public access' stamp: 'tak 7/17/2007 23:45'! scanTokens: aString ^ (self on: aString readStream) tokenize! ! !JoyParser methodsFor: 'public access' stamp: 'tak 7/14/2007 22:59'! parseCompoundDefinition: token on: aStream aStream next. ^ Array streamContents: [:writer | [writer nextPut: (self parseDefinitionOn: aStream)] doWhileFalse: [aStream next = #.]]! ! !JoyParser methodsFor: 'public access' stamp: 'tak 7/14/2007 23:05'! parseCycleOn: aStream | token | token := aStream peek. token == #DEFINE ifTrue: [^ self parseCompoundDefinition: token on: aStream]. token == #. ifTrue: [aStream next. ^ #(#. )]. ^ self parseTermOn: aStream! ! !JoyParser methodsFor: 'public access' stamp: 'tak 7/14/2007 21:14'! parseDefinitionOn: aStream | key value | key := aStream next. self assert: aStream next == #'=='. value := self parseTermOn: aStream. ^ key -> value! ! !JoyParser methodsFor: 'public access' stamp: 'tak 7/14/2007 18:35'! parseSessionOn: aStream | writer | writer := #() writeStream. [aStream atEnd] whileFalse: [writer nextPutAll: (self parseCycleOn: aStream)]. ^ writer contents! ! !JoyParser methodsFor: 'public access' stamp: 'tak 7/17/2007 23:56'! parseTermOn: aStream "term ::= { factor } factor ::= atomic-symbol | integer-constant | float-constant | character-constant | string-constant | '{' { character-constant | integer-constant } '}' | '[' term ']'" | token writer term | writer := #() writeStream. [aStream atEnd or: [#(#. #] #; ) includes: aStream peek]] whileFalse: [token := aStream next. token == #[ ifTrue: [term := self parseTermOn: aStream. "consume ]" aStream next. writer nextPut: term] ifFalse: [token = #true ifTrue: [writer nextPut: true] ifFalse: [token = #false ifTrue: [writer nextPut: false] ifFalse: [writer nextPut: token]]]]. ^ writer contents! ! !JoyParser methodsFor: 'public access' stamp: 'tak 7/17/2007 23:43'! parse: aString | tokens | " tokens := Scanner new scanTokens: aString." tokens := JoyMScanner new scanTokens: aString. ^ self parseSessionOn: tokens readStream ! ! !JoyShell methodsFor: 'accessing' stamp: 'tak 7/20/2007 14:14'! codePaneMenu: aMenu shifted: shifted "Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items in a text pane" | donorMenu | donorMenu _ shifted ifTrue: [ParagraphEditor shiftedYellowButtonMenu] ifFalse: [ParagraphEditor yellowButtonMenu]. ^ aMenu labels: donorMenu labelString lines: donorMenu lineArray selections: donorMenu selections! ! !JoyShell methodsFor: 'accessing' stamp: 'tak 7/20/2007 14:53'! interpreter ^ interpreter! ! !JoyShell methodsFor: 'accessing' stamp: 'tak 7/20/2007 14:28'! statusContents ^ String streamContents: [:s | interpreter printStatusOn: s]! ! !JoyShell methodsFor: 'initialize-release' stamp: 'tak 7/21/2007 00:54'! initialize interpreter := LinearJoy new. "Try Joy object if you prefer traditional behavior." "interpreter := Joy new". transcript := TranscriptStream new. isRunning := false. contents := self class example! ! !JoyShell methodsFor: 'initialize-release' stamp: 'tak 7/20/2007 15:43'! open "self open" | window | window := (SystemWindow labelled: 'Joy Workspace') model: self. window addMorph: ((PluggableTextMorph on: self text: #contents accept: #acceptContents: readSelection: nil menu: #codePaneMenu:shifted:) setBalloonText: 'Input text to evaluate') frame: (0 @ 0 corner: 1 @ 0.5). window addMorph: ((PluggableTextMorph on: transcript text: nil accept: nil readSelection: nil menu: #codePaneMenu:shifted:) setBalloonText: 'Output log') frame: (0 @ 0.5 corner: 1 @ 0.9). window addMorph: ((PluggableTextMorph on: self text: #statusContents accept: nil readSelection: nil menu: #codePaneMenu:shifted:) showScrollBarsOnlyWhenNeeded: true; setBalloonText: 'Status') frame: (0 @ 0.9 corner: 1 @ 1). ^ window openInWorld! ! !JoyShell methodsFor: 'stepping' stamp: 'tak 7/20/2007 21:27'! step | token | interpreter isFinished ifTrue: [interpreter output ifEmpty: [^ self]. interpreter printStack: interpreter output on: transcript. transcript cr. transcript endEntry. interpreter removeOutput. ^ isRunning := false]. token := interpreter step. " (token isSymbol or: [token isNil])" true ifTrue: [interpreter printStatusOn: transcript]. transcript endEntry. self changed: #statusContents! ! !JoyShell methodsFor: 'stepping' stamp: 'tak 7/20/2007 15:16'! stepTimeIn: aSystemWindow ^ 20! ! !JoyShell methodsFor: 'stepping' stamp: 'tak 7/20/2007 14:04'! wantsSteps ^ true! ! !JoyShell methodsFor: 'evaluation' stamp: 'tak 7/20/2007 14:19'! doItContext ^ self! ! !JoyShell methodsFor: 'evaluation' stamp: 'tak 7/20/2007 14:16'! doItReceiver ^ self.! ! !JoyShell methodsFor: 'evaluation' stamp: 'tak 7/20/2007 14:56'! evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag | aString result | aString := textOrStream upToEnd. result := aContext interpreter copy eval: aString. aContext eval: aString. ^result. ! ! !JoyShell methodsFor: 'evaluation' stamp: 'tak 7/20/2007 14:29'! eval: aString transcript show: aString. transcript cr. interpreter readFrom: aString. isRunning := true! ! !JoyShell class methodsFor: 'instance creation' stamp: 'tak 7/20/2007 14:17'! evaluatorClass ^ self! ! !JoyShell class methodsFor: 'instance creation' stamp: 'tak 7/14/2007 19:17'! open ^ self new open! ! !JoyShell class methodsFor: 'documents' stamp: 'tak 7/21/2007 00:55'! example ' (this example works only traditional Joy compiler DEFINE onestep == dup dup 3 rem [null] [pop dup 5 rem [null] [pop pop "FizzBuzz"] [pop pop "Fizz"] ifte] [pop dup 5 rem [null] [pop pop "Buzz"] [pop] ifte] ifte swap pred; fizzbuzz == [] swap [null] [pop] [onestep [swap cons] dip] tailrec. 10 fizzbuzz.'. ^ 'Welcome to Joy Programming Language. Joy programming language is a stack based purely functional programming language by Manfred von Thun. This Joy Workspace is a tiny Joy interpreter, and provides you Smalltalk-style do-it interface. Select and press Alt+D with following expressions. 3 4 + . 3 4 6 [+] dip *. [0 1 > ] ["OK"] ["NG"] ifte. [1 0 3] [null] some. [1 2 3] [2 *] map. 3 [dup null] [] [dup pred] tailrec.... DEFINE factorial1 == [dup null] [pop 1] [dup pred factorial1 *] ifte. 5 factorial1. DEFINE factorial2 == [dup null] [pop 1] [dup pred] [*] linrec. 5 factorial2. ' ! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 20:19'! testArithmetic "self debug: #testArithmetic" | j | j := LinearJoy new. self assert: (j pushValue: 1; pushValue: 2; evalBinary: #+; popValue) == 3. self assert: (j pushValue: 1; pushValue: 2; evalBinary: #-; popValue) == -1. self assert: (j pushValue: 1; pushValue: 2; evalBinary: #*; popValue) == 2. self assert: (j pushValue: 1; pushValue: 2; evalBinary: #/; popValue) = (1 / 2). ! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 20:05'! testBasic "self debug: #testBasic" self assert: (LinearJoy new eval: '1 2 3'; yourself) stack asArray = #(1 2 3). self assert: (LinearJoy new eval: '1 2 +'; yourself) stack asArray = #(3). self assert: (LinearJoy new eval: '5 dup'; yourself) stack asArray = #(5 5). self assert: (LinearJoy new eval: 'DEFINE hello == 1 . hello'; yourself) stack asArray = #(1). self assert: (LinearJoy new eval: '5 double'; yourself) stack asArray = #(10). self assert: (LinearJoy new eval: '[1 2 3]'; yourself) stack asArray = #(#(1 2 3)). self assert: (LinearJoy new eval: 'true'; yourself) stack asArray = #(true). self assert: (LinearJoy new eval: '1 2 swap'; yourself) stack asArray = #(2 1). self assert: (LinearJoy new eval: '"hello"'; yourself) stack asArray = #('hello'). ! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 15:33'! testCombinators "self debug: #testCombinators" self assert: (Joy new eval: '1 2 3.') asArray = #(3). self assert: (Joy new eval: '1 2 + .') asArray = #(3). self assert: (Joy new eval: '1 2 3 [*] dip +.') asArray = #(5). self assert: (Joy new eval: '[true] [1] [2] ifte.') asArray = #(1). self assert: (Joy new eval: '1 [null][true][false] ifte'; yourself) stack asArray = #(1 false). self assert: (Joy new eval: '3 [null] [] [pred dup] tailrec....') asArray = #(0 0 1 2). self assert: (Joy new eval: '1 [] cons.') asArray = #(#(1)). self assert: (Joy new eval: '10 1 2 [+] app2'; yourself) stack asArray = #(10 11 12). self assert: (Joy new eval: '[1 2 3] [dup *] map'; yourself) stack asArray = #(#(1 4 9) ). self assert: (Joy new eval: '5 [pred] [dup *] cleave'; yourself) stack asArray = #(4 25). self assert: (Joy new eval: '[1 2 3] 100 [-] fold.') asArray = #(94). self assert: (Joy new eval: '[1 0 3] [null] some.') asArray = #(true). self assert: (Joy new eval: '[1 2 3] [null] some.') asArray = #(false). self assert: (Joy new eval: '10 [null] [succ] [dup pred] [*] linrec.') asArray = #(3628800). ! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 20:19'! testConstant "self debug: #testConstant" | j | j := LinearJoy new. j pushValue: 1. j pushValue: 2. j pushValue: 3. self assert: j popValue == 3. self assert: j popValue == 2. self assert: j popValue == 1.! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 20:20'! testDebug "self debug: #testDebug" | j | j := LinearJoy readFrom: '3 4 +'. j step. j step. j step. self assert: j stack last = 7. j := LinearJoy readFrom: 'DEFINE hello == 42 . hello .'. j step. j step. self assert: j step = 42. ! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 15:33'! testFizzBuzz "self debug: #testFizzBuzz" | j | j := Joy new. j eval: ' DEFINE onestep == dup dup 3 rem [null] [pop dup 5 rem [null] [pop pop "FizzBuzz"] [pop pop "Fizz"] ifte] [pop dup 5 rem [null] [pop pop "Buzz"] [pop] ifte] ifte swap pred; fizzbuzz == [] swap [null] [pop] [onestep [swap cons] dip] tailrec. '. self assert: (j eval: '10 fizzbuzz.') asArray = #(#(1 2 'Fizz' 4 'Buzz' 'Fizz' 7 8 'Fizz' 'Buzz') )! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/17/2007 23:57'! testParser "self debug: #testParser" self assert: (JoyParser new parse: '1 2 3') asArray = #(1 2 3). self assert: (JoyParser new parse: '1 2 3.') asArray = #(1 2 3 .). self assert: (JoyParser new parse: '1 2 +') asArray = #(1 2 +). self assert: (JoyParser new parse: '5 dup') asArray = #(5 dup). self assert: ((JoyParser new parse: 'DEFINE hello == 1.') first = (#hello -> #(1))). self assert: ((JoyParser new parse: 'DEFINE hello == 1; world == 2.') last = (#world -> #(2))). self assert: (JoyParser new parse: 'DEFINE hello == 1; world == 2.') size = 2. self assert: (JoyParser new parse: '[[hello world] yey]') asArray = #(#(#(hello world) yey)). self assert: (JoyParser new parse: 'true') asArray = #(true). self assert: (JoyParser new parse: '"hello"') asArray = #('hello').! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 15:33'! testRecursion "self debug: #testRecursion" | j | j := Joy new. j eval: 'DEFINE map2 == [ pop null ] [ pop ] [ [uncons] dip dup [dip] dip map2 cons ] ifte.'. self assert: (j eval: '[1 2 3][double] map2 .') asArray = #((2 4 6))! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/20/2007 20:20'! testResult "self debug: #testResult" self assert: (LinearJoy new eval: '1 2 3.') asArray = #(3). self assert: (LinearJoy new eval: '1 2 + .') asArray = #(3). self assert: (LinearJoy new eval: '1 2 > .') asArray = #(false). self assert: (LinearJoy new eval: '5 dup . .') asArray = #(5 5). self assert: (LinearJoy new eval: 'DEFINE hello == 1 . hello .') asArray = #(1). self assert: (LinearJoy new eval: '5 double.') asArray = #(10). self assert: (LinearJoy new eval: '[1 2 3] .') asArray = #(#(1 2 3)). ! ! !JoyTest methodsFor: 'testing' stamp: 'tak 7/17/2007 15:58'! testScanner "self debug: #testScanner" self assert: (JoyMScanner match: '"hello world\r"' with: #stringConstant) = 'hello world '. self assert: (JoyMScanner match: '-1034' with: #integerConstant) = -1034. self assert: (JoyMScanner match: '[' with: #reservedCharacter) = '['. self assert: (JoyMScanner match: 'hello123=_-' with: #atomicSymbol) = #'hello123=_-'. self assert: (JoyMScanner match: '*' with: #atomicSymbol) = #'*'. self assert: (JoyMScanner match: 'test' with: #tokenize) = #(test). self assert: (JoyMScanner match: '"hello world"' with: #tokenize) = #('hello world'). self assert: (JoyMScanner match: 'test "hello world" 123' with: #tokenize) = #(test 'hello world' 123). self assert: (JoyMScanner match: '[1 2 3] [dup *] map' with: #tokenize) = #([ 1 2 3 ] [ dup * ] map) ! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:10'! flush "Initialize everything expect dictionary" stack := OrderedCollection new. tokens := OrderedCollection new. output := OrderedCollection new! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:25'! output ^ output copy! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 21:17'! postCopy stack := stack copy. tokens := tokens copy! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:27'! printQuotation: aCollection on: aStream aStream nextPutAll: '[ '. self printStack: aCollection on: aStream. aStream nextPutAll: '] '! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:24'! printStack: aCollection on: aStream aCollection do: [:token | token class == Array ifTrue: [self printQuotation: token on: aStream] ifFalse: [token isSymbol ifTrue: [aStream nextPutAll: token asString] ifFalse: [token isString ifTrue: [token printOn: aStream] ifFalse: [aStream nextPutAll: token asString]]. aStream nextPut: $ ]]! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:24'! printStatusOn: aStream aStream nextPutAll: '>'. aStream nextPutAll: ' '. self printStack: stack on: aStream. aStream nextPutAll: ' :: '. self printStack: tokens on: aStream. aStream cr. (aStream isKindOf: Transcripter) ifTrue: [aStream endEntry]! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:26'! removeOutput output := OrderedCollection new. ! ! !LinearJoy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:04'! stack ^ stack! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 21:23'! branch | fBlock tBlock cond | fBlock := self popValue. tBlock := self popValue. cond := self popValue. cond ifTrue: [self addTokens: tBlock] ifFalse: [self addTokens: fBlock]! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 21:25'! concat | result list2 list1 | list2 := self popValue. list1 := self popValue. result := list1 , list2. self pushValue: result! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 21:57'! cons | result cdr car | cdr := self popValue. car := self popValue. result := {car}, cdr. self pushValue: result! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 20:27'! dip | x p | p := self popValue. x := self popValue. self addTokens: p, {x}! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 21:54'! fold "[1 2 3] 100 [-] fold." | q x xs | q := self popValue. x := self popValue. xs := self popValue. xs isEmpty ifTrue: [^ self pushValue: x]. self addTokens: {xs allButFirst. x. xs first} , q , {q. #fold}! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 23:27'! linrec | q then else1 else2 | else2 := self popValue. else1 := self popValue. then := self popValue. q := self popValue. self addTokens: q, {then}, {else1, {q}, {then}, {else1}, {else2}, {#linrec}, else2}, {#branch}. ! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 22:34'! rest | list result | list := self popValue. result := list allButFirst. self pushValue: result! ! !LinearJoy methodsFor: 'combinators' stamp: 'tak 7/20/2007 22:35'! size | list result | list := self popValue. result := list size. self pushValue: result! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:15'! evalBinary: token | a b result | b := self popValue. a := self popValue. result := a perform: token with: b. self pushValue: result! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:17'! evalDefinition: anAssociation dictionary at: anAssociation key put: anAssociation value! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:07'! evalTokens: aCollection output: aStream | token | self addTokens: aCollection. output := OrderedCollection new. [tokens isEmpty] whileFalse: [token := self step. (aStream notNil and: [token isSymbol or: [token isNil]]) ifTrue: [self printStatusOn: aStream]]. aStream ifNotNil: [self printStack: output on: aStream. aStream cr]. ^ output! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:15'! evalToken: token to: writer token == #. ifTrue: [^ output addLast: self popValue]. (dictionary includesKey: token) ifTrue: [^ self addTokens: (dictionary at: token)]. token isNumber ifTrue: [^ self pushValue: token]. token class == Array ifTrue: [^ self pushValue: token]. (token isKindOf: Boolean) ifTrue: [^ self pushValue: token]. (#(#+ #- #/ #* #> #< #=) includes: token) ifTrue: [^ self evalBinary: token]. token class == Association ifTrue: [^ self evalDefinition: token]. token isSymbol ifTrue: [^ self perform: token]. token isString ifTrue: [^ self pushValue: token]. ! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:05'! eval: aString "Evaluate a joy expression. Returns result values if the expression ends with . (dot)" ^ self evalTokens: (JoyParser new parse: aString) output: nil ! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:25'! isFinished ^ tokens isEmpty! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:22'! readFrom: aString self addTokens: (JoyParser new parse: aString)! ! !LinearJoy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:13'! step "Execute one token, and answer the token" | token | tokens ifEmpty: [^ nil]. token := tokens removeFirst. self evalToken: token to: nil. ^ token! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 21:56'! abs | value | value := self popValue. self pushValue: value abs! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 21:56'! and | a b | b := self popValue. a := self popValue. self pushValue: a & b! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 20:16'! dup | value | value := self popValue. self pushValue: value copy. self pushValue: value copy! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 21:20'! i | q | q := self popValue. self addTokens: q! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 21:55'! null | value | value := self popValue. value = 0 ifTrue: [^ self pushValue: true]. (value isCollection and: [value size = 0]) ifTrue: [^ self pushValue: true]. self pushValue: false! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 21:55'! or | a b | b := self popValue. a := self popValue. self pushValue: a | b! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 20:31'! pop self popValue! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 22:00'! pred | a | a := self popValue. self pushValue: a - 1! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 22:00'! rem | a b | b := self popValue. a := self popValue. self pushValue: a \\ b! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 22:01'! succ | a | a := self popValue. self pushValue: a + 1! ! !LinearJoy methodsFor: 'functions' stamp: 'tak 7/20/2007 20:18'! swap | a b | a := self popValue. b := self popValue. self pushValue: a. self pushValue: b.! ! !LinearJoy methodsFor: 'initialize-release' stamp: 'tak 7/20/2007 20:11'! initialize self flush. dictionary := IdentityDictionary new. self eval: self prelude! ! !LinearJoy methodsFor: 'initialize-release' stamp: 'tak 7/20/2007 23:37'! prelude ^ ' DEFINE ifte == [[i] dip] dip branch; tailrec == [] linrec. DEFINE double == 2 *; square == dup *; uncons == dup [first] dip rest; mmap == [map] cons map; zip == [] cons cons transpose; transpose == [ [null] [true] [[null] some] ifte ] [ pop [] ] [ [[first] map] [[rest] map] cleave ] [ cons ] linrec. DEFINE some == [false] dip [or] concat fold; reverse == [] [swap cons] fold; map == [[]] dip [swap cons] concat fold reverse.'! ! !LinearJoy methodsFor: 'stack handling' stamp: 'tak 7/20/2007 20:02'! popValue ^ stack removeLast! ! !LinearJoy methodsFor: 'stack handling' stamp: 'tak 7/20/2007 20:03'! pushValue: constant stack addLast: constant! ! !LinearJoy methodsFor: 'token handling' stamp: 'tak 7/20/2007 20:09'! addTokens: aCollection "Add tokens at first." tokens addAllFirst: aCollection! ! !LinearJoy methodsFor: 'token handling' stamp: 'tak 7/20/2007 20:09'! newTokens: aCollection "Clear current tokens and store new tokens" tokens := OrderedCollection new. self addTokens: aCollection! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/20/2007 20:10'! flush "Initialize everything expect dictionary" super flush. context := nil. return := nil ! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/20/2007 15:24'! output ^ output copy! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/20/2007 21:18'! postCopy super postCopy. context := nil. return := nil! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/14/2007 19:40'! printStack ^ String streamContents: [:s | self printStack: stack on: s]! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/15/2007 20:28'! printStack: aCollection on: aStream aCollection do: [:token | token class == Array ifTrue: [self printQuotation: token on: aStream] ifFalse: [token isSymbol ifTrue: [aStream nextPutAll: token asString] ifFalse: [token isString ifTrue: [token printOn: aStream] ifFalse: [aStream nextPutAll: token asString]]. aStream nextPut: $ ]]! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/20/2007 10:59'! printStatusOn: aStream aStream nextPutAll: '>'. context ifNotNil: [^ context printStatusOn: aStream]. aStream nextPutAll: ' '. self printStack: stack on: aStream. aStream nextPutAll: ' :: '. self printStack: tokens on: aStream. aStream cr. (aStream isKindOf: Transcripter) ifTrue: [aStream endEntry]! ! !Joy methodsFor: 'accessing' stamp: 'tak 7/20/2007 10:19'! returnContext: aJoy return := aJoy! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! app2 | q x2 x1 | q := self popValue. x2 := self popValue. x1 := self popValue. self jump: {x1}, q. self addTokens: {x2. q. #app20}! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:12'! app20 | q x2 result1 | q := self popValue. x2 := self popValue. result1 := self popValue. self jump: {x2}, q. self pushValue: result1! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! cleave | q2 q1 value | q2 := self popValue. q1 := self popValue. value := self popValue. self jump: {value}, q1. self addTokens: {value}, q2 ! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:49'! filter "TODO: replace using fold" | q list result j | q := self popValue. list := self popValue. result := list select: [:each | j := self copy. j pushValue: each. j pushValue: q. j i. j popValue]. self pushValue: result! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/15/2007 20:26'! first | list result | list := self popValue. result := list first. self pushValue: result! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! fold "[1 2 3] 100 [-] fold." | q x xs | q := self popValue. x := self popValue. xs := self popValue. xs isEmpty ifTrue: [^ self pushValue: x]. self jump: {x. xs first}, q. self pushValue: xs allButFirst. self addTokens: {q. #fold} ! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! ifte | fBlock tBlock | fBlock := self popValue. tBlock := self popValue. self jump: self popValue. self addTokens: {tBlock. fBlock. #branch}. ! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! linrec | q then else1 else2 | else2 := self popValue. else1 := self popValue. then := self popValue. q := self popValue. self jump: q. self addTokens: {q. then. else1. else2. #linrec0}! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! linrec0 | q then else1 else2 result | else2 := self popValue. else1 := self popValue. then := self popValue. q := self popValue. result := self popValue. result ifTrue: [^ self addTokens: then]. self addTokens: else1, {q. then. else1. else2. #linrec} , else2! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/15/2007 14:50'! sort | list result | list := self popValue. result := list sort. self pushValue: result! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! tailrec | fBlock tBlock cond | fBlock := self popValue. tBlock := self popValue. cond := self popValue. self jump: cond. self addTokens: {cond. tBlock. fBlock. #tailrec0}! ! !Joy methodsFor: 'combinators' stamp: 'tak 7/20/2007 10:39'! tailrec0 | fBlock tBlock cond result | fBlock := self popValue. tBlock := self popValue. cond := self popValue. result := self popValue. result ifTrue: [self addTokens: {tBlock. #i}] ifFalse: [self addTokens: {fBlock. #i. cond. tBlock. fBlock. #tailrec}]! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 15:31'! evalTokens: aCollection output: aStream | token | self addTokens: aCollection. output := OrderedCollection new. [tokens isEmpty and: [context isNil]] whileFalse: [token := self step. (aStream notNil and: [token isSymbol or: [token isNil]]) ifTrue: [self printStatusOn: aStream]]. aStream ifNotNil: [self printStack: output on: aStream. aStream cr]. ^ output! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 10:15'! finished context := nil! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 20:25'! isFinished ^ super isFinished and: [context isNil]! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 10:28'! jump: aCollection "Execute a program in copied stack, and push a value on top of the stack" context := self copy. context newTokens: aCollection. context returnContext: self! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 10:37'! readFrom: aString self addTokens: (JoyParser new parse: aString)! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 10:39'! return return ifNil: [^ nil]. return addTokens: {stack last}. return finished. ^ nil! ! !Joy methodsFor: 'evaluation' stamp: 'tak 7/20/2007 10:25'! step "Execute one token, and answer the token" | token | context ifNotNil: [^ context step]. tokens ifEmpty: [^ self return]. token := tokens removeFirst. self evalToken: token to: nil. ^ token! ! !Joy methodsFor: 'initialize-release' stamp: 'tak 7/20/2007 10:45'! initialize self flush. dictionary := IdentityDictionary new. self eval: self prelude! ! !Joy methodsFor: 'initialize-release' stamp: 'tak 7/20/2007 10:18'! prelude ^ 'DEFINE double == 2 *; square == dup *; uncons == dup [first] dip rest; mmap == [map] cons map; zip == [] cons cons transpose; transpose == [ [null] [true] [[null] some] ifte ] [ pop [] ] [ [[first] map] [[rest] map] cleave ] [ cons ] linrec. DEFINE some == [false] dip [or] concat fold; reverse == [] [swap cons] fold; map == [[]] dip [swap cons] concat fold reverse.'! ! !LinearJoy class methodsFor: 'instance creation' stamp: 'tak 7/20/2007 20:21'! readFrom: aString | instance | instance := self new. ^ instance readFrom: aString! ! !Joy class reorganize! ('as yet unclassified') ! !LinearJoy class reorganize! ('instance creation' readFrom:) ! !Joy reorganize! ('accessing' flush output postCopy printStack printStack:on: printStatusOn: returnContext:) ('combinators' app2 app20 cleave filter first fold ifte linrec linrec0 sort tailrec tailrec0) ('evaluation' evalTokens:output: finished isFinished jump: readFrom: return step) ('functions') ('initialize-release' initialize prelude) ! !LinearJoy reorganize! ('accessing' flush output postCopy printQuotation:on: printStack:on: printStatusOn: removeOutput stack) ('combinators' branch concat cons dip fold linrec rest size) ('evaluation' evalBinary: evalDefinition: evalTokens:output: evalToken:to: eval: isFinished readFrom: step) ('functions' abs and dup i null or pop pred rem succ swap) ('initialize-release' initialize prelude) ('stack handling' popValue pushValue:) ('token handling' addTokens: newTokens:) ! !JoyShell reorganize! ('accessing' codePaneMenu:shifted: interpreter statusContents) ('initialize-release' initialize open) ('stepping' step stepTimeIn: wantsSteps) ('evaluation' doItContext doItReceiver evaluate:in:to:notifying:ifFail:logged: eval:) ! !JoyMScanner reorganize! ('productions' atomicSymbol characterConstant digit escapedCharacter integerConstant letter ordinaryCharacter reservedCharacter stringConstant token tokenize whitespace) ('initializers' initializeatomicSymbol initializecharacterConstant initializedigit initializeescapedCharacter initializeintegerConstant initializeletter initializenumber initializeordinaryCharacter initializereservedCharacter initializestringConstant initializetoken initializetokenize initializewhitespace) ('public access' scanTokens:) !