SystemOrganization addCategory: #'PetitParser-Core'!
SystemOrganization addCategory: #'PetitParser-Builder'!
SystemOrganization addCategory: #'PetitParser-Tests'!

!Set methodsFor: '*petitparser' stamp: 'lr 4/19/2008 19:58'!
asParser
	^ self 
		inject: PPChoiceParser new
		into: [ :result :each | result | each asParser ]! !

!PositionableStream methodsFor: '*petitparser' stamp: 'lr 5/19/2008 15:21'!
asParserStream
	^ collection asParserStream! !

!PositionableStream methodsFor: '*petitparser' stamp: 'lr 4/19/2008 13:17'!
collection
	^ collection! !

TestCase subclass: #PPCompositeParserTest
	instanceVariableNames: 'parser'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Tests'!

!PPCompositeParserTest methodsFor: 'utilities' stamp: 'lr 4/28/2008 11:54'!
assert: aCollection is: anObject
	| stream result |
	stream := PPStream on: aCollection.
	result := parser parse: stream.
	self 
		assert: result = anObject
		description: 'Got: ' , result printString , '; Expected: ' , anObject printString
		resumable: true! !

!PPCompositeParserTest methodsFor: 'accessing' stamp: 'lr 4/21/2008 09:24'!
parseClass
	self subclassResponsibility! !

!PPCompositeParserTest methodsFor: 'running' stamp: 'lr 4/21/2008 09:24'!
setUp
	super setUp.
	parser := self parseClass new! !

PPCompositeParserTest subclass: #PPExpressionParserTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Tests'!

!PPExpressionParserTest methodsFor: 'accessing' stamp: 'lr 4/21/2008 09:25'!
parseClass
	^ PPExpressionParser! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 17:21'!
testAdd
	self assert: '1 + 2' is: 3.
	self assert: '2 + 1' is: 3.
	self assert: '1 + 2.3' is: 3.3.
	self assert: '2.3 + 1' is: 3.3.
	self assert: '1 + -2' is: -1.
	self assert: '-2 + 1' is: -1! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 10:23'!
testAddMany
	self assert: '1' is: 1.
	self assert: '1 + 2' is: 3.
	self assert: '1 + 2 + 3' is: 6.
	self assert: '1 + 2 + 3 + 4' is: 10.
	self assert: '1 + 2 + 3 + 4 + 5' is: 15! !

!PPExpressionParserTest methodsFor: 'testing-expression' stamp: 'lr 4/21/2008 10:03'!
testBrackets
	self assert: '(1)' is: 1.
	self assert: '(1 + 2)' is: 3.
	
	self assert: '((1))' is: 1.
	self assert: '((1 + 2))' is: 3.

	self assert: '2 * (3 + 4)' is: 14.
	self assert: '(2 + 3) * 4' is: 20.
	self assert: '6 / (2 + 4)' is: 1.
	self assert: '(2 + 6) / 2' is: 4! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 09:32'!
testDiv
	self assert: '12 / 3' is: 4.
	self assert: '-16 / -4' is: 4! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 09:31'!
testMul
	self assert: '2 * 3' is: 6.
	self assert: '2 * -4' is: -8! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 10:16'!
testMulMany
	self assert: '1 * 2' is: 2.
	self assert: '1 * 2 * 3' is: 6.
	self assert: '1 * 2 * 3 * 4' is: 24.
	self assert: '1 * 2 * 3 * 4 * 5' is: 120! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 09:32'!
testNum
	self assert: '0' is: 0.
	self assert: '0.0' is: 0.0.
	self assert: '1' is: 1.
	self assert: '1.2' is: 1.2.
	self assert: '34' is: 34.
	self assert: '56.78' is: 56.78.
	self assert: '-9' is: -9.
	self assert: '-9.9' is: -9.9! !

!PPExpressionParserTest methodsFor: 'testing-expression' stamp: 'lr 4/21/2008 10:00'!
testPriority
	self assert: '2 * 3 + 4' is: 10.
	self assert: '2 + 3 * 4' is: 14.
	self assert: '6 / 3 + 4' is: 6.
	self assert: '2 + 6 / 2' is: 5! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/28/2008 11:55'!
testSub
	self assert: '1 - 2' is: -1.
	self assert: '1.3 - 2' is: -0.7.
	self assert: '1 - -2' is: 3.
	self assert: '-1 - -2' is: 1! !

!PPExpressionParserTest methodsFor: 'testing' stamp: 'lr 4/28/2008 11:56'!
testSubMany
	self assert: '1' is: 1.
	self assert: '1 - 2' is: -1.
	self assert: '1 - 2 - 3' is: -4.
	self assert: '1 - 2 - 3 - 4' is: -8.
	self assert: '1 - 2 - 3 - 4 - 5' is: -13! !

PPCompositeParserTest subclass: #PPLambdaParserTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Tests'!

!PPLambdaParserTest methodsFor: 'accessing' stamp: 'lr 4/21/2008 10:41'!
parseClass
	^ PPLambdaParser! !

!PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:38'!
testAbstraction
	self assert: '\x.y' is: #('x' 'y').
	self assert: '\x.\y.z' is: #('x' ('y' 'z'))! !

!PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:38'!
testApplication
	self assert: '(x x)' is: #('x' 'x').
	self assert: '(x y)' is: #('x' 'y').
	self assert: '((x y) z)' is: #(('x' 'y') 'z').
	self assert: '(x (y z))' is: #('x' ('y' 'z'))! !

!PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:33'!
testVariable
	self assert: 'x' is: 'x'.
	self assert: 'xy' is: 'xy'.
	self assert: 'x12' is: 'x12'! !

TestCase subclass: #PPParserTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Tests'!

!PPParserTest methodsFor: 'utilities' stamp: 'lr 4/21/2008 16:21'!
assert: aParser fail: aCollection
	| stream result |
	stream := PPStream on: aCollection.
	result := aParser parse: stream.
	self assert: result isFailure.
	self assert: stream position = 0! !

!PPParserTest methodsFor: 'utilities' stamp: 'lr 4/29/2008 10:46'!
assert: aParser parse: aCollection to: anObject
	self assert: aParser parse: aCollection to: anObject end: aCollection size ! !

!PPParserTest methodsFor: 'utilities' stamp: 'lr 5/19/2008 10:57'!
assert: aParser parse: aCollection to: anObject end: anInteger
	| stream result |
	stream := PPStream on: aCollection.
	result := aParser parse: stream.
	self assert: result value = anObject.
	self assert: stream position = anInteger! !

