"{ Package: 'stx:goodies/petitparser/compiler' }"

PPStream subclass:#PPCContext

	instanceVariableNames:'root properties globals furthestFailure compiledParser rc ws'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Context'

!

!PPCContext class methodsFor:'as yet unclassified'!

new

	^ self basicNew initialize

!

on: aPPParser stream: aStream

	^ self basicNew 

		initialize;

		root: aPPParser;

		stream: aStream asPetitStream;

		yourself

! !

!PPCContext methodsFor:'accessing-globals'!

globalAt: aKey

	"Answer the global property value associated with aKey."

	^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ]

!

globalAt: aKey ifAbsent: aBlock

	"Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."

	^ globals isNil

		ifTrue: [ aBlock value ]

		ifFalse: [ globals at: aKey ifAbsent: aBlock ]

!

globalAt: aKey ifAbsentPut: aBlock

	"Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."

	^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ]

!

globalAt: aKey put: anObject

	"Set the global property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."

	^ (globals ifNil: [ globals := Dictionary new: 1 ])

		at: aKey put: anObject

!

hasGlobal: aKey

	"Test if the global property aKey is present."

	^ globals notNil and: [ globals includesKey: aKey ]

!

invoke: parser

	^ parser parseOn: self

!

peek2

	position = readLimit ifTrue: [ ^ nil ].

	^ collection at: (position + 1)

!

removeGlobal: aKey

	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."

	^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ]

!

removeGlobal: aKey ifAbsent: aBlock

	"Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."

	| answer |

	globals isNil ifTrue: [ ^ aBlock value ].

	answer := globals removeKey: aKey ifAbsent: aBlock.

	globals isEmpty ifTrue: [ globals := nil ].

	^ answer

! !

!PPCContext methodsFor:'accessing-properties'!

hasProperty: aKey

	"Test if the property aKey is present."

	^ properties notNil and: [ properties includesKey: aKey ]

!

propertyAt: aKey

	"Answer the property value associated with aKey."

	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]

!

propertyAt: aKey ifAbsent: aBlock

	"Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."

	^ properties isNil

		ifTrue: [ aBlock value ]

		ifFalse: [ properties at: aKey ifAbsent: aBlock ]

!

propertyAt: aKey ifAbsentPut: aBlock

	"Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."

	^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]

!

propertyAt: aKey put: anObject

	"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."

	^ (properties ifNil: [ properties := Dictionary new: 1 ])

		at: aKey put: anObject

!

removeProperty: aKey

	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."

	^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ]

!

removeProperty: aKey ifAbsent: aBlock

	"Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."

	| answer |

	properties isNil ifTrue: [ ^ aBlock value ].

	answer := properties removeKey: aKey ifAbsent: aBlock.

	properties isEmpty ifTrue: [ properties := nil ].

	^ answer

! !

!PPCContext methodsFor:'acessing'!

hash

	^ collection hash

!

initializeFor: parser

	parser == root ifTrue: [ ^ self ].

	root := parser.

	root allParsersDo: [ :p | 

		p updateContext: self

	]

!

root

	^ root 

!

stream

	^ self

!

stream: aStream

	collection := aStream collection.

	position := aStream position.

	readLimit := collection size.

! !

!PPCContext methodsFor:'as yet unclassified'!

atWs

	^ position = ws

!

goUpTo: char

	[ position < readLimit ] whileTrue: [ 

		(collection at: position + 1) = char ifTrue: [ position := position + 1. ^ char ] .

		position := position + 1.

	]

!

setWs

	^ ws := position

!

ws

	^ ws

!

ws: anInteger

	ws := anInteger

! !

!PPCContext methodsFor:'converting'!

asCompiledParserContext

	^ self

! !

!PPCContext methodsFor:'failures'!

furthestFailure

	^ furthestFailure 

!

noteFailure: aPPFailure

	(aPPFailure position > furthestFailure position)

		ifTrue: [ furthestFailure := aPPFailure ].

! !

!PPCContext methodsFor:'initialization'!

compiledParser

	^ compiledParser

!

compiledParser: anObject

	compiledParser := anObject

!

initialize

	rc := 0.

	"Note a failure at -1"

	furthestFailure  := PPFailure new position: -1; yourself.

! !

!PPCContext methodsFor:'memoization'!

lwRemember

	^ position

!

lwRestore: aPPContextMemento

	position := aPPContextMemento.

!

remember

	| memento |

"

	^ position

"

	memento := PPCContextMemento new

		position: position;

		yourself.

	self rememberProperties: memento.

	"JK: Just while developing"

	rc := rc + 1.

	(rc > ((self size + 1)* 1000*1000)) ifTrue: [ self error: 'Hey, this is not normal, is it?' ].

	^ memento

!

rememberProperties: aPPContextMemento

	properties ifNil: [ ^ self ].

	properties keysAndValuesDo: [ :key :value |

		aPPContextMemento propertyAt: key put: value

	].

!

restore: aPPContextMemento

"	

	position := aPPContextMemento.

"	

	position := aPPContextMemento position.

	self restoreProperties: aPPContextMemento.

!

restoreProperties: aPPContextMemento

	properties ifNil: [ ^ self ].

	properties keysDo: [ :key |

		(aPPContextMemento hasProperty: key)

			ifTrue: [ properties at: key put: (aPPContextMemento propertyAt: key) ]

			ifFalse: [ properties removeKey: key  ]. 

	].

	aPPContextMemento keysAndValuesDo: [ :key :value |

		properties at: key put: value

	]

! !