"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
PPStream subclass:#PPCContext
instanceVariableNames:'root properties globals furthestFailure compiledParser rc ws
currentTokenType currentTokenValue'
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'!
initializeFor: parser
rc := 0.
parser == root ifTrue: [ ^ self ].
root := parser.
!
root
^ root
!
stream
^ self
!
stream: aStream
collection := aStream collection.
position := aStream position.
readLimit := collection size.
! !
!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
]
! !
!PPCContext methodsFor:'whitespace'!
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 class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !