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

"{ NameSpace: Smalltalk }"

Object subclass:#PPContext

	instanceVariableNames:'stream root properties globals furthestFailure'

	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 ]"

	"performance optimization:"

	^ furthestFailure

!

noteFailure: aPPFailure

	"record the furthest failure encountered while parsing the input stream "

	( furthestFailure isNil or: [ aPPFailure position > furthestFailure position ]) 

		ifTrue: [ furthestFailure := 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!!' ].

	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

	]

! !

!PPContext methodsFor:'printing'!

printOn: aStream

	super printOn: aStream.

	aStream nextPut: $:.

	aStream nextPut: $ .

	stream printOn: aStream

! !

!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 

!

skipTo: anObject 

	^ stream skipTo: anObject 

!

skipToAll: aString

	"Set the access position of the receiver to be past the next occurrence of the subCollection. Answer whether subCollection is found.  No wildcards, and case does matter."

	| pattern startMatch |

	pattern := aString readStream.

	startMatch := nil.

	[ pattern atEnd ] whileFalse: 

		[ stream atEnd ifTrue: [ ^ false ].

		stream next = pattern next 

			ifTrue: [ pattern position = 1 ifTrue: [ startMatch := stream position ] ]

			ifFalse: 

				[ pattern position: 0.

				startMatch ifNotNil: 

					[ stream position: startMatch.

					startMatch := nil ] ] ].

	^ true

!

skipToAnyOf: aCharacterSet 

	"Set the access position of the receiver to be past the next occurrence of

	a character in the character set. Answer whether a fitting character is found."

	[stream atEnd]

		whileFalse: [ (aCharacterSet includes: stream next) ifTrue: [^true]].

	^false

!

uncheckedPeek

	^ stream uncheckedPeek

!

upTo: anObject

	^ stream upTo: anObject

!

upToAll: whatever

	^ stream upToAll: whatever

!

upToAnyOf: whatever

	^ stream upToAnyOf: whatever

! !