SystemOrganization addCategory: #'PetitBeta-Processor'! SystemOrganization addCategory: #'PetitBeta-Generator'! SystemOrganization addCategory: #'PetitBeta-Tests'! !PPChoiceParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:13'! storeSeparatorOn: aStream aStream nextPutAll: ' / '! ! !PPPluggableParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 11:02'! match: aParser inContext: aDictionary seen: aSet ^ (super match: aParser inContext: aDictionary seen: aSet) and: [ self block = aParser block ]! ! !PPPluggableParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 19:26'! storeOn: aStream continue: aBlock aStream nextPutAll: self class name; nextPutAll: ' new'! ! !PPAndParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:14'! storeOn: aStream continue: aBlock super storeOn: aStream continue: aBlock. aStream nextPutAll: ' and'! ! !PPEpsilonParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 12:01'! match: aParser inContext: aDictionary seen: anIdentitySet ^ self class = aParser class! ! !PPEpsilonParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:21'! storeOn: aStream continue: aBlock aStream nextPutAll: 'nil asParser'! ! !PPTokenParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 11:01'! match: aParser inContext: aDictionary seen: aSet ^ (super match: aParser inContext: aDictionary seen: aSet) and: [ self tokenClass = aParser tokenClass ]! ! !PPTokenParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/2/2010 12:04'! storeOn: aStream continue: aBlock aBlock value: parser. aStream nextPutAll: ' token'! ! !PPLiteralParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 12:01'! match: aParser inContext: aDictionary seen: anIdentitySet ^ self class = aParser class and: [ self literal = aParser literal ]! ! !PPLiteralParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 20:30'! storeOn: aStream continue: aBlock aStream store: literal; nextPutAll: ' asParser'! ! !PPTrimmingParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:18'! storeOn: aStream continue: aBlock super storeOn: aStream continue: aBlock. aStream nextPutAll: ' trim'! ! !PPEndOfInputParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:17'! storeOn: aStream continue: aBlock super storeOn: aStream continue: aBlock. aStream nextPutAll: ' end'! ! !PPSequenceParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:13'! storeSeparatorOn: aStream aStream nextPutAll: ' , '! ! Object subclass: #PPGenerator instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Generator'! !PPGenerator methodsFor: 'utilities' stamp: 'lr 5/1/2010 19:15'! createClass: classSymbol superclass: superclassSymbol category: categoryString | class | model defineClass: ('<1s> subclass: #<2s> instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: <3p>' expandMacrosWith: superclassSymbol with: classSymbol with: categoryString asSymbol). class := model classNamed: classSymbol. class isNil ifTrue: [ ^ nil ]. class selectors do: [ :selector | ((class protocolsFor: selector) anySatisfy: [ :each | each beginsWith: #generated ]) ifTrue: [ class removeSelector: selector ] ]. ^ class! ! !PPGenerator methodsFor: 'initialization' stamp: 'lr 4/30/2010 21:44'! initialize model := RBNamespace new! ! PPGenerator subclass: #PPParserGenerator instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Generator'! !PPParserGenerator methodsFor: 'generation' stamp: 'lr 5/2/2010 12:00'! generate: aParser named: aString "self new generate: PPSmalltalkGrammar new named: #PPGenerationTest" "self new generate: PPArithmeticParser new named: #PPGenerationTest" "self new generate: PPLambdaParser new named: #PPGenerationTest" aParser name isNil ifTrue: [ aParser name: #start ]. class := self createClass: aString superclass: #PPCompositeParser category: #Generated. aParser allParsers do: [ :each | each name isNil ifFalse: [ self generateProduction: each ] ]. model changes open! ! !PPParserGenerator methodsFor: 'generation-productions' stamp: 'lr 5/2/2010 11:49'! generateProduction: aParser self generateProduction: aParser named: aParser name seen: IdentitySet new! ! !PPParserGenerator methodsFor: 'generation-productions' stamp: 'lr 5/2/2010 11:50'! generateProduction: aParser named: aString seen: anIdentitySet | stream | stream := WriteStream on: String new. stream nextPutAll: aString; cr. stream tab; nextPutAll: '^ '. class addInstanceVariable: aString. aParser storeOn: stream continue: [ :parser | self generateProduction: parser named: aString seen: anIdentitySet on: stream ]. class compile: stream contents classified: #(generated-productions)! ! !PPParserGenerator methodsFor: 'generation-productions' stamp: 'lr 5/2/2010 11:48'! generateProduction: aParser named: aString seen: anIdentitySet on: aStream aParser name notNil ifTrue: [ aStream nextPutAll: aParser name ] ifFalse: [ (anIdentitySet includes: aParser) ifTrue: [ | index | index := 1. [ aParser name: aString , index asString. anIdentitySet includes: aParser name ] whileTrue: [ index := index + 1 ]. self generateProduction: aParser named: aString seen: anIdentitySet ] ifFalse: [ anIdentitySet add: self. aParser storeOn: aStream continue: [ :parser | self generateProduction: parser named: aString seen: anIdentitySet on: aStream ] ] ]! ! Object subclass: #PPOptimizer instanceVariableNames: 'rewriter' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Processor'! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 21:40'! emptyChoice rewriter replace: PPChoiceParser new with: PPEpsilonParser new! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/29/2010 21:41'! identityWrapper rewriter replace: (PPPattern kind: PPDelegateParser) withValueFrom: [ :parser | parser children first ]! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/29/2010 21:41'! idepotentDelegate rewriter replace: PPPattern any withValueFrom: [ :parser | parser children first ] when: [ :parser | parser children size = 1 and: [ parser class = parser children first class and: [ #(PPAndParser PPNotParser PPEndOfInputParser PPFlattenParser PPTokenParser PPMemoizedParser PPTrimmingParser) includes: parser class name ] ] ]! ! !PPOptimizer methodsFor: 'initialization' stamp: 'lr 4/29/2010 21:01'! initialize rewriter := PPRewriter new. (Pragma allNamed: #optimize in: self class) do: [ :each | self perform: each selector ]! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 21:40'! nestedChoice | before inside after | before := PPListPattern any. inside := PPListPattern any. after := PPListPattern any. rewriter replace: before / (PPChoiceParser with: inside) / after with: before / inside / after! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 21:40'! nulledChoice | before parser after | before := PPListPattern any. parser := PPPattern any. after := PPListPattern any. rewriter replace: before / PPEpsilonParser new / parser / after with: before / PPEpsilonParser new! ! !PPOptimizer methodsFor: 'public' stamp: 'lr 4/29/2010 21:29'! 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. [ current := rewriter execute: current. rewriter hasChanged ] whileTrue. ^ current! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 23:19'! prefixedChoice | before prefix body1 body2 postfix after | before := PPListPattern any. prefix := PPPattern any. body1 := PPListPattern any. body2 := PPListPattern any. postfix := PPPattern any. after := PPListPattern any. rewriter replace: before / (prefix , body1) / (prefix , body2) / after with: before / (prefix , (body1 / body2)) / after. rewriter replace: before / (body1 , postfix) / (body2 , postfix) / after with: before / ((body1 / body2) , postfix) / after! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 21:41'! repeatedChoice | before parser between after | before := PPListPattern any. parser := PPPattern any. between := PPListPattern any. after := PPListPattern any. rewriter replace: before / parser / between / parser / after with: before / parser / between / after! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 21:41'! singleChoice | parser | parser := PPPattern any. rewriter replace: (PPChoiceParser with: parser) with: parser! ! Object subclass: #PPProcessor instanceVariableNames: 'searches context' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Processor'! !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 heavily 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 recursive pattern and search graphs.! !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 4/29/2010 09:42'! perform: aRule on: aParser context := Dictionary new. ^ aRule performOn: aParser! ! PPProcessor subclass: #PPRewriter instanceVariableNames: 'changed' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Processor'! !PPRewriter commentStamp: '' prior: 0! PPRewriter walks over a grammar graph and transforms its parsers. If the grammar is modified, #hasChanged returns true.! !PPRewriter methodsFor: 'public' stamp: 'lr 4/29/2010 21:31'! execute: aParser "Perform the replace rules of the receiver on aParser, answer the resulting parser." | old result | old := context. changed := false. context := Dictionary new. result := aParser transform: [ :each | | transformed | transformed := searches inject: each into: [ :parser :rule | (self perform: rule on: parser) ifNil: [ parser ] ]. transformed == each ifFalse: [ changed := true ]. transformed ]. context := old. ^ 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: 'PetitBeta-Processor'! !PPSearcher commentStamp: '' prior: 0! PPSearcher walks over a grammar specification and matches its parsers against the patterns using #match:inContext:.! !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-Processor'! !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.! PPRule subclass: #PPReplaceRule instanceVariableNames: 'verificationBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Processor'! !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.! PPReplaceRule subclass: #PPBlockReplaceRule instanceVariableNames: 'replaceBlock' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Processor'! !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.! !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-Processor'! !PPParserReplaceRule commentStamp: '' prior: 0! PPParserReplaceRule replaces a matched grammar with another grammar, which may include patterns from the matching grammar.! !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-Processor'! !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:.! !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! ! !PPFlattenParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:17'! storeOn: aStream continue: aBlock super storeOn: aStream continue: aBlock. aStream nextPutAll: ' flatten'! ! !PPFailingParser methodsFor: '*petitbeta-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 ]! ! !PPFailingParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 20:30'! storeOn: aStream continue: aBlock aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' message: '; store: message; nextPut: $)! ! !PPDelegateParser methodsFor: '*petitbeta-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: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:11'! storeOn: aStream continue: aBlock aBlock value: parser! ! !PPMemoizedParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:17'! storeOn: aStream continue: aBlock super storeOn: aStream continue: aBlock. aStream nextPutAll: ' memoized'! ! !PPListParser methodsFor: '*petitbeta-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: '*petitbeta-storing' stamp: 'lr 5/1/2010 20:28'! storeOn: aStream continue: aBlock aStream nextPut: $(. parsers do: [ :each | aBlock value: each ] separatedBy: [ self storeSeparatorOn: aStream ]. aStream nextPut: $)! ! !PPListParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:12'! storeSeparatorOn: aStream self subclassResponsibility! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 07:49'! copyInContext: aDictionary ^ self copyInContext: aDictionary seen: IdentityDictionary new! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 08:11'! copyInContext: aDictionary seen: aSeenDictionary ^ aSeenDictionary at: self ifAbsentPut: [ self copy ]! ! !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 23:14'! match: aParser inContext: aDictionary ^ self match: aParser inContext: aDictionary seen: IdentitySet new! ! !PPParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 11:07'! match: aParser inContext: aDictionary seen: aSet "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: [ aSet includes: self ]) ifTrue: [ ^ true ]. aSet add: self. ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: aSet ]! ! !PPParser methodsFor: '*petitbeta-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: '*petitbeta-matching' stamp: 'lr 4/29/2010 23:10'! 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: '*petitbeta-operations' stamp: 'lr 4/29/2010 23:13'! optimize "Optimizes the receiving parser for speed and size." ^ PPOptimizer new optimize: self! ! !PPParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:10'! storeOn: aStream continue: aBlock self subclassResponsibility! ! !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-Processor'! !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: 'PetitBeta-Processor'! !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! ! PPAbstractParseTest subclass: #PPOptimizerTest instanceVariableNames: 'a b c' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Tests'! !PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 4/29/2010 23:21'! optimize: aParser ^ aParser optimize! ! !PPOptimizerTest methodsFor: 'running' stamp: 'lr 4/29/2010 23:20'! setUp super setUp. a := $a asParser. b := $b asParser. c := $c asParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/29/2010 23:21'! 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-choice' stamp: 'lr 4/29/2010 22:10'! testPostfixChoice | grammar | grammar := self optimize: (a , b) / (c , b). self assert: grammar class = PPSequenceParser. self assert: grammar children size = 2. self assert: grammar children first class = PPChoiceParser. self assert: grammar children first children size = 2. self assert: grammar children first children first literal = $a. self assert: grammar children first children last literal = $c. self assert: grammar children last literal = $b! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/29/2010 22:09'! testPrefixChoice | grammar | grammar := self optimize: (a , b) / (a , c). self assert: grammar class = PPSequenceParser. self assert: grammar children size = 2. self assert: grammar children first literal = $a. self assert: grammar children last class = PPChoiceParser. self assert: grammar children last children size = 2. self assert: grammar children last children first literal = $b. self assert: grammar children last children last literal = $c! ! !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 17: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: result children size = 1. self assert: result children first literal = $a. result := rewriter execute: $b asParser / $a asParser / $a asParser. 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: 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: result children size = 2. self assert: result children first literal = $a. self assert: result children last literal = $b ! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 4/29/2010 10:51'! testPatternRemoval | pattern result | pattern := PPPattern kind: PPLiteralObjectParser. rewriter replace: pattern / pattern with: pattern. result := rewriter execute: $a asParser / $a asParser. self assert: result class = PPLiteralObjectParser. self assert: result literal = $a! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 4/29/2010 10:50'! testPatternReplacement | pattern result | pattern := PPPattern kind: PPLiteralObjectParser. rewriter replace: pattern with: pattern , pattern. result := rewriter execute: $a asParser. self assert: result class = PPSequenceParser. self assert: result children first literal = $a. self assert: result children last literal = $a! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 4/29/2010 10:44'! testReplaceLiteral | 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:43'! 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: result children first literal = $b. self assert: result children last literal = $a. result := rewriter execute: $a asParser / $b asParser. self assert: result children first literal = $a. self assert: result children last literal = $b! ! !PPRewriterTest methodsFor: 'testing' stamp: 'lr 4/29/2010 10:44'! testWrapLiteral | 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-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 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 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' 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/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! ! !PPNotParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 16:15'! storeOn: aStream continue: aBlock super storeOn: aStream continue: aBlock. aStream nextPutAll: ' not'! ! !PPActionParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 11:00'! match: aParser inContext: aDictionary seen: aSet ^ (super match: aParser inContext: aDictionary seen: aSet) and: [ self block = aParser block ]! ! !PPRepeatingParser methodsFor: '*petitbeta-matching' stamp: 'lr 4/30/2010 11:01'! match: aParser inContext: aDictionary seen: aSet ^ (super match: aParser inContext: aDictionary seen: aSet) and: [ self min = aParser min and: [ self max = aParser max ] ]! ! !PPRepeatingParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/1/2010 20:33'! storeOn: aStream continue: aBlock aStream nextPut: $(. super storeOn: aStream continue: aBlock. (min = 1 and: [ max = SmallInteger maxVal ]) ifTrue: [ aStream nextPutAll: ' plus' ] ifFalse: [ (min = 0 and: [ max = SmallInteger maxVal ]) ifTrue: [ aStream nextPutAll: ' star' ] ifFalse: [ aStream nextPutAll: ' min: '; store: min; nextPutAll: ' max: '; store: max ] ]. aStream nextPut: $)! ! !PPPredicateParser methodsFor: '*petitbeta-matching' stamp: 'lr 5/1/2010 17:07'! match: aParser inContext: aDictionary seen: aSet ^ (super match: aParser inContext: aDictionary seen: aSet) and: [ self selector = aParser selector and: [ self arguments = aParser arguments ] ]! ! !PPPredicateParser methodsFor: '*petitbeta-storing' stamp: 'lr 5/2/2010 12:01'! storeOn: aStream continue: aBlock self class = PPPredicateParser ifTrue: [ self selector = #isDigit ifTrue: [ ^ aStream nextPutAll: '#digit asParser' ]. self selector = #isLetter ifTrue: [ ^ aStream nextPutAll: '#letter asParser' ]. self selector = #isAlphaNumeric ifTrue: [ ^ aStream nextPutAll: '#word asParser' ] ]. aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' selector: '; store: self selector; nextPutAll: ' arguments: '; store: self arguments; nextPutAll: ' message: '; store: self message; nextPut: $)! !