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

Object subclass:#PPContext
	instanceVariableNames:'stream root properties globals'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitParser-Core'
!

!PPContext class methodsFor:'as yet unclassified'!

on: aPPParser stream: aStream
	^ self basicNew 
		initialize;
		root: aPPParser;
		stream: aStream asPetitStream;
		yourself
! !



!PPContext 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 ]
!

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
! !

!PPContext 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
! !

!PPContext methodsFor:'acessing'!

root
	^ root 
!

stream
	^ stream
!

stream: aStream
	stream := aStream.
! !

!PPContext methodsFor:'failures'!

furthestFailure
	" the furthest failure encountered while parsing the input stream "
	
	^ self globalAt: #furthestFailure ifAbsent: [ nil ]
!

noteFailure: aPPFailure
	"record the furthest failure encountered while parsing the input stream "

	| furthestFailure |
	furthestFailure := self furthestFailure.
	( furthestFailure isNil or: [ aPPFailure position > furthestFailure position ]) 
		ifTrue: [ self globalAt: #furthestFailure put: aPPFailure ].
! !

!PPContext methodsFor:'initialization'!

initialize
	stream := nil.
!

initializeFor: parser
	parser == root ifTrue: [ ^ self ].
	
	root := parser.
	root allParsersDo: [ :p | 
		p updateContext: self
	]
! !

!PPContext methodsFor:'memoization'!

remember
	| memento |
	memento := PPContextMemento new
		stream: stream;
		position: stream position;
		yourself.
		
	self rememberProperties: memento.
	^ memento
!

rememberProperties: aPPContextMemento
	properties ifNil: [ ^ self ].
	
	properties keysAndValuesDo: [ :key :value |
		aPPContextMemento propertyAt: key put: value
	].
!

restore: aPPContextMemento
	aPPContextMemento stream == stream ifFalse: [ self error: 'Oops!!' ].

	stream position: aPPContextMemento position.
	self restoreProperties: aPPContextMemento.
!

restoreProperties: aPPContextMemento
	aPPContextMemento stream == stream ifFalse: [ self error: 'Oops!!' ].
	
	aPPContextMemento keysAndValuesDo: [ :key :value |
		self propertyAt: key put: value
	].
! !

!PPContext methodsFor:'stream mimicry'!

atEnd
	^ stream atEnd
!

back
	^ stream back
!

collection
	^ stream collection  
!

contents 
	^ stream contents
!

isEndOfLine
	^ stream isEndOfLine
!

isStartOfLine
	^ stream isStartOfLine
!

next
	^ stream next
!

next: anInteger
	^ stream next: anInteger
!

peek
	^ stream peek
!

peekTwice
	^ stream peekTwice
!

position
	^ stream position
!

position: anInteger
	^ stream position: anInteger
!

skip: anInteger 
	^ stream skip: anInteger 
!

uncheckedPeek
	^ stream uncheckedPeek
!

upTo: anObject
	^ stream upTo: anObject
!

upToAll: whatever
	^ stream upToAll: whatever
!

upToAnyOf: whatever
	^ stream upToAnyOf: whatever
! !