--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/PPContext.st	Fri Oct 03 02:33:08 2014 +0100
@@ -0,0 +1,269 @@
+"{ 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
+!
+
+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
+! !
+