!PPParserTest methodsFor: 'examples' stamp: 'lr 5/19/2008 10:56'!
comment
	^ ($" asParser , $" asParser not star , $" asParser) flatten! !

!PPParserTest methodsFor: 'examples' stamp: 'lr 5/19/2008 10:56'!
identifier
	^ (#letter asParser , #word asParser star) flatten! !

!PPParserTest methodsFor: 'examples' stamp: 'lr 5/19/2008 10:57'!
integer
	^ (#digit asParser plus) flatten! !

!PPParserTest methodsFor: 'examples' stamp: 'lr 5/19/2008 10:57'!
number
	^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testAction
	| parser |
	parser := #any asParser ==> [ :a | a asUppercase ].
	
	self assert: parser parse: 'a' to: $A.
	
	self assert: parser parse: 'ba' to: $B end: 1.
	self assert: parser parse: 'cba' to: $C end: 1.
	
	self assert: parser fail: ''! !

!PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/29/2008 11:04'!
testCharacter
	| parser |
	parser := $a asParser.	
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'aa' to: $a end: 1.
	self assert: parser fail: ''.
	self assert: parser fail: 'b'.
	self assert: parser fail: 'A'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testChoice
	| parser |
	parser := $a asParser | $b asParser.
	
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'b' to: $b.

	self assert: parser parse: 'ab' to: $a end: 1.
	self assert: parser parse: 'ba' to: $b end: 1.

	self assert: parser fail: ''.
	self assert: parser fail: 'c'.
	self assert: parser fail: 'ca'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 5/7/2008 08:58'!
testDelimitedBy
	| parser |
	parser := $a asParser delimitedBy: $b asParser.
	
	self assert: parser parse: 'a' to: #($a).
	self assert: parser parse: 'aba' to: #($a $b $a).
	self assert: parser parse: 'ababa' to: #($a $b $a $b $a).

	self assert: parser parse: 'ab' to: #($a $b).
	self assert: parser parse: 'abab' to: #($a $b $a $b).
	self assert: parser parse: 'ababab' to: #($a $b $a $b $a $b).
	
	self assert: parser parse: 'ac' to: #($a) end: 1.
	self assert: parser parse: 'abc' to: #($a $b) end: 2.
	self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
	self assert: parser parse: 'ababc' to: #($a $b $a $b) end: 4.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'b'.
	self assert: parser fail: 'c'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testEndOfInput
	| parser |
	parser := PPEndOfInputParser new.
	
	self assert: parser parse: '' to: nil.
	self assert: parser fail: 'a'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testEpsilon
	| parser |
	parser := PPEpsilonParser new.
	
	self assert: parser parse: '' to: nil.
	
	self assert: parser parse: 'a' to: nil end: 0.
	self assert: parser parse: 'ab' to: nil end: 0! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testFailing
	| parser |
	parser := PPFailingParser new.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser fail: 'aa'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 5/19/2008 10:57'!
testFlatten
	| parser |
	parser := $a asParser flatten.
	
	self assert: parser parse: 'a' to: 'a'.
	self assert: parser parse: 'a ' to: 'a'.
	self assert: parser parse: 'a	' to: 'a'.
	self assert: parser parse: 'a  ' to: 'a'.
	
	self assert: parser parse: 'a a' to: 'a' end: 2.
	self assert: parser parse: 'a	a' to: 'a' end: 2.
	self assert: parser parse: 'a  a' to: 'a' end: 3.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'b'.
	self assert: parser fail: ' a'! !

!PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/29/2008 11:05'!
testInterval
	| parser |
	parser := (1 to: 3) asParser.
	self assert: parser parse: #(1) to: 1.
	self assert: parser parse: #(2) to: 2.
	self assert: parser parse: #(3) to: 3.
	self assert: parser parse: #(1 2) to: 1 end: 1.
	self assert: parser parse: #(2 3) to: 2 end: 1.
	self assert: parser parse: #(3 4) to: 3 end: 1.
	self assert: parser fail: #(0).
	self assert: parser fail: #(4)! !

!PPParserTest methodsFor: 'testing-composed' stamp: 'lr 5/19/2008 11:00'!
testListOfIntegers
	"S ::= S , number | number"
	
	| number list parser |
	number := self integer ==> #asInteger.
	list := (number separatedBy: $, asParser flatten)
		==> [ :node | node select: [ :each | each isInteger ] ].
	parser := list end.

	self assert: parser parse: '1' to: (1 to: 1) asArray.
	self assert: parser parse: '1,2' to: (1 to: 2) asArray.
	self assert: parser parse: '1,2,3' to: (1 to: 3) asArray.
	self assert: parser parse: '1,2,3,4' to: (1 to: 4) asArray.
	self assert: parser parse: '1,2,3,4,5' to: (1 to: 5) asArray.

	self assert: parser parse: '1' to: (1 to: 1) asArray.
	self assert: parser parse: '1, 2' to: (1 to: 2) asArray.
	self assert: parser parse: '1, 2, 3' to: (1 to: 3) asArray.
	self assert: parser parse: '1, 2, 3, 4' to: (1 to: 4) asArray.
	self assert: parser parse: '1, 2, 3, 4, 5' to: (1 to: 5) asArray.

	self assert: parser parse: '1' to: (1 to: 1) asArray.
	self assert: parser parse: '1 ,2' to: (1 to: 2) asArray.
	self assert: parser parse: '1 ,2 ,3' to: (1 to: 3) asArray.
	self assert: parser parse: '1 ,2 ,3 ,4' to: (1 to: 4) asArray.
	self assert: parser parse: '1 ,2 ,3 ,4 ,5' to: (1 to: 5) asArray.
	
	self assert: parser fail: ''.
	self assert: parser fail: ','.
	self assert: parser fail: '1,'.
	self assert: parser fail: '1,,2'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testOptional
	| parser |
	parser := $a asParser optional.
	
	self assert: parser parse: '' to: nil.
	self assert: parser parse: 'a' to: $a.
	
	self assert: parser parse: 'aa' to: $a end: 1.
	self assert: parser parse: 'ab' to: $a end: 1.
	self assert: parser parse: 'b' to: nil end: 0.
	self assert: parser parse: 'bb' to: nil end: 0.
	self assert: parser parse: 'ba' to: nil end: 0! !

!PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/29/2008 11:06'!
testOrdered
	| parser |
	parser := #(1 2) asParser.
	self assert: parser parse: #(1 2) to: #(1 2).
	self assert: parser parse: #(1 2 3) to: #(1 2) end: 2.
	self assert: parser fail: #().
	self assert: parser fail: #(1).
	self assert: parser fail: #(1 1).
	self assert: parser fail: #(1 1 2)! !

!PPParserTest methodsFor: 'testing-composed' stamp: 'lr 5/19/2008 10:55'!
testPalindrome
	"S0 ::= a S1 a | b S1 b | ...
	 S1 ::= S0 | epsilon"
	
	| s0 s1 parser |
	s0 := PPChoiceParser new.
	s1 := PPChoiceParser new.
	s0 | ($a asParser , s1 , $a asParser).
	s0 | ($b asParser , s1 , $b asParser).	
	s0 | ($c asParser , s1 , $c asParser).	
	s1 | s0 | PPEpsilonParser new.
	parser := s0 flatten end.

	self assert: parser parse: 'aa' to: 'aa'.
	self assert: parser parse: 'bb' to: 'bb'.
	self assert: parser parse: 'cc' to: 'cc'.
	
	self assert: parser parse: 'abba' to: 'abba'.
	self assert: parser parse: 'baab' to: 'baab'.

	self assert: parser parse: 'abccba' to: 'abccba'.
	self assert: parser parse: 'abaaba' to: 'abaaba'.
	self assert: parser parse: 'cbaabc' to: 'cbaabc'.

	self assert: parser fail: 'a'.
	self assert: parser fail: 'ab'.
	self assert: parser fail: 'aab'.
	self assert: parser fail: 'abccbb'! !

!PPParserTest methodsFor: 'testing-composed' stamp: 'lr 5/19/2008 11:01'!
testParseAaaBbb
	"S0 ::= a S1 b
	 S1 ::= S0 | epsilon"
	
	| s0 s1 parser |
	s0 := $a asParser , (s1 := PPChoiceParser new) , $b asParser.
	s1 | s0 | PPEpsilonParser new.
	parser := s0 flatten.

	self assert: parser parse: 'ab' to: 'ab'.
	self assert: parser parse: 'aabb' to: 'aabb'.
	self assert: parser parse: 'aaabbb' to: 'aaabbb'.
	self assert: parser parse: 'aaaabbbb' to: 'aaaabbbb'.

	self assert: parser parse: 'abb' to: 'ab' end: 2.
	self assert: parser parse: 'aabbb' to: 'aabb' end: 4.
	self assert: parser parse: 'aaabbbb' to: 'aaabbb' end: 6.
	self assert: parser parse: 'aaaabbbbb' to: 'aaaabbbb' end: 8.

	self assert: parser fail: 'a'.
	self assert: parser fail: 'b'.
	self assert: parser fail: 'aab'.
	self assert: parser fail: 'aaabb'! !

!PPParserTest methodsFor: 'testing-composed' stamp: 'lr 5/19/2008 11:01'!
testParseAbAbAb
	"S ::= (A B)+"
	
	| parser |
	parser := ($a asParser , $b asParser) plus flatten.

	self assert: parser parse: 'ab' to: 'ab'.
	self assert: parser parse: 'abab' to: 'abab'.
	self assert: parser parse: 'ababab' to: 'ababab'.
	self assert: parser parse: 'abababab' to: 'abababab'.

	self assert: parser parse: 'abb' to: 'ab' end: 2.
	self assert: parser parse: 'ababa' to: 'abab' end: 4.
	self assert: parser parse: 'abababb' to: 'ababab' end: 6.
	self assert: parser parse: 'ababababa' to: 'abababab' end: 8.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser fail: 'bab'! !

!PPParserTest methodsFor: 'testing-composed' stamp: 'lr 5/19/2008 11:01'!
testParseAbabbb
	"S ::= (A | B)+"

	| parser |
	parser := ($a asParser | $b asParser) plus flatten.

	self assert: parser parse: 'a' to: 'a'.
	self assert: parser parse: 'b' to: 'b'.
	self assert: parser parse: 'ab' to: 'ab'.
	self assert: parser parse: 'ba' to: 'ba'.
	self assert: parser parse: 'aaa' to: 'aaa'.
	self assert: parser parse: 'aab' to: 'aab'.
	self assert: parser parse: 'aba' to: 'aba'.
	self assert: parser parse: 'baa' to: 'baa'.
	self assert: parser parse: 'abb' to: 'abb'.
	self assert: parser parse: 'bab' to: 'bab'.
	self assert: parser parse: 'bba' to: 'bba'.
	self assert: parser parse: 'bbb' to: 'bbb'.

	self assert: parser parse: 'ac' to: 'a' end: 1.
	self assert: parser parse: 'bc' to: 'b' end: 1.
	self assert: parser parse: 'abc' to: 'ab' end: 2.
	self assert: parser parse: 'bac' to: 'ba' end: 2.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'c'! !

!PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/29/2008 11:00'!
testParseComment
	self assert: self comment parse: '""' to: '""'.
	self assert: self comment parse: '"a"' to: '"a"'.
	self assert: self comment parse: '"ab"' to: '"ab"'.
	self assert: self comment parse: '"abc"' to: '"abc"'.

	self assert: self comment parse: '""a' to: '""' end: 2.
	self assert: self comment parse: '"a"a' to: '"a"' end: 3.
	self assert: self comment parse: '"ab"a' to: '"ab"' end: 4.
	self assert: self comment parse: '"abc"a' to: '"abc"' end: 5.

	self assert: self comment fail: '"'.
	self assert: self comment fail: '"a'.
	self assert: self comment fail: '"aa'.
	self assert: self comment fail: 'a"'.
	self assert: self comment fail: 'aa"'! !

!PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/29/2008 11:01'!
testParseIdentifier
	self assert: self identifier parse: 'a' to: 'a'.
	self assert: self identifier parse: 'a1' to: 'a1'.
	self assert: self identifier parse: 'a12' to: 'a12'.
	self assert: self identifier parse: 'ab' to: 'ab'.
	self assert: self identifier parse: 'a1b' to: 'a1b'.

	self assert: self identifier parse: 'a_' to: 'a' end: 1.
	self assert: self identifier parse: 'a1-' to: 'a1' end: 2.
	self assert: self identifier parse: 'a12+' to: 'a12' end: 3.
	self assert: self identifier parse: 'ab^' to: 'ab' end: 2.
	self assert: self identifier parse: 'a1b*' to: 'a1b' end: 3.

	self assert: self identifier fail: ''.
	self assert: self identifier fail: ' '.
	self assert: self identifier fail: '1'.
	self assert: self identifier fail: '1a'! !

!PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/29/2008 11:02'!
testParseNumber
	self assert: self number parse: '1' to: '1'.
	self assert: self number parse: '12' to: '12'.
	self assert: self number parse: '12.3' to: '12.3'.
	self assert: self number parse: '12.34' to: '12.34'.

	self assert: self number parse: '1..' to: '1' end: 1.
	self assert: self number parse: '12-' to: '12' end: 2.
	self assert: self number parse: '12.3.' to: '12.3' end: 4.
	self assert: self number parse: '12.34.' to: '12.34' end: 5.
	
	self assert: self number parse: '-1' to: '-1'.
	self assert: self number parse: '-12' to: '-12'.
	self assert: self number parse: '-12.3' to: '-12.3'.
	self assert: self number parse: '-12.34' to: '-12.34'.
	
	self assert: self number fail: ''.
	self assert: self number fail: '-'.
	self assert: self number fail: '.'.
	self assert: self number fail: '.1'! !

!PPParserTest methodsFor: 'testing-examples' stamp: 'lr 5/19/2008 11:00'!
testParseReturn
	| number spaces return |
	number := #digit asParser plus flatten.
	spaces := #space asParser star.
	return := (spaces , $^ asParser , spaces , number)
		==> [ :nodes | { #return. nodes at: 4 } ].

	self assert: return parse: '^1' to: #(return '1').
	self assert: return parse: ' ^12' to: #(return '12').
	self assert: return parse: '^123 ' to: #(return '123').
	self assert: return parse: '^ 1234' to: #(return '1234').
	
	self assert: return fail: '1'.
	self assert: return fail: '^'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 5/15/2008 16:18'!
testPeek
	| parser |
	parser := $a asParser peek.
	
	self assert: parser parse: 'a' to: $a end: 0.
	self assert: parser fail: 'b'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'!
testPlus
	| parser |
	parser := $a asParser plus.
	
	self assert: parser parse: 'a' to: #($a).
	self assert: parser parse: 'aa' to: #($a $a).
	self assert: parser parse: 'aaa' to: #($a $a $a).
	
	self assert: parser parse: 'ab' to: #($a) end: 1.
	self assert: parser parse: 'aab' to: #($a $a) end: 2.
	self assert: parser parse: 'aaab' to: #($a $a $a) end: 3.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'b'.
	self assert: parser fail: 'ba'! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:10'!
testPredicateAny
	| parser |
	parser := #any asParser.
	self assert: parser parse: ' ' to: $ .
	self assert: parser parse: '1' to: $1.
	self assert: parser parse: 'a' to: $a.
	self assert: parser fail: ''.
	self assert: parser not fail: ''.
	self assert: parser not fail: '1'.
	self assert: parser not fail: 'a'! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:10'!
testPredicateCharacter
	| parser |
	parser := $* asParser.
	self assert: parser parse: '*' to: $*.
	self assert: parser parse: '**' to: $* end: 1.
	self assert: parser fail: ''.
	self assert: parser fail: '1'.
	self assert: parser fail: 'a'.
	self assert: parser not parse: '1' to: $1.
	self assert: parser not parse: 'a' to: $a.
	self assert: parser not fail: '*'.
	self assert: parser not fail: ''! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:10'!
testPredicateControl
	| parser |
	parser := #control asParser.
	self assert: parser parse: String cr to: Character cr.
	self assert: parser parse: String tab to: Character tab.
	self assert: parser fail: ''.
	self assert: parser fail: '1'.
	self assert: parser fail: 'a'.
	self assert: parser not parse: '1' to: $1.
	self assert: parser not parse: 'a' to: $a.
	self assert: parser not fail: ''.
	self assert: parser not fail: String cr.
	self assert: parser not fail: String tab! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:10'!
testPredicateDigit
	| parser |
	parser := #digit asParser.
	self assert: parser parse: '0' to: $0.
	self assert: parser parse: '9' to: $9.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser not parse: ' ' to: $ .
	self assert: parser not parse: 'a' to: $a.
	self assert: parser not fail: ''.
	self assert: parser not fail: '0'! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:11'!
testPredicateLetter
	| parser |
	parser := #letter asParser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'Z' to: $Z.
	self assert: parser fail: ''.
	self assert: parser fail: '0'.
	self assert: parser not parse: '1' to: $1.
	self assert: parser not parse: ' ' to: $ .
	self assert: parser not fail: ''.
	self assert: parser not fail: 'a'! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:11'!
testPredicateLowercase
	| parser |
	parser := #lowercase asParser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'z' to: $z.
	self assert: parser fail: ''.
	self assert: parser fail: 'A'.
	self assert: parser fail: '0'.
	self assert: parser not parse: 'A' to: $A.
	self assert: parser not parse: 'Z' to: $Z.
	self assert: parser not fail: ''.
	self assert: parser not fail: 'a'.
	self assert: parser not fail: '0'! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:12'!
testPredicateSpace
	| parser |
	parser := #space asParser.
	self assert: parser parse: String tab to: Character tab.
	self assert: parser parse: ' ' to: Character space.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser not parse: 'a' to: $a.
	self assert: parser not parse: '/' to: $/.
	self assert: parser not fail: ''.
	self assert: parser not fail: ' '! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:12'!
testPredicateUppercase
	| parser |
	parser := #uppercase asParser.
	self assert: parser parse: 'A' to: $A.
	self assert: parser parse: 'Z' to: $Z.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser fail: '0'.
	self assert: parser not parse: 'a' to: $a.
	self assert: parser not parse: 'z' to: $z.
	self assert: parser not fail: ''.
	self assert: parser not fail: 'A'.
	self assert: parser not fail: '0'! !

!PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/29/2008 11:12'!
testPredicateWord
	| parser |
	parser := #word asParser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'A' to: $A.
	self assert: parser parse: '0' to: $0.
	self assert: parser fail: ''.
	self assert: parser fail: '-'.
	self assert: parser not parse: ' ' to: $ .
	self assert: parser not parse: '-' to: $-.
	self assert: parser not fail: ''.
	self assert: parser not fail: 'a'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:42'!
testSeparatedBy
	| parser |
	parser := $a asParser separatedBy: $b asParser.
	
	self assert: parser parse: 'a' to: #($a).
	self assert: parser parse: 'aba' to: #($a $b $a).
	self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
	
	self assert: parser parse: 'ab' to: #($a) end: 1.
	self assert: parser parse: 'abab' to: #($a $b $a) end: 3.
	self assert: parser parse: 'ac' to: #($a) end: 1.
	self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'c'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'!
testSequence
	| parser |
	parser := $a asParser , $b asParser.
	
	self assert: parser parse: 'ab' to: #($a $b).
	
	self assert: parser parse: 'aba' to: #($a $b) end: 2.
	self assert: parser parse: 'abb' to: #($a $b) end: 2.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser fail: 'aa'.
	self assert: parser fail: 'ba'.
	self assert: parser fail: 'bab'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'!
testStar
	| parser |
	parser := $a asParser star.
	
	self assert: parser parse: '' to: #().
	self assert: parser parse: 'a' to: #($a).
	self assert: parser parse: 'aa' to: #($a $a).
	self assert: parser parse: 'aaa' to: #($a $a $a).
	
	self assert: parser parse: 'b' to: #() end: 0.
	self assert: parser parse: 'ab' to: #($a) end: 1.
	self assert: parser parse: 'aab' to: #($a $a) end: 2.
	self assert: parser parse: 'aaab' to: #($a $a $a) end: 3! !

!PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/29/2008 11:07'!
testString
	| parser |
	parser := 'ab' asParser.
	self assert: parser parse: 'ab' to: #($a $b).
	self assert: parser parse: 'aba' to: #($a $b) end: 2.
	self assert: parser parse: 'abb' to: #($a $b) end: 2.
	self assert: parser fail: 'a'.
	self assert: parser fail: 'ac'! !

!PPParserTest methodsFor: 'testing' stamp: 'lr 5/19/2008 11:01'!
testToken
	| parser |
	parser := $a asParser token.
	
	self assert: parser parse: 'a' to: 'a'.
	self assert: parser parse: 'a ' to: 'a'.
	self assert: parser parse: 'a	' to: 'a'.
	self assert: parser parse: 'a  ' to: 'a'.
	
	self assert: parser parse: 'a a' to: 'a' end: 2.
	self assert: parser parse: 'a	a' to: 'a' end: 2.
	self assert: parser parse: 'a  a' to: 'a' end: 3.
	
	self assert: parser fail: ''.
	self assert: parser fail: 'b'.
	self assert: parser fail: ' a'! !

!PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/29/2008 11:08'!
testUnordered
	| parser |
	parser := #(1 2) asSet asParser.
	self assert: parser parse: #(1) to: 1.
	self assert: parser parse: #(2) to: 2.
	self assert: parser parse: #(1 2) to: 1 end: 1.
	self assert: parser parse: #(2 1) to: 2 end: 1.
	self assert: parser fail: #().
	self assert: parser fail: #(3)! !

!Text methodsFor: '*petitparser' stamp: 'lr 5/19/2008 15:10'!
asParserStream
	^ string asParserStream! !

!SequenceableCollection methodsFor: '*petitparser' stamp: 'lr 4/19/2008 19:58'!
asParser
	^ self 
		inject: PPSequenceParser new
		into: [ :result :each | result , each asParser ]! !

!SequenceableCollection methodsFor: '*petitparser' stamp: 'lr 5/19/2008 15:22'!
asParserStream
	^ PPStream on: self! !

!Object methodsFor: '*petitparser' stamp: 'lr 4/20/2008 16:06'!
asParser
	^ PPPredicateParser expect: self! !

!Object methodsFor: '*petitparser-testing' stamp: 'lr 4/18/2008 13:40'!
isFailure
	^ false! !

Object subclass: #PPCompilerAdapter
	instanceVariableNames: 'parserClass'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

!PPCompilerAdapter class methodsFor: 'instance-creation' stamp: 'lr 5/19/2008 15:03'!
on: aParserClass
	^ self basicNew initializeOn: aParserClass! !

!PPCompilerAdapter methodsFor: 'compiling' stamp: 'lr 5/19/2008 15:23'!
compile: aString in: aClass classified: aSymbol notifying: aRequestor ifFail: aBlock
	^ self parserClass
		parse: aString
		ifError: [ :error |
			^ aRequestor requestor
				notify: error reason
				at: error position + 1
				in: aString ]! !

!PPCompilerAdapter methodsFor: 'decompiling' stamp: 'lr 5/19/2008 16:32'!
decompile: aSelector in: aClass method: aCompiledMethod
	^ Decompiler new decompile: aSelector in: aClass method: aCompiledMethod! !

!PPCompilerAdapter methodsFor: 'accessing' stamp: 'lr 5/19/2008 15:27'!
decompilerClass
	^ self! !

!PPCompilerAdapter methodsFor: 'initialization' stamp: 'lr 5/19/2008 15:04'!
initializeOn: aParserClass
	parserClass := aParserClass! !

!PPCompilerAdapter methodsFor: 'adapting' stamp: 'lr 5/19/2008 15:27'!
new! !

!PPCompilerAdapter methodsFor: 'accessing' stamp: 'lr 5/19/2008 15:16'!
parserClass
	^ parserClass! !

!PPCompilerAdapter methodsFor: 'adapting' stamp: 'lr 5/19/2008 15:27'!
withTempNames: anArray! !

Object subclass: #PPFailure
	instanceVariableNames: 'reason position'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPFailure class methodsFor: 'instance-creation' stamp: 'lr 5/19/2008 12:21'!
reason: aString
	^ self basicNew reason: aString! !

!PPFailure class methodsFor: 'instance-creation' stamp: 'lr 5/19/2008 12:21'!
reason: aString at: anInteger
	^ self basicNew reason: aString; position: anInteger! !

!PPFailure methodsFor: 'testing' stamp: 'lr 4/18/2008 13:41'!
isFailure
	^ true! !

!PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'!
position
	^ position! !

!PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'!
position: anInteger
	position := anInteger! !

!PPFailure methodsFor: 'printing' stamp: 'lr 4/30/2008 10:28'!
printOn: aStream
	aStream nextPutAll: reason.
	position isNil 
		ifFalse: [ aStream nextPutAll: ' at '; print: position ]! !

!PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'!
reason
	^ reason! !

!PPFailure methodsFor: 'accessing' stamp: 'lr 4/18/2008 14:18'!
reason: aString
	reason := aString! !

Object subclass: #PPMemento
	instanceVariableNames: 'result count position'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPMemento class methodsFor: 'instance-creation' stamp: 'lr 4/22/2008 18:21'!
new
	^ self basicNew initialize! !

!PPMemento methodsFor: 'accessing-readonly' stamp: 'lr 4/22/2008 18:23'!
count
	^ count! !

!PPMemento methodsFor: 'actions' stamp: 'lr 4/22/2008 18:20'!
increment
	count := count + 1! !

!PPMemento methodsFor: 'initialization' stamp: 'lr 4/22/2008 18:21'!
initialize
	count := 0
	! !

!PPMemento methodsFor: 'accessing' stamp: 'lr 4/22/2008 18:23'!
position
	^ position! !

!PPMemento methodsFor: 'accessing' stamp: 'lr 4/26/2008 15:48'!
position: anInteger
	position := anInteger! !

!PPMemento methodsFor: 'accessing' stamp: 'lr 4/24/2008 10:15'!
result
	^ result! !

!PPMemento methodsFor: 'accessing' stamp: 'lr 4/22/2008 18:23'!
result: anObject
	result := anObject! !

Object subclass: #PPParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

PPParser subclass: #PPDelegateParser
	instanceVariableNames: 'parser'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPDelegateParser commentStamp: 'lr 4/19/2008 12:57' prior: 0!
A parser that delegates to another parser.!

PPDelegateParser subclass: #PPActionParser
	instanceVariableNames: 'block'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPActionParser commentStamp: 'lr 4/19/2008 12:55' prior: 0!
A parser that performs an action on the delegate.!

!PPActionParser methodsFor: 'parsing' stamp: 'lr 5/15/2008 15:36'!
basicParse: aStream
	| element |
	^ (element := super basicParse: aStream) isFailure
		ifFalse: [ block value: element ]
		ifTrue: [ element ]! !

!PPActionParser methodsFor: 'accessing' stamp: 'lr 4/18/2008 14:02'!
block: aBlock
	block := aBlock! !

PPDelegateParser subclass: #PPCompositeParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

!PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 5/19/2008 15:23'!
parse: aString
	^ self new parse: aString asParserStream! !

!PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 5/19/2008 11:22'!
parse: aString ifError: aBlock
	| result |
	^ (result := self parse: aString) isFailure
		ifTrue: [ aBlock value: result ]
		ifFalse: [ result ]! !

!PPCompositeParser methodsFor: 'initialization' stamp: 'lr 5/19/2008 12:24'!
initialize
	| resolved unresolved symbol |
	super initialize.
	resolved := Array new: self class instSize.
	unresolved := Array new: self class instSize.
	1 to: self class instSize do: [ :each |
		self instVarAt: each put: (unresolved at: each put: PPUnresolvedParser new) ].
	self class allInstVarNames keysAndValuesDo: [ :index :name |
		symbol := index = 1 ifTrue: [ #start ] ifFalse: [ name asSymbol ].
		(self respondsTo: symbol)
			ifTrue: [ resolved at: index put: (self perform: symbol) ]
			ifFalse: [ self error: 'Unable to initialize ' , symbol printString ].
		(resolved at: index) == self
			ifTrue: [ self error: 'Invalid definition for ' , symbol printString ] ].
	unresolved with: resolved do: [ :a :b |
		(a isKindOf: PPUnresolvedParser)
			ifTrue: [ a becomeForward: b ] ]! !

!PPCompositeParser methodsFor: 'accessing' stamp: 'lr 5/16/2008 17:32'!
start
	"Answer the production to start this parser with."
	
	self subclassResponsibility! !

PPCompositeParser subclass: #PPExpressionParser
	instanceVariableNames: 'add addop expr mul mulop num val'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

!PPExpressionParser methodsFor: 'productions-operations' stamp: 'lr 5/19/2008 11:27'!
add
	^ (mul separatedBy: addop) ==> [ :node | self evalArray: node ]! !

!PPExpressionParser methodsFor: 'productions-operations' stamp: 'lr 5/19/2008 11:27'!
addop
	^ ($+ asParser | $- asParser) flatten ==> #asSymbol! !

!PPExpressionParser methodsFor: 'private' stamp: 'lr 4/30/2008 17:30'!
evalArray: anArray
	| collection |
	collection := OrderedCollection withAll: anArray.
	[ collection size > 1 ] whileTrue: [
		collection addFirst: (collection removeFirst 
			perform: collection removeFirst 
			with: collection removeFirst) ].
	^ collection first! !

!PPExpressionParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:27'!
expr
	^ $( asParser flatten , add , $) asParser flatten ==> #second! !

!PPExpressionParser methodsFor: 'productions-operations' stamp: 'lr 5/19/2008 11:27'!
mul
	^ (val separatedBy: mulop) ==> [ :node | self evalArray: node ]! !

!PPExpressionParser methodsFor: 'productions-operations' stamp: 'lr 5/19/2008 11:27'!
mulop
	^ ($* asParser | $/ asParser) flatten ==> #asSymbol! !

!PPExpressionParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:27'!
num
	^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten ==> #asNumber! !

!PPExpressionParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:34'!
start
	^ add end! !

!PPExpressionParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:27'!
val
	^ num | expr! !

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: 'PetitParser-Builder'!

!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: 'PetitParser-Builder'!

!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: 'PetitParser-Builder'!

!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 ]! !

PPCompositeParser subclass: #PPLambdaParser
	instanceVariableNames: 'expression abstraction application variable'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

PPLambdaParser subclass: #PPLambdaCompiler
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

!PPLambdaCompiler class methodsFor: 'curch-booleans' stamp: 'lr 5/15/2008 16:27'!
and
	^ self parse: '\p.\q.((p q) p)'! !

!PPLambdaCompiler class methodsFor: 'curch-booleans' stamp: 'lr 5/15/2008 16:23'!
false
	^ self parse: '\x.\y.y'! !

!PPLambdaCompiler class methodsFor: 'curch-booleans' stamp: 'lr 5/15/2008 17:21'!
ifthenelse
	^ self parse: '\p.p'! !

!PPLambdaCompiler class methodsFor: 'curch-booleans' stamp: 'lr 5/15/2008 17:21'!
not
	^ self parse: '\p.\a.\b.((p b) a)'! !

!PPLambdaCompiler class methodsFor: 'curch-booleans' stamp: 'lr 5/15/2008 17:20'!
or
	^ self parse: '\p.\q.((p p) q)'! !

!PPLambdaCompiler class methodsFor: 'curch-booleans' stamp: 'lr 5/15/2008 16:23'!
true
	^ self parse: '\x.\y.x'! !

!PPLambdaCompiler methodsFor: 'productions' stamp: 'lr 5/19/2008 11:41'!
abstraction
	^ super abstraction ==> [ :node | RBBlockNode arguments: (Array with: node first) body: (RBSequenceNode statements: (Array with: node second)) ]! !

!PPLambdaCompiler methodsFor: 'productions' stamp: 'lr 5/19/2008 11:40'!
application
	^ super application ==> [ :node | RBMessageNode receiver: node first selector: #value: arguments: (Array with: node second) ]! !

!PPLambdaCompiler methodsFor: 'productions' stamp: 'lr 5/19/2008 11:36'!
variable
	^ super variable ==> [ :node | RBVariableNode named: node ]! !

!PPLambdaParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:35'!
abstraction
	^ $\ asParser flatten , variable , $. asParser flatten , expression ==> [ :node | Array with: node second with: node fourth ]! !

!PPLambdaParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:36'!
application
	^ $( asParser flatten , expression , expression , $) asParser flatten ==> [ :node | Array with: node second with: node third ]! !

!PPLambdaParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:38'!
expression
	^ variable | abstraction | application! !

!PPLambdaParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:35'!
start
	^ expression end! !

!PPLambdaParser methodsFor: 'productions' stamp: 'lr 5/19/2008 11:36'!
variable
	^ (#letter asParser , #word asParser star) flatten! !

PPCompositeParser subclass: #PPSchemeParser
	instanceVariableNames: 'open close boolean character number string list'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

!PPSchemeParser methodsFor: 'grammar' stamp: 'lr 5/20/2008 11:26'!
body
	! !

!PPSchemeParser methodsFor: 'grammar-literals' stamp: 'lr 5/19/2008 23:47'!
boolean
	"The standard boolean objects for true and false have external representations #t and #f."

	^ ('#t' asParser | '#f' asParser) flatten ==> [ :each | each = '#t' ]! !

!PPSchemeParser methodsFor: 'grammar-literals' stamp: 'lr 5/19/2008 23:46'!
character
	"Characters are represented using the notation #\<character>."

	^ ('#\' asParser , #any asParser) flatten ==> #second! !

!PPSchemeParser methodsFor: 'token' stamp: 'lr 5/19/2008 23:22'!
close
	^ $) asParser token! !

!PPSchemeParser methodsFor: 'grammar-expression' stamp: 'lr 5/20/2008 11:26'!
definition
	! !

!PPSchemeParser methodsFor: 'token' stamp: 'lr 5/19/2008 23:27'!
false
	^ 'false' asParser token! !

!PPSchemeParser methodsFor: 'token' stamp: 'lr 5/19/2008 23:27'!
id
	^ (#letter asParser , (#word asParser | $- asParser) star) token! !

!PPSchemeParser methodsFor: 'grammar-expression' stamp: 'lr 5/20/2008 11:26'!
lambda
	! !

!PPSchemeParser methodsFor: 'grammar-expression' stamp: 'lr 5/20/2008 11:26'!
let
	! !

!PPSchemeParser methodsFor: 'grammar-literals' stamp: 'lr 5/19/2008 23:47'!
number
	"The syntax of external representations for number objects is described formally by the <number> rule in the formal grammar."

	^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser star) optional) flatten ==> #asNumber! !

!PPSchemeParser methodsFor: 'token' stamp: 'lr 5/19/2008 23:28'!
open
	^ $( asParser token! !

!PPSchemeParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 23:21'!
start
	^ atom | expression! !

!PPSchemeParser methodsFor: 'grammar-literals' stamp: 'lr 5/19/2008 23:46'!
string
	"String are represented by sequences of characters enclosed within doublequotes."

	^ ($" asParser , $" asParser not star , $" asParser) flatten ==> [ :value | value copyFrom: 2 to: value size - 1 ]! !

!PPSchemeParser methodsFor: 'token' stamp: 'lr 5/19/2008 23:27'!
true
	^ 'true' asParser token! !

!PPDelegateParser class methodsFor: 'instance-creation' stamp: 'lr 4/20/2008 16:22'!
on: aParser
	^ self new setParser: aParser! !

!PPDelegateParser methodsFor: 'parsing' stamp: 'lr 4/21/2008 16:24'!
basicParse: aStream 
	^ parser parse: aStream! !

!PPDelegateParser methodsFor: 'initialization' stamp: 'lr 4/20/2008 16:23'!
setParser: aParser
	parser := aParser! !

PPDelegateParser subclass: #PPFlattenParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPFlattenParser commentStamp: 'lr 4/19/2008 12:54' prior: 0!
A parser that produces a token from the range my delegate parses.!

!PPFlattenParser methodsFor: 'parsing' stamp: 'lr 5/15/2008 15:59'!
basicParse: aStream
	| start element stop |
	start := aStream position.
	element := super basicParse: aStream.
	element isFailure ifTrue: [ ^ element ].
	stop := aStream position.
	self consumeSpaces: aStream.
	^ self create: aStream collection from: start + 1 to: stop! !

!PPFlattenParser methodsFor: 'hooks' stamp: 'lr 5/15/2008 15:58'!
consumeSpaces: aStream
	[ aStream atEnd not and: [ aStream peek isSeparator ] ]
		whileTrue: [ aStream next ]! !

!PPFlattenParser methodsFor: 'hooks' stamp: 'lr 5/15/2008 15:56'!
create: aCollection from: aStartInteger to: aStopInteger
	^ aCollection copyFrom: aStartInteger to: aStopInteger! !

PPFlattenParser subclass: #PPTokenParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPTokenParser methodsFor: 'hooks' stamp: 'lr 5/19/2008 10:52'!
create: aCollection from: aStartInteger to: aStopInteger
	^ PPToken on: aCollection from: aStartInteger to: aStopInteger! !

PPDelegateParser subclass: #PPPeekParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPPeekParser commentStamp: 'lr 5/15/2008 15:37' prior: 0!
A parser that peeks at the result of the delegate, but does not consume it.!

!PPPeekParser methodsFor: 'parsing' stamp: 'lr 4/28/2008 13:58'!
basicParse: aStream
	| element position |
	position := aStream position.
	element := super basicParse: aStream.
	aStream position: position.
	^ element! !

PPDelegateParser subclass: #PPStarParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPStarParser commentStamp: 'lr 5/15/2008 15:37' prior: 0!
A parser that eagerly parses zero or more instances of my delegate.!

!PPStarParser methodsFor: 'parsing' stamp: 'lr 4/30/2008 11:54'!
basicParse: aStream
	| elements element |
	elements := OrderedCollection new.
	[	element := super basicParse: aStream.
	 	element isFailure
			ifTrue: [ ^ elements asArray ].
		elements addLast: element ] repeat! !

PPParser subclass: #PPEndOfInputParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPEndOfInputParser commentStamp: 'lr 4/18/2008 13:46' prior: 0!
A parser that succeeds only at the end of the input stream.!

!PPEndOfInputParser methodsFor: 'parsing' stamp: 'lr 4/30/2008 11:54'!
basicParse: aStream
	^ aStream atEnd 
		ifFalse: [ PPFailure reason: 'end of input expected' at: aStream position ]! !

PPParser subclass: #PPEpsilonParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPEpsilonParser commentStamp: 'lr 5/15/2008 15:09' prior: 0!
A parser that consumes nothing and always succeeds.!

!PPEpsilonParser methodsFor: 'parsing' stamp: 'lr 4/18/2008 14:13'!
parse: aStream
	^ nil! !

PPParser subclass: #PPFailingParser
	instanceVariableNames: 'message'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPFailingParser commentStamp: 'lr 5/15/2008 15:10' prior: 0!
A parser that consumes nothing and always fails.!

!PPFailingParser class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 09:57'!
message: aString
	^ self new message: aString! !

!PPFailingParser methodsFor: 'parsing' stamp: 'lr 4/30/2008 11:55'!
basicParse: aStream
	^ PPFailure reason: message at: aStream position! !

!PPFailingParser methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:56'!
message: aString
	message := aString! !

PPParser subclass: #PPListParser
	instanceVariableNames: 'parsers'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

PPListParser subclass: #PPChoiceParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPChoiceParser commentStamp: 'lr 4/18/2008 15:35' prior: 0!
A parser that uses the first parser that succeeds.!

!PPChoiceParser methodsFor: 'parsing' stamp: 'lr 4/30/2008 11:02'!
basicParse: aStream
	| element |
	parsers do: [ :each |
		element := each parse: aStream.
		element isFailure
			ifFalse: [ ^ element ] ].
	^ element! !

!PPChoiceParser methodsFor: 'operations' stamp: 'lr 4/30/2008 10:46'!
| aRule 
	parsers addLast: aRule! !

!PPListParser methodsFor: 'initialization' stamp: 'lr 4/18/2008 10:53'!
initialize
	super initialize.
	parsers := OrderedCollection new! !

PPListParser subclass: #PPSequenceParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPSequenceParser commentStamp: 'lr 4/18/2008 15:34' prior: 0!
A parser that parses a sequence of parsers.!

!PPSequenceParser methodsFor: 'operations' stamp: 'lr 4/30/2008 10:46'!
, aRule 
	parsers addLast: aRule! !

!PPSequenceParser methodsFor: 'parsing' stamp: 'lr 5/15/2008 15:14'!
basicParse: aStream
	| start elements element |
	start := aStream position.
	elements := Array new: parsers size.
	parsers keysAndValuesDo: [ :index :each |
		element := each parse: aStream.
		element isFailure 
			ifFalse: [ elements at: index put: element ]
			ifTrue: [
				aStream position: start.
				^ element ] ].
	^ elements! !

!PPParser class methodsFor: 'instance-creation' stamp: 'lr 4/18/2008 14:00'!
new
	^ self basicNew initialize! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 19:58'!
, aParser 
	"Answer a new parser that parses the receiver followed by aParser."

	^ PPSequenceParser new , self , aParser! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 10:05'!
==> aBlock
	"Assigns aBlock as a success action handler."
	
	^ (PPActionParser on: self) block: aBlock! !

!PPParser methodsFor: 'converting' stamp: 'lr 4/19/2008 13:08'!
asParser
	^ self! !

!PPParser methodsFor: 'parsing' stamp: 'lr 4/21/2008 16:23'!
basicParse: aStream
	self subclassResponsibility! !

!PPParser methodsFor: 'operations-conveniance' stamp: 'lr 4/29/2008 11:43'!
delimitedBy: aParser
	"Answer a parser that parses the receiver one or more times, separated and possibly ended by aParser."
	
	^ PPSequenceParser new , (self separatedBy: aParser) , aParser optional ==> [ :node | 
		node second	isNil
			ifTrue: [ node first ]
			ifFalse: [ node first copyWith: node second ] ]! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/26/2008 15:50'!
end
	"Ensure the end of the input and return the result of the receiver."

	^ PPSequenceParser new , self , PPEndOfInputParser new ==> #first! !

!PPParser methodsFor: 'operations' stamp: 'lr 5/15/2008 16:08'!
flatten
	"Answer a new parser that flattens the underlying collection."
	
	^ PPFlattenParser on: self! !

!PPParser methodsFor: 'initialization' stamp: 'lr 4/24/2008 10:33'!
initialize! !

!PPParser methodsFor: 'testing' stamp: 'lr 4/20/2008 16:30'!
isUnresolved
	^ false! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/21/2008 06:49'!
optional
	"Answer a new parser that parses the receiver, if possible."

	^ PPChoiceParser new | self | PPEpsilonParser new! !

!PPParser methodsFor: 'parsing' stamp: 'lr 4/21/2008 16:23'!
parse: aStream
	^ aStream for: self do: [ self basicParse: aStream ]! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/28/2008 13:57'!
peek
	"Answer a parser that peeks at the result of the receiver, but does not consume it."

	^ PPPeekParser on: self! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/25/2008 15:40'!
plus
	"Answer a new parser that parses the receiver one or more times."

	^ PPSequenceParser new , self , self star ==> [ :value | (Array with: value first) , value second ]! !

!PPParser methodsFor: 'operations-conveniance' stamp: 'lr 4/29/2008 11:37'!
separatedBy: aParser
	"Answer a parser that parses the receiver one or more times, separated by aParser."
	
	^ PPSequenceParser new , self , (aParser , self) star ==> [ :node | 
		Array streamContents: [ :stream |
			stream nextPut: node first.
			node second do: [ :each | stream nextPutAll: each ] ] ]! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 10:07'!
star
	"Answer a new parser that parses the receiver zero or more times."

	^ PPStarParser on: self! !

!PPParser methodsFor: 'operations' stamp: 'lr 5/15/2008 16:08'!
token
	"Answer a new parser that answers a token."
	
	^ PPTokenParser on: self! !

!PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 19:59'!
| aParser 
	"Answer a new parser that either parses the receiver or aParser."
	
	^ PPChoiceParser new | self | aParser! !

PPParser subclass: #PPPredicateParser
	instanceVariableNames: 'predicate predicateMessage negated negatedMessage'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPPredicateParser commentStamp: 'lr 4/18/2008 15:34' prior: 0!
A parser that accepts if a given predicate holds.!

!PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:21'!
any
	^ self
		on: [ :each | true ] message: 'something expected'
		negated: [ :each | false ] message: 'nothing expected'! !

!PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:25'!
between: min and: max
	^ self
		on: [ :each | each >= min and: [ each <= max ] ] message: min printString , '..' , max printString , ' expected'
		negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected'! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/20/2008 15:54'!
char: aCharacter
	^ self expect: aCharacter! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:28'!
control
	^ self
		on: [ :each | each asInteger < 32 ] message: 'control character expected'
		negated: [ :each | each asInteger >= 32 ] message: 'no control character expected'! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:35'!
digit
	^ self 
		on: [ :each | each isDigit ] message: 'digit expected'
		negated: [ :each | each isDigit not ] message: 'no digit expected'! !

!PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 5/16/2008 16:26'!
eol
	^ self
		on: [ :each | String crlf includes: each ] message: 'newline expected'
		negated: [ :each | (String crlf includes: each) not ] message: 'no newline expected'! !

!PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:21'!
expect: anObject
	^ self 
		on: [ :each | each = anObject ] message: anObject printString , ' expected'
		negated: [ :each | each ~= anObject ] message: anObject printString , ' not expected'! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:35'!
letter
	^ self 
		on: [ :each | each isLetter ] message: 'letter expected'
		negated: [ :each | each isLetter not ] message: 'no letter expected'! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:28'!
lowercase
	^ self
		on: #isLowercase message: 'lowercase letter expected'
		negated: #isUppercase message: 'uppercase letter expected'! !

!PPPredicateParser class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 11:21'!
on: aBlock message: aString
	^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString! !

!PPPredicateParser class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 11:21'!
on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
	^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:36'!
space
	^ self 
		on: [ :each | each isSeparator ] message: 'separator expected'
		negated: [ :each | each isSeparator not ] message: 'no separator expected'! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:29'!
uppercase
	^ self lowercase not! !

!PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:37'!
word
	^ self 
		on: [ :each | each isAlphaNumeric ] message: 'letter or digit expected'
		negated: [ :each | each isAlphaNumeric not ] message: 'no letter or digit expected'! !

!PPPredicateParser methodsFor: 'parsing' stamp: 'lr 4/30/2008 11:55'!
basicParse: aStream
	^ (aStream atEnd not and: [ predicate value: aStream peek ])
		ifFalse: [ PPFailure reason: predicateMessage at: aStream position ]
		ifTrue: [ aStream next ]! !

!PPPredicateParser methodsFor: 'initialization' stamp: 'lr 4/19/2008 11:23'!
initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString 
	predicate := aBlock.
	predicateMessage := aString.
	negated := aNegatedBlock.
	negatedMessage := aNegatedString! !

!PPPredicateParser methodsFor: 'operators' stamp: 'lr 5/15/2008 15:14'!
not
	"Negate the receiving predicate parser."
	
	^ PPPredicateParser 
		on: negated message: negatedMessage 
		negated: predicate message: predicateMessage! !

PPParser subclass: #PPUnresolvedParser
	instanceVariableNames: 'symbol'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Builder'!

!PPUnresolvedParser class methodsFor: 'instance-creation' stamp: 'lr 4/21/2008 07:06'!
on: aSymbol
	^ self new initializeOn: aSymbol! !

!PPUnresolvedParser methodsFor: 'initialization' stamp: 'lr 4/21/2008 07:07'!
initializeOn: aSymbol
	symbol := aSymbol! !

!PPUnresolvedParser methodsFor: 'testing' stamp: 'lr 4/20/2008 16:29'!
isUnresolved
	^ true! !

!PPUnresolvedParser methodsFor: 'parsing' stamp: 'lr 4/22/2008 17:02'!
parse: aStream
	self error: self printString , ' need to be resolved before execution.'! !

!PPUnresolvedParser methodsFor: 'accessing' stamp: 'lr 4/21/2008 07:07'!
symbol
	^ symbol! !

Object subclass: #PPToken
	instanceVariableNames: 'collection from to'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPToken class methodsFor: 'instance-creation' stamp: 'lr 5/19/2008 10:38'!
on: aSequenzeableCollection from: aFromInteger to: aToInteger 
	^ self basicNew 
		initializeOn: aSequenzeableCollection
		from: aFromInteger
		to: aToInteger! !

!PPToken methodsFor: 'accessing' stamp: 'lr 5/19/2008 10:54'!
collection
	^ collection! !

!PPToken methodsFor: 'accessing' stamp: 'lr 5/19/2008 10:53'!
from
	^ from! !

!PPToken methodsFor: 'accessing-compatibility' stamp: 'lr 5/19/2008 10:41'!
id
	^ 0! !

!PPToken methodsFor: 'initialization' stamp: 'lr 5/19/2008 10:40'!
initializeOn: aSequenzeableCollection from: aFromInteger to: aToInteger 
	collection := aSequenzeableCollection.
	from := aFromInteger.
	to := aToInteger! !

!PPToken methodsFor: 'accessing-compatibility' stamp: 'lr 5/19/2008 10:54'!
length
	^ to - from + 1! !

!PPToken methodsFor: 'accessing-compatibility' stamp: 'lr 5/19/2008 10:41'!
startPosition
	^ from! !

!PPToken methodsFor: 'accessing-compatibility' stamp: 'lr 5/19/2008 10:41'!
stopPosition
	^ to! !

!PPToken methodsFor: 'accessing' stamp: 'lr 5/19/2008 10:54'!
to
	^ to! !

!PPToken methodsFor: 'accessing' stamp: 'lr 5/19/2008 10:54'!
value
	^ collection copyFrom: from to: to! !

ReadStream subclass: #PPStream
	instanceVariableNames: 'cache'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitParser-Core'!

!PPStream methodsFor: 'converting' stamp: 'lr 5/19/2008 15:11'!
asParserStream
	^ self! !

!PPStream methodsFor: 'accessing' stamp: 'lr 4/30/2008 11:52'!
for: aParser do: aBlock
	| memento |
	memento := (cache
		at: aParser
		ifAbsentPut: [ IdentityDictionary new ])
			at: position
			ifAbsentPut: [ PPMemento new ].
	memento result isNil 
		ifTrue: [
			memento result: (readLimit - position + 1 < memento count
				ifTrue: [ PPFailure reason: 'overflow' at: position ]
				ifFalse: [ memento increment. aBlock value ]).
			memento position: position ]
		ifFalse: [ position := memento position ].
	^ memento result! !

!PPStream methodsFor: 'initialization' stamp: 'lr 4/24/2008 10:10'!
initialize
	cache := IdentityDictionary new! !

!PPStream methodsFor: 'private' stamp: 'lr 4/21/2008 16:35'!
on: aCollection
	self initialize.
	super on: aCollection! !

!PPStream methodsFor: 'private' stamp: 'lr 4/21/2008 16:35'!
on: aCollection from: firstIndex to: lastIndex
	self initialize.
	super on: aCollection from: firstIndex to: lastIndex! !

!PPStream methodsFor: 'accessing' stamp: 'lr 4/29/2008 21:48'!
peek
	"An improved version of peek, that is slightly faster than the built in version."

	^ self atEnd ifFalse: [ collection at: position + 1 ]! !

!PPStream methodsFor: 'printing' stamp: 'lr 4/30/2008 09:12'!
printOn: aStream
	aStream 
		nextPutAll: (collection copyFrom: 1 to: position);
		nextPut: $·;
		nextPutAll: (collection copyFrom: position + 1 to: readLimit)! !

!ReadStream methodsFor: '*petitparser' stamp: 'lr 4/29/2008 08:26'!
for: aParser do: aBlock
	^ aBlock value! !

!Symbol methodsFor: '*petitparser' stamp: 'lr 4/20/2008 14:01'!
asParser
	^ PPPredicateParser perform: self! !

!Interval methodsFor: '*petitparser' stamp: 'lr 4/19/2008 13:06'!
asParser
	^ PPPredicateParser between: start and: stop! !