SystemOrganization addCategory: #'PetitParser-Core'! SystemOrganization addCategory: #'PetitParser-Parsers'! SystemOrganization addCategory: #'PetitParser-Tools'! SystemOrganization addCategory: #'PetitParser-Examples'! SystemOrganization addCategory: #'PetitParser-Tests'! !String methodsFor: '*petitparser-core-converting' stamp: 'lr 11/7/2009 13:32'! asParser ^ PPLiteralSequenceParser on: self! ! TestResource subclass: #PPParserResource instanceVariableNames: 'parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPParserResource methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:19'! parserAt: aParserClass "Answer a cached instance of aParserClass." ^ parsers at: aParserClass name ifAbsentPut: [ aParserClass new ]! ! !PPParserResource methodsFor: 'running' stamp: 'lr 3/29/2010 15:20'! setUp super setUp. parsers := Dictionary new! ! !PositionableStream methodsFor: '*petitparser-core-converting' stamp: 'lr 4/8/2010 14:50'! asPetitStream "Some of my subclasses do not use the instance-variables collection, position and readLimit but instead have a completely different internal representation. In these cases just use the super implementation that is inefficient but should work in all cases." ^ (collection isNil or: [ position isNil or: [ readLimit isNil ] ]) ifFalse: [ PPStream on: collection from: position to: readLimit ] ifTrue: [ super asPetitStream ]! ! !PositionableStream methodsFor: '*petitparser-core-accessing' stamp: 'lr 4/19/2008 13:17'! collection ^ collection! ! !Set methodsFor: '*petitparser-core-converting' stamp: 'lr 9/23/2008 16:26'! asParser ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])! ! !BlockContext methodsFor: '*petitparser-core-converting' stamp: 'lr 7/4/2008 10:18'! asParser ^ PPPluggableParser on: self! ! !Stream methodsFor: '*petitparser-core-converting' stamp: 'lr 4/8/2010 14:46'! asPetitStream ^ self contents asPetitStream! ! !BlockClosure methodsFor: '*petitparser-core-converting' stamp: 'lr 6/18/2008 08:47'! asParser ^ PPPluggableParser on: self! ! TestCase subclass: #PPAbstractParseTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPAbstractParseTest class methodsFor: 'testing' stamp: 'lr 10/4/2009 17:08'! isAbstract ^ self name = #PPAbstractParseTest! ! !PPAbstractParseTest class methodsFor: 'accessing' stamp: 'lr 4/13/2009 09:45'! packageNamesUnderTest ^ #('PetitParser')! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'lr 2/7/2010 20:54'! assert: aParser fail: aCollection | stream result | stream := aCollection asPetitStream. result := aParser parse: stream. self assert: result isPetitFailure. self assert: stream position = 0! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:20'! assert: aParser parse: aCollection self assert: aParser parse: aCollection to: nil end: aCollection size ! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:21'! assert: aParser parse: aCollection end: anInteger self assert: aParser parse: aCollection to: nil end: anInteger! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:21'! assert: aParser parse: aCollection to: anObject self assert: aParser parse: aCollection to: anObject end: aCollection size ! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'lr 2/7/2010 20:54'! assert: aParser parse: aParseObject to: aTargetObject end: anInteger | stream result | stream := aParseObject asPetitStream. result := aParser parse: stream. aTargetObject isNil ifTrue: [ self deny: result isPetitFailure ] ifFalse: [ self assert: result = aTargetObject ]. self assert: stream position = anInteger! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'lr 10/6/2009 08:21'! assert: aParser parse: aParserObject toToken: from stop: to | token | token := PPToken on: aParserObject start: from stop: to. ^ self assert: aParser parse: aParserObject to: token! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'lr 10/6/2009 08:22'! assert: aParser parse: aParserObject toToken: from stop: to end: end | token | token := PPToken on: aParserObject start: from stop: to. ^ self assert: aParser parse: aParserObject to: token end: end! ! PPAbstractParseTest subclass: #PPComposedTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPComposedTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 16:44'! comment ^ ($" asParser , $" asParser negate star , $" asParser) flatten! ! !PPComposedTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 16:44'! identifier ^ (#letter asParser , #word asParser star) flatten! ! !PPComposedTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 16:44'! number ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten! ! !PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 2/8/2010 16:44'! testComment 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"'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 7/6/2009 08:34'! testDoubledString | parser | parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser) ==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ]. self assert: parser parse: '''''' to: ''. self assert: parser parse: '''a''' to: 'a'. self assert: parser parse: '''ab''' to: 'ab'. self assert: parser parse: '''a''''b''' to: 'a''b'. self assert: parser parse: '''a''''''''b''' to: 'a''''b'! ! !PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 2/8/2010 16:44'! testIdentifier 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: '1'. self assert: self identifier fail: '1a'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 4/6/2010 19:41'! testIfThenElse "S ::= if C then S else S | if C then S | X" | start if then else cond expr parser | start := PPUnresolvedParser new. if := 'if' asParser token trim. then := 'then' asParser token trim. else := 'else' asParser token trim. cond := 'C' asParser token trim. expr := 'X' asParser token trim. start def: (if , cond , then , start , else , start) / (if , cond , then , start) / expr. parser := start end. self assert: parser parse: 'X'. self assert: parser parse: 'if C then X'. self assert: parser parse: 'if C then X else X'. self assert: parser parse: 'if C then if C then X'. self assert: parser parse: 'if C then if C then X else if C then X'. self assert: parser parse: 'if C then if C then X else X else if C then X'. self assert: parser parse: 'if C then if C then X else X else if C then X else X'. self assert: parser fail: 'if C'. self assert: parser fail: 'if C else X'. self assert: parser fail: 'if C then if C'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 4/2/2009 20:46'! testLeftRecursion "S ::= S 'x' S / '1'" | parser | parser := PPUnresolvedParser new. parser def: ((parser , $x asParser , parser) / $1 asParser) memoized flatten. self assert: parser parse: '1' to: '1'. self assert: parser parse: '1x1' to: '1x1'. self assert: parser parse: '1x1x1' to: '1x1x1'. self assert: parser parse: '1x1x1x1' to: '1x1x1x1'. self assert: parser parse: '1x1x1x1x1' to: '1x1x1x1x1'. self assert: parser parse: '1x1x1x1x1x1' to: '1x1x1x1x1x1'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 4/6/2010 19:34'! testListOfIntegers "S ::= S , number | number" | number list parser | number := #digit asParser plus token trim ==> [ :node | node value asInteger ]. list := (number separatedBy: $, asParser token trim) ==> [ :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'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 10/20/2008 13:27'! testNestedComments "C ::= B I* E" "I ::= !!E (C | T)" "B ::= /*" "E ::= */" "T ::= ." | begin end any inside parser | begin := '/*' asParser. end := '*/' asParser. any := #any asParser. parser := PPUnresolvedParser new. inside := end not , (parser / any). parser def: begin , inside star , end. self assert: parser parse: '/*ab*/cd' end: 6. self assert: parser parse: '/*a/*b*/c*/'. self assert: parser fail: '/*a/*b*/c'! ! !PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 2/8/2010 16:44'! testNumber 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'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testPalindrome "S0 ::= a S1 a | b S1 b | ... S1 ::= S0 | epsilon" | s0 s1 parser | s0 := PPUnresolvedParser new. s1 := PPUnresolvedParser new. s0 def: ($a asParser , s1 , $a asParser) / ($b asParser , s1 , $b asParser) / ($c asParser , s1 , $c asParser). s1 def: s0 / nil asParser. 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'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testParseAaaBbb "S0 ::= a S1 b S1 ::= S0 | epsilon" | s0 s1 parser | s0 := PPUnresolvedParser new. s1 := PPUnresolvedParser new. s0 def: $a asParser , s1 , $b asParser. s1 def: s0 / nil asParser. 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'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testParseAaaaaa "S ::= a a S | epsilon" | s0 s1 parser | s0 := PPUnresolvedParser new. s1 := $a asParser , $a asParser , s0. s0 def: s1 / nil asParser. parser := s0 flatten. self assert: parser parse: '' to: ''. self assert: parser parse: 'aa' to: 'aa'. self assert: parser parse: 'aaaa' to: 'aaaa'. self assert: parser parse: 'aaaaaa' to: 'aaaaaa'. self assert: parser parse: 'a' to: '' end: 0. self assert: parser parse: 'aaa' to: 'aa' end: 2. self assert: parser parse: 'aaaaa' to: 'aaaa' end: 4. self assert: parser parse: 'aaaaaaa' to: 'aaaaaa' end: 6! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:26'! 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'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:26'! 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'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 2/8/2010 16:43'! testParseAnBnCn "PEGs for a non context- free language: a^n , b^n , c^n S <- &P1 P2 P1 <- AB 'c' AB <- 'a' AB 'b' / epsilon P2 <- 'a'* BC end BC <- 'b' BC 'c' / epsilon" | s p1 ab p2 bc | s := PPUnresolvedParser new. p1 := PPUnresolvedParser new. ab := PPUnresolvedParser new. p2 := PPUnresolvedParser new. bc := PPUnresolvedParser new. s def: (p1 and , p2 end) flatten. p1 def: ab , $c asParser. ab def: ($a asParser , ab , $b asParser) optional. p2 def: $a asParser star , bc. bc def: ($b asParser , bc , $c asParser) optional. self assert: s parse: 'abc' to: 'abc'. self assert: s parse: 'aabbcc' to: 'aabbcc'. self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'. self assert: s fail: 'bc'. self assert: s fail: 'ac'. self assert: s fail: 'ab'. self assert: s fail: 'abbcc'. self assert: s fail: 'aabcc'. self assert: s fail: 'aabbc'! ! !PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 4/6/2010 19:35'! testReturn | number spaces return | number := #digit asParser plus token. spaces := #space asParser star. return := (spaces , $^ asParser token , spaces , number) ==> [ :nodes | { #return. (nodes at: 4) value } ]. 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: '^'! ! PPAbstractParseTest subclass: #PPDemoTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPDemoTest commentStamp: 'on 9/14/2008 16:16' prior: 0! These are some simple demos of parser combinators for the compiler construction course. http://www.iam.unibe.ch/~scg/Teaching/CC/index.html! !PPDemoTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'! addMulInterpreter "Same as testMiniGrammar but with semantic actions" | mul prim add dec | add := PPUnresolvedParser new. mul := PPUnresolvedParser new. prim := PPUnresolvedParser new. dec := ($0 - $9) ==> [ :token | token asciiValue - $0 asciiValue ]. add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ]) / mul. mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ]) / prim. prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ]) / dec. ^ add end! ! !PPDemoTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'! addMulParser "Simple demo of scripting a parser" | add mul prim dec | add := PPUnresolvedParser new. mul := PPUnresolvedParser new. prim := PPUnresolvedParser new. dec := $0 - $9. add def: ( mul, $+ asParser, add ) / mul. mul def: ( prim, $* asParser, mul) / prim. prim def: ( $( asParser, add, $) asParser) / dec. ^ add end! ! !PPDemoTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'! straightLineParser | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper | goal := PPUnresolvedParser new. stmList := PPUnresolvedParser new. stm := PPUnresolvedParser new. exp := PPUnresolvedParser new. expList := PPUnresolvedParser new. mulExp := PPUnresolvedParser new. primExp := PPUnresolvedParser new. lower := $a - $z. upper := $A - $Z. char := lower / upper. nonzero := $1 - $9. dec := $0 - $9. id := char, ( char / dec ) star. num := $0 asParser / ( nonzero, dec star). goal def: stmList end. stmList def: stm , ( $; asParser, stm ) star. stm def: ( id, ':=' asParser, exp ) / ( 'print' asParser, $( asParser, expList, $) asParser ). exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star. expList def: exp, ( $, asParser, exp ) star. mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star. primExp def: id / num / ( $( asParser, stmList, $, asParser, exp, $) asParser ). ^ goal ! ! !PPDemoTest methodsFor: 'tests' stamp: 'on 9/14/2008 16:28'! testMiniGrammar self assert: (self addMulParser) parse: '2*(3+4)' to: #($2 $* #($( #($3 $+ $4) $))).! ! !PPDemoTest methodsFor: 'tests' stamp: 'on 9/14/2008 16:29'! testMiniSemanticActions self assert: (self addMulInterpreter) parse: '2*(3+4)' to: 14! ! !PPDemoTest methodsFor: 'tests' stamp: 'lr 9/17/2008 22:44'! testSLassign self assert: self straightLineParser parse: 'abc:=1' to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())! ! !PPDemoTest methodsFor: 'tests' stamp: 'lr 9/17/2008 22:46'! testSLprint self assert: self straightLineParser parse: 'print(3,4)' to: #(#('print' $( #(#(#($3 #()) #()) #() #(#($, #(#(#($4 #()) #()) #())))) $)) #())! ! PPAbstractParseTest subclass: #PPExtensionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 5/2/2010 18:18'! testCharacter | parser | parser := $a asParser. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b'! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 5/5/2010 14:03'! testClosure | parser | parser := [ :stream | stream upTo: $s ] asParser. self assert: parser parse: '' to: ''. self assert: parser parse: 'a' to: 'a'. self assert: parser parse: 'aa' to: 'aa'. self assert: parser parse: 's' to: ''. self assert: parser parse: 'as' to: 'a'. self assert: parser parse: 'aas' to: 'aa'. self assert: parser parse: 'sa' to: '' end: 1. self assert: parser parse: 'saa' to: '' end: 1. parser := [ :stream | stream upTo: $s. PPFailure message: 'stream' at: stream position ] asParser. self assert: parser fail: ''. self assert: parser fail: 's'. self assert: parser fail: 'as' ! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testEpsilon | parser | parser := nil asParser. self assert: parser asParser = parser! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:20'! 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)! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:30'! testParser | parser | parser := $a asParser. self assert: parser asParser = parser! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:48'! testRange | parser | parser := $a - $c. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'b' to: $b. self assert: parser parse: 'c' to: $c. self assert: parser fail: 'd'! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 2/7/2010 20:53'! testStream | stream | stream := 'abc' readStream asPetitStream. self assert: (stream class = PPStream). self assert: (stream printString = '·abc'). self assert: (stream peek) = $a. self assert: (stream next) = $a. self assert: (stream printString = 'a·bc'). self assert: (stream asPetitStream = stream)! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 5/2/2010 18:18'! testString | parser | parser := 'ab' asParser. self assert: parser parse: 'ab' to: 'ab'. self assert: parser parse: 'aba' to: 'ab' end: 2. self assert: parser parse: 'abb' to: 'ab' end: 2. self assert: parser fail: 'a'. self assert: parser fail: 'ac'! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:03'! testSymbol | parser | parser := #any asParser. self assert: parser parse: 'a'. self assert: parser fail: ''! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 2/7/2010 20:53'! testText | stream | stream := 'abc' asText asPetitStream. self assert: stream class = PPStream! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:20'! 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)! ! PPAbstractParseTest subclass: #PPMappingTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldLeft2 | parser | parser := #any asParser star foldLeft: [ :a :b | Array with: a with: b ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b) to: #(a b). self assert: parser parse: #(a b c) to: #((a b) c). self assert: parser parse: #(a b c d) to: #(((a b) c) d). self assert: parser parse: #(a b c d e) to: #((((a b) c) d) e)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldLeft3 | parser | parser := #any asParser star foldLeft: [ :a :b :c | Array with: a with: b with: c ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b c) to: #(a b c). self assert: parser parse: #(a b c d e) to: #((a b c) d e)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldRight2 | parser | parser := #any asParser star foldRight: [ :a :b | Array with: a with: b ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b) to: #(a b). self assert: parser parse: #(a b c) to: #(a (b c)). self assert: parser parse: #(a b c d) to: #(a (b (c d))). self assert: parser parse: #(a b c d e) to: #(a (b (c (d e))))! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldRight3 | parser | parser := #any asParser star foldRight: [ :a :b :c | Array with: a with: b with: c ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b c) to: #(a b c). self assert: parser parse: #(a b c d e) to: #(a b (c d e))! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 3/30/2009 16:38'! testMap1 | parser | parser := #any asParser map: [ :a | Array with: a ]. self assert: parser parse: #(a) to: #(a)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testMap2 | parser | parser := (#any asParser , #any asParser) map: [ :a :b | Array with: b with: a ]. self assert: parser parse: #(a b) to: #(b a)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testMap3 | parser | parser := (#any asParser , #any asParser , #any asParser) map: [ :a :b :c | Array with: c with: b with: a ]. self assert: parser parse: #(a b c) to: #(c b a)! ! PPAbstractParseTest subclass: #PPParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:22'! testAction | block parser | block := [ :char | char asUppercase ]. parser := #any asParser ==> block. self assert: parser block = block. self assert: parser parse: 'a' to: $A. self assert: parser parse: 'b' to: $B! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 16:30'! testAnd | parser | parser := 'foo' asParser flatten , 'bar' asParser flatten and. self assert: parser parse: 'foobar' to: #('foo' 'bar') end: 3. self assert: parser fail: 'foobaz'. parser := 'foo' asParser and. self assert: parser and = parser! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 1/8/2010 12:04'! testAnswer | parser | parser := $a asParser answer: $b. self assert: parser parse: 'a' to: $b. self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/2/2009 19:56'! testBlock | parser | parser := [ :s | s next ] asParser. self assert: parser parse: 'ab' to: $a end: 1. self assert: parser parse: 'b' to: $b. self assert: parser parse: '' to: nil! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/7/2010 22:15'! testChildren | p1 p2 p3 | p1 := #lowercase asParser. p2 := p1 ==> #asUppercase. p3 := PPUnresolvedParser new. p3 def: p2 / p3. self assert: p1 children isEmpty. self assert: p2 children size = 1. self assert: p3 children size = 2! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:24'! 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 1/29/2010 11:39'! testEndOfInput | parser | parser := PPEndOfInputParser on: $a asParser. self assert: parser end = parser. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''. self assert: parser fail: 'aa'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:47'! testEndOfInputAfterMatch | parser | parser := 'stuff' asParser end. self assert: parser parse: 'stuff' to: 'stuff'. self assert: parser fail: 'stufff'. self assert: parser fail: 'fluff'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:31'! testEpsilon | parser | parser := nil asParser. 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 5/5/2010 14:10'! testFailing | parser result | parser := PPFailingParser message: 'Plonk'. self assert: parser message = 'Plonk'. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'aa'. result := parser parse: 'a'. self assert: result message = 'Plonk'. self assert: result printString = 'Plonk at 0'! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/5/2010 13:58'! testFailure | failure | failure := PPFailure message: 'Error' at: 3. self assert: failure message = 'Error'. self assert: failure position = 3. self assert: failure isPetitFailure. self deny: 4 isPetitFailure. self deny: 'foo' isPetitFailure! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:18'! testFlatten | parser | parser := $a asParser flatten. self assert: parser parse: 'a' to: 'a'. self assert: parser parse: #($a) to: #($a). self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:38'! testHasProperty | parser | parser := PPParser new. self deny: (parser hasProperty: #foo). parser propertyAt: #foo put: 123. self assert: (parser hasProperty: #foo)! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/31/2010 19:27'! testListConstructor | p1 p2 p3 | p1 := PPChoiceParser with: $a asParser. p2 := PPChoiceParser with: $a asParser with: $b asParser. p3 := PPChoiceParser withAll: (Array with: $a asParser with: $b asParser with: $c asParser). self assert: p1 children size = 1. self assert: p2 children size = 2. self assert: p3 children size = 3! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 18:20'! testLiteralObject | parser | parser := PPLiteralObjectParser on: $a message: 'letter "a" expected'. self assert: parser literal = $a. self assert: parser message = 'letter "a" expected'. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b' ! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 6/1/2010 22:30'! testLiteralObjectCaseInsensitive | parser | parser := $a asParser caseInsensitive. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'A' to: $A. self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'B' ! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 18:20'! testLiteralSequence | parser | parser := PPLiteralSequenceParser on: 'abc' message: 'sequence "abc" expected'. self assert: parser literal = 'abc'. self assert: parser message = 'sequence "abc" expected'. self assert: parser parse: 'abc' to: 'abc'. self assert: parser fail: 'ab'. self assert: parser fail: 'abd'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 6/1/2010 22:31'! testLiteralSequenceCaseInsensitive | parser | parser := 'abc' asParser caseInsensitive. self assert: parser parse: 'abc' to: 'abc'. self assert: parser parse: 'ABC' to: 'ABC'. self assert: parser parse: 'abC' to: 'abC'. self assert: parser parse: 'AbC' to: 'AbC'. self assert: parser fail: 'ab'. self assert: parser fail: 'abd'! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/8/2010 00:32'! testMatches | parser | parser := $a asParser. self assert: (parser matches: 'a'). self deny: (parser matches: 'b'). self assert: (parser matches: 'a' readStream). self deny: (parser matches: 'b' readStream)! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/8/2010 00:32'! testMatchesIn | parser result | parser := $a asParser. result := parser matchesIn: 'abba'. self assert: result size = 2. self assert: result first = $a. self assert: result last = $a. result := parser matchesIn: 'baaah'. self assert: result size = 3. self assert: result first = $a. self assert: result last = $a! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 3/3/2010 15:33'! testMatchesInEmpty "Empty matches should properly advance and match at each position and at the end." | parser result | parser := [ :stream | stream position ] asParser. result := parser matchesIn: '123'. self assert: result asArray = #(0 1 2 3)! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 3/3/2010 15:31'! testMatchesInOverlapping "Matches that overlap should be properly reported." | parser result | parser := #digit asParser , #digit asParser. result := parser matchesIn: 'a123b'. self assert: result size = 2. self assert: result first = #($1 $2). self assert: result last = #($2 $3)! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 3/3/2010 15:47'! testMatchingRangesIn | input parser result | input := 'a12b1'. parser := #digit asParser plus. result := parser matchingRangesIn: input. self assert: result size = 3. result do: [ :each | self assert: (parser matches: (input copyFrom: each first to: each last)) ]! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:18'! testMax | parser | parser := $a asParser max: 2. self assert: parser min = 0. self assert: parser max = 2. 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) end: 2. self assert: parser parse: 'aaaa' to: #($a $a) end: 2. self assert: (parser printString endsWith: '[0, 2]')! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/2/2009 20:35'! testMemoized | count parser twice | count := 0. parser := [ :s | count := count + 1. s next ] asParser memoized. twice := parser and , parser. count := 0. self assert: parser parse: 'a' to: $a. self assert: count = 1. count := 0. self assert: twice parse: 'a' to: #($a $a). self assert: count = 1. self assert: parser memoized = parser! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:18'! testMin | parser | parser := $a asParser min: 2. self assert: parser min = 2. self assert: parser max > parser min. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a $a). self assert: parser parse: 'aaaa' to: #($a $a $a $a). self assert: (parser printString endsWith: '[2, *]')! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:19'! testMinMax | parser | parser := $a asParser min: 2 max: 4. self assert: parser min = 2. self assert: parser max = 4. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a $a). self assert: parser parse: 'aaaa' to: #($a $a $a $a). self assert: parser parse: 'aaaaa' to: #($a $a $a $a) end: 4. self assert: parser parse: 'aaaaaa' to: #($a $a $a $a) end: 4. self assert: (parser printString endsWith: '[2, 4]')! ! !PPParserTest methodsFor: 'testing-accessing' stamp: 'lr 3/30/2009 16:36'! testNamed | parser | parser := PPSequenceParser new. self assert: parser name isNil. parser := PPChoiceParser named: 'choice'. self assert: parser name = 'choice'. parser := $* asParser name: 'star'. self assert: parser name = 'star'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 2/7/2010 20:10'! testNegate | parser | parser := 'foo' asParser negate. self assert: parser parse: 'f' to: $f end: 1. self assert: parser parse: 'fo' to: $f end: 1. self assert: parser parse: 'fob' to: $f end: 1. self assert: parser parse: 'ffoo' to: $f end: 1. self assert: parser fail: ''. self assert: parser fail: 'foo'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 16:30'! testNot | parser | parser := 'foo' asParser flatten , 'bar' asParser flatten not. self assert: parser parse: 'foobaz' to: #('foo' nil) end: 3. self assert: parser fail: 'foobar'. parser := 'foo' asParser. self assert: parser not not = parser! ! !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-utilities' stamp: 'lr 5/5/2010 14:11'! testParse | parser result | parser := $a asParser. self assert: (parser parse: 'a') = $a. self assert: (result := parser parse: 'b') isPetitFailure. self assert: (result position = 0). self assert: (result message = '$a expected'). self assert: (parser parse: 'a' readStream) = $a. self assert: (result := parser parse: 'b' readStream) isPetitFailure. self assert: (result position = 0). self assert: (result message = '$a expected')! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/7/2010 23:00'! testParseOnError0 | parser result seen | parser := $a asParser. result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. self assert: result = $a. result := parser parse: 'b' onError: [ seen := true ]. self assert: result. self assert: seen! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/5/2010 14:10'! testParseOnError1 | parser result seen | parser := $a asParser. result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. self assert: result = $a. result := parser parse: 'b' onError: [ :failure | self assert: failure position = 0. self assert: failure message = '$a expected'. seen := true ]. self assert: result. self assert: seen! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/7/2010 23:00'! testParseOnError2 | parser result seen | parser := $a asParser. result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. self assert: result = $a. result := parser parse: 'b' onError: [ :msg :pos | self assert: msg = '$a expected'. self assert: pos = 0. seen := true ]. self assert: result. self assert: seen! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 1/8/2010 12:09'! testPermutation | parser | parser := #any asParser , #any asParser , #any asParser. self assert: (parser permutation: #()) parse: '123' to: #(). self assert: (parser permutation: #(1)) parse: '123' to: #($1). self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3). self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1). self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2). self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1). self should: [ parser permutation: #(0) ] raise: Error. self should: [ parser permutation: #(4) ] raise: Error. self should: [ parser permutation: #($2) ] raise: Error! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:26'! testPluggable | block parser | block := [ :stream | stream position ]. parser := block asParser. self assert: parser block = block! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:16'! testPlus | parser | parser := $a asParser plus. self assert: parser min = 1. self assert: parser max > parser min. 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' stamp: 'lr 3/1/2010 10:06'! testPlusGreedy | parser | parser := #word asParser plusGreedy: #digit asParser. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'. self assert: parser fail: 'ab'. self assert: parser parse: 'a1' to: #($a) end: 1. self assert: parser parse: 'ab1' to: #($a $b) end: 2. self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. self assert: parser parse: 'a12' to: #($a $1) end: 2. self assert: parser parse: 'ab12' to: #($a $b $1) end: 3. self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4. self assert: parser parse: 'a123' to: #($a $1 $2) end: 3. self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4. self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5.! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 3/1/2010 10:07'! testPlusLazy | parser | parser := #word asParser plusLazy: #digit asParser. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'. self assert: parser fail: 'ab'. self assert: parser parse: 'a1' to: #($a) end: 1. self assert: parser parse: 'ab1' to: #($a $b) end: 2. self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. self assert: parser parse: 'a12' to: #($a) end: 1. self assert: parser parse: 'ab12' to: #($a $b) end: 2. self assert: parser parse: 'abc12' to: #($a $b $c) end: 3. self assert: parser parse: 'a123' to: #($a) end: 1. self assert: parser parse: 'ab123' to: #($a $b) end: 2. self assert: parser parse: 'abc123' to: #($a $b $c) end: 3! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:41'! testPostCopy | parser copy | parser := PPParser new. parser propertyAt: #foo put: true. copy := parser copy. copy propertyAt: #foo put: false. self assert: (parser propertyAt: #foo). self deny: (copy propertyAt: #foo)! ! !PPParserTest methodsFor: 'testing-accessing' stamp: 'lr 4/18/2010 18:54'! testPrint | parser | parser := PPParser new. self assert: (parser printString beginsWith: 'a PPParser'). parser := PPParser named: 'choice'. self assert: (parser printString beginsWith: 'a PPParser(choice'). parser := PPLiteralObjectParser on: $a. self assert: (parser printString includesSubString: '$a'). parser := PPFailingParser message: 'error'. self assert: (parser printString includesSubString: 'error'). parser := PPPredicateParser on: [ :c | true ] message: 'error'. self assert: (parser printString includesSubString: 'error')! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:36'! testPropertyAt | parser | parser := PPParser new. self should: [ parser propertyAt: #foo ] raise: Error. parser propertyAt: #foo put: true. self assert: (parser propertyAt: #foo)! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'! testPropertyAtIfAbsent | parser | parser := PPParser new. self assert: (parser propertyAt: #foo ifAbsent: [ true ]). parser propertyAt: #foo put: true. self assert: (parser propertyAt: #foo ifAbsent: [ false ])! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'! testPropertyAtIfAbsentPut | parser | parser := PPParser new. self assert: (parser propertyAt: #foo ifAbsentPut: [ true ]). self assert: (parser propertyAt: #foo ifAbsentPut: [ false ])! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'! testRemoveProperty | parser | parser := PPParser new. self should: [ parser removeProperty: #foo ] raise: Error. parser propertyAt: #foo put: true. self assert: (parser removeProperty: #foo)! ! !PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'! testRemovePropertyIfAbsent | parser | parser := PPParser new. self assert: (parser removeProperty: #foo ifAbsent: [ true ]). parser propertyAt: #foo put: true. self assert: (parser removeProperty: #foo ifAbsent: [ false ])! ! !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-fixtures' stamp: 'lr 2/7/2010 22:00'! testSideEffectChoice "Adding another element to a choice should create a copy, otherwise we get unwanted side-effects." | p1 p2 p3 | p1 := $a asParser. p2 := p1 / $b asParser. p3 := p1 / $c asParser. self assert: p1 parse: 'a'. self assert: p1 fail: 'b'. self assert: p1 fail: 'c'. self assert: p2 parse: 'a'. self assert: p2 parse: 'b'. self assert: p2 fail: 'c'. self assert: p3 parse: 'a'. self assert: p3 fail: 'b'. self assert: p3 parse: 'c'! ! !PPParserTest methodsFor: 'testing-fixtures' stamp: 'lr 5/31/2010 19:25'! testSideEffectListCopy | old new | old := $a asParser , $b asParser. new := old copy. self deny: old == new. self deny: old children == new children. self assert: old children first == new children first. self assert: old children last == new children last! ! !PPParserTest methodsFor: 'testing-fixtures' stamp: 'lr 4/14/2010 11:38'! testSideEffectSequence "Adding another element to a sequence should create a copy, otherwise we get unwanted side-effects." | p1 p2 p3 | p1 := $a asParser. p2 := p1 , $b asParser. p3 := p1 , $c asParser. self assert: p1 parse: 'a'. self assert: p1 parse: 'ab' end: 1. self assert: p1 parse: 'ac' end: 1. self assert: p2 fail: 'a'. self assert: p2 parse: 'ab'. self assert: p2 fail: 'ac'. self assert: p3 fail: 'a'. self assert: p3 fail: 'ab'. self assert: p3 parse: 'ac'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:17'! testStar | parser | parser := $a asParser star. self assert: parser min = 0. self assert: parser max > parser min. 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' stamp: 'lr 3/1/2010 10:03'! testStarGreedy | parser | parser := #word asParser starGreedy: #digit asParser. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'ab'. self assert: parser parse: '1' to: #() end: 0. self assert: parser parse: 'a1' to: #($a) end: 1. self assert: parser parse: 'ab1' to: #($a $b) end: 2. self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. self assert: parser parse: '12' to: #($1) end: 1. self assert: parser parse: 'a12' to: #($a $1) end: 2. self assert: parser parse: 'ab12' to: #($a $b $1) end: 3. self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4. self assert: parser parse: '123' to: #($1 $2) end: 2. self assert: parser parse: 'a123' to: #($a $1 $2) end: 3. self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4. self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 3/1/2010 10:03'! testStarLazy | parser | parser := #word asParser starLazy: #digit asParser. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'ab'. self assert: parser parse: '1' to: #() end: 0. self assert: parser parse: 'a1' to: #($a) end: 1. self assert: parser parse: 'ab1' to: #($a $b) end: 2. self assert: parser parse: 'abc1' to: #($a $b $c) end: 3. self assert: parser parse: '12' to: #() end: 0. self assert: parser parse: 'a12' to: #($a) end: 1. self assert: parser parse: 'ab12' to: #($a $b) end: 2. self assert: parser parse: 'abc12' to: #($a $b $c) end: 3. self assert: parser parse: '123' to: #() end: 0. self assert: parser parse: 'a123' to: #($a) end: 1. self assert: parser parse: 'ab123' to: #($a $b) end: 2. self assert: parser parse: 'abc123' to: #($a $b $c) end: 3! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/6/2010 19:47'! testToken | parser | parser := $a asParser token. self assert: parser tokenClass = PPToken. self assert: parser parse: 'a' toToken: 1 stop: 1. self assert: parser fail: 'b'. self assert: parser fail: ''. parser := $a asParser token: PPToken. self assert: parser tokenClass = PPToken. self assert: parser parse: 'a' toToken: 1 stop: 1. self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/19/2010 11:41'! testTrim | parser | parser := $a asParser token trim. self assert: parser trim = parser. self assert: parser parse: 'a' toToken: 1 stop: 1. self assert: parser parse: 'a ' toToken: 1 stop: 1. self assert: parser parse: 'a ' toToken: 1 stop: 1. self assert: parser parse: 'a ' toToken: 1 stop: 1. self assert: parser parse: 'a' toToken: 1 stop: 1. self assert: parser parse: ' a' toToken: 2 stop: 2. self assert: parser parse: ' a' toToken: 2 stop: 2. self assert: parser parse: ' a' toToken: 5 stop: 5. self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1. self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2. self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3. self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:31'! testUnresolved | parser | parser := PPUnresolvedParser new. self assert: parser isUnresolved. self should: [ parser parse: '' ] raise: Error. self should: [ parser parse: 'a' ] raise: Error. self should: [ parser parse: 'ab' ] raise: Error. parser := nil asParser. self deny: parser isUnresolved! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:44'! testWrapped | parser | parser := $a asParser wrapped. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/12/2010 20:40'! testWrapping | parser result | parser := #digit asParser plus >=> [ :stream :cc | Array with: stream position with: cc value with: stream position ]. self assert: parser parse: '1' to: #(0 ($1) 1). self assert: parser parse: '12' to: #(0 ($1 $2) 2). self assert: parser parse: '123' to: #(0 ($1 $2 $3) 3). result := parser parse: 'a'. self assert: result first = 0. self assert: result second isPetitFailure. self assert: result last = 0! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/14/2010 16:30'! testXor | parser | parser := ($a asParser / $b asParser) | ($b asParser / $c asParser). self assert: parser parse: 'a' to: $a. self assert: parser parse: 'c' to: $c. self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'd'. " truly symmetric " parser := ($b asParser / $c asParser) | ($a asParser / $b asParser). self assert: parser parse: 'a' to: $a. self assert: parser parse: 'c' to: $c. self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'd'! ! PPAbstractParseTest subclass: #PPPredicateTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPPredicateTest methodsFor: 'utilities' stamp: 'lr 11/29/2009 09:33'! assertCharacterSets: aParser "Assert the character set of aParser does not overlap with the character set with the negated parser, and that they both cover the complete character space." | positives negatives | positives := self parsedCharacterSet: aParser. negatives := self parsedCharacterSet: aParser negate. Character allCharacters do: [ :char | | positive negative | positive := positives includes: char. negative := negatives includes: char. self assert: ((positive and: [ negative not ]) or: [ positive not and: [ negative ] ]) description: char printString , ' should be in exactly one set' ]! ! !PPPredicateTest methodsFor: 'utilities' stamp: 'lr 2/8/2010 16:46'! parsedCharacterSet: aParser | result stream | result := WriteStream on: String new. Character allCharacters do: [ :char | (aParser matches: (String with: char)) ifTrue: [ result nextPut: char ] ]. ^ result contents! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'! testAny | parser | parser := #any asParser. self assertCharacterSets: parser. self assert: parser parse: ' ' to: $ . self assert: parser parse: '1' to: $1. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'! testAnyOf | parser | parser := PPPredicateParser anyOf: #($a $z). self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'z' to: $z. self assert: parser fail: 'x'! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'! testBetweenAnd | parser | parser := PPPredicateParser between: $b and: $d. self assertCharacterSets: parser. self assert: parser fail: 'a'. self assert: parser parse: 'b' to: $b. self assert: parser parse: 'c' to: $c. self assert: parser parse: 'd' to: $d. self assert: parser fail: 'e'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 5/5/2010 14:15'! testBlank | parser | parser := #blank asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character space) to: Character space. self assert: parser parse: (String with: Character tab) to: Character tab. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: (String with: Character cr)! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 5/2/2010 12:51'! testChar | parser | parser := $* asParser. self assertCharacterSets: parser. 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'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testControl | parser | parser := #control asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character cr) to: Character cr. self assert: parser parse: (String with: Character tab) to: Character tab. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testCr | parser | parser := #cr asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character cr) to: Character cr! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testDigit | parser | parser := #digit asParser. self assertCharacterSets: parser. self assert: parser parse: '0' to: $0. self assert: parser parse: '9' to: $9. self assert: parser fail: ''. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:40'! testExpect | parser | parser := PPPredicateParser expect: $a. self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b'. self assert: parser fail: ''! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testHex | parser | parser := #hex asParser. self assertCharacterSets: parser. self assert: parser parse: '0' to: $0. self assert: parser parse: '5' to: $5. self assert: parser parse: '9' to: $9. self assert: parser parse: 'A' to: $A. self assert: parser parse: 'D' to: $D. self assert: parser parse: 'F' to: $F. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'e' to: $e. self assert: parser parse: 'f' to: $f. self assert: parser fail: ''. self assert: parser fail: 'g'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testLetter | parser | parser := #letter asParser. self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'Z' to: $Z. self assert: parser fail: ''. self assert: parser fail: '0'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testLf | parser | parser := #lf asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character lf) to: Character lf! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testLowercase | parser | parser := #lowercase asParser. self assertCharacterSets: parser. 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'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:36'! testNewline | parser | parser := #newline asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character cr) to: Character cr. self assert: parser parse: (String with: Character lf) to: Character lf. self assert: parser fail: ' '! ! !PPPredicateTest methodsFor: 'testing' stamp: 'lr 5/2/2010 13:49'! testOnMessage | block parser | block := [ :char | char = $* ]. parser := PPPredicateParser on: block message: 'starlet'. self assert: parser block = block. self assert: parser message = 'starlet'. self assertCharacterSets: parser. 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'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 5/5/2010 14:14'! testPunctuation | parser | parser := #punctuation asParser. self assertCharacterSets: parser. self assert: parser parse: '.' to: $.. self assert: parser parse: ',' to: $,. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: '1'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testSpace | parser | parser := #space asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character tab) to: Character tab. self assert: parser parse: ' ' to: Character space. self assert: parser fail: ''. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testTab | parser | parser := #tab asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character tab) to: Character tab! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testUppercase | parser | parser := #uppercase asParser. self assertCharacterSets: parser. 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'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testWord | parser | parser := #word asParser. self assertCharacterSets: parser. 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: '-'! ! PPAbstractParseTest subclass: #PPTokenTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPTokenTest methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:51'! identifier ^ #word asParser plus token! ! !PPTokenTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 15:34'! parse: aString using: aParser ^ aParser parse: aString! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:49'! testCollection | input result | input := 'foo '. result := self parse: input using: self identifier. self assert: (result collection = input). self assert: (result collection == input)! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/21/2009 08:50'! testCopyFromTo | result other | result := PPToken on: 'abc'. other := result copyFrom: 2 to: 2. self assert: other size = 1. self assert: other start = 2. self assert: other stop = 2. self assert: other collection = result collection! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 10/23/2009 11:37'! testEquality | token1 token2 | token1 := self parse: 'foo' using: self identifier. token2 := self parse: 'foo' using: self identifier. self deny: token1 == token2. self assert: token1 = token2. self assert: token1 hash = token2 hash.! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/14/2010 11:44'! testNew self should: [ PPToken new ] raise: Error. ! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testPrinting | result | result := PPToken on: 'var'. self assert: result printString = 'a PPToken(var)'! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testSize | result | result := self parse: 'foo' using: self identifier. self assert: result size = 3! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testStart | result | result := self parse: 'foo' using: self identifier. self assert: result start = 1! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testStop | result | result := self parse: 'foo' using: self identifier. self assert: result stop = 3! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:51'! testValue | input result | input := 'foo'. result := self parse: input using: self identifier. self assert: result value = input. self deny: result value == input! ! TestCase subclass: #PPCompositeParserTest instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! PPCompositeParserTest subclass: #PPArithmeticParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPArithmeticParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:53'! parserClass ^ PPArithmeticParser! ! !PPArithmeticParserTest methodsFor: 'testing-operations' 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! ! !PPArithmeticParserTest methodsFor: 'testing-operations' 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! ! !PPArithmeticParserTest 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! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 09:32'! testDiv self assert: '12 / 3' is: 4. self assert: '-16 / -4' is: 4! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:46'! testDivMany self assert: '100 / 2' is: 50. self assert: '100 / 2 / 2' is: 25. self assert: '100 / 2 / 2 / 5' is: 5. self assert: '100 / 2 / 2 / 5 / 5' is: 1 ! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 09:31'! testMul self assert: '2 * 3' is: 6. self assert: '2 * -4' is: -8! ! !PPArithmeticParserTest methodsFor: 'testing-operations' 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! ! !PPArithmeticParserTest 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! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:28'! testPow self assert: '2 ^ 3' is: 8. self assert: '-2 ^ 3' is: -8. self assert: '-2 ^ -3' is: -0.125! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:45'! testPowMany self assert: '4 ^ 3' is: 64. self assert: '4 ^ 3 ^ 2' is: 262144. self assert: '4 ^ 3 ^ 2 ^ 1' is: 262144. self assert: '4 ^ 3 ^ 2 ^ 1 ^ 0' is: 262144! ! !PPArithmeticParserTest 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! ! !PPArithmeticParserTest methodsFor: 'testing-operations' 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! ! !PPArithmeticParserTest methodsFor: 'testing-operations' 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! ! PPArithmeticParserTest subclass: #PPExpressionParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPExpressionParserTest class methodsFor: 'testing' stamp: 'lr 4/6/2010 19:40'! shouldInheritSelectors ^ true! ! !PPExpressionParserTest methodsFor: 'accessing' stamp: 'lr 4/6/2010 19:39'! parserInstance | expression parens number | expression := PPExpressionParser new. parens := $( asParser token trim , expression , $) asParser token trim ==> [ :nodes | nodes second ]. number := (#digit asParser plus , ($. asParser , #digit asParser plus) optional) token trim ==> [ :token | token value asNumber ]. expression term: parens / number. expression group: [ :g | g prefix: $- asParser token trim do: [ :op :a | a negated ] ]; group: [ :g | g postfix: '++' asParser token trim do: [ :a :op | a + 1 ]. g postfix: '--' asParser token trim do: [ :a :op | a - 1 ] ]; group: [ :g | g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ]; group: [ :g | g left: $* asParser token trim do: [ :a :op :b | a * b ]. g left: $/ asParser token trim do: [ :a :op :b | a / b ] ]; group: [ :g | g left: $+ asParser token trim do: [ :a :op :b | a + b ]. g left: $- asParser token trim do: [ :a :op :b | a - b ] ]. ^ expression end! ! !PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:13'! testPostfixAdd self assert: '0++' is: 1. self assert: '0++++' is: 2. self assert: '0++++++' is: 3. self assert: '0+++1' is: 2. self assert: '0+++++1' is: 3. self assert: '0+++++++1' is: 4! ! !PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:11'! testPostfixSub self assert: '1--' is: 0. self assert: '2----' is: 0. self assert: '3------' is: 0. self assert: '2---1' is: 0. self assert: '3-----1' is: 0. self assert: '4-------1' is: 0.! ! !PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:13'! testPrefixNegate self assert: '1' is: 1. self assert: '-1' is: -1. self assert: '--1' is: 1. self assert: '---1' is: -1! ! !PPCompositeParserTest class methodsFor: 'testing' stamp: 'lr 10/4/2009 17:09'! isAbstract ^ self name = #PPCompositeParserTest! ! !PPCompositeParserTest class methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:21'! resources ^ Array with: PPParserResource! ! !PPCompositeParserTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 15:33'! assert: aCollection is: anObject | result | result := parser parse: aCollection. result isPetitFailure ifTrue: [ self error: result printString ]. self assert: result = anObject description: 'Got: ' , result printString , '; Expected: ' , anObject printString resumable: true! ! !PPCompositeParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:52'! parserClass self subclassResponsibility! ! !PPCompositeParserTest methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:21'! parserInstance ^ PPParserResource current parserAt: self parserClass! ! !PPCompositeParserTest methodsFor: 'running' stamp: 'FirstnameLastname 11/26/2009 21:48'! setUp super setUp. parser := self parserInstance! ! PPCompositeParserTest subclass: #PPLambdaParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPLambdaParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:53'! parserClass ^ 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-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testAnd self assert: self parserClass and = #('p' ('q' (('p' 'q') 'p')))! ! !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-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testFalse self assert: self parserClass false = #('x' ('y' 'y'))! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testIfThenElse self assert: self parserClass ifthenelse = #('p' 'p')! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testNot self assert: self parserClass not = #('p' ('a' ('b' (('p' 'b') 'a'))))! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testOr self assert: self parserClass or = #('p' ('q' (('p' 'p') 'q')))! ! !PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/22/2010 11:52'! testParseOnError | result beenHere | result := self parserClass parse: '\x.y' onError: [ self fail ]. self assert: result = #('x' 'y'). beenHere := false. result := self parserClass parse: '\x.' onError: [ beenHere := true ]. self assert: beenHere. beenHere := false. result := self parserClass parse: '\x.' onError: [ :fail | beenHere := true. fail ]. self assert: beenHere. self assert: result message = '$( expected'. self assert: result position = 0. beenHere := false. result := self parserClass parse: '\x.' onError: [ :msg :pos | self assert: msg = '$( expected'. self assert: pos = 0. beenHere := true ]. self assert: result. self assert: beenHere! ! !PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/5/2010 14:10'! testParseStartingAtOnError | result beenHere | result := self parserClass parse: 'x' startingAt: #variable onError: [ self fail ]. self assert: result = 'x'. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ beenHere := true ]. self assert: beenHere. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ :fail | beenHere := true. fail ]. self assert: beenHere. self assert: result message = 'letter expected'. self assert: result position = 0. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ :msg :pos | self assert: msg = 'letter expected'. self assert: pos = 0. beenHere := true ]. self assert: beenHere! ! !PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'FirstnameLastname 11/26/2009 21:56'! testProductionAt self assert: (parser productionAt: #foo) isNil. self assert: (parser productionAt: #foo ifAbsent: [ true ]). self assert: (parser productionAt: #start) notNil. self assert: (parser productionAt: #start ifAbsent: [ true ]) notNil. self assert: (parser productionAt: #variable) notNil. self assert: (parser productionAt: #variable ifAbsent: [ true ]) notNil! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testTrue self assert: self parserClass true = #('x' ('y' 'x'))! ! !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'! ! !Symbol methodsFor: '*petitparser-core-converting' stamp: 'lr 4/20/2008 14:01'! asParser ^ PPPredicateParser perform: self! ! !Object methodsFor: '*petitparser-core-converting' stamp: 'lr 4/20/2008 16:06'! asParser ^ PPPredicateParser expect: self! ! !Object methodsFor: '*petitparser-core-testing' stamp: 'lr 2/7/2010 20:54'! isPetitFailure ^ false! ! Object subclass: #PPFailure instanceVariableNames: 'message position' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFailure commentStamp: '' prior: 0! The failure object in PetitParser. It is the only class that responds to #isPetitFailure with true. It contains an error message and a position of the occurence of the failure. Instance Variables: message The error message of this failure. position The position of this failure in the input stream. ! !PPFailure class methodsFor: 'instance creation' stamp: 'lr 5/5/2010 13:56'! message: aString at: anInteger ^ self basicNew initializeMessage: aString at: anInteger! ! !PPFailure methodsFor: 'initialization' stamp: 'lr 5/5/2010 13:55'! initializeMessage: aString at: anInteger message := aString. position := anInteger! ! !PPFailure methodsFor: 'testing' stamp: 'lr 2/7/2010 20:54'! isPetitFailure "I am the only class that should implement this method to return true." ^ true! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 5/5/2010 13:56'! message "Answer a human readable error message of this parse failure." ^ message! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 5/5/2010 13:55'! position "Answer the position in the source string that caused this parse failure." ^ position! ! !PPFailure methodsFor: 'printing' stamp: 'lr 5/5/2010 14:01'! printOn: aStream aStream nextPutAll: self message; nextPutAll: ' at '; print: position! ! Object subclass: #PPMemento instanceVariableNames: 'result count position' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPMemento commentStamp: '' prior: 0! PPMemento is an internal class used by PPMemoizedParser to cache results and detect left-recursive calls. Instance Variables: result The cached result. count The number of recursive cycles followed. position The position of the cached result in the input stream.! !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: 'properties' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPParser commentStamp: '' prior: 0! An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol. Instance Variables: properties Stores additional state in the parser object.! PPParser subclass: #PPDelegateParser instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPDelegateParser commentStamp: '' prior: 0! A parser that delegates to another parser. Instance Variables: parser The parser to delegate to.! PPDelegateParser subclass: #PPActionParser instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPActionParser commentStamp: '' prior: 0! A parser that performs an action block with the successful parse result of the delegate. Instance Variables: block The action block to be executed. ! !PPActionParser class methodsFor: 'instance creation' stamp: 'lr 5/2/2010 16:58'! on: aParser block: aBlock ^ (self on: aParser) setBlock: aBlock! ! !PPActionParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:10'! block "Answer the action block of the receiver." ^ block! ! !PPActionParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:54'! parseOn: aStream | element | ^ (element := super parseOn: aStream) isPetitFailure ifFalse: [ block value: element ] ifTrue: [ element ]! ! !PPActionParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 16:58'! setBlock: aBlock block := aBlock! ! PPActionParser subclass: #PPWrappingParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPWrappingParser commentStamp: '' prior: 0! A parser that performs an action block upon activation with the stream and a continuation block.! !PPWrappingParser methodsFor: 'parsing' stamp: 'lr 5/12/2010 20:19'! parseOn: aStream ^ block value: aStream value: [ parser parseOn: aStream ]! ! PPDelegateParser subclass: #PPAndParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPAndParser commentStamp: 'lr 12/4/2009 18:38' prior: 0! The and-predicate, a parser that succeeds whenever its delegate does, but consumes the input stream [Parr 1994, 1995].! !PPAndParser methodsFor: 'operations' stamp: 'lr 5/1/2010 16:16'! and ^ self! ! !PPAndParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:47'! parseOn: aStream | element position | position := aStream position. element := super parseOn: aStream. aStream position: position. ^ element! ! PPDelegateParser subclass: #PPCompositeParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tools'! !PPCompositeParser commentStamp: 'lr 12/4/2009 18:38' prior: 0! A PPCompositeParser is composed parser built from various primitive parsers. Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection. The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.! PPCompositeParser subclass: #PPArithmeticParser instanceVariableNames: 'terms addition factors multiplication power primary parentheses number' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Examples'! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'! addition ^ (factors separatedBy: ($+ asParser / $- asParser) token trim) foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:28'! factors ^ multiplication / power! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'! multiplication ^ (power separatedBy: ($* asParser / $/ asParser) token trim) foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'! number ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) token trim ==> [ :token | token value asNumber ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'! parentheses ^ $( asParser flatten trim , terms , $) asParser flatten trim ==> #second! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'! power ^ (primary separatedBy: $^ asParser token trim) foldRight: [ :a :op :b | a raisedTo: b ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:28'! primary ^ number / parentheses! ! !PPArithmeticParser methodsFor: 'accessing' stamp: 'lr 7/3/2008 17:06'! start ^ terms end! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:29'! terms ^ addition / factors! ! !PPCompositeParser class methodsFor: 'accessing' stamp: 'lr 1/29/2010 11:35'! ignoredNames "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser." ^ PPCompositeParser allInstVarNames! ! !PPCompositeParser class methodsFor: 'instance creation' stamp: 'lr 12/7/2009 08:24'! new "Answer a new parser starting at the default start symbol." ^ self newStartingAt: self startSymbol! ! !PPCompositeParser class methodsFor: 'instance creation' stamp: 'lr 12/7/2009 08:24'! newStartingAt: aSymbol "Answer a new parser starting at aSymbol." ^ self basicNew initializeStartingAt: aSymbol! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:57'! parse: anObject ^ self parse: anObject startingAt: self startSymbol! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 2/7/2010 21:02'! parse: anObject onError: aBlock ^ self parse: anObject startingAt: self startSymbol onError: aBlock! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:57'! parse: anObject startingAt: aSymbol ^ (self newStartingAt: aSymbol) parse: anObject! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 2/7/2010 21:02'! parse: anObject startingAt: aSymbol onError: aBlock ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock! ! !PPCompositeParser class methodsFor: 'accessing' stamp: 'lr 12/7/2009 08:20'! startSymbol "Answer the method that represents the default start symbol." ^ #start! ! !PPCompositeParser methodsFor: 'initialization' stamp: 'lr 4/30/2010 12:14'! initializeStartingAt: aSymbol | allVariableNames ignoredVariableNames productionIndexesAndNames | self initialize. "find all the productions that need to be initialized" allVariableNames := self class allInstVarNames. ignoredVariableNames := self class ignoredNames. productionIndexesAndNames := ((1 to: self class instSize) collect: [ :index | index -> (allVariableNames at: index) asSymbol ]) reject: [ :assoc | ignoredVariableNames includes: assoc value ]. "initialize productions with an undefined parser to be replaced later" parser := PPUnresolvedParser named: aSymbol. productionIndexesAndNames do: [ :assoc | self instVarAt: assoc key put: (PPUnresolvedParser named: assoc value) ]. parser := self perform: aSymbol. "resolve unresolved parsers with their actual implementation" productionIndexesAndNames do: [ :assoc | (self respondsTo: assoc value) ifFalse: [ self error: 'Unable to initialize ' , assoc value printString ] ifTrue: [ (self instVarAt: assoc key) def: (self perform: assoc value) ] ]! ! !PPCompositeParser methodsFor: 'querying' stamp: 'lr 12/4/2009 18:39'! productionAt: aSymbol "Answer the production named aSymbol." ^ self productionAt: aSymbol ifAbsent: [ nil ]! ! !PPCompositeParser methodsFor: 'querying' stamp: 'lr 12/7/2009 08:47'! productionAt: aSymbol ifAbsent: aBlock "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock." | index | (self class ignoredNames includes: aSymbol) ifTrue: [ ^ aBlock value ]. (self class startSymbol = aSymbol) ifTrue: [ ^ parser ]. ^ self instVarAt: (self class allInstVarNames indexOf: aSymbol ifAbsent: [ ^ aBlock value ])! ! !PPCompositeParser methodsFor: 'accessing' stamp: 'lr 5/16/2008 17:32'! start "Answer the production to start this parser with." self subclassResponsibility! ! PPCompositeParser subclass: #PPLambdaParser instanceVariableNames: 'expression abstraction application variable' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Examples'! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! and ^ self parse: '\p.\q.((p q) p)'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! false ^ self parse: '\x.\y.y'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! ifthenelse ^ self parse: '\p.p'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! not ^ self parse: '\p.\a.\b.((p b) a)'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! or ^ self parse: '\p.\q.((p p) q)'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! true ^ self parse: '\x.\y.x'! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/6/2010 19:38'! abstraction ^ $\ asParser token trim , variable , $. asParser token trim , expression ==> [ :node | Array with: node second with: node fourth ]! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/6/2010 19:38'! application ^ $( asParser token trim , expression , expression , $) asParser token trim ==> [ :node | Array with: node second with: node third ]! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 9/15/2008 09:29'! expression ^ variable / abstraction / application! ! !PPLambdaParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:35'! start ^ expression end! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/6/2010 19:37'! variable ^ (#letter asParser , #word asParser star) token trim ==> [ :token | token value ]! ! !PPDelegateParser class methodsFor: 'instance creation' stamp: 'lr 4/20/2008 16:22'! on: aParser ^ self new setParser: aParser! ! !PPDelegateParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:37'! children ^ Array with: parser! ! !PPDelegateParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:47'! parseOn: aStream ^ parser parseOn: aStream! ! !PPDelegateParser methodsFor: 'initialization' stamp: 'lr 4/20/2008 16:23'! setParser: aParser parser := aParser! ! PPDelegateParser subclass: #PPEndOfInputParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPEndOfInputParser commentStamp: 'lr 4/18/2008 13:46' prior: 0! A parser that succeeds only at the end of the input stream.! !PPEndOfInputParser methodsFor: 'operations' stamp: 'lr 12/7/2009 08:53'! end ^ self! ! !PPEndOfInputParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 13:57'! parseOn: aStream | position result | position := aStream position. result := super parseOn: aStream. (result isPetitFailure or: [ aStream atEnd ]) ifTrue: [ ^ result ]. result := PPFailure message: 'end of input expected' at: aStream position. aStream position: position. ^ result! ! PPDelegateParser subclass: #PPExpressionParser instanceVariableNames: 'operators' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tools'! !PPExpressionParser commentStamp: '' prior: 0! A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators. The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers. expression := PPExpressionParser new. parens := $( asParser token trim , expression , $) asParser token trim ==> [ :nodes | nodes second ]. integer := #digit asParser plus token trim ==> [ :token | token value asInteger ]. Then we define on what term the expression grammar is built on: expression term: parens / integer. Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input. expression group: [ :g | g prefix: $- asParser token trim do: [ :op :a | a negated ] ]; group: [ :g | g postfix: '++' asParser token trim do: [ :a :op | a + 1 ]. g postfix: '--' asParser token trim do: [ :a :op | a - 1 ] ]; group: [ :g | g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ]; group: [ :g | g left: $* asParser token trim do: [ :a :op :b | a * b ]. g left: $/ asParser token trim do: [ :a :op :b | a / b ] ]; group: [ :g | g left: $+ asParser token trim do: [ :a :op :b | a + b ]. g left: $- asParser token trim do: [ :a :op :b | a - b ] ]. After evaluating the above code the 'expression' is an efficient parser that evaluates examples like: expression parse: '-8++'. expression parse: '1+2*3'. expression parse: '1*2+3'. expression parse: '(1+2)*3'. expression parse: '8/4/2'. expression parse: '8/(4/2)'. expression parse: '2^2^3'. expression parse: '(2^2)^3'. Instance Variables: operators The operators defined in the current group.! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 20:48'! build: aParser left: aChoiceParser ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'lr 12/4/2009 17:38'! build: aParser postfix: aChoiceParser ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'lr 12/4/2009 17:39'! build: aParser prefix: aChoiceParser ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 20:48'! build: aParser right: aChoiceParser ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 21:15'! buildOn: aParser ^ self buildSelectors inject: aParser into: [ :term :selector | | list | list := operators at: selector ifAbsent: [ #() ]. list isEmpty ifTrue: [ term ] ifFalse: [ self perform: selector with: term with: (list size = 1 ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ] ifFalse: [ list inject: PPChoiceParser new into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 20:48'! buildSelectors ^ #(build:prefix: build:postfix: build:right: build:left:)! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'lr 2/7/2010 23:20'! group: aOneArgumentBlock "Defines a priority group by evaluating aOneArgumentBlock." operators := Dictionary new. parser := [ aOneArgumentBlock value: self. self buildOn: parser ] ensure: [ operators := nil ]! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! left: aParser do: aThreeArgumentBlock "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." self operator: #build:left: parser: aParser do: aThreeArgumentBlock! ! !PPExpressionParser methodsFor: 'private' stamp: 'lr 2/7/2010 23:23'! operator: aSymbol parser: aParser do: aBlock parser isNil ifTrue: [ ^ self error: 'You did not specify a term when creating the receiver.' ]. operators isNil ifTrue: [ ^ self error: 'Use #group: to define precedence groups in descending order.' ]. (operators at: aSymbol ifAbsentPut: [ OrderedCollection new ]) addLast: (Array with: aParser asParser with: aBlock)! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! postfix: aParser do: aTwoArgumentBlock "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator." self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! prefix: aParser do: aTwoArgumentBlock "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term." self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! right: aParser do: aThreeArgumentBlock "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." self operator: #build:right: parser: aParser do: aThreeArgumentBlock! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 21:26'! term: aParser "Defines the initial term aParser of the receiver." parser isNil ifTrue: [ parser := aParser ] ifFalse: [ self error: 'Unable to redefine the term.' ]! ! PPDelegateParser subclass: #PPFlattenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPFlattenParser commentStamp: 'lr 11/22/2009 13:09' prior: 0! A parser that answers a flat copy of the range my delegate parses.! !PPFlattenParser methodsFor: 'hooks' stamp: 'lr 6/16/2008 10:10'! create: aCollection start: aStartInteger stop: aStopInteger ^ aCollection copyFrom: aStartInteger to: aStopInteger! ! !PPFlattenParser methodsFor: 'parsing' stamp: 'lr 4/6/2010 19:23'! parseOn: aStream | start element stop | start := aStream position. element := super parseOn: aStream. element isPetitFailure ifTrue: [ aStream position: start. ^ element ]. stop := aStream position. ^ self create: aStream collection start: start + 1 stop: stop! ! PPFlattenParser subclass: #PPTokenParser instanceVariableNames: 'tokenClass' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPTokenParser commentStamp: '' prior: 0! A parser that answers a token of the range my delegate parses. Instance Variables: tokenClass The token sub-class to be used.! !PPTokenParser methodsFor: 'private' stamp: 'lr 12/7/2009 09:54'! create: aCollection start: aStartInteger stop: aStopInteger ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger! ! !PPTokenParser methodsFor: 'private' stamp: 'lr 4/6/2010 19:18'! defaultTokenClass ^ PPToken! ! !PPTokenParser methodsFor: 'initialization' stamp: 'lr 4/6/2010 19:19'! initialize tokenClass := self defaultTokenClass ! ! !PPTokenParser methodsFor: 'accessing' stamp: 'lr 4/6/2010 19:23'! tokenClass ^ tokenClass! ! !PPTokenParser methodsFor: 'accessing' stamp: 'lr 4/6/2010 19:24'! tokenClass: aTokenClass tokenClass := aTokenClass! ! PPDelegateParser subclass: #PPMemoizedParser instanceVariableNames: 'stream buffer' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPMemoizedParser commentStamp: '' prior: 0! A memoized parser, for refraining redundant computations. Instance Variables: stream The stream of the associated memento objects. buffer The buffer of memento objects. ! !PPMemoizedParser methodsFor: 'operations' stamp: 'lr 4/2/2009 19:48'! memoized "Ther is no point in memoizing more than once." ^ self! ! !PPMemoizedParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 13:57'! parseOn: aStream | memento | stream == aStream ifFalse: [ self reset: aStream ]. memento := (buffer at: stream position + 1) ifNil: [ buffer at: stream position + 1 put: PPMemento new ]. memento position isNil ifTrue: [ memento result: (stream size - stream position + 2 < memento count ifTrue: [ PPFailure message: 'overflow' at: stream position ] ifFalse: [ memento increment. super parseOn: stream ]). memento position: stream position ] ifFalse: [ stream position: memento position ]. ^ memento result! ! !PPMemoizedParser methodsFor: 'private' stamp: 'lr 4/2/2009 19:22'! reset: aStream stream := aStream. buffer := Array new: aStream size + 1! ! PPDelegateParser subclass: #PPNotParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPNotParser commentStamp: 'lr 12/4/2009 18:38' prior: 0! The npt-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].! !PPNotParser methodsFor: 'operations' stamp: 'lr 7/2/2008 12:13'! not ^ parser! ! !PPNotParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 14:02'! parseOn: aStream | element position | position := aStream position. element := super parseOn: aStream. aStream position: position. ^ element isPetitFailure ifFalse: [ PPFailure message: '' at: aStream position ]! ! PPDelegateParser subclass: #PPRepeatingParser instanceVariableNames: 'min max' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPRepeatingParser commentStamp: '' prior: 0! A parser that eagerly parses min to max instances of my delegate. The default instance parses eagerly an infinite number of elements, as min is set to 0 and max to infinity (SmallInteger maxVal). Instance Variables: min The minimum number of repetitions. max The maximum number of repetitions.! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 11/18/2008 14:53'! on: aParser ^ (super on: aParser) setMin: 0 max: SmallInteger maxVal! ! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser max: aMaxInteger ^ (self on: aParser) setMin: 0 max: aMaxInteger! ! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser min: aMinInteger ^ (self on: aParser) setMin: aMinInteger max: SmallInteger maxVal ! ! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser min: aMinInteger max: aMaxInteger ^ (self on: aParser) setMin: aMinInteger max: aMaxInteger! ! !PPRepeatingParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:08'! max "Answer the maximum number of repetitions." ^ max! ! !PPRepeatingParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:08'! min "Answer the minimum number of repetitions." ^ min! ! !PPRepeatingParser methodsFor: 'parsing' stamp: 'lr 5/3/2010 08:23'! parseOn: aStream | start element elements | start := aStream position. elements := OrderedCollection new. [ elements size < min ] whileTrue: [ (element := super parseOn: aStream) isPetitFailure ifTrue: [ aStream position: start. ^ element ]. elements addLast: element ]. [ elements size < max ] whileTrue: [ (element := super parseOn: aStream) isPetitFailure ifTrue: [ ^ elements asArray ]. elements addLast: element ]. ^ elements asArray! ! !PPRepeatingParser methodsFor: 'printing' stamp: 'lr 4/3/2009 08:39'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' ['; print: min; nextPutAll: ', '; nextPutAll: (max = SmallInteger maxVal ifTrue: [ '*' ] ifFalse: [ max asString ]); nextPut: $]! ! !PPRepeatingParser methodsFor: 'initialization' stamp: 'lr 11/18/2008 14:53'! setMin: aMinInteger max: aMaxInteger min := aMinInteger. max := aMaxInteger! ! PPDelegateParser subclass: #PPTrimmingParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPTrimmingParser commentStamp: 'lr 4/6/2010 19:27' prior: 0! A parser that silently consumes spaces before and after the delegate parser.! !PPTrimmingParser methodsFor: 'private' stamp: 'lr 4/6/2010 19:24'! consumeSpaces: aStream [ aStream atEnd not and: [ aStream peek isSeparator ] ] whileTrue: [ aStream next ]! ! !PPTrimmingParser methodsFor: 'parsing' stamp: 'lr 4/6/2010 19:24'! parseAfterOn: aStream self consumeSpaces: aStream! ! !PPTrimmingParser methodsFor: 'parsing' stamp: 'lr 4/6/2010 19:24'! parseBeforeOn: aStream self consumeSpaces: aStream! ! !PPTrimmingParser methodsFor: 'parsing' stamp: 'lr 4/6/2010 19:30'! parseOn: aStream | position element | position := aStream position. self parseBeforeOn: aStream. element := super parseOn: aStream. element isPetitFailure ifTrue: [ aStream position: position. ^ element ]. self parseAfterOn: aStream. ^ element! ! !PPTrimmingParser methodsFor: 'operations' stamp: 'lr 4/30/2010 12:14'! trim "There is no point in trimming more than once." ^ self! ! PPParser subclass: #PPEpsilonParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPEpsilonParser commentStamp: 'lr 5/15/2008 15:09' prior: 0! A parser that consumes nothing and always succeeds.! !PPEpsilonParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:49'! parseOn: aStream ^ nil! ! PPParser subclass: #PPFailingParser instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPFailingParser commentStamp: '' prior: 0! A parser that consumes nothing and always fails. Instance Variables: message The failure message.! !PPFailingParser class methodsFor: 'instance creation' stamp: 'lr 5/2/2010 19:16'! message: aString ^ self new setMessage: aString! ! !PPFailingParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:10'! message "Answer the error message of the receiving parser." ^ message! ! !PPFailingParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 13:57'! parseOn: aStream ^ PPFailure message: message at: aStream position! ! !PPFailingParser methodsFor: 'printing' stamp: 'lr 4/16/2010 21:27'! printNameOn: aStream super printNameOn: aStream. aStream nextPutAll: ', '; print: message! ! !PPFailingParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 19:16'! setMessage: aString message := aString! ! PPParser subclass: #PPListParser instanceVariableNames: 'parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPListParser commentStamp: '' prior: 0! Abstract parser that parses a list of things in some way (to be specified by the subclasses). Instance Variables: parsers A sequence of other parsers to delegate to.! PPListParser subclass: #PPChoiceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPChoiceParser commentStamp: 'lr 4/18/2008 15:35' prior: 0! A parser that uses the first parser that succeeds.! !PPChoiceParser methodsFor: 'operations' stamp: 'lr 9/17/2008 00:16'! / aRule ^ self copyWith: aRule! ! !PPChoiceParser methodsFor: 'parsing' stamp: 'lr 5/22/2010 11:48'! parseOn: aStream "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered." | element | 1 to: parsers size do: [ :index | element := (parsers at: index) parseOn: aStream. element isPetitFailure ifFalse: [ ^ element ] ]. ^ element! ! !PPListParser class methodsFor: 'instance creation' stamp: 'lr 5/3/2010 20:26'! with: aParser ^ self withAll: (Array with: aParser)! ! !PPListParser class methodsFor: 'instance creation' stamp: 'lr 9/23/2008 18:32'! with: aFirstParser with: aSecondParser ^ self withAll: (Array with: aFirstParser with: aSecondParser)! ! !PPListParser class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 10:12'! withAll: aCollection ^ self basicNew setParsers: aCollection! ! !PPListParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:37'! children ^ parsers! ! !PPListParser methodsFor: 'copying' stamp: 'lr 9/17/2008 22:36'! copyWith: aParser ^ self species withAll: (parsers copyWith: aParser)! ! !PPListParser methodsFor: 'initialization' stamp: 'lr 4/29/2010 10:12'! initialize super initialize. self setParsers: #()! ! !PPListParser methodsFor: 'copying' stamp: 'lr 5/22/2010 10:26'! postCopy super postCopy. parsers := parsers copy! ! !PPListParser methodsFor: 'initialization' stamp: 'lr 4/29/2010 10:12'! setParsers: aCollection parsers := aCollection asArray! ! PPListParser subclass: #PPSequenceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPSequenceParser commentStamp: 'lr 4/18/2008 15:34' prior: 0! A parser that parses a sequence of parsers.! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 9/17/2008 00:17'! , aRule ^ self copyWith: aRule! ! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 9/23/2008 19:09'! map: aBlock ^ self ==> [ :nodes | aBlock valueWithArguments: nodes ]! ! !PPSequenceParser methodsFor: 'parsing' stamp: 'lr 5/6/2010 10:47'! parseOn: aStream "This is optimized code that avoids unnecessary block activations, do not change." | start elements element | start := aStream position. elements := Array new: parsers size. 1 to: parsers size do: [ :index | element := (parsers at: index) parseOn: aStream. element isPetitFailure ifTrue: [ aStream position: start. ^ element ]. elements at: index put: element ]. ^ elements! ! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 1/8/2010 12:01'! permutation: anArrayOfIntegers "Answer a permutation of the receivers sequence." anArrayOfIntegers do: [ :index | (index isInteger and: [ index between: 1 and: parsers size ]) ifFalse: [ self error: 'Invalid permutation index: ' , index printString ] ]. ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]! ! PPParser subclass: #PPLiteralParser instanceVariableNames: 'literal message' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPLiteralParser commentStamp: '' prior: 0! Abstract literal parser that parses some kind of literal type (to be specified by subclasses). Instance Variables: literal The literal object to be parsed. message The error message to be generated. ! PPLiteralParser subclass: #PPLiteralObjectParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPLiteralObjectParser commentStamp: '' prior: 0! A parser that accepts a single literal object, such as a character. This is the same as the predicate parser 'PPPredicateParser expect: literal' but slightly more efficient.! !PPLiteralObjectParser methodsFor: 'operators' stamp: 'lr 6/2/2010 08:39'! caseInsensitive "Answer a parser that can parse the receiver case-insensitive." ^ PPPredicateParser on: [ :value | literal sameAs: value ] message: message! ! !PPLiteralObjectParser methodsFor: 'operators' stamp: 'lr 5/2/2010 13:39'! negate "Answer a parser that is the negation of the receiving literal parser." ^ PPPredicateParser on: [ :each | each ~= literal ] message: 'no ' , message negated: [ :each | each = literal ] message: message! ! !PPLiteralObjectParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 13:57'! parseOn: aStream ^ (aStream atEnd not and: [ aStream peek = literal ]) ifFalse: [ PPFailure message: message at: aStream position ] ifTrue: [ aStream next ]! ! !PPLiteralParser class methodsFor: 'instance creation' stamp: 'lr 1/7/2010 15:30'! on: anObject ^ self on: anObject message: anObject printString , ' expected'! ! !PPLiteralParser class methodsFor: 'instance creation' stamp: 'lr 1/7/2010 15:29'! on: anObject message: aString ^ self new initializeOn: anObject message: aString! ! !PPLiteralParser methodsFor: 'operators' stamp: 'lr 6/1/2010 22:24'! caseInsensitive "Answer a parser that can parse the receiver case-insensitive." self subclassResponsibility! ! !PPLiteralParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 13:25'! initializeOn: anObject message: aString literal := anObject. message := aString! ! !PPLiteralParser methodsFor: 'accessing' stamp: 'lr 5/2/2010 13:26'! literal "Answer the parsed literal." ^ literal! ! !PPLiteralParser methodsFor: 'accessing' stamp: 'lr 5/2/2010 13:26'! message "Answer the failure message." ^ message! ! !PPLiteralParser methodsFor: 'printing' stamp: 'lr 4/16/2010 16:38'! printNameOn: aStream super printNameOn: aStream. aStream nextPutAll: ', '; print: literal! ! PPLiteralParser subclass: #PPLiteralSequenceParser instanceVariableNames: 'size' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPLiteralSequenceParser commentStamp: 'lr 12/4/2009 18:39' prior: 0! A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.! !PPLiteralSequenceParser methodsFor: 'operators' stamp: 'lr 6/1/2010 22:29'! caseInsensitive "Answer a parser that can parse the receiver case-insensitive." ^ [ :stream | | result | (literal sameAs: (result := stream next: size)) ifFalse: [ PPFailure message: message at: stream position ] ifTrue: [ result ] ] asParser! ! !PPLiteralSequenceParser methodsFor: 'initialization' stamp: 'lr 6/1/2010 22:21'! initializeOn: anObject message: aString super initializeOn: anObject message: aString. size := literal size! ! !PPLiteralSequenceParser methodsFor: 'parsing' stamp: 'lr 6/1/2010 22:20'! parseOn: aStream | position result | position := aStream position. result := aStream next: size. result = literal ifTrue: [ ^ result ]. aStream position: position. ^ PPFailure message: message at: position! ! !PPParser class methodsFor: 'instance creation' stamp: 'lr 10/27/2008 11:17'! named: aString ^ self new name: aString! ! !PPParser class methodsFor: 'instance creation' stamp: 'lr 4/18/2008 14:00'! new ^ self basicNew initialize! ! !PPParser methodsFor: 'operations' stamp: 'lr 9/23/2008 18:32'! , aParser "Answer a new parser that parses the receiver followed by aParser." ^ PPSequenceParser with: self with: aParser! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/14/2010 11:46'! / aParser "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)." ^ PPChoiceParser with: self with: aParser! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 5/12/2010 20:32'! ==> aBlock "Answer a new parser that performs aBlock as action handler on success." ^ PPActionParser on: self block: aBlock! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 5/12/2010 20:32'! >=> aBlock "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delgate parser." ^ PPWrappingParser on: self block: aBlock! ! !PPParser methodsFor: 'operations' stamp: 'lr 5/31/2010 15:12'! and "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input." ^ PPAndParser on: self! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 2/19/2010 07:42'! answer: anObject "Answer a new parser that always returns anObject from a successful parse." ^ self ==> [ :nodes | anObject ]! ! !PPParser methodsFor: 'converting' stamp: 'lr 4/19/2008 13:08'! asParser ^ self! ! !PPParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:38'! children "Answer a set of child parsers that could follow the receiver." ^ #()! ! !PPParser methodsFor: 'private' stamp: 'lr 5/7/2009 11:25'! currentTokenParser | context | context := thisContext sender. [ context notNil ] whileTrue: [ (context receiver respondsTo: #tokenParser) ifTrue: [ ^ context receiver tokenParser ]. context := context sender ]. ^ PPTokenParser! ! !PPParser methodsFor: 'operations' stamp: 'lr 2/19/2010 07:38'! def: aParser "Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPParser and later redefine it with another one." ^ self becomeForward: (aParser name: self name)! ! !PPParser methodsFor: 'operations-convenience' stamp: 'lr 2/19/2010 07:42'! delimitedBy: aParser "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser." ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node | node second isNil ifTrue: [ node first ] ifFalse: [ node first copyWith: node second ] ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/30/2010 12:13'! end "Answer a new parser that succeeds at the end of the input and return the result of the receiver." ^ PPEndOfInputParser on: self! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 5/15/2008 16:08'! flatten "Answer a new parser that flattens the underlying collection." ^ PPFlattenParser on: self! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 2/19/2010 07:44'! foldLeft: aBlock "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments." | size args | size := aBlock numArgs. args := Array new: size. ^ self ==> [ :nodes | args at: 1 put: (nodes at: 1). 2 to: nodes size by: size - 1 do: [ :index | args replaceFrom: 2 to: size with: nodes startingAt: index; at: 1 put: (aBlock valueWithArguments: args) ]. args at: 1 ]! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 2/19/2010 07:44'! foldRight: aBlock "Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments." | size args | size := aBlock numArgs. args := Array new: size. ^ self ==> [ :nodes | args at: size put: (nodes at: nodes size). nodes size - size + 1 to: 1 by: 1 - size do: [ :index | args replaceFrom: 1 to: size - 1 with: nodes startingAt: index; at: size put: (aBlock valueWithArguments: args) ]. args at: size ]! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:32'! hasProperty: aKey "Test if the property aKey is present." ^ properties notNil and: [ properties includesKey: aKey ]! ! !PPParser methodsFor: 'initialization' stamp: 'lr 4/24/2008 10:33'! initialize! ! !PPParser methodsFor: 'testing' stamp: 'lr 10/27/2008 11:28'! isUnresolved ^ false! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 2/19/2010 07:43'! map: aBlock "Answer a new parser that works on the receiving sequence an passes in each element as a block argument." ^ self ==> aBlock! ! !PPParser methodsFor: 'parsing' stamp: 'lr 2/8/2010 00:30'! matches: anObject "Answer if anObject can be parsed by the receiver." ^ (self parse: anObject) isPetitFailure not! ! !PPParser methodsFor: 'parsing' stamp: 'lr 2/8/2010 00:32'! matchesIn: anObject "Search anObject repeatedly for the matches of the receiver." | result | result := OrderedCollection new. self matchesIn: anObject do: [ :each | result addLast: each ]. ^ result! ! !PPParser methodsFor: 'parsing' stamp: 'lr 3/1/2010 21:51'! matchesIn: anObject do: aBlock "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match." ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject! ! !PPParser methodsFor: 'parsing' stamp: 'lr 3/3/2010 15:46'! matchingRangesIn: anObject "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." | result | result := OrderedCollection new. [ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser matchesIn: anObject do: [ :value | result addLast: (value first to: value last) ]. ^ result! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:42'! max: anInteger "Answer a new parser that parses the receiver at most anInteger times." ^ PPRepeatingParser on: self max: anInteger! ! !PPParser methodsFor: 'operations' stamp: 'lr 5/31/2010 16:34'! memoized "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway." ^ PPMemoizedParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:42'! min: anInteger "Answer a new parser that parses the receiver at least anInteger times." ^ PPRepeatingParser on: self min: anInteger! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:43'! min: aMinInteger max: aMaxInteger "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times." ^ PPRepeatingParser on: self min: aMinInteger max: aMaxInteger! ! !PPParser methodsFor: 'accessing' stamp: 'lr 4/19/2010 10:35'! name "Answer the production name of the receiver." ^ self propertyAt: #name ifAbsent: [ nil ]! ! !PPParser methodsFor: 'accessing' stamp: 'lr 4/19/2010 10:38'! name: aString self propertyAt: #name put: aString! ! !PPParser methodsFor: 'operations' stamp: 'lr 2/19/2010 07:36'! negate "Answer a new parser consumes any input token but the receiver." ^ self not , #any asParser ==> #second! ! !PPParser methodsFor: 'operations' stamp: 'lr 5/31/2010 15:12'! not "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input." ^ PPNotParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/20/2009 15:30'! optional "Answer a new parser that parses the receiver, if possible." ^ self / nil asParser! ! !PPParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:53'! parse: anObject "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." ^ self parseOn: anObject asPetitStream! ! !PPParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 14:10'! parse: anObject onError: aBlock "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position." | result | result := self parseOn: anObject asPetitStream. result isPetitFailure ifFalse: [ ^ result ]. aBlock numArgs = 0 ifTrue: [ ^ aBlock value ]. aBlock numArgs = 1 ifTrue: [ ^ aBlock value: result ]. ^ aBlock value: result message value: result position! ! !PPParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 22:18'! parseOn: aStream "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:." self subclassResponsibility! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:55'! plus "Answer a new parser that parses the receiver one or more times." ^ self min: 1! ! !PPParser methodsFor: 'operations' stamp: 'lr 5/6/2010 17:02'! plusGreedy: aParser "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." ^ self , (self starGreedy: aParser) map: [ :first :rest | rest copyWithFirst: first ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 3/1/2010 09:56'! plusLazy: aParser "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." ^ self , (self starLazy: aParser) map: [ :first :rest | rest copyWithFirst: first ]! ! !PPParser methodsFor: 'copying' stamp: 'lr 4/19/2010 10:33'! postCopy super postCopy. properties := properties copy! ! !PPParser methodsFor: 'printing' stamp: 'lr 4/16/2010 16:36'! printNameOn: aStream self name isNil ifTrue: [ aStream print: self hash ] ifFalse: [ aStream nextPutAll: self name ]! ! !PPParser methodsFor: 'printing' stamp: 'lr 4/16/2010 16:36'! printOn: aStream super printOn: aStream. aStream nextPut: $(. self printNameOn: aStream. aStream nextPut: $)! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:32'! propertyAt: aKey "Answer the property value associated with aKey." ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:32'! propertyAt: aKey ifAbsent: aBlock "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." ^ properties isNil ifTrue: [ aBlock value ] ifFalse: [ properties at: aKey ifAbsent: aBlock ]! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:32'! propertyAt: aKey ifAbsentPut: aBlock "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:33'! propertyAt: aKey put: anObject "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." ^ (properties ifNil: [ properties := Dictionary new: 1 ]) at: aKey put: anObject! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:33'! removeProperty: aKey "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]! ! !PPParser methodsFor: 'accessing-properties' stamp: 'lr 4/19/2010 10:33'! removeProperty: aKey ifAbsent: aBlock "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." | answer | properties isNil ifTrue: [ ^ aBlock value ]. answer := properties removeKey: aKey ifAbsent: aBlock. properties isEmpty ifTrue: [ properties := nil ]. ^ answer! ! !PPParser methodsFor: 'operations-convenience' stamp: 'lr 2/19/2010 07:56'! separatedBy: aParser "Answer a new parser that parses the receiver one or more times, separated by aParser." ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes | | result | result := Array new: 2 * nodes second size + 1. result at: 1 put: nodes first. nodes second keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ]. result ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 2/8/2010 19:47'! star "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards." ^ PPRepeatingParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 5/6/2010 17:01'! starGreedy: aParser "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." | parser | parser := PPChoiceParser new. parser setParsers: (Array with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ]) with: (aParser and ==> [ :each | OrderedCollection new ])). ^ parser ==> [ :rest | rest asArray ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/29/2010 10:24'! starLazy: aParser "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." | parser | parser := PPChoiceParser new. parser setParsers: (Array with: (aParser and ==> [ :each | OrderedCollection new ]) with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])). ^ parser ==> [ :rest | rest asArray ]! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 4/6/2010 19:25'! token "Answer a new parser that transforms the input to a token." ^ self currentTokenParser on: self! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 4/6/2010 19:26'! token: aTokenClass "Answer a new parser that transforms the input to a token of class aTokenClass." ^ self token tokenClass: aTokenClass! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 4/6/2010 19:31'! trim "Answer a new parser that consumes spaces before and after the receiving parser." ^ PPTrimmingParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 10/23/2008 14:05'! wrapped "Answer a new parser that is simply wrapped." ^ PPDelegateParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/14/2010 11:53'! | aParser "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)." ^ (self not , aParser) / (aParser not , self) ==> #second! ! PPParser subclass: #PPPluggableParser instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPPluggableParser commentStamp: '' prior: 0! A pluggable parser that passes the parser stream into a block. This enables users to perform manual parsing or to embed other parser frameworks into PetitParser. Instance Variables: block The pluggable one-argument block. ! !PPPluggableParser class methodsFor: 'instance creation' stamp: 'lr 5/2/2010 16:52'! on: aBlock ^ self new initializeOn: aBlock! ! !PPPluggableParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:10'! block "Answer the pluggable block." ^ block! ! !PPPluggableParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 16:52'! initializeOn: aBlock block := aBlock! ! !PPPluggableParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:54'! parseOn: aStream | position result | position := aStream position. result := block value: aStream. result isPetitFailure ifTrue: [ aStream position: position ]. ^ result! ! PPParser subclass: #PPPredicateParser instanceVariableNames: 'predicate predicateMessage negated negatedMessage' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Parsers'! !PPPredicateParser commentStamp: '' prior: 0! A parser that accepts if a given predicate holds. Instance Variables: predicate The block testing for the predicate. predicateMessage The error message of the predicate. negated The block testing for the negation of the predicate. negatedMessage The error message of the negated predicate.! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 5/2/2010 13:38'! any ^ self on: [ :each | true ] message: 'input expected' negated: [ :each | false ] message: 'no input expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 5/2/2010 13:38'! anyOf: anArray ^ self on: [ :each | anArray includes: each ] message: 'any of ' , anArray printString , ' expected' negated: [ :each | (anArray includes: each) not ] message: 'none of ' , anArray printString , 'expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 11/29/2009 09:28'! 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 5/5/2010 14:12'! blank ^ self anyOf: (String with: Character space with: Character tab)! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/20/2008 15:54'! char: aCharacter ^ self expect: aCharacter! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! control ^ self on: [ :char | char asInteger < 32 ] message: 'control character expected' negated: [ :char | char asInteger >= 32 ] message: 'no control character expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/5/2009 14:53'! cr ^ self char: Character cr! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! digit ^ self on: [ :char | char isDigit ] message: 'digit expected' negated: [ :char | char isDigit not ] message: 'no digit 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 11/29/2009 09:38'! hex ^ self on: [ :char | (char between: $0 and: $9) or: [ (char between: $a and: $f) or: [ (char between: $A and: $F) ] ] ] message: 'hex digit expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! letter ^ self on: [ :char | char isLetter ] message: 'letter expected' negated: [ :char | char isLetter not ] message: 'no letter expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/5/2009 14:53'! lf ^ self char: Character lf! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! lowercase ^ self on: [ :char | char isLowercase ] message: 'lowercase letter expected' negated: [ :char | char isLowercase not ] message: 'no lowercase letter expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/2/2010 21:02'! newline ^ self anyOf: (String with: Character cr with: Character lf)! ! !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 5/5/2010 14:13'! punctuation ^ self anyOf: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! space ^ self on: [ :char | char isSeparator ] message: 'separator expected' negated: [ :char | char isSeparator not ] message: 'no separator expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/7/2009 11:15'! tab ^ self char: Character tab! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:37'! uppercase ^ self on: [ :char | char isUppercase ] message: 'uppercase letter expected' negated: [ :char | char isUppercase not ] message: 'no uppercase letter expected' ! ! !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: 'accessing' stamp: 'lr 5/2/2010 13:36'! block "Answer the predicate block of the receiver." ^ predicate! ! !PPPredicateParser methodsFor: 'initialization' stamp: 'lr 6/2/2010 08:31'! initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString predicate := aBlock. predicateMessage := aString. negated := aNegatedBlock. negatedMessage := aNegatedString! ! !PPPredicateParser methodsFor: 'accessing' stamp: 'lr 5/2/2010 13:36'! message "Answer the failure message." ^ predicateMessage! ! !PPPredicateParser methodsFor: 'operators' stamp: 'lr 2/7/2010 20:05'! negate "Answer a parser that is the negation of the receiving predicate parser." ^ self class on: negated message: negatedMessage negated: predicate message: predicateMessage! ! !PPPredicateParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 13:58'! parseOn: aStream ^ (aStream atEnd not and: [ predicate value: aStream peek ]) ifFalse: [ PPFailure message: predicateMessage at: aStream position ] ifTrue: [ aStream next ]! ! !PPPredicateParser methodsFor: 'printing' stamp: 'lr 5/2/2010 13:37'! printNameOn: aStream super printNameOn: aStream. aStream nextPutAll: ', '; print: predicateMessage! ! PPParser subclass: #PPUnresolvedParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tools'! !PPUnresolvedParser commentStamp: 'lr 11/28/2009 18:50' prior: 0! This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.! !PPUnresolvedParser methodsFor: 'testing' stamp: 'lr 10/27/2008 11:29'! isUnresolved ^ true! ! !PPUnresolvedParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:51'! parseOn: aStream self error: self printString , ' need to be resolved before execution.'! ! Object subclass: #PPToken instanceVariableNames: 'collection start stop' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPToken commentStamp: '' prior: 0! PPToken represents a parsed part of the input stream. Contrary to a simple String it rembers where it came from, the original collection and its start and stop position. Instance Variables: collection The collection this token comes from. start The start position in the collection. stop The stop position in the collection.! !PPToken class methodsFor: 'instance creation' stamp: 'lr 4/6/2010 20:58'! new self error: 'Token can only be created using a dedicated constructor.'! ! !PPToken class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 12:13'! on: aSequenceableCollection ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size! ! !PPToken class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 12:13'! on: aSequenceableCollection start: aStartInteger stop: aStopInteger ^ self basicNew initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger! ! !PPToken methodsFor: 'comparing' stamp: 'lr 10/7/2009 09:06'! = anObject ^ self class = anObject class and: [ self value = anObject value ]! ! !PPToken methodsFor: 'accessing' stamp: 'lr 5/19/2008 10:54'! collection ^ collection! ! !PPToken methodsFor: 'copying' stamp: 'lr 6/16/2008 10:55'! copyFrom: aStartInteger to: aStopInteger ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3! ! !PPToken methodsFor: 'comparing' stamp: 'lr 10/7/2009 09:06'! hash ^ self value hash! ! !PPToken methodsFor: 'initialization' stamp: 'lr 4/30/2010 12:13'! initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger collection := aSequenceableCollection. start := aStartInteger. stop := aStopInteger! ! !PPToken methodsFor: 'printing' stamp: 'lr 6/16/2008 10:13'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self value; nextPut: $)! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:07'! size ^ self stop - self start + 1! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:05'! start ^ start! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:05'! stop ^ stop! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:12'! value ^ collection copyFrom: start to: stop! ! ReadStream subclass: #PPStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPStream commentStamp: '' prior: 0! A positional stream implementation used for parsing. It overrides some methods for optimization reasons.! !PPStream methodsFor: 'converting' stamp: 'lr 2/7/2010 20:53'! asPetitStream ^ self! ! !PPStream methodsFor: 'accessing' stamp: 'lr 12/4/2009 18:39'! next: anInteger "Answer up to anInteger elements of my collection. Overridden for efficiency." | answer endPosition | endPosition := position + anInteger min: readLimit. answer := collection copyFrom: position + 1 to: endPosition. position := endPosition. ^ answer ! ! !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: 'PaoloBonzini 10/6/2009 20:33'! printOn: aStream aStream nextPutAll: (collection copyFrom: 1 to: position); nextPutAll: '·'; nextPutAll: (collection copyFrom: position + 1 to: readLimit)! ! !UndefinedObject methodsFor: '*petitparser-converting' stamp: 'lr 11/20/2009 15:27'! asParser ^ PPEpsilonParser new! ! !Text methodsFor: '*petitparser-core' stamp: 'lr 2/7/2010 20:53'! asPetitStream ^ string asPetitStream! ! !SequenceableCollection methodsFor: '*petitparser-core-converting' stamp: 'lr 9/17/2008 22:00'! asParser ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])! ! !SequenceableCollection methodsFor: '*petitparser-core-converting' stamp: 'lr 2/7/2010 20:53'! asPetitStream ^ PPStream on: self! ! !Character methodsFor: '*petitparser-core-operators' stamp: 'lr 9/17/2008 21:56'! - aCharacter "Create a range of characters between the receiver and the argument." ^ PPPredicateParser between: self and: aCharacter! ! !Character methodsFor: '*petitparser-converting' stamp: 'lr 11/7/2009 13:36'! asParser ^ PPLiteralObjectParser on: self! !