SystemOrganization addCategory: #'Factorial-Language'! PPCompositeParser subclass: #FLFactorialParser 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'! !FLFactorialParser 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.! FLFactorialParser 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 ]! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! add ^ $+ asParser flatten! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! apply ^ open , id , expression star , close! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! binary ^ open , expression , operation , expression , close! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! close ^ $) asParser flatten! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! cmp ^ '==' asParser flatten! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! condition ^ if , expression , then , expression , else , expression! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! else ^ 'else' asParser flatten! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! equal ^ $= asParser flatten! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:09'! expression ^ apply / condition / binary / variable / literal! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! function ^ id , variable star , equal , expression! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! id ^ #letter asParser plus flatten! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! if ^ 'if' asParser flatten! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:44'! literal ^ num! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! num ^ #digit asParser plus flatten! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! open ^ $( asParser flatten! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 4/3/2009 08:09'! operation ^ cmp / add / sub! ! !FLFactorialParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:43'! start ^ function end! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:59'! sub ^ $- asParser flatten! ! !FLFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:45'! then ^ 'then' asParser flatten! ! !FLFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:51'! variable ^ id! ! FLFactorialParser 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 4/3/2009 08:15'! testAck self assert: (FLFactorialParser 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) isKindOf: RBProgramNode)! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 4/3/2009 08:16'! testFac self assert: (FLFactorialParser 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) isKindOf: RBProgramNode)! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 4/3/2009 08:17'! testFib self assert: (FLFactorialParser 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) isKindOf: RBProgramNode)! ! !FLFactorialExample methodsFor: 'testing' stamp: 'lr 4/3/2009 08:17'! testMul self assert: (FLFactorialParser 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) isKindOf: RBProgramNode)! !