SystemOrganization addCategory: #'PetitBeta-Core'! SystemOrganization addCategory: #'PetitBeta-Tests'! !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-testing' stamp: 'lr 4/28/2010 21:31'! isList ^ false! ! !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:37'! 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 isList 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: 'name kind' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! PPPattern subclass: #PPListPattern instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPListPattern methodsFor: 'testing' stamp: 'lr 4/28/2010 23:45'! isList ^ true! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 22:26'! any ^ self new! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 23:03'! kind: aParserClass ^ self new kind: aParserClass! ! !PPPattern class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 22:43'! name: aString ^ self new name: aString! ! !PPPattern methodsFor: 'accessing' stamp: 'lr 4/28/2010 22:25'! kind ^ kind! ! !PPPattern methodsFor: 'accessing' stamp: 'lr 4/28/2010 22:25'! kind: aParserClass kind := aParserClass! ! !PPPattern methodsFor: 'matching' stamp: 'lr 4/29/2010 00:17'! match: aParser inContext: aDictionary (kind isNil or: [ aParser isKindOf: kind ]) ifFalse: [ ^ false ]. (name isNil or: [ aParser name = name ]) ifFalse: [ ^ false ]. ^ (aDictionary at: self ifAbsentPut: [ aParser ]) match: aParser inContext: aDictionary! ! !PPPattern methodsFor: 'accessing' stamp: 'lr 4/28/2010 22:24'! name ^ name! ! !PPPattern methodsFor: 'accessing' stamp: 'lr 4/28/2010 22:25'! name: aString name := aString! ! Object subclass: #PPGrammarRule instanceVariableNames: 'search owner' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPGrammarRule class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 22:17'! search: aParser ^ self basicNew setSearch: aParser! ! !PPGrammarRule methodsFor: 'matching' stamp: 'lr 4/28/2010 21:10'! canMatch: aParser ^ true! ! !PPGrammarRule methodsFor: 'matching' stamp: 'lr 4/29/2010 00:04'! performOn: aParser (search match: aParser inContext: owner context) ifFalse: [ ^ nil ]. (self canMatch: aParser) ifFalse: [ ^ nil ]. ^ aParser! ! !PPGrammarRule methodsFor: 'initialization' stamp: 'lr 4/28/2010 20:45'! setOwner: aGrammarSearcher owner := aGrammarSearcher! ! !PPGrammarRule methodsFor: 'initialization' stamp: 'lr 4/28/2010 22:16'! setSearch: aParser search := aParser! ! PPGrammarRule subclass: #PPSearchRule instanceVariableNames: 'answer' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPSearchRule class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 22:17'! search: aParser answer: aBlock ^ (self search: aParser) setAnswer: aBlock! ! !PPSearchRule methodsFor: 'matching' stamp: 'lr 4/28/2010 22:37'! canMatch: aParser owner setAnswer: (answer value: aParser value: owner answer). ^ true! ! !PPSearchRule methodsFor: 'initialization' stamp: 'lr 4/28/2010 22:16'! setAnswer: aBlock answer := aBlock! ! Object subclass: #PPGrammarSearcher instanceVariableNames: 'searches context answer' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPGrammarSearcher methodsFor: 'configuration' stamp: 'lr 4/28/2010 20:47'! addRule: aGrammarRule searches add: (aGrammarRule setOwner: self)! ! !PPGrammarSearcher methodsFor: 'configuration' stamp: 'lr 4/28/2010 20:47'! addRules: aCollection aCollection do: [ :each | self addRule: each ]! ! !PPGrammarSearcher methodsFor: 'accessing' stamp: 'lr 4/28/2010 20:40'! answer ^ answer! ! !PPGrammarSearcher methodsFor: 'accessing' stamp: 'lr 4/28/2010 20:41'! context ^ context! ! !PPGrammarSearcher methodsFor: 'public' stamp: 'lr 4/28/2010 22:55'! execute: aParser | old | old := context. context := Dictionary new. aParser allParsersDo: [ :parser | self performSearchOn: parser ]. context := old. ^ answer! ! !PPGrammarSearcher methodsFor: 'public' stamp: 'lr 4/28/2010 20:48'! execute: aParser initialAnswer: anObject answer := anObject. ^ self execute: aParser! ! !PPGrammarSearcher methodsFor: 'initialization' stamp: 'lr 4/28/2010 22:55'! initialize super initialize. context := Dictionary new. searches := OrderedCollection new. answer := nil! ! !PPGrammarSearcher methodsFor: 'searching' stamp: 'lr 4/28/2010 22:31'! matches: aParser do: aBlock self addRule: (PPSearchRule search: aParser answer: aBlock)! ! !PPGrammarSearcher methodsFor: 'searching' stamp: 'lr 4/28/2010 22:18'! matchesAnyOf: aCollectionOfParsers do: aBlock aCollectionOfParsers do: [ :each | self matches: each do: aBlock ]! ! !PPGrammarSearcher methodsFor: 'private' stamp: 'lr 4/28/2010 23:53'! performSearch: aGrammarRule on: aParser context := Dictionary new. aGrammarRule performOn: aParser! ! !PPGrammarSearcher methodsFor: 'private' stamp: 'lr 4/28/2010 23:52'! performSearchOn: aParser searches do: [ :rule | self performSearch: rule on: aParser ]! ! !PPGrammarSearcher methodsFor: 'initialization' stamp: 'lr 4/28/2010 22:37'! setAnswer: anObject answer := anObject! ! Object subclass: #PPGrammarVisitor instanceVariableNames: 'typeMap' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! PPGrammarVisitor subclass: #PPGrammarOptimizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPGrammarOptimizer 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. ! !PPGrammarOptimizer 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! ! !PPGrammarOptimizer 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! ! !PPGrammarOptimizer 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 ] ] ]! ! !PPGrammarOptimizer 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 ]! ! !PPGrammarOptimizer 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! ! !PPGrammarVisitor methodsFor: 'initialization' stamp: 'lr 4/28/2010 20:36'! initialize self initializeMap! ! !PPGrammarVisitor methodsFor: 'initialization' stamp: 'lr 4/28/2010 20:49'! initializeMap | class | typeMap := Dictionary new. (Pragma allNamed: #accept: from: self class to: PPGrammarVisitor) do: [ :pragma | (typeMap at: pragma arguments first ifAbsentPut: [ Set new ]) add: pragma selector ]! ! !PPGrammarVisitor methodsFor: 'visiting' stamp: 'lr 4/28/2010 20:54'! visit: aParser | selectors | selectors := typeMap at: aParser class name ifAbsent: [ ^ aParser ]. ^ selectors inject: aParser into: [ :parser :selector | self perform: selector with: parser ]! ! !PPGrammarVisitor methodsFor: 'visiting' stamp: 'lr 4/28/2010 20:53'! visitAll: aCollection ^ self collect: [ :each | self visit: each ]! ! 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/28/2010 20:45'! setUp super setUp. optimizer := PPGrammarOptimizer 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: #PPSearcherTest instanceVariableNames: 'searcher' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Tests'! !PPSearcherTest methodsFor: 'running' stamp: 'lr 4/28/2010 21:43'! setUp searcher := PPGrammarSearcher 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! ! !PPLiteralParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/29/2010 00:15'! match: aParser inContext: aDictionary ^ self class = aParser class and: [ self literal = aParser literal ]! !