SystemOrganization addCategory: #'PetitBeta-Core'! SystemOrganization addCategory: #'PetitBeta-Tests'! !PPListParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 10:11'! copyInContext: aDictionary ^ self copy setParsers: (parsers collect: [ :each | each copyInContext: aDictionary ]); yourself! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 10:08'! copyInContext: aDictionary ^ self! ! !PPParser methodsFor: '*petitbeta-operations' stamp: 'lr 4/16/2010 15:43'! dynamicChoice: aParser | dynamicChoice | ^ dynamicChoice := self | aParser / [ :stream | | resolution | resolution := UIManager default chooseFrom: { self name. aParser name } values: { self. aParser } title: 'Resolve ambiguity'. dynamicChoice def: resolution. resolution parseOn: stream ] asParser! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 00:14'! match: aParser inContext: aDictionary ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary ]! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/28/2010 21:25'! matchList: matchList against: parserList inContext: aDictionary ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 00:51'! matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary | parser currentIndex currentDictionary parsers | matchList size < matchIndex ifTrue: [ ^ parserList size < parserIndex ]. parser := matchList at: matchIndex. parser class = PPListPattern ifTrue: [ currentIndex := parserIndex - 1. [ currentDictionary := aDictionary 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) 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) ifFalse: [ ^ false ]. ^ self matchList: matchList index: matchIndex + 1 against: parserList index: parserIndex + 1 inContext: aDictionary! ! !PPParser methodsFor: '*petitbeta-operations' stamp: 'lr 4/16/2010 21:09'! whatFollows: aString at: anInteger | stream | stream := aString asPetitStream. (self transform: [ :parser | parser ==> [ :node | stream position < anInteger ifTrue: [ node ] ifFalse: [ ^ parser followSets ] ] ]) parseOn: stream. ^ #()! ! PPParser subclass: #PPPattern instanceVariableNames: 'verificationBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! PPPattern subclass: #PPListPattern instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 10:22'! any ^ self on: [ :node :context | true ]! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 10:22'! kind: aBehavior ^ self on: [ :node :context | node class = aBehavior ]! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 10:21'! name: aString ^ self on: [ :node :context | node 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/29/2010 10:20'! on: aBlock ^ self basicNew initializeOn: aBlock! ! !PPPattern methodsFor: 'matching' stamp: 'lr 4/29/2010 10:13'! copyInContext: aDictionary ^ aDictionary at: self! ! !PPPattern methodsFor: 'initialization' stamp: 'lr 4/29/2010 10:20'! initializeOn: aBlock verificationBlock := aBlock! ! !PPPattern methodsFor: 'matching' stamp: 'lr 4/29/2010 10:20'! match: aParser inContext: aDictionary (verificationBlock value: aParser value: aDictionary) ifFalse: [ ^ false ]. ^ (aDictionary at: self ifAbsentPut: [ aParser ]) match: aParser inContext: aDictionary! ! Object subclass: #PPOptimizer instanceVariableNames: 'typeMap' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPOptimizer commentStamp: '' prior: 0! - fold duplicate productions into a single production - combine prefixes of an ordered choice - fold nested choices and sequences into the embedding choice or sequence (done, not possible for sequences) - eliminate choices and sequences with only one alternative or element (done, not possible for sequences) - reduce repetitions and options to their simplest form - reduce trivial character classes and string literals to character - transform direct left-recursions into equivalent right-recursions - implement direct left-recursions as repetitions, not recursions. ! !PPOptimizer methodsFor: 'initialization' stamp: 'lr 4/29/2010 00:46'! initialize self initializeMap! ! !PPOptimizer methodsFor: 'initialization' stamp: 'lr 4/29/2010 00:46'! initializeMap | class | typeMap := Dictionary new. (Pragma allNamed: #accept: in: self class) do: [ :pragma | (typeMap at: pragma arguments first ifAbsentPut: [ Set new ]) add: pragma selector ]! ! !PPOptimizer methodsFor: 'public' stamp: 'lr 4/28/2010 20:56'! optimize: aParser "Transform aParser by applying all the matching optimization rules. Repeatedly apply the rules until no more changes can be done." | current | current := aParser. [ | changed | changed := false. current := current transform: [ :parser | | replacement | replacement := self visit: parser. replacement = parser ifFalse: [ changed := true ]. replacement ]. changed ] whileTrue. ^ current! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/28/2010 20:37'! reduceChoice: aChoiceParser "Reduce nested choices and remove repeated elements." | choices index | choices := OrderedCollection new. self reduceChoice: aChoiceParser into: choices. index := choices findFirst: [ :parser | parser class = PPEpsilonParser ]. index isZero ifFalse: [ choices := choices copyFrom: 1 to: index ]. choices isEmpty ifTrue: [ ^ PPEpsilonParser new ]. choices size = 1 ifTrue: [ ^ choices first ]. aChoiceParser children size = choices size ifTrue: [ ^ aChoiceParser ]. ^ aChoiceParser class withAll: choices! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/18/2010 13:21'! reduceChoice: aChoiceParser into: aCollection aChoiceParser children do: [ :parser | aChoiceParser class = parser class ifTrue: [ self reduceChoice: parser into: aCollection ] ifFalse: [ (aCollection includes: parser) ifFalse: [ aCollection addLast: parser ] ] ]! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/28/2010 20:37'! reduceDelegate: aDelegateParser "Certain kind of delegate parsers are idepotent, remove duplicates." ^ aDelegateParser children first class = aDelegateParser class ifTrue: [ aDelegateParser class on: aDelegateParser children first children first ] ifFalse: [ aDelegateParser ]! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/28/2010 20:37'! removeDelegate: aDelegateParser "Delegate parsers are only useful at composition-time, they can be removed at run-time." ^ aDelegateParser children first! ! !PPOptimizer methodsFor: 'visiting' stamp: 'lr 4/29/2010 00:46'! visit: aParser | selectors | selectors := typeMap at: aParser class name ifAbsent: [ ^ aParser ]. ^ selectors inject: aParser into: [ :parser :selector | self perform: selector with: parser ]! ! Object subclass: #PPProcessor instanceVariableNames: 'searches context' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !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 4/29/2010 09:42'! perform: aRule on: aParser context := Dictionary new. ^ aRule performOn: aParser! ! PPProcessor subclass: #PPRewriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPRewriter methodsFor: 'public' stamp: 'lr 4/29/2010 10:03'! execute: aParser "Perform the replace rules of the receiver on aParser, answer the resulting parser." | old | old := context. context := Dictionary new. result := aParser transform: [ :each | searches inject: each into: [ :parser :rule | (self perform: rule on: parser) ifNil: [ parser ] ] ]. context := old. ^ result! ! !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: 'PetitBeta-Core'! !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 4/29/2010 09:58'! execute: aParser initialAnswer: anObject "Perform the search rules of the receiver on aParser. Inject anObject into the matches and answer the result." | old | old := context. answer := anObject. context := Dictionary new. aParser allParsersDo: [ :each | searches do: [ :rule | self perform: rule on: each ] ]. context := old. ^ 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: 'PetitBeta-Core'! PPRule subclass: #PPReplaceRule instanceVariableNames: 'verificationBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! PPReplaceRule subclass: #PPBlockReplaceRule instanceVariableNames: 'replaceBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !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 4/29/2010 08:15'! foundMatchFor: aParser ^ replaceBlock value: aParser! ! !PPBlockReplaceRule methodsFor: 'initialization' stamp: 'lr 4/29/2010 08:29'! setReplaceBlock: aBlock replaceBlock := aBlock! ! PPReplaceRule subclass: #PPParserReplaceRule instanceVariableNames: 'replaceParser' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !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 4/29/2010 08:14'! canMatch: aParser ^ verificationBlock value: 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: 'PetitBeta-Core'! !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 4/29/2010 08:22'! canMatch: aParser owner setAnswer: (answerBlock value: aParser value: 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! ! PPAbstractParseTest subclass: #PPOptimizerTest instanceVariableNames: 'optimizer a b c' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Tests'! !PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 4/19/2010 11:42'! optimize: aParser ^ optimizer optimize: aParser! ! !PPOptimizerTest methodsFor: 'running' stamp: 'lr 4/29/2010 08:10'! setUp super setUp. optimizer := PPOptimizer new. a := $a asParser. b := $b asParser. c := $c asParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/28/2010 20:57'! testEmptyChoice | grammar | grammar := self optimize: (PPChoiceParser withAll: #()). self assert: grammar class = PPEpsilonParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/28/2010 20:57'! testNestedChoice | grammar | grammar := self optimize: a / (b / c). self assert: grammar class = PPChoiceParser. self assert: grammar children size = 3. self assert: grammar children first class = PPLiteralObjectParser. self assert: grammar children last class = PPLiteralObjectParser. grammar := self optimize: (a / b) / c. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 3. self assert: grammar children first class = PPLiteralObjectParser. self assert: grammar children last class = PPLiteralObjectParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/28/2010 20:57'! testNulledChoice | grammar | grammar := self optimize: a / nil asParser / b / c. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 2. self assert: grammar children first class = PPLiteralObjectParser. self assert: grammar children last class = PPEpsilonParser. grammar := self optimize: a / b / nil asParser / c. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 3. self assert: grammar children first class = PPLiteralObjectParser. self assert: grammar children last class = PPEpsilonParser. grammar := self optimize: a / b / c / nil asParser. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 4. self assert: grammar children first class = PPLiteralObjectParser. self assert: grammar children last class = PPEpsilonParser ! ! !PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 4/19/2010 18:39'! testReduceDelegate | grammar | grammar := self optimize: (PPAndParser on: (PPAndParser on: a)). self assert: grammar class = PPAndParser. self assert: grammar children first class = PPLiteralObjectParser. grammar := self optimize: (PPNotParser on: (PPNotParser on: a)). self assert: grammar class = PPNotParser. self assert: grammar children first class = PPLiteralObjectParser. grammar := self optimize: (PPFlattenParser on: (PPFlattenParser on: a)). self assert: grammar class = PPFlattenParser. self assert: grammar children first class = PPLiteralObjectParser. grammar := self optimize: (PPTokenParser on: (PPTokenParser on: a)). self assert: grammar class = PPTokenParser. self assert: grammar children first class = PPLiteralObjectParser. grammar := self optimize: (PPMemoizedParser on: (PPMemoizedParser on: a)). self assert: grammar class = PPMemoizedParser. self assert: grammar children first class = PPLiteralObjectParser. grammar := self optimize: (PPTrimmingParser on: (PPTrimmingParser on: a)). self assert: grammar class = PPTrimmingParser. self assert: grammar children first class = PPLiteralObjectParser! ! !PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 4/28/2010 20:57'! testRemoveDelegate | grammar | grammar := self optimize: a wrapped. self assert: grammar class = PPLiteralObjectParser. grammar := self optimize: a wrapped wrapped. self assert: grammar class = PPLiteralObjectParser. grammar := self optimize: a wrapped / b wrapped wrapped. self assert: grammar class = PPChoiceParser. self assert: grammar children first class = PPLiteralObjectParser. self assert: grammar children last class = PPLiteralObjectParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/28/2010 20:57'! testRepeatedChoice | grammar | grammar := self optimize: a / a / b / c. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 3. grammar := self optimize: a / b / a / a. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 2. grammar := self optimize: a / a / a / a. self assert: grammar class = PPLiteralObjectParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/28/2010 20:57'! testSingleChoice | grammar | grammar := self optimize: (PPChoiceParser withAll: (Array with: a)). self assert: grammar class = PPLiteralObjectParser! ! PPAbstractParseTest subclass: #PPRewriterTest instanceVariableNames: 'rewriter' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Tests'! !PPRewriterTest methodsFor: 'running' stamp: 'lr 4/29/2010 08:47'! setUp rewriter := PPRewriter new! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 4/29/2010 08:55'! testLiteralReplacement | result | rewriter replace: $a asParser with: $b asParser. result := rewriter execute: $a asParser. self assert: result literal = $b. result := rewriter execute: $c asParser. self assert: result literal = $c. result := rewriter execute: $a asParser , $b asParser , $c asParser. 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 4/29/2010 10:04'! testLiteralWrapping | result | rewriter replace: $a asParser withValueFrom: [ :parser | parser token ]. result := rewriter execute: $a asParser. self assert: result class = PPTokenParser. self assert: result children first literal = $a. result := rewriter execute: $c asParser. self assert: result literal = $c. result := rewriter execute: $a asParser , $b asParser. 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! ! PPAbstractParseTest subclass: #PPSearcherTest instanceVariableNames: 'searcher' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Tests'! !PPSearcherTest class methodsFor: 'accessing' stamp: 'lr 4/29/2010 00:52'! packageNamesUnderTest ^ #('PetitBeta')! ! !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' 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 4/29/2010 00:37'! testListInfix | pattern 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 4/29/2010 00:37'! testListPostfix | pattern 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 4/29/2010 00:37'! testListPrefix | pattern 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 4/29/2010 00:10'! 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 second size = 4! ! !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/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! ! !PPEpsilonParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 00:15'! match: aParser inContext: aDictionary ^ self class = aParser class! ! !PPFailingParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 00:15'! match: aParser inContext: aDictionary ^ self class = aParser class! ! !PPDelegateParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 10:09'! copyInContext: aDictionary ^ self copy setParser: (parser copyInContext: aDictionary); yourself! ! !PPLiteralParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 00:15'! match: aParser inContext: aDictionary ^ self class = aParser class and: [ self literal = aParser literal ]! !