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! ! !Symbol methodsFor: '*petitparser' stamp: 'lr 4/20/2008 14:01'! asParser ^ PPPredicateParser perform: self! ! !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! ! 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! ! !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: 'adapting' stamp: 'lr 5/21/2008 21:16'! parseSelector: aString ^ nil! ! !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: 'private' stamp: 'lr 5/21/2008 21:18'! endOfLastToken ^ 0! ! !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: 'private' stamp: 'lr 5/21/2008 21:18'! parseSelector: aString! ! !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: #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! ! !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! ! !Interval methodsFor: '*petitparser' stamp: 'lr 4/19/2008 13:06'! asParser ^ PPPredicateParser between: start and: stop! !