SystemOrganization addCategory: #'PetitBeta-Core'! !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-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. ^ #()! ! PPAbstractParseTest subclass: #PPOptimizerTest instanceVariableNames: 'optimizer a b c' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Core'! !PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 4/19/2010 11:42'! optimize: aParser ^ optimizer optimize: aParser! ! !PPOptimizerTest methodsFor: 'running' stamp: 'lr 4/19/2010 11:42'! setUp super setUp. optimizer := PPOptimizer new. a := $a asParser. b := $b asParser. c := $c asParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/19/2010 11:44'! testEmptyChoice | grammar | grammar := self optimize: (PPChoiceParser withAll: #()). self assert: grammar class = PPEpsilonParser. self assert: optimizer statistics notEmpty! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/19/2010 11:45'! 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. self assert: optimizer statistics notEmpty. 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. self assert: optimizer statistics isEmpty! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/19/2010 11:44'! 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. self assert: optimizer statistics notEmpty. 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. self assert: optimizer statistics notEmpty. 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. self assert: optimizer statistics isEmpty ! ! !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/19/2010 18:38'! testRemoveDelegate | grammar | grammar := self optimize: a wrapped. self assert: grammar class = PPLiteralObjectParser. self assert: optimizer statistics notEmpty. grammar := self optimize: a wrapped wrapped. self assert: grammar class = PPLiteralObjectParser. self assert: optimizer statistics notEmpty. 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. self assert: optimizer statistics notEmpty! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/19/2010 11:46'! testRepeatedChoice | grammar | grammar := self optimize: a / a / b / c. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 3. self assert: optimizer statistics notEmpty. grammar := self optimize: a / b / a / a. self assert: grammar class = PPChoiceParser. self assert: grammar children size = 2. self assert: optimizer statistics notEmpty. grammar := self optimize: a / a / a / a. self assert: grammar class = PPLiteralObjectParser. self assert: optimizer statistics notEmpty! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 4/19/2010 11:46'! testSingleChoice | grammar | grammar := self optimize: (PPChoiceParser withAll: (Array with: a)). self assert: grammar class = PPLiteralObjectParser. self assert: optimizer statistics notEmpty! ! Object subclass: #PPOptimizer instanceVariableNames: 'typeMap statistics' 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/17/2010 17:07'! initialize self initializeMap! ! !PPOptimizer methodsFor: 'initialization' stamp: 'lr 4/19/2010 11:12'! initializeMap | class | typeMap := Dictionary new. (Pragma allNamed: #optimize: in: self class) do: [ :pragma | (typeMap at: pragma arguments first ifAbsentPut: [ Set new ]) add: pragma selector ]! ! !PPOptimizer methodsFor: 'public' stamp: 'lr 4/19/2010 11:35'! 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. statistics := Bag new. [ | changed | changed := false. current := current transform: [ :parser | (typeMap at: parser class name ifAbsent: [ #() ]) inject: parser into: [ :result :selector | | replacement | replacement := self perform: selector with: result. replacement = result ifFalse: [ statistics add: selector. changed := true ]. replacement ] ]. changed ] whileTrue. ^ current! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 4/18/2010 18:29'! 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/19/2010 18: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/19/2010 18:37'! removeDelegate: aDelegateParser "Delegate parsers are only useful at composition-time, they can be removed at run-time." ^ aDelegateParser children first! ! !PPOptimizer methodsFor: 'public' stamp: 'lr 4/19/2010 11:34'! statistics "Answer the optimization statistics from the most recent run." ^ statistics! !