SystemOrganization addCategory: #'Factorial-Language'! PPCompositeParser subclass: #FLFactorialGrammar instanceVariableNames: 'apply binary condition expression function literal operation variable add close cmp else equal id if num open sub then' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !FLFactorialGrammar commentStamp: 'lr 5/21/2008 20:07' prior: 0! I define the scanner and parser for the FL programming language using the parser combinator framework PetitParser.! FLFactorialGrammar subclass: #FLFactorialCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !FLFactorialCompiler commentStamp: 'lr 5/21/2008 20:10' prior: 0! I define productions to create a Smalltalk AST from the FL source. The Smalltalk AST can be trivially transformed to Smalltalk bytecodes and executed using the infrastructure of the development environment.! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:47'! apply ^ super apply ==> [ :node | RBMessageNode receiver: (RBVariableNode named: 'self') selector: (self selector: node second count: node third size) arguments: node third ]! ! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:48'! binary ^ super binary ==> [ :node | RBMessageNode receiver: node second selector: node third asSymbol arguments: (Array with: node fourth) ]! ! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:49'! condition ^ super condition ==> [ :node | RBMessageNode receiver: node second selector: #ifTrue:ifFalse: arguments: (Array with: (RBBlockNode arguments: #() body: (RBSequenceNode statements: (Array with: node fourth))) with: (RBBlockNode arguments: #() body: (RBSequenceNode statements: (Array with: node sixth)))) ]! ! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! function ^ super function ==> [ :node | RBMethodNode selector: (self selector: node first count: node second size) arguments: node second body: ((RBSequenceNode statements: (Array with: node fourth)) addReturn; yourself) ]! ! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:49'! literal ^ super literal ==> [ :node | RBLiteralNode value: node asNumber ]! ! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/21/2008 00:56'! operation ^ super operation ==> [ :node | node = '==' ifTrue: [ #= ] ifFalse: [ node asSymbol ] ]! ! !FLFactorialCompiler methodsFor: 'private' stamp: 'lr 5/16/2008 21:58'! selector: aString count: anInteger | stream | stream := WriteStream on: String new. stream nextPutAll: aString. 1 to: anInteger do: [ :index | index > 1 ifTrue: [ stream nextPutAll: 'with' ]. stream nextPut: $: ]. ^ stream contents asSymbol! ! !FLFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! variable ^ super variable ==> [ :node | RBVariableNode named: node ]! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! add ^ $+ asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! apply ^ open , id , expression star , close! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! binary ^ open , expression , operation , expression , close! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! close ^ $) asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! cmp ^ '==' asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! condition ^ if , expression , then , expression , else , expression! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! else ^ 'else' asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! equal ^ $= asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:09'! expression ^ apply / condition / binary / variable / literal! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! function ^ id , variable star , equal , expression! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! id ^ #letter asParser plus flatten trim! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! if ^ 'if' asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:44'! literal ^ num! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! num ^ #digit asParser plus flatten trim! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! open ^ $( asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:09'! operation ^ cmp / add / sub! ! !FLFactorialGrammar methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:43'! start ^ function end! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! sub ^ $- asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'token' stamp: 'lr 9/2/2010 11:52'! then ^ 'then' asParser flatten trim! ! !FLFactorialGrammar methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:51'! variable ^ id! ! FLFactorialGrammar subclass: #FLFactorialPrinter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !FLFactorialPrinter commentStamp: 'lr 5/21/2008 20:09' prior: 0! I implement the pretty printer of the FL language. ! !FLFactorialPrinter methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:20'! apply ^ super apply ==> [ :nodes | nodes first , nodes second , (nodes third inject: String new into: [ :r :e | r , ' ' , e ]) , nodes fourth ]! ! !FLFactorialPrinter methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:25'! binary ^ super binary ==> [ :nodes | nodes first , nodes second , ' ' , nodes third , ' ' , nodes fourth , nodes fifth ]! ! !FLFactorialPrinter methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:22'! condition ^ super condition ==> [ :nodes | nodes first , ' ' , nodes second , ' ' , nodes third , ' ' , nodes fourth , ' ' , nodes fifth , ' ' , nodes sixth ]! ! !FLFactorialPrinter methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:23'! function ^ super function ==> [ :nodes | nodes first , (nodes second inject: String new into: [ :r :e | r , ' ' , e ]) , ' ' , nodes third , ' ' , nodes fourth ]! ! TestCase subclass: #FLFactorialExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !FLFactorialExample commentStamp: 'lr 5/21/2008 20:15' prior: 0! I implement the example given in "factorial.txt". The code can be edited directly in the Smalltalk code browser and is automatically parsed, transformed and eventually compiled down to Smalltalk bytecodes.! !FLFactorialExample methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:13'! ack ^ 'ack m n = if (m == 0) then (n + 1) else if (n == 0) then (ack (m - 1) 1) else (ack (m - 1) (ack m (n - 1)))'! ! !FLFactorialExample methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:25'! fac ^ 'fac n = if (n == 0) then 1 else (mult n (fac (n - 1)))'! ! !FLFactorialExample methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:13'! fib ^ 'fib n = if (n == 0) then 0 else if (n == 1) then 1 else ((fib (n - 1)) + (fib (n - 2)))'! ! !FLFactorialExample methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:25'! mul ^ 'mult n m = if (n == 0) then 0 else (m + (mult (n - 1) m))'! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 9/2/2010 11:52'! testAck self assert: (FLFactorialGrammar parse: self ack) = #('ack' #('m' 'n') '=' #('if' #('(' 'm' '==' '0' ')') 'then' #('(' 'n' '+' '1' ')') 'else' #('if' #('(' 'n' '==' '0' ')') 'then' #('(' 'ack' #(#('(' 'm' '-' '1' ')') '1') ')') 'else' #('(' 'ack' #(#('(' 'm' '-' '1' ')') #('(' 'ack' #('m' #('(' 'n' '-' '1' ')')) ')')) ')')))). self assert: (FLFactorialPrinter parse: self ack) = self ack. self assert: (FLFactorialCompiler parse: self ack) = (RBParser parseMethod: 'ack: m with: n ^ m = 0 ifTrue: [ n + 1 ] ifFalse: [ n = 0 ifTrue: [ self ack: m - 1 with: 1 ] ifFalse: [ self ack: m - 1 with: (self ack: m with: n - 1) ] ]')! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 9/2/2010 11:52'! testFac self assert: (FLFactorialGrammar parse: self fac) = #('fac' #('n') '=' #('if' #('(' 'n' '==' '0' ')') 'then' '1' 'else' #('(' 'mult' #('n' #('(' 'fac' #(#('(' 'n' '-' '1' ')')) ')')) ')'))). self assert: (FLFactorialPrinter parse: self fac) = self fac. self assert: (FLFactorialCompiler parse: self fac) = (RBParser parseMethod: 'fac: n ^ n = 0 ifTrue: [ 1 ] ifFalse: [ self mult: n with: (self fac: n - 1) ]')! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 9/2/2010 11:52'! testFib self assert: (FLFactorialGrammar parse: self fib) = #('fib' #('n') '=' #('if' #('(' 'n' '==' '0' ')') 'then' '0' 'else' #('if' #('(' 'n' '==' '1' ')') 'then' '1' 'else' #('(' #('(' 'fib' #(#('(' 'n' '-' '1' ')')) ')') '+' #('(' 'fib' #(#('(' 'n' '-' '2' ')')) ')') ')')))). self assert: (FLFactorialPrinter parse: self fib) = self fib. self assert: (FLFactorialCompiler parse: self fib) = (RBParser parseMethod: 'fib: n ^ n = 0 ifTrue: [ 0 ] ifFalse: [ n = 1 ifTrue: [ 1 ] ifFalse: [ (self fib: n - 1) + (self fib: n - 2) ] ]')! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 9/2/2010 11:52'! testMul self assert: (FLFactorialGrammar parse: self mul) = #('mult' #('n' 'm') '=' #('if' #('(' 'n' '==' '0' ')') 'then' '0' 'else' #('(' 'm' '+' #('(' 'mult' #(#('(' 'n' '-' '1' ')') 'm') ')') ')'))). self assert: (FLFactorialPrinter parse: self mul) = self mul. self assert: (FLFactorialCompiler parse: self mul) = (RBParser parseMethod: 'mult: n with: m ^ n = 0 ifTrue: [ 0 ] ifFalse: [ m + (self mult: n - 1 with: m) ]')! !