SystemOrganization addCategory: #'PetitAnalyzer-Core'! SystemOrganization addCategory: #'PetitAnalyzer-Tests'! !PPListParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/30/2010 08:15'! copyInContext: aDictionary seen: aSeenDictionary | copy copies | aSeenDictionary at: self ifPresent: [ :value | ^ value ]. copy := aSeenDictionary at: self put: self copy. copies := OrderedCollection new. parsers do: [ :each | | result | result := each copyInContext: aDictionary seen: aSeenDictionary. result isCollection ifTrue: [ copies addAll: result ] ifFalse: [ copies add: result ] ]. ^ copy setParsers: copies; yourself! ! !PPListParser methodsFor: '*petitanalyzer-transforming' stamp: 'lr 5/22/2010 10:24'! replace: aParser with: anotherParser super replace: aParser with: anotherParser. parsers keysAndValuesDo: [ :index :parser | parser == aParser ifTrue: [ parsers at: index put: anotherParser ] ]! ! !PPEpsilonParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 10/21/2009 12:11'! isNullable ^ true! ! PPEpsilonParser subclass: #PPSentinel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! PPSentinel class instanceVariableNames: 'current instance'! PPSentinel class instanceVariableNames: 'current instance'! !PPSentinel class methodsFor: 'instance creation' stamp: 'lr 9/16/2010 17:54'! instance ^ instance ifNil: [ instance := self new ]! ! PPAbstractParserTest subclass: #PPAnalyzerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Tests'! !PPAnalyzerTest class methodsFor: 'accessing' stamp: 'lr 11/19/2009 21:51'! packageNamesUnderTest ^ #('PetitAnalyzer')! ! !PPAnalyzerTest methodsFor: 'utilities' stamp: 'lr 2/7/2010 20:54'! assert: aCollection includes: aString epsilon: aBoolean | parsers checker stream | parsers := aCollection collect: [ :each | each end ]. checker := [ :string | parsers anySatisfy: [ :parser | (parser parse: string asPetitStream) isPetitFailure not ] ]. stream := WriteStream on: String new. 32 to: 127 do: [ :index | (checker value: (String with: (Character value: index))) ifTrue: [ stream nextPut: (Character value: index) ] ]. self assert: stream contents = aString description: 'Expected ' , aString printString , ', but got ' , stream contents printString. self assert: (checker value: '') = aBoolean description: 'Expected epsilon to ' , (aBoolean ifTrue: [ 'be' ] ifFalse: [ 'not be' ]) , ' included'! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/20/2009 15:29'! grammarA "Güting, Erwig, Übersetzerbau, Springer (p.63)" | grammar | grammar := Dictionary new. " terminals " grammar at: #a put: $a asParser. grammar at: #b put: $b asParser. grammar at: #c put: $c asParser. grammar at: #d put: $d asParser. grammar at: #e put: nil asParser. " non terminals " grammar at: #B put: (grammar at: #b) / (grammar at: #e). grammar at: #A put: (grammar at: #a) / (grammar at: #B). grammar at: #S put: (grammar at: #A) , (grammar at: #B) , (grammar at: #c) , (grammar at: #d). ^ grammar ! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/19/2009 23:42'! grammarB "The canonical grammar to exercise first- and follow-set calculation, probably originally from the dragon-book." | grammar | grammar := Dictionary new. #(E Ep T Tp F) do: [ :each | grammar at: each put: (PPUnresolvedParser named: each) ]. (grammar at: #E) def: (grammar at: #T) , (grammar at: #Ep). (grammar at: #Ep) def: ($+ asParser , (grammar at: #T) , (grammar at: #Ep)) optional. (grammar at: #T) def: (grammar at: #F) , (grammar at: #Tp). (grammar at: #Tp) def: ($* asParser , (grammar at: #F) , (grammar at: #Tp)) optional. (grammar at: #F) def: ($( asParser , (grammar at: #E) , $) asParser) / $i asParser. #(E Ep T Tp F) do: [ :each | (grammar at: each) name: each ]. ^ grammar! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 10/22/2009 18:32'! grammarC "A highly recrusive grammar." | grammar | grammar := PPUnresolvedParser new. grammar def: (grammar , $+ asParser , grammar) / $1 asParser. ^ grammar! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/19/2009 23:42'! grammarD "A highly ambiguous grammar from: Saichaitanya Jampana. Exploring the problem of ambiguity in context-free grammars. Master s thesis, Oklahoma State University, July 2005." | grammar | grammar := Dictionary new. #(S A a B b) do: [ :each | grammar at: each put: (PPUnresolvedParser named: each) ]. (grammar at: #a) def: $a asParser. (grammar at: #b) def: $b asParser. (grammar at: #S) def: (grammar at: #A) , (grammar at: #B) / (grammar at: #a). (grammar at: #A) def: (grammar at: #S) , (grammar at: #B) / (grammar at: #b). (grammar at: #B) def: (grammar at: #B) , (grammar at: #A) / (grammar at: #a). ^ grammar! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/19/2009 23:52'! grammarE "The most stupid parser, it just references itself and never consumes anything. All algorithms should survive such an attack." | parser | parser := PPDelegateParser new. parser setParser: parser. ^ parser! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/23/2010 10:59'! testAllNamedParsers | p1 p2 p3 | p1 := (#digit asParser name: 'a'). p2 := (#digit asParser name: 'b') star. p3 := (#digit asParser name: 'c') token end. self assert: p1 allNamedParsers size = 1. self assert: p1 allNamedParsers first name = 'a'. self assert: p2 allNamedParsers size = 1. self assert: p2 allNamedParsers first name = 'b'. self assert: p3 allNamedParsers size = 1. self assert: p3 allNamedParsers first name = 'c'! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 4/13/2010 08:37'! testAllParsers | p1 p2 p3 | p1 := #lowercase asParser. p2 := p1 ==> #asUppercase. p3 := PPUnresolvedParser new. p3 def: p2 / p3. self assert: p1 allParsers size = 1. self assert: p2 allParsers size = 2. self assert: p3 allParsers size = 3! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:00'! testCycleSetGrammarA self grammarA do: [ :each | self assert: each cycleSet isEmpty ]! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:01'! testCycleSetGrammarB self grammarB do: [ :each | self assert: each cycleSet isEmpty ]! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:02'! testCycleSetGrammarC | grammar cycleSet | grammar := self grammarC. cycleSet := grammar cycleSet. self assert: (cycleSet size = 2). self assert: (cycleSet includes: grammar)! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'TestRunner 11/20/2009 00:04'! testCycleSetGrammarD | grammar cycleSet | grammar := self grammarD. cycleSet := (grammar at: #S) cycleSet. self assert: (cycleSet size = 4). self assert: (cycleSet includes: (grammar at: #A)). self assert: (cycleSet includes: (grammar at: #S)). cycleSet := (grammar at: #A) cycleSet. self assert: (cycleSet size = 4). self assert: (cycleSet includes: (grammar at: #A)). self assert: (cycleSet includes: (grammar at: #S)). cycleSet := (grammar at: #B) cycleSet. self assert: (cycleSet size = 2). self assert: (cycleSet includes: (grammar at: #B))! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:05'! testCycleSetGrammarE | grammar cycleSet | grammar := self grammarE. cycleSet := grammar cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: grammar)! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/19/2009 23:58'! testCycleSetInChoice | parser cycleSet | parser := PPUnresolvedParser new. parser def: parser / $a asParser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser). parser := PPUnresolvedParser new. parser def: $a asParser / parser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser).! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 15:28'! testCycleSetInSequence | parser cycleSet | parser := PPUnresolvedParser new. parser def: parser , $a asParser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser). parser := PPUnresolvedParser new. parser def: nil asParser , parser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser). parser := PPUnresolvedParser new. parser def: $a asParser , parser. cycleSet := parser cycleSet. self assert: cycleSet isEmpty! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/13/2010 12:19'! testDelegateReplace | one other delegate | one := $a asParser. other := $b asParser. delegate := one token. self assert: delegate children first == one. self deny: delegate children first == other. delegate replace: other with: one. self assert: delegate children first == one. self deny: delegate children first == other. delegate replace: one with: other. self deny: delegate children first == one. self assert: delegate children first == other! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'FirstnameLastname 11/26/2009 21:17'! testFirstSetExpression | grammar | grammar := PPArithmeticParser new. self assert: grammar start firstSet includes: '(-0123456789' epsilon: false. self assert: grammar addition firstSet includes: '(-0123456789' epsilon: false. self assert: grammar factors firstSet includes: '(-0123456789' epsilon: false. self assert: grammar multiplication firstSet includes: '(-0123456789' epsilon: false. self assert: grammar number firstSet includes: '-0123456789' epsilon: false. self assert: grammar parentheses firstSet includes: '(' epsilon: false. self assert: grammar power firstSet includes: '(-0123456789' epsilon: false. self assert: grammar primary firstSet includes: '(-0123456789' epsilon: false. self assert: grammar terms firstSet includes: '(-0123456789' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/12/2009 17:53'! testFirstSetGrammarA | grammar | grammar := self grammarA. self assert: (grammar at: #a) firstSet includes: 'a' epsilon: false. self assert: (grammar at: #b) firstSet includes: 'b' epsilon: false. self assert: (grammar at: #c) firstSet includes: 'c' epsilon: false. self assert: (grammar at: #d) firstSet includes: 'd' epsilon: false. self assert: (grammar at: #e) firstSet includes: '' epsilon: true. self assert: (grammar at: #S) firstSet includes: 'abc' epsilon: false. self assert: (grammar at: #A) firstSet includes: 'ab' epsilon: true. self assert: (grammar at: #B) firstSet includes: 'b' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/12/2009 17:53'! testFirstSetGrammarB | grammar | grammar := self grammarB. self assert: (grammar at: #E) firstSet includes: '(i' epsilon: false. self assert: (grammar at: #Ep) firstSet includes: '+' epsilon: true. self assert: (grammar at: #T) firstSet includes: '(i' epsilon: false. self assert: (grammar at: #Tp) firstSet includes: '*' epsilon: true. self assert: (grammar at: #F) firstSet includes: '(i' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/12/2009 17:53'! testFirstSetGrammarC | grammar | grammar := self grammarC. self assert: grammar firstSet includes: '1' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'TestRunner 11/12/2009 17:55'! testFirstSetGrammarD | grammar | grammar := self grammarD. self assert: (grammar at: #S) firstSet includes: 'ab' epsilon: false. self assert: (grammar at: #A) firstSet includes: 'ab' epsilon: false. self assert: (grammar at: #B) firstSet includes: 'a' epsilon: false. self assert: (grammar at: #a) firstSet includes: 'a' epsilon: false. self assert: (grammar at: #b) firstSet includes: 'b' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/19/2009 23:55'! testFirstSetGrammarE self assert: self grammarE firstSet includes: '' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 10/22/2009 18:10'! testFirstSetLambda | grammar | grammar := PPLambdaParser new. self assert: grammar start firstSet includes: '(ABCDEFGHIJKLMNOPQRSTUVWXYZ\abcdefghijklmnopqrstuvwxyz' epsilon: false. self assert: grammar abstraction firstSet includes: '\' epsilon: false. self assert: grammar application firstSet includes: '(' epsilon: false. self assert: grammar expression firstSet includes: '(ABCDEFGHIJKLMNOPQRSTUVWXYZ\abcdefghijklmnopqrstuvwxyz' epsilon: false. self assert: grammar variable firstSet includes: 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 10/22/2009 19:53'! testFollowSetExampleA | grammar followSets | grammar := self grammarA. followSets := (grammar at: #S) followSets. self assert: (followSets at: (grammar at: #a)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #b)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #c)) includes: 'd' epsilon: false. self assert: (followSets at: (grammar at: #d)) includes: '' epsilon: true. self assert: (followSets at: (grammar at: #e)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #S)) includes: '' epsilon: true. self assert: (followSets at: (grammar at: #A)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #B)) includes: 'bc' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 10/22/2009 19:06'! testFollowSetExampleB | grammar followSets | grammar := self grammarB. followSets := (grammar at: #E) followSets. self assert: (followSets at: (grammar at: #E)) includes: ')' epsilon: true. self assert: (followSets at: (grammar at: #Ep)) includes: ')' epsilon: true. self assert: (followSets at: (grammar at: #T)) includes: ')+' epsilon: true. self assert: (followSets at: (grammar at: #Tp)) includes: ')+' epsilon: true. self assert: (followSets at: (grammar at: #F)) includes: ')*+' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 10/22/2009 19:10'! testFollowSetExampleC self assert: self grammarC followSet includes: '+' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 11/12/2009 18:00'! testFollowSetExampleD | grammar followSets | grammar := self grammarD. followSets := (grammar at: #S) followSets. self assert: (followSets at: (grammar at: #S)) includes: 'a' epsilon: true. self assert: (followSets at: (grammar at: #A)) includes: 'ab' epsilon: true. self assert: (followSets at: (grammar at: #B)) includes: 'ab' epsilon: true. self assert: (followSets at: (grammar at: #a)) includes: 'ab' epsilon: true. self assert: (followSets at: (grammar at: #b)) includes: 'ab' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 11/19/2009 23:54'! testFollowSetExampleE self assert: self grammarE followSet includes: '' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 12/3/2010 17:35'! testInnerChildren | p1 p2 p3 | p1 := (#digit asParser name: 'a'). p2 := (#digit asParser star name: 'b'). p3 := (#digit asParser name: 'c') token star end. self assert: p1 innerChildren isEmpty. self assert: p2 innerChildren size = 1. self assert: (p2 innerChildren allSatisfy: [ :each | each name isNil ]). self assert: p3 innerChildren size = 2. self assert: (p3 innerChildren allSatisfy: [ :each | each name isNil ])! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testIsNullable self assert: $a asParser star isNullable. self assert: nil asParser isNullable. self deny: $a asParser plus isNullable. self deny: PPLiteralSequenceParser new isNullable. self deny: PPLiteralObjectParser new isNullable. self deny: PPPredicateParser new isNullable. self deny: PPChoiceParser new isNullable. self deny: PPSequenceParser new isNullable. self deny: PPAndParser new isNullable. self deny: PPTokenParser new isNullable! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 6/12/2010 09:04'! testIsTerminal self assert: PPEpsilonParser new isTerminal. self assert: PPFailingParser new isTerminal. self assert: PPPluggableParser new isTerminal. self assert: PPLiteralObjectParser new isTerminal. self assert: PPLiteralSequenceParser new isTerminal. self assert: PPPredicateObjectParser new isTerminal. self assert: PPPredicateSequenceParser new isTerminal. self deny: ($a asParser / $b asParser) isTerminal. self deny: ($a asParser , $b asParser) isTerminal. self deny: ($a asParser and) isTerminal. self deny: ($a asParser not) isTerminal! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/13/2010 12:21'! testListReplace | one other another list | one := $a asParser. other := $b asParser. another := $c asParser. list := one , another , one. self assert: list children first == one. self assert: list children second == another. self assert: list children last == one. list replace: other with: one. self assert: list children first == one. self assert: list children second == another. self assert: list children last == one. list replace: one with: other. self assert: list children first == other. self assert: list children second == another. self assert: list children last == other. list replace: another with: one. self assert: list children first == other. self assert: list children second == one. self assert: list children last == other! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/23/2010 11:38'! testNamedChildren | p1 p2 p3 p4 | p1 := (#digit asParser name: 'a'). p2 := (#digit asParser name: 'b') star. p3 := (#digit asParser name: 'c') token end. p4 := ((#digit asParser name: 'c') token name: 'd') end. self assert: p1 namedChildren isEmpty. self assert: p2 namedChildren size = 1. self assert: p2 namedChildren first name = 'b'. self assert: p3 namedChildren size = 1. self assert: p3 namedChildren first name = 'c'. self assert: p4 namedChildren size = 1. self assert: p4 namedChildren first name = 'd'! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/4/2011 19:22'! testRepetitionReplace | one two otherone othertwo repetition | one := $a asParser. two := $b asParser. otherone := $1 asParser. othertwo := $2 asParser. repetition := one starLazy: two. self assert: repetition children first == one. self assert: repetition children second == two. repetition replace: one with: otherone. self assert: repetition children first == otherone. self assert: repetition children second == two. repetition replace: two with: othertwo. self assert: repetition children first == otherone. self assert: repetition children second == othertwo! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/13/2010 23:33'! testTransformIdentityGrammarC | orig tran | orig := self grammarC. tran := orig transform: [ :each | each ]. self deny: orig == tran. self deny: orig children first == tran children first. self deny: orig children first children first == tran children first children first. self deny: orig children first children last == tran children first children last. self deny: orig children last == tran children last. self assert: orig class == PPChoiceParser. self assert: orig children first class == PPSequenceParser. self assert: orig children first children first == orig. self assert: orig children first children last == orig. self assert: orig children last class == PPLiteralObjectParser. self assert: tran class == PPChoiceParser. self assert: tran children first class == PPSequenceParser. self assert: tran children first children first == tran. self assert: tran children first children last == tran. self assert: tran children last class == PPLiteralObjectParser! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/13/2010 23:13'! testTransformIdentityGrammarE | orig tran | orig := self grammarE. tran := orig transform: [ :each | each ]. self deny: orig == tran. self deny: orig children first = tran children first. self assert: orig class == PPDelegateParser. self assert: orig children first == orig. self assert: tran class == PPDelegateParser. self assert: tran children first == tran! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/13/2010 23:32'! testTransformWrapGrammarC | orig tran | orig := self grammarC. tran := orig transform: [ :each | each memoized ]. self assert: orig class == PPChoiceParser. self assert: orig children first class == PPSequenceParser. self assert: orig children first children first == orig. self assert: orig children first children last == orig. self assert: orig children last class == PPLiteralObjectParser. self assert: tran class == PPMemoizedParser. self assert: tran children first class == PPChoiceParser. self assert: tran children first children first class == PPMemoizedParser. self assert: tran children first children first children first class == PPSequenceParser. self assert: tran children first children first children first children first == tran. self assert: tran children first children first children first children last == tran. self assert: tran children first children last class == PPMemoizedParser. self assert: tran children first children last children first class == PPLiteralObjectParser! ! !PPAnalyzerTest methodsFor: 'testing-transform' stamp: 'lr 4/13/2010 23:08'! testTransformWrapGrammarE | orig tran | orig := self grammarE. tran := orig transform: [ :each | each memoized ]. self assert: orig class == PPDelegateParser. self assert: orig children first == orig. self assert: tran class == PPMemoizedParser. self assert: tran children first class == PPDelegateParser. self assert: tran children first children first == tran! ! PPAbstractParserTest subclass: #PPRewriterTest instanceVariableNames: 'rewriter' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Tests'! !PPRewriterTest methodsFor: 'running' stamp: 'lr 4/29/2010 08:47'! setUp rewriter := PPRewriter new! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 5/31/2010 19:19'! testDuplicationRemoval | duplicate before between after result | duplicate := PPPattern any. before := PPListPattern any. between := PPListPattern any. after := PPListPattern any. rewriter replace: before / duplicate / between / duplicate / after with: before / duplicate / between / after. result := rewriter execute: $a asParser / $a asParser. self assert: rewriter hasChanged. self assert: result children size = 1. self assert: result children first literal = $a. result := rewriter execute: $b asParser / $a asParser / $a asParser. self assert: rewriter hasChanged. self assert: result children size = 2. self assert: result children first literal = $b. self assert: result children last literal = $a. result := rewriter execute: $a asParser / $b asParser / $a asParser. self assert: rewriter hasChanged. self assert: result children size = 2. self assert: result children first literal = $a. self assert: result children last literal = $b. result := rewriter execute: $a asParser / $a asParser / $b asParser. self assert: rewriter hasChanged. self assert: result children size = 2. self assert: result children first literal = $a. self assert: result children last literal = $b ! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 5/31/2010 19:20'! testPatternRemoval | pattern result | pattern := PPPattern kind: PPLiteralObjectParser. rewriter replace: pattern / pattern with: pattern. result := rewriter execute: $a asParser / $a asParser. self assert: rewriter hasChanged. self assert: result class = PPLiteralObjectParser. self assert: result literal = $a. result := rewriter execute: $a asParser / $a asParser / $a asParser. self deny: rewriter hasChanged. self assert: result class = PPChoiceParser. self assert: result children size = 3! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 6/12/2010 09:19'! testPatternReplacement | pattern result | pattern := PPPattern kind: PPLiteralObjectParser. rewriter replace: pattern with: pattern , pattern. result := rewriter execute: $a asParser. self assert: rewriter hasChanged. self assert: result class = PPSequenceParser. self assert: result children first literal = $a. self assert: result children last literal = $a. result := rewriter execute: #any asParser. self deny: rewriter hasChanged. self assert: result class = PPPredicateObjectParser! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 5/31/2010 19:21'! testReplaceLiteral | result | rewriter replace: $a asParser with: $b asParser. result := rewriter execute: $a asParser. self assert: rewriter hasChanged. self assert: result literal = $b. result := rewriter execute: $c asParser. self deny: rewriter hasChanged. self assert: result literal = $c. result := rewriter execute: $a asParser , $b asParser , $c asParser. self assert: rewriter hasChanged. self assert: result children size = 3. self assert: result children first literal = $b. self assert: result children last literal = $c! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 5/31/2010 19:22'! testSwapTwoPattern | first second result | first := PPPattern any. second := PPPattern any. rewriter replace: first , second with: second , first. result := rewriter execute: $a asParser , $b asParser. self assert: rewriter hasChanged. self assert: result children first literal = $b. self assert: result children last literal = $a. result := rewriter execute: $a asParser / $b asParser. self deny: rewriter hasChanged. self assert: result children first literal = $a. self assert: result children last literal = $b! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 5/31/2010 19:22'! testWrapLiteral | result | rewriter replace: $a asParser withValueFrom: [ :parser | parser token ]. result := rewriter execute: $a asParser. self assert: rewriter hasChanged. self assert: result class = PPTokenParser. self assert: result children first literal = $a. result := rewriter execute: $c asParser. self deny: rewriter hasChanged. self assert: result literal = $c. result := rewriter execute: $a asParser , $b asParser. self assert: rewriter hasChanged. self assert: result children first class = PPTokenParser. self assert: result children first children first literal = $a. self assert: result children last class = PPLiteralObjectParser. self assert: result children last literal = $b! ! PPAbstractParserTest subclass: #PPSearcherTest instanceVariableNames: 'searcher' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Tests'! !PPSearcherTest methodsFor: 'running' stamp: 'lr 4/29/2010 08:09'! setUp searcher := PPSearcher new! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 4/28/2010 23:04'! testAnyPattern | result | searcher matches: PPPattern any do: [ :parser :answer | answer add: parser; yourself ]. result := searcher execute: ($a asParser) initialAnswer: OrderedCollection new. self assert: result size = 1. result := searcher execute: ($a asParser star) initialAnswer: OrderedCollection new. self assert: result size = 2. result := searcher execute: ($a asParser , $b asParser) initialAnswer: OrderedCollection new. self assert: result size = 3! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/31/2010 19:16'! testCopyMatchAction | old new | old := $a asParser ==> [ :token | $b ]. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 4/30/2010 08:04'! testCopyMatchDelegate | old new | old := $a asParser token trim. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 9/1/2010 22:08'! testCopyMatchEpsilon | old new | old := nil asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/31/2010 19:17'! testCopyMatchFailure | old new | old := PPFailingParser message: 'problem'. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 4/30/2010 08:04'! testCopyMatchList | old new | old := $a asParser , $b asParser , $c asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 4/30/2010 08:04'! testCopyMatchLiteral | old new | old := $a asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/31/2010 19:18'! testCopyMatchPluggable | old new | old := [ :stream | ] asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/31/2010 19:17'! testCopyMatchPredicate | old new | old := #word asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 4/30/2010 08:15'! testCopyMatchRecursiveDelegate | old new | old := PPDelegateParser new. old setParser: old. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 4/30/2010 08:16'! testCopyMatchRecursiveList | old new | old := PPChoiceParser new. old setParsers: (Array with: old). new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/8/2011 20:25'! testCopyMatchRepetition | old new | old := #word asParser star. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/8/2011 20:25'! testCopyMatchRepetitionGreedy | old new | old := #word asParser starGreedy: #digit asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/8/2011 20:25'! testCopyMatchRepetitionLazy | old new | old := #word asParser starLazy: #digit asParser. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing-copy' stamp: 'lr 5/8/2011 20:26'! testCopyMatchRepetitionMinMax | old new | old := #word asParser min: 5 max: 10. new := old copyInContext: Dictionary new. self assert: (old match: old inContext: Dictionary new). self assert: (old match: new inContext: Dictionary new). self deny: (old == new).! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 4/28/2010 23:05'! testKindPattern | result | searcher matches: (PPPattern kind: PPLiteralObjectParser) do: [ :parser :answer | answer add: parser; yourself ]. result := searcher execute: ($a asParser) initialAnswer: OrderedCollection new. self assert: result size = 1. self assert: (result allSatisfy: [ :each | each class = PPLiteralObjectParser ]). result := searcher execute: (#any asParser) initialAnswer: OrderedCollection new. self assert: result isEmpty. result := searcher execute: ($a asParser / #any asParser , $b asParser) initialAnswer: OrderedCollection new. self assert: result size = 2. self assert: (result allSatisfy: [ :each | each class = PPLiteralObjectParser ])! ! !PPSearcherTest methodsFor: 'testing-lists' stamp: 'lr 6/4/2010 13:37'! testListInfix | result | searcher matches: PPListPattern any , $a asParser , PPListPattern any do: [ :parser :answer | true ]. result := searcher execute: $a asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $b asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $a asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $b asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $b asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $b asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $b asParser , $b asParser initialAnswer: false. self deny: result! ! !PPSearcherTest methodsFor: 'testing-lists' stamp: 'lr 6/4/2010 13:37'! testListPostfix | result | searcher matches: PPListPattern any , $b asParser do: [ :parser :answer | true ]. result := searcher execute: $a asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $b asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $a asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $b asParser , $a asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $b asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $b asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $b asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $b asParser , $b asParser initialAnswer: false. self assert: result! ! !PPSearcherTest methodsFor: 'testing-lists' stamp: 'lr 6/4/2010 13:37'! testListPrefix | result | searcher matches: $a asParser , PPListPattern any do: [ :parser :answer | true ]. result := searcher execute: $a asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $b asParser , $b asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $a asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $b asParser , $a asParser initialAnswer: false. self assert: result. result := searcher execute: $a asParser , $a asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $b asParser , $a asParser initialAnswer: false. self deny: result. result := searcher execute: $a asParser , $b asParser , $b asParser initialAnswer: false. self assert: result. result := searcher execute: $b asParser , $a asParser , $b asParser initialAnswer: false. self deny: result. result := searcher execute: $b asParser , $b asParser , $b asParser initialAnswer: false. self deny: result! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 9/15/2010 10:44'! testMatchesAny | result | searcher matchesAnyOf: (Array with: $a asParser with: $b asParser) do: [ :parser :answer | answer add: parser; yourself ]. result := searcher execute: $a asParser , $b asParser , $c asParser initialAnswer: OrderedCollection new. self assert: result size = 2. self assert: result first literal = $a. self assert: result last literal = $b! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 9/1/2010 21:02'! testMultiplePattern | result | searcher matches: $a asParser do: [ :parser :answer | answer first add: parser. answer ]. searcher matches: PPPattern any do: [ :parser :answer | answer second add: parser. answer ]. result := searcher execute: $a asParser , $a asParser , $b asParser initialAnswer: (Array with: OrderedCollection new with: OrderedCollection new). self assert: result first size = 2. self assert: result first first literal = $a. self assert: result first last literal = $a. self assert: result last size = 2. self assert: result last first class = PPSequenceParser. self assert: result last last literal = $b! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 4/28/2010 23:04'! testNamePattern | result | searcher matches: (PPPattern name: 'foo') do: [ :parser :answer | answer add: parser; yourself ]. result := searcher execute: ($a asParser) initialAnswer: OrderedCollection new. self assert: result isEmpty. result := searcher execute: ($a asParser name: 'foo') initialAnswer: OrderedCollection new. self assert: result size = 1. self assert: result first name = 'foo'. result := searcher execute: ($a asParser name: 'bar') , ($b asParser name: 'foo') initialAnswer: OrderedCollection new. self assert: result size = 1. self assert: result first name = 'foo'! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 4/29/2010 21:03'! testNewPattern self should: [ PPPattern new ] raise: Error! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 4/30/2010 07:58'! testRecursivePattern | recursive | recursive := PPDelegateParser new. recursive setParser: recursive. searcher matches: recursive do: [ :parser :answer | parser ]. self assert: (searcher execute: recursive) = recursive. self assert: (searcher execute: $a asParser) isNil. self assert: (searcher execute: $a asParser / $b asParser star) isNil! ! !PPSearcherTest methodsFor: 'testing' stamp: 'lr 4/28/2010 23:20'! testRepeatedPattern | pattern result | searcher matches: (pattern := PPPattern any) , pattern do: [ :parser :answer | answer add: parser; yourself ]. result := searcher execute: ($a asParser , $b asParser) initialAnswer: OrderedCollection new. self assert: result isEmpty. result := searcher execute: $a asParser , $a asParser initialAnswer: OrderedCollection new. self assert: result size = 1. result := searcher execute: ($a asParser , ($a asParser , $b asParser)) initialAnswer: OrderedCollection new. self assert: result isEmpty. result := searcher execute: ($b asParser , ($a asParser , $a asParser)) initialAnswer: OrderedCollection new. self assert: result size = 1! ! !PPPredicateParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 9/15/2010 11:56'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]! ! !PPLiteralParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 9/15/2010 12:08'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]! ! !PPSequenceParser methodsFor: '*petitanalyzer-private' stamp: 'lr 12/9/2010 10:37'! cycleSet: aDictionary | firstSet | 1 to: parsers size do: [ :index | firstSet := aDictionary at: (parsers at: index). (firstSet anySatisfy: [ :each | each isNullable ]) ifFalse: [ ^ parsers copyFrom: 1 to: index ] ]. ^ parsers! ! !PPSequenceParser methodsFor: '*petitanalyzer-private' stamp: 'lr 9/16/2010 17:56'! firstSets: aFirstDictionary into: aSet | nullable | parsers do: [ :parser | nullable := false. (aFirstDictionary at: parser) do: [ :each | each isNullable ifTrue: [ nullable := true ] ifFalse: [ aSet add: each ] ]. nullable ifFalse: [ ^ self ] ]. aSet add: PPSentinel instance! ! !PPSequenceParser methodsFor: '*petitanalyzer-private' stamp: 'lr 8/14/2010 13:51'! followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet parsers keysAndValuesDo: [ :index :parser | | followSet firstSet | followSet := aFollowDictionary at: parser. index = parsers size ifTrue: [ followSet addAll: aSet ] ifFalse: [ (self class withAll: (parsers copyFrom: index + 1 to: parsers size)) firstSets: aFirstDictionary into: (firstSet := IdentitySet new). (firstSet anySatisfy: [ :each | each isNullable ]) ifTrue: [ followSet addAll: aSet ]. followSet addAll: (firstSet reject: [ :each | each isNullable ]) ] ]! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 11/23/2010 10:01'! allNamedParsers "Answer all the named parse nodes of the receiver." | result | result := OrderedCollection new. self allNamedParsersDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 11/23/2010 10:12'! allNamedParsersDo: aBlock "Iterate over all the named parse nodes of the receiver." self allParsersDo: [ :each | each name notNil ifTrue: [ aBlock value: each ] ]! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 4/13/2010 08:36'! allParsers "Answer all the parse nodes of the receiver." | result | result := OrderedCollection new. self allParsersDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 4/13/2010 08:36'! allParsersDo: aBlock "Iterate over all the parse nodes of the receiver." self allParsersDo: aBlock seen: IdentitySet new! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 4/13/2010 08:35'! allParsersDo: aBlock seen: aSet "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet." (aSet includes: self) ifTrue: [ ^ self ]. aSet add: self. aBlock value: self. self children do: [ :each | each allParsersDo: aBlock seen: aSet ]! ! !PPParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/30/2010 07:49'! copyInContext: aDictionary ^ self copyInContext: aDictionary seen: IdentityDictionary new! ! !PPParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/30/2010 08:11'! copyInContext: aDictionary seen: aSeenDictionary ^ aSeenDictionary at: self ifAbsentPut: [ self copy ]! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 11/19/2009 23:49'! cycleSet "Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible." | cycles | cycles := IdentitySet new. self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles. ^ cycles! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/19/2009 23:47'! cycleSet: aDictionary "PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets." ^ self children! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 5/22/2010 10:45'! cycleSet: aStack firstSets: aDictionary into: aSet "PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don't process the children further and add the nodes to aSet." | index | self isTerminal ifTrue: [ ^ self ]. (index := aStack indexOf: self) > 0 ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ]. aStack addLast: self. (self cycleSet: aDictionary) do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ]. aStack removeLast! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 10/22/2009 19:59'! firstSet "Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once." ^ self firstSets at: self! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 9/16/2010 17:55'! firstSets "Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser." | firstSets | firstSets := IdentityDictionary new. self allParsersDo: [ :each | firstSets at: each put: (each isTerminal ifTrue: [ IdentitySet with: each ] ifFalse: [ IdentitySet new ]). each isNullable ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ]. [ | changed tally | changed := false. firstSets keysAndValuesDo: [ :parser :first | tally := first size. parser firstSets: firstSets into: first. changed := changed or: [ tally ~= first size ] ]. changed ] whileTrue. ^ firstSets! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/12/2009 21:25'! firstSets: aFirstDictionary into: aSet "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary." self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 11/12/2009 21:13'! followSet "Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once." ^ self followSets at: self! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 9/16/2010 17:55'! followSets "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser." | current previous continue firstSets followSets | current := previous := 0. firstSets := self firstSets. followSets := IdentityDictionary new. self allParsersDo: [ :each | followSets at: each put: IdentitySet new ]. (followSets at: self) add: PPSentinel instance. [ followSets keysAndValuesDo: [ :parser :follow | parser followSets: followSets firstSets: firstSets into: follow ]. current := followSets inject: 0 into: [ :result :each | result + each size ]. continue := previous < current. previous := current. continue ] whileTrue. ^ followSets! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/12/2009 21:25'! followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary." self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 12/3/2010 16:45'! innerChildren "Answer the inner children of the receiver." | result | result := OrderedCollection new. self innerChildrenDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 12/3/2010 16:48'! innerChildrenDo: aBlock "Iterate over the inner children of the receiver." self innerChildrenDo: aBlock seen: IdentitySet new! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 12/3/2010 16:51'! innerChildrenDo: aBlock seen: aSet "Iterate over the inner children of the receiver." self children do: [ :each | (aSet includes: each) ifTrue: [ ^ self ]. aSet add: each. each name isNil ifTrue: [ aBlock value: each. each innerChildrenDo: aBlock seen: aSet ] ]! ! !PPParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 11/12/2009 17:25'! isNullable "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing." ^ false! ! !PPParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 5/22/2010 10:45'! isTerminal "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser." ^ self children isEmpty! ! !PPParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/29/2010 23:14'! match: aParser inContext: aDictionary ^ self match: aParser inContext: aDictionary seen: IdentitySet new! ! !PPParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 6/18/2010 14:09'! match: aParser inContext: aDictionary seen: anIdentitySet "This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state." (self == aParser or: [ anIdentitySet includes: self ]) ifTrue: [ ^ true ]. anIdentitySet add: self. ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]! ! !PPParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/29/2010 23:07'! matchList: matchList against: parserList inContext: aDictionary seen: aSet ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet! ! !PPParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 5/31/2010 18:37'! matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet | parser currentIndex currentDictionary currentSeen parsers | matchList size < matchIndex ifTrue: [ ^ parserList size < parserIndex ]. parser := matchList at: matchIndex. parser class = PPListPattern ifTrue: [ currentIndex := parserIndex - 1. [ currentDictionary := aDictionary copy. currentSeen := aSet copy. parserList size < currentIndex or: [ parsers := parserList copyFrom: parserIndex to: currentIndex. (currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [ (self matchList: matchList index: matchIndex + 1 against: parserList index: currentIndex + 1 inContext: currentDictionary seen: currentSeen) ifTrue: [ currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ]. ^ true ]. false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ]. ^ false ]. parserList size < parserIndex ifTrue: [ ^ false ]. (parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet) ifFalse: [ ^ false ]. ^ self matchList: matchList index: matchIndex + 1 against: parserList index: parserIndex + 1 inContext: aDictionary seen: aSet! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 11/23/2010 10:55'! namedChildren "Answer the named children of the receiver." | result | result := OrderedCollection new. self namedChildrenDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 11/23/2010 10:55'! namedChildrenDo: aBlock "Iterate over the named children of the receiver." self namedChildrenDo: aBlock seen: IdentitySet new! ! !PPParser methodsFor: '*petitanalyzer-named' stamp: 'lr 11/23/2010 10:55'! namedChildrenDo: aBlock seen: aSet "Iterate over the named children of the receiver." self children do: [ :each | (aSet includes: each) ifTrue: [ ^ self ]. aSet add: each. each name isNil ifTrue: [ each namedChildrenDo: aBlock seen: aSet ] ifFalse: [ aBlock value: each ] ]! ! !PPParser methodsFor: '*petitanalyzer-transforming' stamp: 'lr 4/13/2010 09:38'! replace: aParser with: anotherParser "Replace the references of the receiver pointing to aParser with anotherParser."! ! !PPParser methodsFor: '*petitanalyzer-transforming' stamp: 'lr 10/30/2010 11:54'! transform: aBlock "Answer a copy of all parsers reachable from the receiver transformed using aBlock." | mapping root | mapping := IdentityDictionary new. self allParsersDo: [ :each | mapping at: each put: (aBlock value: each copy) ]. root := mapping at: self. [ | changed | changed := false. root allParsersDo: [ :each | each children do: [ :old | mapping at: old ifPresent: [ :new | each replace: old with: new. changed := true ] ] ]. changed ] whileTrue. ^ root! ! PPParser subclass: #PPPattern instanceVariableNames: 'verificationBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPPattern commentStamp: '' prior: 0! PPPattern is meta-parser that is solely used to match other types of parsers. It cannot be used for actually parsing something. The constructor method determines what can be matched.! PPPattern subclass: #PPListPattern instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPListPattern commentStamp: '' prior: 0! PPListPattern that is used to match any number of parsers. As its superclass, it cannot be used for actually parsing something.! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 08:47'! any "Matches all parsers." ^ self on: [ :parser :context | true ]! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 08:46'! kind: aBehavior "Matches parsers that are of the class aBehavior." ^ self on: [ :parser :context | parser class = aBehavior ]! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 08:46'! name: aString "Matches parsers with the name aString." ^ self on: [ :parser :context | parser name = aString ]! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 10:21'! new self error: 'Use an explicit constructur on ' , self name! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 08:46'! on: aBlock "Matches parsers that satisfy an arbitrary condition in aBlock." ^ self basicNew initializeOn: aBlock! ! !PPPattern methodsFor: 'comparing' stamp: 'lr 4/29/2010 10:33'! = aParser ^ self == aParser or: [ self name notNil and: [ self name = aParser name ] ]! ! !PPPattern methodsFor: 'matching' stamp: 'lr 4/30/2010 07:53'! copyInContext: aDictionary seen: aSeenDictionary ^ aDictionary at: self! ! !PPPattern methodsFor: 'comparing' stamp: 'lr 4/29/2010 10:33'! hash ^ self identityHash! ! !PPPattern methodsFor: 'initialization' stamp: 'lr 4/29/2010 10:20'! initializeOn: aBlock verificationBlock := aBlock! ! !PPPattern methodsFor: 'matching' stamp: 'lr 4/30/2010 12:01'! match: aParser inContext: aDictionary seen: anIdentitySet (verificationBlock value: aParser value: aDictionary) ifFalse: [ ^ false ]. ^ (aDictionary at: self ifAbsentPut: [ aParser ]) match: aParser inContext: aDictionary seen: anIdentitySet! ! !PPPattern methodsFor: 'parsing' stamp: 'lr 4/30/2010 08:48'! parseOn: aStream "This is just a pattern used for matching. It should not be used in actual grammars." self shouldNotImplement! ! !PPActionParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 5/7/2011 15:08'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]! ! !PPLimitedRepeatingParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 5/8/2011 20:07'! copyInContext: aDictionary seen: aSeenDictionary aSeenDictionary at: self ifPresent: [ :value | ^ value ]. ^ (aSeenDictionary at: self put: self copy) setParser: (parser copyInContext: aDictionary seen: aSeenDictionary); setLimit: (limit copyInContext: aDictionary seen: aSeenDictionary); yourself! ! !PPLimitedRepeatingParser methodsFor: '*petitanalyzer-transforming' stamp: 'lr 4/4/2011 18:46'! replace: aParser with: anotherParser super replace: aParser with: anotherParser. limit == aParser ifTrue: [ limit := anotherParser ]! ! !PPDelegateParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/30/2010 08:13'! copyInContext: aDictionary seen: aSeenDictionary aSeenDictionary at: self ifPresent: [ :value | ^ value ]. ^ (aSeenDictionary at: self put: self copy) setParser: (parser copyInContext: aDictionary seen: aSeenDictionary); yourself! ! !PPDelegateParser methodsFor: '*petitanalyzer-transforming' stamp: 'lr 4/13/2010 09:39'! replace: aParser with: anotherParser super replace: aParser with: anotherParser. parser == aParser ifTrue: [ parser := anotherParser ]! ! !PPOptionalParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 9/1/2010 22:10'! isNullable ^ true! ! !PPPredicateSequenceParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 6/18/2010 14:09'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]! ! !PPTokenParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 6/18/2010 14:09'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]! ! !PPRepeatingParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 10/21/2009 12:13'! isNullable ^ min = 0! ! !PPRepeatingParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 6/18/2010 14:09'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]! ! !PPPluggableParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 6/18/2010 14:09'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]! ! Object subclass: #PPProcessor instanceVariableNames: 'searches context' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPProcessor commentStamp: '' prior: 0! PPProcessor is an abstract superclass to PPRewriter and PPSearcher. It implements common functionality to search and transform grammars. The implementation of these matching algorithms is inspired from the refactoring engine by Don Roberts and John Brant. Contrary to the original implementation that worked on syntax trees, this implementation was generalized and works on possibly cyclic search patterns and grammar graphs. Instance Variables: searches The rules to be processed. context The current search context.! !PPProcessor class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 08:34'! new ^ self basicNew initialize! ! !PPProcessor methodsFor: 'rules' stamp: 'lr 4/29/2010 09:34'! addRule: aGrammarRule searches add: (aGrammarRule setOwner: self)! ! !PPProcessor methodsFor: 'private' stamp: 'lr 4/29/2010 09:34'! context ^ context! ! !PPProcessor methodsFor: 'initialization' stamp: 'lr 4/29/2010 09:38'! initialize super initialize. searches := OrderedCollection new. context := Dictionary new! ! !PPProcessor methodsFor: 'private' stamp: 'lr 9/1/2010 20:53'! performRule: aRule on: aParser context := Dictionary new. ^ aRule performOn: aParser! ! !PPProcessor methodsFor: 'private' stamp: 'lr 9/1/2010 20:56'! performRulesOn: aParser | result | searches do: [ :rule | result := self performRule: rule on: aParser. result notNil ifTrue: [ ^ result ] ]. ^ nil! ! PPProcessor subclass: #PPRewriter instanceVariableNames: 'changed' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPRewriter commentStamp: '' prior: 0! PPRewriter walks over a grammar graph and transforms its parsers. If the grammar is modified, #hasChanged returns true. Instance Variables: changed Indicates if the last operation has changed anything.! !PPRewriter methodsFor: 'public' stamp: 'lr 9/1/2010 20:58'! execute: aParser "Perform the replace rules of the receiver on aParser, answer the resulting parser." | previous result | previous := context. changed := false. context := Dictionary new. result := aParser transform: [ :each | | transformed | transformed := self performRulesOn: each. transformed isNil ifTrue: [ each ] ifFalse: [ changed := true. transformed ] ]. context := previous. ^ result! ! !PPRewriter methodsFor: 'testing' stamp: 'lr 4/29/2010 21:28'! hasChanged "Answer if the last operation has changed anything." ^ changed! ! !PPRewriter methodsFor: 'initialization' stamp: 'lr 4/29/2010 21:28'! initialize super initialize. changed := false! ! !PPRewriter methodsFor: 'accessing' stamp: 'lr 4/29/2010 10:16'! replace: aSearchParser with: aReplaceParser self replace: aSearchParser with: aReplaceParser when: [ :node | true ]! ! !PPRewriter methodsFor: 'accessing' stamp: 'lr 4/29/2010 08:25'! replace: aSearchParser with: aReplaceParser when: aValidationBlock self addRule: (PPParserReplaceRule searchFor: aSearchParser replaceWith: aReplaceParser when: aValidationBlock)! ! !PPRewriter methodsFor: 'accessing' stamp: 'lr 4/29/2010 10:16'! replace: aSearchParser withValueFrom: aReplaceBlock self replace: aSearchParser withValueFrom: aReplaceBlock when: [ :node | true ]! ! !PPRewriter methodsFor: 'accessing' stamp: 'lr 4/29/2010 08:25'! replace: aSearchParser withValueFrom: aReplaceBlock when: aValidationBlock self addRule: (PPBlockReplaceRule searchFor: aSearchParser replaceWith: aReplaceBlock when: aValidationBlock)! ! PPProcessor subclass: #PPSearcher instanceVariableNames: 'answer' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPSearcher commentStamp: '' prior: 0! PPSearcher walks over a grammar specification and matches its parsers against the patterns using #match:inContext:. Instance Variables: answer The answer propagated between matches.! !PPSearcher methodsFor: 'private' stamp: 'lr 4/29/2010 09:46'! answer ^ answer! ! !PPSearcher methodsFor: 'public' stamp: 'lr 4/29/2010 09:45'! execute: aParser "Perform the search rules of the receiver on aParser. Answer the result of the search." ^ self execute: aParser initialAnswer: nil! ! !PPSearcher methodsFor: 'public' stamp: 'lr 9/1/2010 20:56'! execute: aParser initialAnswer: anObject "Perform the search rules of the receiver on aParser. Inject anObject into the matches and answer the result." | previous | previous := context. answer := anObject. context := Dictionary new. aParser allParsersDo: [ :each | self performRulesOn: each ]. context := previous. ^ answer! ! !PPSearcher methodsFor: 'rules' stamp: 'lr 4/29/2010 09:48'! matches: aParser do: anAnswerBlock "Add a search expression aParser, evaluate anAnswerBlock with the matched node and the previous answer." self addRule: (PPSearchRule searchFor: aParser thenDo: anAnswerBlock)! ! !PPSearcher methodsFor: 'rules' stamp: 'lr 4/29/2010 09:56'! matchesAnyOf: aCollectionOfParsers do: anAnswerBlock "Add a collection of search expressions aCollectionOfParsers, evaluate anAnswerBlock with the matched node and the previous answer." aCollectionOfParsers do: [ :each | self matches: each do: anAnswerBlock ]! ! !PPSearcher methodsFor: 'initialization' stamp: 'lr 4/29/2010 09:37'! setAnswer: anObject answer := anObject! ! Object subclass: #PPRule instanceVariableNames: 'owner search' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPRule commentStamp: '' prior: 0! PPRule is the abstract superclass of all of the grammar search rules. A rule is the first class representation of a particular pattern to search for. The owner of the rule is the algorithms that actually executes the search. This arrangement allows multiple searches to be conducted by a single processor. Instance Variables: owner The processor that is actually performing the search. search The parse pattern to be searched. ! PPRule subclass: #PPReplaceRule instanceVariableNames: 'verificationBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPReplaceRule commentStamp: '' prior: 0! PPReplaceRule is the abstract superclass of all of the transforming rules. The rules change the grammar by replacing the node that matches the rule. Subclasses implement different strategies for this replacement. Instance Variables: verificationBlock Is evaluated with the matching parser and allows for further verification of a match.! PPReplaceRule subclass: #PPBlockReplaceRule instanceVariableNames: 'replaceBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPBlockReplaceRule commentStamp: '' prior: 0! PPBlockReplaceRule replaces the matching node by the result of evaluating replaceBlock. This allows arbitrary computation to come up with a replacement. Instance Variables: replaceBlock The block that returns the parer to replace to matching parser with. ! !PPBlockReplaceRule class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 08:28'! searchFor: aSearchParser replaceWith: aReplaceBlock when: aVerificationBlock ^ (self searchFor: aSearchParser) setReplaceBlock: aReplaceBlock; setVerificationBlock: aVerificationBlock; yourself! ! !PPBlockReplaceRule methodsFor: 'matching' stamp: 'lr 6/5/2011 16:51'! foundMatchFor: aParser ^ replaceBlock cull: aParser! ! !PPBlockReplaceRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:29'! setReplaceBlock: aBlock replaceBlock := aBlock! ! PPReplaceRule subclass: #PPParserReplaceRule instanceVariableNames: 'replaceParser' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPParserReplaceRule commentStamp: '' prior: 0! PPParserReplaceRule replaces a matched grammar with another grammar, which may include patterns from the matching grammar. Instance Variables: replaceParser The parser to replace the matched parser with.! !PPParserReplaceRule class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 08:28'! searchFor: aSearchParser replaceWith: aReplaceParser when: aVerificationBlock ^ (self searchFor: aSearchParser) setReplaceParser: aReplaceParser; setVerificationBlock: aVerificationBlock; yourself! ! !PPParserReplaceRule methodsFor: 'matching' stamp: 'lr 4/29/2010 08:16'! foundMatchFor: aParser ^ replaceParser copyInContext: owner context! ! !PPParserReplaceRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:29'! setReplaceParser: aParser replaceParser := aParser! ! !PPReplaceRule methodsFor: 'matching' stamp: 'lr 6/5/2011 16:52'! canMatch: aParser ^ verificationBlock cull: aParser! ! !PPReplaceRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:13'! initialize super initialize. verificationBlock := [ :parser | true ]! ! !PPReplaceRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:26'! setVerificationBlock: aBlock verificationBlock := aBlock! ! !PPRule class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 09:51'! new ^ self basicNew initialize! ! !PPRule class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 09:51'! searchFor: aParser ^ self new setSearch: aParser! ! !PPRule methodsFor: 'matching' stamp: 'lr 4/28/2010 21:10'! canMatch: aParser ^ true! ! !PPRule methodsFor: 'matching' stamp: 'lr 4/29/2010 08:14'! foundMatchFor: aParser self subclassResponsibility! ! !PPRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:51'! initialize! ! !PPRule methodsFor: 'matching' stamp: 'lr 4/29/2010 08:53'! performOn: aParser (search match: aParser inContext: owner context) ifFalse: [ ^ nil ]. (self canMatch: aParser) ifFalse: [ ^ nil ]. ^ self foundMatchFor: aParser! ! !PPRule methodsFor: 'initialization' stamp: 'lr 4/28/2010 20:45'! setOwner: aGrammarSearcher owner := aGrammarSearcher! ! !PPRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:23'! setSearch: aParser search := aParser! ! PPRule subclass: #PPSearchRule instanceVariableNames: 'answerBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Core'! !PPSearchRule commentStamp: '' prior: 0! PPSearchRule is a rule that simply searches for matches to the rule. Every time a match is found, answerBlock is evaluated with the parser that matches and the current answer. This two-argument approach allows a collection to be formed from all of the matches, like with #inject:into:. Instance Variables: answerBlock Block to evaluate with the matching node and the current answer. ! !PPSearchRule class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 08:21'! searchFor: aParser thenDo: aBlock ^ (self searchFor: aParser) setAnswerBlock: aBlock! ! !PPSearchRule methodsFor: 'matching' stamp: 'lr 6/5/2011 16:51'! canMatch: aParser owner setAnswer: (answerBlock cull: aParser cull: owner answer). ^ super canMatch: aParser! ! !PPSearchRule methodsFor: 'matching' stamp: 'lr 4/29/2010 08:15'! foundMatchFor: aParser ^ aParser! ! !PPSearchRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 09:51'! setAnswerBlock: aBlock answerBlock := aBlock! ! !PPFailingParser methodsFor: '*petitanalyzer-matching' stamp: 'lr 4/30/2010 12:01'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]! !