SystemOrganization addCategory: #'PetitBeta-Bindings'!
SystemOrganization addCategory: #'PetitBeta-Compound'!
SystemOrganization addCategory: #'PetitBeta-Optimizer'!
SystemOrganization addCategory: #'PetitBeta-JIT'!

PPAbstractParserTest subclass: #PPCaptureTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Bindings'!

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'!
testCharacter
	| parser |
	parser := ($a asParser bind: #a) 
		capture: [ :a | a ].
	self assert: parser parse: 'a' to: $a! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 18:46'!
testChoice
	| parser |
	parser := ($a asParser bind: #a) 
		/ ($b asParser bind: #b) 
		/ ($c asParser bind: #b)
		capture: [ :a :b | Array with: a with: b ].
	self assert: parser parse: 'a' to: #($a nil).
	self assert: parser parse: 'b' to: #(nil $b).
	self assert: parser parse: 'c' to: #(nil $c)! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:36'!
testFailed
	| parser |
	parser := (($a asParser bind: #a) , (PPFailingParser message: 'oops'))
		/ ($a asParser bind: #b)
		capture: [ :a :b | Array with: a with: b ].
	"$a successfully matched, thus it is bound:"
	self assert: parser parse: 'a' to: #($a $a)! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:34'!
testHiding
	| parser |
	parser := (($a asParser bind: #a) 
		capture: [ :a | a ])
		capture: [ :a | a ].
	self assert: parser parse: 'a' to: nil! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:18'!
testNested
	| parser |
	parser := ((#word asParser plus bind: #a) flatten bind: #b)
		capture: [ :a :b | Array with: a with: b ].
	self assert: parser parse: 'a' to: #(#($a) 'a').
	self assert: parser parse: 'ab' to: #(#($a $b) 'ab').
	self assert: parser parse: 'abc' to: #(#($a $b $c) 'abc')! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'!
testOptional
	| parser |
	parser := ($a asParser bind: #a) optional
		capture: [ :a | a ].
	self assert: parser parse: '' to: nil.
	self assert: parser parse: 'a' to: $a! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'!
testRepetition
	| parser |
	parser := ($a asParser bind: #a) star
		capture: [ :a | a ].
	self assert: parser parse: '' to: #().
	self assert: parser parse: 'a' to: #($a).
	self assert: parser parse: 'aa' to: #($a $a)! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 18:55'!
testSeparated
	| ap bp sp |
	ap := $a asParser bind: #a.
	bp := $b asParser bind: #b.
	sp := (ap , (bp , ap) star)
		capture: [ :a :b | Array with: a with: b ].
	self assert: sp parse: 'a' to: #(#($a) #()).
	self assert: sp parse: 'aba' to: #(#($a $a) #($b)).
	self assert: sp parse: 'ababa' to: #(#($a $a $a) #($b $b))! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'!
testSequence
	| parser |
	parser := ($a asParser bind: #a) , ($b asParser bind: #b) 
		capture: [ :a :b | Array with: a with: b ].
	self assert: parser parse: 'ab' to: #($a $b)! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 19:35'!
testSequence2
	| parser |
	parser := ($a asParser bind: #a) , ($b asParser bind: #b) 
		capture: [ :b :a | Array with: a with: b ].
	self assert: parser parse: 'ab' to: #($a $b)! !

!PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:14'!
testWroms
	| parser |
	parser := (($a asParser bind: #a) , (PPFailingParser message: 'worm') bind: #fail) / ($a asParser bind: #b)
		capture: [ :a :b :fail | 
			Array
				with:
					(fail notNil
						ifTrue: [ a ]
						ifFalse: [ nil ])
				with: b ].
	self assert: parser parse: 'a' to: #(nil $a)! !

PPAbstractParserTest subclass: #PPOptimizerTest
	instanceVariableNames: 'a b c'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Optimizer'!

!PPOptimizerTest class methodsFor: 'accessing' stamp: 'lr 5/31/2010 18:50'!
packageNamesUnderTest
	^ #('PetitBeta')! !

!PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 8/26/2010 10:58'!
assert: aParser equals: anotherParser
	self 
		assert: (aParser match: anotherParser inContext: Dictionary new)
		description: (self comparingStringBetween: aParser and: anotherParser)! !

!PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 4/29/2010 23:21'!
optimize: aParser
	^ aParser optimize! !

!PPOptimizerTest methodsFor: 'running' stamp: 'lr 8/26/2010 11:08'!
setUp
	super setUp.
	a := $a asParser.
	b := $b asParser.
	c := $c asParser! !

!PPOptimizerTest methodsFor: 'testing' stamp: 'lr 9/15/2010 11:52'!
testDuplicates
	| grammar |
	grammar := self optimize: $a asParser , $a asParser.
	self assert: grammar children first = grammar children last.
	self deny:  $a asParser = $a asParser! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 10:57'!
testEmptyChoice
	| grammar |
	grammar := self optimize: PPChoiceParser new.
	self assert: grammar equals: PPFailingParser new! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 10:59'!
testNestedChoice
	| grammar |
	grammar := self optimize: a / (b / c).
	self assert: grammar equals: a / b / c.

	grammar := self optimize: (a / b) / c.
	self assert: grammar equals: a / b / c! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:00'!
testNulledChoice
	| grammar |
	grammar := self optimize: a / nil asParser / b / c.
	self assert: grammar equals: a optional.

	grammar := self optimize: a / b / nil asParser / c.
	self assert: grammar equals: a / b / nil asParser.
	
	grammar := self optimize: a / b / c / nil asParser.
	self assert: grammar equals: a / b / c / nil asParser! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:10'!
testOptionalChoice
	| grammar |
	grammar := self optimize: a optional / a.
	self assert: grammar equals: a optional! !

!PPOptimizerTest methodsFor: 'testing-epsilon' stamp: 'lr 8/26/2010 11:09'!
testOptionalEpsilon
	| grammar |
	grammar := self optimize: nil asParser optional.
	self assert: grammar equals: nil asParser! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:10'!
testOptionalOptional
	| grammar |
	grammar := self optimize: a optional optional.
	self assert: grammar equals: a optional! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'!
testOptionalPlus
	| grammar |
	grammar := self optimize: a optional plus.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'!
testOptionalPlusChoice
	| grammar |
	grammar := self optimize: a optional / a plus.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'!
testOptionalStar
	| grammar |
	grammar := self optimize: a optional star.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'!
testOptionalStarChoice
	| grammar |
	grammar := self optimize: a optional / a star.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:12'!
testPlusChoice
	| grammar |
	grammar := self optimize: a plus / a.
	self assert: grammar equals: a plus! !

!PPOptimizerTest methodsFor: 'testing-epsilon' stamp: 'lr 8/26/2010 11:09'!
testPlusEpsilon
	| grammar |
	grammar := self optimize: nil asParser plus.
	self assert: grammar equals: nil asParser! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:13'!
testPlusOptional
	| grammar |
	grammar := self optimize: a plus optional.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:14'!
testPlusOptionalChoice
	| grammar |
	grammar := self optimize: a plus / a optional.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:13'!
testPlusPlus
	| grammar |
	grammar := self optimize: a plus plus.
	self assert: grammar equals: a plus! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:13'!
testPlusStar
	| grammar |
	grammar := self optimize: a plus star.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:14'!
testPlusStarChoice
	| grammar |
	grammar := self optimize: a plus / a star.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:00'!
testPostfixChoice
	| grammar |
	grammar := self optimize: (a , b) / (c , b).
	self assert: grammar equals: (a / c) , b! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:00'!
testPrefixChoice
	| grammar |
	grammar := self optimize: (a , b) / (a , c).
	self assert: grammar equals: a , (b / c)! !

!PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 8/26/2010 11:03'!
testReduceDelegate
	| grammar |
	grammar := self optimize: (PPAndParser on: (PPAndParser on: a)).
	self assert: grammar equals: a and.
	
	grammar := self optimize: (PPFlattenParser on: (PPFlattenParser on: a)).
	self assert: grammar equals: a flatten.
	
	grammar := self optimize: (PPTokenParser on: (PPTokenParser on: a)).
	self assert: grammar equals: a token.

	grammar := self optimize: (PPMemoizedParser on: (PPMemoizedParser on: a)).
	self assert: grammar equals: a memoized.

	grammar := self optimize: (PPTrimmingParser on: (PPTrimmingParser on: a)).
	self assert: grammar equals: a trim.
	
	grammar := self optimize: (PPNotParser on: (PPNotParser on: a)).
	self assert: grammar equals: a not not! !

!PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 8/26/2010 11:03'!
testRemoveDelegate
	| grammar |
	grammar := self optimize: a wrapped.
	self assert: grammar equals: a.
	
	grammar := self optimize: a wrapped wrapped.
	self assert: grammar equals: a.
	
	grammar := self optimize: a wrapped / b wrapped wrapped.
	self assert: grammar equals: a / b! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:02'!
testRepeatedChoice
	| grammar |
	grammar := self optimize: a / a / b / c.
	self assert: grammar equals: a / b / c.
	
	grammar := self optimize: a / b / a / a.
	self assert: grammar equals: a / b.

	grammar := self optimize: a / a / a / a.
	self assert: grammar equals: a! !

!PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:02'!
testSingleChoice
	| grammar |
	grammar := self optimize: (PPChoiceParser with: a).
	self assert: grammar equals: a! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:15'!
testStarChoice
	| grammar |
	grammar := self optimize: a star / a.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-epsilon' stamp: 'lr 8/26/2010 11:09'!
testStarEpsilon
	| grammar |
	grammar := self optimize: nil asParser star.
	self assert: grammar equals: nil asParser! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:15'!
testStarOptional
	| grammar |
	grammar := self optimize: a star optional.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:15'!
testStarOptionalChoice
	| grammar |
	grammar := self optimize: a star / a optional.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:16'!
testStarPlus
	| grammar |
	grammar := self optimize: a star plus.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:16'!
testStarPlusChoice
	| grammar |
	grammar := self optimize: a star / a plus.
	self assert: grammar equals: a star! !

!PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:16'!
testStarStar
	| grammar |
	grammar := self optimize: a star star.
	self assert: grammar equals: a star! !

!PPChoiceParser methodsFor: '*petitbeta-bindings' stamp: 'lr 5/6/2011 23:12'!
basicAccessor: aString named: aSymbol seen: aSet
	1 to: self children size do: [ :index |
		((self children at: index) accessor: '(' , aString , ') at: ' , index asNumber asString named: aSymbol seen: aSet)
			ifNotNil: [ :accessor | ^ accessor ] ].
	^ super basicAccessor: aString named: aSymbol seen: aSet! !

!PPParser methodsFor: '*petitbeta-bindings' stamp: 'lr 5/7/2011 19:21'!
bind: aSymbol
	"Answer a parser that binds the result of the receiver parser to the variable aSymbol."

	^ PPBindParser on: self named: aSymbol! !

!PPParser methodsFor: '*petitbeta-bindings' stamp: 'lr 5/7/2011 17:16'!
capture: aBlock
	"Answer a parser that captures bound results in the scope of the receiver and binds them to the arguments of aBlock."

	^ PPCaptureParser on: self block: aBlock! !

!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/29/2010 23:13'!
optimize
	"Optimizes the receiving parser for speed and size."

	^ PPOptimizer new optimize: self! !

!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.
	^ #()! !

PPActionParser subclass: #PPCaptureParser
	instanceVariableNames: 'variableNames collectionTypes bindings'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Bindings'!

!PPCaptureParser commentStamp: 'lr 5/7/2011 15:47' prior: 0!
The capture parser has no special parsing behavior and just delegates to another parser. It however captures the result of the parse and makes it avialable to other users.

Instance Variables:
	variables	<ProtoObject | PseudoContext>!

!PPCaptureParser methodsFor: 'private' stamp: 'lr 5/7/2011 21:03'!
argumentNames
	"Answer a collection of block argument names as symbols. Other Smalltalk implementation might need to patch this method."

	^ block decompile arguments collect: [ :each | each name asSymbol ]! !

!PPCaptureParser methodsFor: 'private' stamp: 'lr 5/7/2011 18:43'!
evaluateBindings
	1 to: bindings size do: [ :index | 
		(collectionTypes at: index)
			ifTrue: [ bindings at: index put: (bindings at: index) asArray ] ].
	^ block valueWithArguments: bindings! !

!PPCaptureParser methodsFor: 'private' stamp: 'lr 5/7/2011 19:21'!
find: aParser many: aBoolean seen: aSet
	| many index |
	" 1. record bindings in the receiver "
	(aParser class = PPBindParser and: [ (index := variableNames indexOf: aParser variable) > 0 ]) ifTrue: [
		collectionTypes at: index put: (aBoolean or: [ collectionTypes at: index ]).
		aParser setCapture: self ].
	
	" 2. do not go into other capture parsers and avoid recursion "
	(aParser class = self class or: [ aSet includes: aParser ])
		ifTrue: [ ^ self ].
	aSet add: aParser.

	" 3. continue with the children of the parser "		
	many := aBoolean or: [ aParser isKindOf: PPRepeatingParser ].
	aParser children do: [ :child | self find: child many: many seen: aSet ]! !

!PPCaptureParser methodsFor: 'parsing' stamp: 'lr 5/8/2011 13:55'!
parseOn: aStream
	| previous result |
	block isNil
		ifTrue: [ ^ parser parseOn: aStream ].
	previous := bindings.
	bindings := collectionTypes 
		collect: [ :each | each ifTrue: [ OrderedCollection new ] ].
	result := parser parseOn: aStream.
	result isPetitFailure
		ifFalse: [ result := self evaluateBindings ].
	bindings := previous.
	^ result! !

!PPCaptureParser methodsFor: 'private' stamp: 'lr 5/8/2011 10:42'!
set: aSymbol to: anObject
	1 to: variableNames size do: [ :index |
		(variableNames at: index) == aSymbol ifTrue: [ 
			(collectionTypes at: index)
				ifTrue: [ (bindings at: index) addLast: anObject ]
				ifFalse: [ bindings at: index put: anObject ].
			^ self ] ]! !

!PPCaptureParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 14:39'!
setBlock: aBlock
	super setBlock: aBlock.
	self update! !

!PPCaptureParser methodsFor: 'actions' stamp: 'lr 5/8/2011 10:33'!
update
	variableNames := self argumentNames.
	collectionTypes := Array new: variableNames size withAll: false.
	variableNames isEmpty
		ifFalse: [ self find: parser many: false seen: IdentitySet new ]! !

PPDelegateParser subclass: #PPBindParser
	instanceVariableNames: 'capture name'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Bindings'!

!PPBindParser class methodsFor: 'instance creation' stamp: 'lr 5/7/2011 18:45'!
on: aParser named: aSymbol
	^ (self on: aParser) setName: aSymbol! !

!PPBindParser methodsFor: 'parsing' stamp: 'lr 5/7/2011 21:07'!
parseOn: aParser
	| result |
	result := super parseOn: aParser.
	result isPetitFailure 
		ifFalse: [ capture isNil ifFalse: [ capture set: name to: result ] ].
	^ result! !

!PPBindParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 10:25'!
setCapture: aCaptureParser
	capture == aCaptureParser
		ifTrue: [ ^ self ].
	capture isNil
		ifFalse: [ ^ self error: self printString , ' is already captured by ' , capture printString ].
	capture := aCaptureParser! !

!PPBindParser methodsFor: 'initialization' stamp: 'lr 5/7/2011 18:44'!
setName: aSymbol
	name := aSymbol! !

!PPBindParser methodsFor: 'accessing' stamp: 'lr 5/7/2011 18:44'!
variable
	^ name! !

PPDelegateParser subclass: #PPCompoundParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Compound'!

PPCompoundParser subclass: #PPArithmeticCompoundParser
	instanceVariableNames: 'terms addition factors multiplication primary parentheses number'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Compound'!

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 14:58'!
addition
	^ (factors bind: #a) , ($+ asParser token trim , (factors bind: #b)) star! !

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:37'!
factors
	^ multiplication / primary! !

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 14:58'!
multiplication
	^ (primary bind: #a) , ($* asParser token trim , (primary bind: #b)) star! !

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 14:54'!
number
	^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten bind: #number! !

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:41'!
parentheses
	^ $( asParser flatten trim , (terms bind: #a) , $) asParser flatten trim! !

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:10'!
primary
	^ number / parentheses! !

!PPArithmeticCompoundParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 11:11'!
start
	^ terms end! !

!PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:36'!
terms
	^ addition / factors! !

!PPCompoundParser class methodsFor: 'accessing' stamp: 'lr 5/8/2011 12:50'!
ignoredNames
	"Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."

	^ PPCompoundParser allInstVarNames! !

!PPCompoundParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 12:38'!
new
	self error: self name , ' is instantiated with #on: or #on:startingAt:'! !

!PPCompoundParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 11:45'!
on: aHandler
	^ self on: aHandler startingAt: self startSymbol! !

!PPCompoundParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 13:20'!
on: aHandler startingAt: aSymbol
	^ (self basicNew initializeStartingAt: aSymbol) setHandler: aHandler! !

!PPCompoundParser class methodsFor: 'accessing' stamp: 'lr 5/8/2011 11:43'!
startSymbol
	"Answer the method that represents the default start symbol."

	^ #start! !

!PPCompoundParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 15:08'!
initializeStartingAt: aSymbol
	| productionNames |
	productionNames := self productionNames.
	productionNames keysAndValuesDo: [ :key :value |
		self instVarAt: key put: (PPCompoundProductionParser named: value) ].	
	parser := PPCompoundProductionParser named: aSymbol.
	parser setParser: (self perform: aSymbol).
	productionNames keysAndValuesDo: [ :key :value |
		(self instVarAt: key) setParser: (self perform: value) ]! !

!PPCompoundParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:43'!
install: aProductionSelector on: aHandler send: aSelector arguments: anArray
	| index |
	(self class ignoredNames includes: aProductionSelector)
		ifTrue: [ self error: 'Production ' , aProductionSelector printString , ' not found' ].
	index := self class allInstVarNames
		indexOf: aProductionSelector asString
		ifAbsent: [ self error: 'Production ' , aProductionSelector printString , ' not found' ].
	(self instVarAt: index) 
		setTarget: aHandler
		selector: aSelector
		arguments: anArray! !

!PPCompoundParser methodsFor: 'private' stamp: 'lr 5/8/2011 13:53'!
productionNames
	"Answer a dictionary of slot indexes and production names."
	
	| productionNames ignoredNames |
	productionNames := Dictionary new.
	ignoredNames := self class ignoredNames.
	self class allInstVarNames keysAndValuesDo: [ :key :value |
		(ignoredNames includes: value asSymbol)
			ifFalse: [ productionNames at: key put: value asSymbol ] ].
	^ productionNames! !

!PPCompoundParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 14:51'!
setHandler: aHandler
	self productionNames
		keysDo: [ :key | (self instVarAt: key) reset ].
	(Pragma allNamed: #production:arguments: in: aHandler class)
		do: [ :pragma | self install: pragma arguments first on: aHandler send: pragma selector arguments: pragma arguments second ]! !

!PPCompoundParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 11:45'!
start
	"Answer the default production to start this parser with."
	
	self subclassResponsibility! !

PPDelegateParser subclass: #PPCompoundProductionParser
	instanceVariableNames: 'target selector arguments bindings collections'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Compound'!

!PPCompoundProductionParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:53'!
evaluateBindings
	1 to: bindings size do: [ :index | 
		(collections at: index)
			ifTrue: [ bindings at: index put: (bindings at: index) asArray ] ].
	^ target perform: selector withArguments: bindings! !

!PPCompoundProductionParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:52'!
find: aParser many: aBoolean seen: aSet
	| many index |
	(aParser class = PPBindParser and: [ (index := arguments indexOf: aParser variable) > 0 ]) ifTrue: [
		collections at: index put: (aBoolean or: [ collections at: index ]).
		aParser setCapture: self ].
	(aParser class = self class or: [ aSet includes: aParser ])
		ifTrue: [ ^ self ].
	aSet add: aParser.
	many := aBoolean or: [ aParser isKindOf: PPRepeatingParser ].
	aParser children do: [ :child | self find: child many: many seen: aSet ]! !

!PPCompoundProductionParser methodsFor: 'parsing' stamp: 'lr 5/8/2011 14:53'!
parseOn: aStream
	| previous result |
	collections isNil
		ifTrue: [ ^ super parseOn: aStream ].
	previous := bindings.
	bindings := collections
		collect: [ :each | each ifTrue: [ OrderedCollection new ] ].
	result := parser parseOn: aStream.
	result isPetitFailure
		ifFalse: [ result := self evaluateBindings ].
	bindings := previous.
	^ result! !

!PPCompoundProductionParser methodsFor: 'actions' stamp: 'lr 5/8/2011 14:47'!
reset
	target := selector := arguments := bindings := collections := nil! !

!PPCompoundProductionParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:54'!
set: aSymbol to: anObject
	1 to: arguments size do: [ :index |
		(arguments at: index) == aSymbol ifTrue: [ 
			(collections at: index)
				ifTrue: [ (bindings at: index) addLast: anObject ]
				ifFalse: [ bindings at: index put: anObject ].
			^ self ] ]! !

!PPCompoundProductionParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 15:00'!
setTarget: anObject selector: aSelector arguments: anArray
	target := anObject.
	selector := aSelector.
	arguments := anArray.
	collections := Array new: arguments size withAll: false.
	arguments isEmpty
		ifFalse: [ self find: parser many: false seen: IdentitySet new ]! !

PPDelegateParser subclass: #PPJitParser
	instanceVariableNames: 'method'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-JIT'!

!PPJitParser class methodsFor: 'instance creation' stamp: 'lr 8/1/2010 09:02'!
on: aParser method: aCompiledMethod
	^ (self on: aParser) setMethod: aCompiledMethod! !

!PPJitParser methodsFor: 'accessing' stamp: 'lr 8/1/2010 15:51'!
method
	^ method! !

!PPJitParser methodsFor: 'parsing' stamp: 'lr 7/31/2010 23:15'!
parseOn: aStream
	^ self 
		withArgs: (Array with: aStream)
		executeMethod: method! !

!PPJitParser methodsFor: 'initialization' stamp: 'lr 7/31/2010 23:16'!
setMethod: aCompiledMethod
	method := aCompiledMethod! !

PPCompositeParserTest subclass: #PPArithmeticEvaluatorTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Compound'!

!PPArithmeticEvaluatorTest class methodsFor: 'as yet unclassified' stamp: 'lr 5/8/2011 11:23'!
add: a with: b
	^ a + b! !

!PPArithmeticEvaluatorTest class methodsFor: 'as yet unclassified' stamp: 'lr 5/8/2011 11:23'!
div: a with: b
	^ a / b! !

!PPArithmeticEvaluatorTest class methodsFor: 'as yet unclassified' stamp: 'lr 5/8/2011 11:23'!
mul: a with: b
	^ a * b! !

!PPArithmeticEvaluatorTest class methodsFor: 'as yet unclassified' stamp: 'lr 5/8/2011 11:23'!
sub: a with: b
	^ a - b! !

!PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:50'!
add: anObject and: aCollection
	<production: #addition arguments: #(a b)>
	
	^ aCollection inject: anObject into: [ :a :b | a + b ]	! !

!PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:50'!
mul: anObject and: aCollection
	<production: #multiplication arguments: #(a b)>
	
	^ aCollection inject: anObject into: [ :a :b | a * b ]	! !

!PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:54'!
number: anObject
	<production: #number arguments: #(number)>
	
	^ anObject asNumber! !

!PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:50'!
parens: anObject
	<production: #parentheses arguments: #(a)>
	
	^ anObject! !

!PPArithmeticEvaluatorTest methodsFor: 'accessing' stamp: 'lr 5/8/2011 15:09'!
parserInstance
	^ PPArithmeticCompoundParser on: self! !

!PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:10'!
testAddition
	self assert: parser parse: '1 + 2' to: 3! !

!PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'!
testMixed
	self assert: parser parse: '1 + 2 * 3' to: 7! !

!PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'!
testMultiplication
	self assert: parser parse: '2 * 3' to: 6! !

!PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:10'!
testNumber
	self assert: parser parse: '123' to: 123! !

PPCompositeParserTest subclass: #PPArithmeticPrinterTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Compound'!

!PPArithmeticPrinterTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:51'!
add: anObject and: aCollection
	<production: #addition arguments: #(a b)>
	
	^ aCollection inject: anObject into: [ :a :b | a , ' + ' , b ]	! !

!PPArithmeticPrinterTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:51'!
mul: anObject and: aCollection
	<production: #multiplication arguments: #(a b)>
	
	^ aCollection inject: anObject into: [ :a :b | a , ' * ' , b ]	! !

!PPArithmeticPrinterTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:54'!
parens: anObject
	<production: #parentheses arguments: #(number)>
	
	^ '(' , anObject , ')'! !

!PPArithmeticPrinterTest methodsFor: 'accessing' stamp: 'lr 5/8/2011 15:09'!
parserInstance
	^ PPArithmeticCompoundParser on: self! !

!PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'!
testAddition
	self assert: parser parse: '1 + 2' to: '1 + 2'! !

!PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'!
testMixed
	self assert: parser parse: '1 + 2 * 3' to: '1 + 2 * 3'! !

!PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'!
testMultiplication
	self assert: parser parse: '2 * 3' to: '2 * 3'! !

!PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'!
testNumber
	self assert: parser parse: '123' to: '123'! !

PPParserTest subclass: #PPJitTest
	instanceVariableNames: 'jitter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-JIT'!

!PPJitTest class methodsFor: 'accessing' stamp: 'lr 8/6/2010 19:17'!
resources
	^ Array with: PPJitResource! !

!PPJitTest class methodsFor: 'testing' stamp: 'lr 10/5/2010 17:19'!
shouldInheritSelectors
	^ true! !

!PPJitTest methodsFor: 'utilities' stamp: 'lr 8/6/2010 19:18'!
assert: aParser fail: aCollection
	| parser stream result |
	parser := PPJitResource current jitter
		compile: aParser.
	self assert: (parser isKindOf: PPJitParser).
	stream := aCollection asPetitStream.
	result := parser parse: stream.
	self assert: result isPetitFailure.
	self assert: stream position = 0! !

!PPJitTest methodsFor: 'utilities' stamp: 'lr 8/6/2010 19:18'!
assert: aParser parse: aCollection to: aTargetObject end: anInteger
	| parser stream result |
	parser := PPJitResource current jitter
		compile: aParser.
	self assert: (parser isKindOf: PPJitParser).
	stream := aCollection asPetitStream.
	result := parser parse: stream.
	aTargetObject isNil
		ifTrue: [ self deny: result isPetitFailure ]
		ifFalse: [ self assert: result = aTargetObject ].
	self assert: stream position = anInteger! !

!PPJitTest methodsFor: 'testing' stamp: 'lr 8/7/2010 10:37'!
testMemoized
	"This test does not work"! !

Object subclass: #PPJit
	instanceVariableNames: 'methodTemplates inlineTemplates literalMapping'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-JIT'!

!PPJit methodsFor: 'public' stamp: 'lr 8/6/2010 19:15'!
compile: aParser
	"Try to optimize aParser. If no reasonable optimization can be performed return the original parser."
	
	| methodTree |
	methodTree := (methodTemplates
		at: aParser class
		ifAbsent: [ ^ aParser ])
			copy.
	literalMapping := IdentityDictionary new.
	
	methodTree := self inlineAll: methodTree for: aParser.
	methodTree := self
		rewrite: (self
			rewrite: (self
				rewrite: methodTree removeDeadCode
				using: self rewriteParserBlocks)
			using: self rewriteEmtpyIfTrue)
		using: self rewriteEmptyBlock.
	
	^ PPJitParser on: aParser method: (self 
		patchLiterals: (self rootParserClass compilerClass new
			compile: methodTree formattedCode
			in: self rootParserClass
			classified: nil notifying: nil
			ifFail: [ ^ aParser ])
				generate)! !

!PPJit methodsFor: 'initialization' stamp: 'lr 8/6/2010 14:55'!
initialize
	self initializeTemplates! !

!PPJit methodsFor: 'initialization' stamp: 'lr 10/5/2010 17:23'!
initializeTemplate: class
	| parseTree |
	parseTree := (class lookupSelector: self parseOnSelector)
		parseTree.
	(parseTree isNil 
		or: [ parseTree isPrimitive 
		or: [ parseTree superMessages notEmpty ] ])
			ifTrue: [ ^ self ].
	parseTree := (self
		rewrite: (self
			rewrite: (self
				rewrite: parseTree 
				using: self rewriteGuardClause)
			using: self rewriteIfTrue)
		using: self rewriteReturns)
			addSelfReturn;
			yourself.
	(parseTree body temporaries isEmpty
		and: [ parseTree body statements size = 1
		and: [ parseTree body statements first isReturn
		and: [ parseTree body statements first value containsReturn not ] ] ])
			ifTrue: [ inlineTemplates at: class put: parseTree body statements first value ].
	methodTemplates at: class put: parseTree! !

!PPJit methodsFor: 'initialization' stamp: 'lr 8/6/2010 18:24'!
initializeTemplates
	methodTemplates := IdentityDictionary new.
	inlineTemplates := IdentityDictionary new.
	self rootParserClass
		withAllSubclassesDo: [ :class | self initializeTemplate: class ]! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 19:12'!
inlineAll: aNode for: aParser
	| rewriter1 rewriter2 |
	rewriter1 := RBParseTreeRewriter new.
	rewriter1
		replace: '`variable value: `@expr'
			withValueFrom: [ :node | self inlineBlock: node for: aParser ]
			when: [ :node | (self instanceVariable: node receiver for: aParser) isBlock ];
		replace: '`variable parseOn: `stream'
			withValueFrom: [ :node | self inlineParser: node for: aParser ]
			when: [ :node | (self instanceVariable: node receiver for: aParser) isPetitParser ];
		replace: '`variable `@msg: `@args'
			withValueFrom: [ :node | self inlineCollection: node for: aParser ]
			when: [ :node | (self instanceVariable: node receiver for: aParser) isCollection ].
	rewriter2 := RBParseTreeRewriter new.
	rewriter2
		replace: 'self' 
		withValueFrom: [ :node | self inlineObject: aParser ];
		replace: '`variable' 
		withValueFrom: [ :node | self inlineVariable: node for: aParser ].
	^ rewriter2 executeTree: (rewriter1 executeTree: aNode; tree); tree! !

!PPJit methodsFor: 'private' stamp: 'lr 8/7/2010 09:52'!
inlineBlock: aNode for: aParser
	| block tree |
	block := self
		instanceVariable: aNode receiver
		for: aParser.
	(block numArgs = 1 and: [ block numCopiedValues = 0 ])
		ifFalse: [ ^ aNode ].
	tree := RBParser
		parseExpression: block asString
		onError: [ :msg :pos | ^ aNode ].
	(tree isBlock and: [ tree body temporaries isEmpty and: [ tree body statements size = 1 and: [ tree containsReturn not ] ] ])
		ifFalse: [ ^ aNode ].
	tree body statements first nodesDo: [ :each |
		each isVariable ifTrue: [ 
			each name = tree arguments first name
				ifTrue: [ each replaceWith: aNode arguments first ]
				ifFalse: [ ^ aNode ] ] ].
	^ tree body statements first! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 18:18'!
inlineCollection: aNode for: aParser
	| collection arguments |
	collection := self
		instanceVariable: aNode receiver
		for: aParser.
	arguments := aNode arguments collect: [ :each | 
		each isLiteral
			ifTrue: [ each value ]
			ifFalse: [ ^ aNode ] ].
	^ RBLiteralNode value: (collection
		perform: aNode selector
		withArguments: arguments)! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 18:13'!
inlineObject: anObject
	"Inlines anObject into the literal frame of the generated method."
	
	^ RBLiteralNode value: (literalMapping
		at: anObject
		ifAbsentPut: [ ('__ref_' , literalMapping size asString) asSymbol ])! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 17:52'!
inlineParser: aNode for: aParser
	| parser tree |
	parser := self
		instanceVariable: aNode receiver
		for: aParser.
	tree := (inlineTemplates
		at: parser class
		ifAbsent: [ ^ aNode ])
			copy.
	^ self inlineAll: tree for: parser! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 16:56'!
inlineVariable: aNode for: aParser
	| value |
	value := self 
		instanceVariable: aNode for: aParser
		ifAbsent: [ ^ aNode ].
	value isLiteral
		ifTrue: [ ^ RBLiteralNode value: value ].
	^ self inlineObject: value! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 17:41'!
inlineVariables: aNode for: aParser
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '`var value'
			withValueFrom: [ :node | self inlineBlock: node for: aParser ]
			when: [ :node | (self instanceVariable: node receiver for: aParser) isBlock ];
		replace: '`var parseOn: aStream'
			withValueFrom: [ :node | self inlineParser: node for: aParser ]
			when: [ :node | (self instanceVariable: node receiver for: aParser) isPetitParser ];
		replace: '`var' 
			withValueFrom: [ :node | self inlineVariable: node for: aParser ].
	^ rewriter executeTree: aNode; answer! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 16:56'!
instanceVariable: aNode for: aParser
	^ self instanceVariable: aNode for: aParser ifAbsent: [ nil ]! !

!PPJit methodsFor: 'private' stamp: 'lr 8/6/2010 16:56'!
instanceVariable: aNode for: aParser ifAbsent: aBlock
	| index |
	(aNode whoDefines: aNode name) notNil
		ifTrue: [ ^ aBlock value ].
	index := aParser class allInstVarNames
		indexOf: aNode name
		ifAbsent: [ ^ aBlock value ].
	^ aParser instVarAt: index! !

!PPJit methodsFor: 'configuration' stamp: 'lr 8/1/2010 08:52'!
parseOnSelector
	^ #parseOn:! !

!PPJit methodsFor: 'private' stamp: 'lr 8/2/2010 21:53'!
patchLiterals: aCompiledMethod
	| inverseMapping |
	inverseMapping := IdentityDictionary new: literalMapping size.
	literalMapping keysAndValuesDo: [ :key :value | inverseMapping at: value put: key ].
	2 to: aCompiledMethod numLiterals + 1 do: [ :index |
		aCompiledMethod objectAt: index put: (inverseMapping
			at: (aCompiledMethod objectAt: index)
			ifAbsent: [ aCompiledMethod objectAt: index ]) ].
	^ aCompiledMethod! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 17:33'!
rewrite: aNode using: aRewriter
	"Apply aRewriter repeatedly to aNode until no more changes can be performed."

	| tree |
	tree := aNode.
	[ aRewriter executeTree: tree ]
		whileTrue: [ tree := aRewriter tree ].
	^ tree! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 17:51'!
rewriteEmptyBlock
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '[ ``.object ] value'
			with: '``.object'
			when: [ :aNode | aNode parent isCascade not ];
		replace: '| `@temps | ``@.Stmts1. [ | `@bTemps | ``@.bStmts ] value. ``@.Stmts2'
			with: '| `@temps `@bTemps | ``@.Stmts1. ``@.bStmts. ``@.Stmts2'.
	^ rewriter! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 17:51'!
rewriteEmtpyIfTrue
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '``@boolean ifTrue: [ ] ifFalse: [ | `@temps | ``@.Stmts ]'
			with: '``@boolean ifFalse: [ |`@temps | ``@.Stmts ]';
		replace: '``@boolean ifFalse: [ ] ifTrue: [ | `@temps | ``@.Stmts ]'
			with: '``@boolean ifTrue: [ |`@temps | ``@.Stmts ]';
		replace: '``@boolean ifTrue: [ | `@temps | ``@.Stmts ] ifFalse: [ ]'
			with: '``@boolean ifTrue: [ |`@temps | ``@.Stmts ]';
		replace: '``@boolean ifFalse: [ | `@temps | ``@.Stmts ] ifTrue: [ ]'
			with: '``@boolean ifFalse: [ |`@temps | ``@.Stmts ]'.
	^ rewriter! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 17:33'!
rewriteGuardClause
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^`@r2]';
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^`@r2] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]';
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^self]';
		replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2'
			with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^self] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]'.
	^ rewriter! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 17:32'!
rewriteIfTrue
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2'
			with: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1] ifFalse: [``@.s2. ^``@r2]';
		replace: '| `@temps | ``@.s1. ``@boolean ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2'
			with: '| `@temps | ``@.s1. ``@boolean ifTrue: [``@.s2. ^``@r2] ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]'.
	^ rewriter! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 18:01'!
rewriteParserBlocks
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '| `@temps1 | `@.stmts1. [ `collection size < 0 ] whileTrue: [ | `@temps2 | `@.stmts2 ]. `@.stmts3'
			with: '| `@temps1 | `@.stmts1. `@.stmts3';
		replace: '| `@temps1 | `@.stmts1. [ `collection size < 1 ] whileTrue: [ | `@temps2 | `@.stmts2 ]. `@.stmts3'
			with: '| `@temps1 `@temps2 | `@.stmts1. `@.stmts2. `@.stmts3';
		replace: '| `@temps1 | `@.stmts1. [ `collection size < 1073741823 ] whileTrue: [ | `@temps2 | `@.stmts2 ]. `@.stmts3'
			with: '| `@temps1 | `@.stmts1. [ | `@temps2 | `@.stmts2 ] repeat'.
	^ rewriter! !

!PPJit methodsFor: 'rewriting' stamp: 'lr 8/2/2010 17:32'!
rewriteReturns
	| rewriter |
	rewriter := RBParseTreeRewriter new.
	rewriter
		replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]';
		replace: '``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]'
			with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'.
	^ rewriter! !

!PPJit methodsFor: 'configuration' stamp: 'lr 8/1/2010 08:52'!
rootParserClass
	^ PPParser! !

Object subclass: #PPOptimizer
	instanceVariableNames: 'rewriter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-Optimizer'!

!PPOptimizer commentStamp: '<historical>' prior: 0!
PPOptimizer improves the internal structure of a grammar without touching its behavior.

Instance Variables:
	rewriter	<PPRewriter>	The rewriter that knows how to optimize a grammar.!

!PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 8/26/2010 08:36'!
emptyChoice
	<optimize>

	rewriter
		replace: PPChoiceParser new
		with: PPFailingParser new! !

!PPOptimizer methodsFor: 'optimizations' stamp: 'lr 9/15/2010 13:53'!
foldDuplicates: aParser
	"Merges duplicated parsers into one single instance, what reduces the memory and enables many of the other optimizations to perform better. For efficiency reasons this optimization is implemented imperatively."

	| uniques |
	uniques := IdentitySet with: aParser.
	aParser allParsersDo: [ :parent |
		parent children do: [ :child |
			| duplicate |
			duplicate := uniques
				detect: [ :each | 
					child ~~ each
						and: [ child match: each inContext: Dictionary new ] ]
				ifNone: [ nil ].
			duplicate isNil
				ifTrue: [ uniques add: child ]
				ifFalse: [ parent replace: child with: duplicate ] ] ].
	^ aParser ! !

!PPOptimizer methodsFor: 'optimizations-delegate' stamp: 'lr 4/29/2010 21:41'!
identityWrapper
	<optimize>
	
	rewriter
		replace: (PPPattern kind: PPDelegateParser)
		withValueFrom: [ :parser | parser children first ]! !

!PPOptimizer methodsFor: 'optimizations-delegate' stamp: 'lr 8/26/2010 09:55'!
idepotentDelegate
	<optimize>
	
	rewriter
		replace: PPPattern any
		withValueFrom: [ :parser | parser children first ]
		when: [ :parser |
			parser children size = 1
				and: [ parser class = parser children first class
				and: [ #(PPAndParser 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 5/3/2010 21:50'!
nestedChoice
	<optimize>
	
	| 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 9/1/2010 22:07'!
nilledChoice
	<optimize>
	
	| before parser after |
	parser := PPPattern any.
	rewriter
		replace: parser / nil asParser
		with: parser optional! !

!PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 9/1/2010 22:07'!
nulledChoice
	<optimize>
	
	| before parser after |
	before := PPListPattern any.
	parser := PPPattern any.
	after := PPListPattern any.
	rewriter
		replace: before / nil asParser / parser / after
		with: before / nil asParser! !

!PPOptimizer methodsFor: 'public' stamp: 'lr 9/15/2010 11:43'!
optimize: aParser
	"Transform aParser by applying all the matching optimization rules. Repeatedly apply the rules until no more changes can be done."
	
	| current |
	current := self foldDuplicates: aParser.
	[ current := rewriter execute: current.
	  rewriter hasChanged ]
			whileTrue.
	^ current! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:00'!
optionalChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser optional / parser
		with: parser optional! !

!PPOptimizer methodsFor: 'optimizations-epsilon' stamp: 'lr 8/26/2010 09:39'!
optionalEpsilon
	<optimize>

	rewriter
		replace: nil asParser optional
		with: nil asParser! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'!
optionalOptional
	<optimize>
	
	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser optional optional
		with: parser optional! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'!
optionalPlus
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser optional plus
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:02'!
optionalPlusChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser optional / parser plus
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'!
optionalStar
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser optional star
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:02'!
optionalStarChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser optional / parser star
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:00'!
plusChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser plus / parser
		with: parser plus! !

!PPOptimizer methodsFor: 'optimizations-epsilon' stamp: 'lr 8/26/2010 11:09'!
plusEpsilon
	<optimize>

	rewriter
		replace: nil asParser plus
		with: nil asParser! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'!
plusOptional
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser plus optional
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'!
plusOptionalChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser plus / parser optional
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'!
plusPlus
	<optimize>
	
	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser plus plus
		with: parser plus! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'!
plusStar
	<optimize>
	
	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser plus star
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'!
plusStarChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser plus / parser star
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 23:19'!
prefixedChoice
	<optimize>
	
	| 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
	<optimize>
	
	| 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 5/3/2010 21:50'!
singleChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: (PPChoiceParser with: parser)
		with: parser! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:00'!
starChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser star / parser
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-epsilon' stamp: 'lr 8/26/2010 11:09'!
starEpsilon
	<optimize>

	rewriter
		replace: nil asParser star
		with: nil asParser! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:47'!
starOptional
	<optimize>
	
	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser star optional
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'!
starOptionalChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser star / parser optional
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:47'!
starPlus
	<optimize>
	
	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser star plus
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'!
starPlusChoice
	<optimize>

	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser star / parser plus
		with: parser star! !

!PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:47'!
starStar
	<optimize>
	
	| parser |
	parser := PPPattern any.
	rewriter
		replace: parser star star
		with: parser star! !

TestResource subclass: #PPJitResource
	instanceVariableNames: 'jitter'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitBeta-JIT'!

!PPJitResource methodsFor: 'accessing' stamp: 'lr 8/6/2010 19:17'!
jitter
	^ jitter! !

!PPJitResource methodsFor: 'running' stamp: 'lr 8/7/2010 10:21'!
setUp
	super setUp.
	jitter := PPJit new! !