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 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.! FLFactorialParser subclass: #FLFactorialCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !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 5/19/2008 11:43'! 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 5/19/2008 11:44'! 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 methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! apply ^ super apply ==> [ :node | '(' , node second , ' ' , (node third fold: [ :a :b | a , ' ' , b ]) , ')' ]! ! !FLFactorialPrinter methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:45'! binary ^ super binary ==> [ :node | '(' , node second , ' ' , node third , ' ' , node fourth , ')' ]! ! !FLFactorialPrinter methodsFor: 'grammar' stamp: 'lr 5/19/2008 11:46'! condition ^ super condition ==> [ :node | 'if ' , node second , ' then ' , node fourth , ' else ' , node sixth ]! ! !FLFactorialPrinter 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: #FLFactorialExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Factorial-Language'! !FLFactorialExample class methodsFor: 'accessing' stamp: 'lr 5/19/2008 15:16'! compilerClass ^ PPCompilerAdapter on: PPFactorialCompiler! ! !FLFactorialExample class methodsFor: 'accessing' stamp: 'lr 5/21/2008 16:45'! sourceCodeAt: aSelector ^ self sourceCodeAt: aSelector ifAbsent: [ nil ]! ! !FLFactorialExample class methodsFor: 'accessing' stamp: 'lr 5/19/2008 16:30'! sourceCodeAt: aSelector ifAbsent: aBlock ^ (self methodDictionary at: aSelector ifAbsent: [ ^ aBlock value ]) getSourceFromFile! ! !FLFactorialExample 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)))! ! !FLFactorialExample methodsFor: 'factorial' stamp: 'lr 5/21/2008 00:52'! fac n = if (n==0) then 1 else (mult n (fac (n - 1)))! ! !FLFactorialExample 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)))! ! !FLFactorialExample methodsFor: 'factorial' stamp: 'lr 5/21/2008 00:52'! mult n m = if (n==0) then 0 else (m + (mult (n - 1) m))! !