SystemOrganization addCategory: #'Factorial-Language'! PPCompositeParser subclass: #PPFactorialParser 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'! !PPFactorialParser commentStamp: 'lr 5/21/2008 00:54' prior: 0! FL -- The factorial language. This is a toy functional language. It provides first-order function definitions on integers. There are built-in operations for equality, addition, substraction. The language is powerful enough to define the factorial function. Copyright (c) 2008, Ralf Laemmel and contributors to the SLPS project All rights reserved.! PPFactorialParser subclass: #PPFactorialCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !PPFactorialCompiler 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 ]! ! !PPFactorialCompiler 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) ]! ! !PPFactorialCompiler 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)))) ]! ! !PPFactorialCompiler 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) ]! ! !PPFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:49'! literal ^ super literal ==> [ :node | RBLiteralNode value: node asNumber ]! ! !PPFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/21/2008 00:56'! operation ^ super operation ==> [ :node | node = '==' ifTrue: [ #= ] ifFalse: [ node asSymbol ] ]! ! !PPFactorialCompiler 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! ! !PPFactorialCompiler methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! variable ^ super variable ==> [ :node | RBVariableNode named: node ]! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! add ^ $+ asParser flatten! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! apply ^ open , id , expression star , close! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! binary ^ open , expression , operation , expression , close! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! close ^ $) asParser flatten! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! cmp ^ '==' asParser flatten! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! condition ^ if , expression , then , expression , else , expression! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! else ^ 'else' asParser flatten! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! equal ^ $= asParser flatten! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! expression ^ apply | condition | binary | variable | literal! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:43'! function ^ id , variable star , equal , expression! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! id ^ #letter asParser plus flatten! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! if ^ 'if' asParser flatten! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:44'! literal ^ num! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! num ^ #digit asParser plus flatten! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:44'! open ^ $( asParser flatten! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:44'! operation ^ cmp | add | sub! ! !PPFactorialParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:43'! start ^ function end! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:59'! sub ^ $- asParser flatten! ! !PPFactorialParser methodsFor: 'token' stamp: 'lr 5/19/2008 11:45'! then ^ 'then' asParser flatten! ! !PPFactorialParser methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:51'! variable ^ id! ! PPFactorialParser subclass: #PPFactorialPrinter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !PPFactorialPrinter methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! apply ^ super apply ==> [ :node | '(' , node second , ' ' , (node third fold: [ :a :b | a , ' ' , b ]) , ')' ]! ! !PPFactorialPrinter methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! binary ^ super binary ==> [ :node | '(' , node second , ' ' , node third , ' ' , node fourth , ')' ]! ! !PPFactorialPrinter methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:46'! condition ^ super condition ==> [ :node | 'if ' , node second , ' then ' , node fourth , ' else ' , node sixth ]! ! !PPFactorialPrinter methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:46'! function ^ super function ==> [ :node | node first , ' ' , (node second fold: [ :a :b | a , ' ' , b ]) , ' = ' , node fourth ]! ! Object subclass: #PPFactorialExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !PPFactorialExample class methodsFor: 'accessing' stamp: 'lr 5/19/2008 15:16'! compilerClass ^ PPCompilerAdapter on: PPFactorialCompiler! ! !PPFactorialExample class methodsFor: 'accessing' stamp: 'lr 5/21/2008 16:45'! sourceCodeAt: aSelector ^ self sourceCodeAt: aSelector ifAbsent: [ nil ]! ! !PPFactorialExample class methodsFor: 'accessing' stamp: 'lr 5/19/2008 16:30'! sourceCodeAt: aSelector ifAbsent: aBlock ^ (self methodDictionary at: aSelector ifAbsent: [ ^ aBlock value ]) getSourceFromFile! ! !PPFactorialExample methodsFor: 'other' stamp: 'lr 5/21/2008 00:58'! 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)))! ! !PPFactorialExample methodsFor: 'factorial' stamp: 'lr 5/21/2008 00:52'! fac n = if (n==0) then 1 else (mult n (fac (n - 1)))! ! !PPFactorialExample methodsFor: 'other' stamp: 'lr 5/21/2008 00:59'! fib n = if (n == 0) then 0 else if (n == 1) then 1 else ((fib (n - 1)) + (fib (n - 2)))! ! !PPFactorialExample methodsFor: 'factorial' stamp: 'lr 5/21/2008 00:52'! mult n m = if (n==0) then 0 else (m + (mult (n - 1) m))! !