diff -r 17ba167b8ee1 -r 553a5456963b compiler/PPCContext.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCContext.st	Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,278 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+PPStream subclass:#PPCContext
+	instanceVariableNames:'root properties globals furthestFailure compiledParser rc ws'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Context'
+!
+
+PPCContext comment:''
+!
+
+!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
+	aPPContextMemento keysAndValuesDo: [ :key :value |
+		self propertyAt: key put: value
+	].
+! !
+