Action inlining [1/x]: Initial support for inlining actions parsers (i.e., ==>)
The code of the action is now inlined into parsing method rather then delegated to
stored block. Mapping parser (i.e., map:[...]) are not supported and not detected, so
using them cause crash. This will be fixed later.
"{ 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
! !