Updated to PetitCompiler-JanVrany.135, PetitCompiler-Tests-JanKurs.93, PetitCompiler-Extras-Tests-JanVrany.16, PetitCompiler-Benchmarks-JanKurs.12
Name: PetitCompiler-JanVrany.135
Author: JanVrany
Time: 22-07-2015, 06:53:29.127 PM
UUID: 890178b5-275d-46af-a2ad-1738998f07cb
Ancestors: PetitCompiler-JanVrany.134
Name: PetitCompiler-Tests-JanKurs.93
Author: JanKurs
Time: 20-07-2015, 11:30:10.283 PM
UUID: 6473e671-ad70-42ca-b6c3-654b78edc531
Ancestors: PetitCompiler-Tests-JanKurs.92
Name: PetitCompiler-Extras-Tests-JanVrany.16
Author: JanVrany
Time: 22-07-2015, 05:18:22.387 PM
UUID: 8f6f9129-dbba-49b1-9402-038470742f98
Ancestors: PetitCompiler-Extras-Tests-JanKurs.15
Name: PetitCompiler-Benchmarks-JanKurs.12
Author: JanKurs
Time: 06-07-2015, 02:10:06.901 PM
UUID: cb24f1ac-46a4-494d-9780-64576f0f0dba
Ancestors: PetitCompiler-Benchmarks-JanKurs.11, PetitCompiler-Benchmarks-JanVrany.e29bd90f388e.20150619081300
"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
Object subclass:#PEGFsaState
instanceVariableNames:'name retval priority transitions final multivalue'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-FSA'
!
!PEGFsaState methodsFor:'accessing'!
destination
self assert: transitions size = 1.
^ transitions anyOne destination
!
destinations
^ (transitions collect: #destination) asIdentitySet
!
final
^ final
!
final: anObject
final := anObject
!
multivalue
^ multivalue
!
multivalue: anObject
multivalue := anObject
!
name
^ name
!
name: anObject
name := anObject asString
!
prefix
^ 'state'
!
priority
^ priority
!
priority: anObject
priority := anObject
!
priorityIfNone: value
^ self hasPriority ifTrue: [ self priority ] ifFalse: [ value ]
!
retval
^ retval
!
retval: anObject
retval := anObject
!
retvalAsCollection
^ self isMultivalue ifTrue: [
self retval
] ifFalse: [
Array with: self retval
]
!
suffix
^ ''
!
transitions
^ transitions
! !
!PEGFsaState methodsFor:'analysis'!
reachableStates
| openSet |
openSet := IdentitySet new.
self reachableStatesOpenSet: openSet.
^ openSet
!
reachableStatesOpenSet: openSet
(openSet includes: self) ifTrue: [
^ self
].
openSet add: self.
(self transitions) do: [ :t |
t destination reachableStatesOpenSet: openSet
].
!
transitionPairs
| size pairs collection |
size := transitions size.
pairs := OrderedCollection new: (size - 1) * size / 2.
collection := transitions asOrderedCollection.
1 to: (size - 1) do: [ :index1 |
(index1 + 1 to: size) do: [ :index2 |
pairs add: (PEGFsaPair new
first: (collection at: index1);
second: (collection at: index2);
yourself).
]
].
^ pairs
! !
!PEGFsaState methodsFor:'comparing'!
= anotherState
(self == anotherState) ifTrue: [ ^ true ].
(self class == anotherState class) ifFalse: [ ^ true ].
(name == anotherState name) ifFalse: [ ^ false ].
(priority == anotherState priority) ifFalse: [ ^ false ].
(multivalue == anotherState multivalue) ifFalse: [ ^ false ].
(retval = anotherState retval) ifFalse: [ ^ false ].
(final = anotherState final) ifFalse: [ ^ false ].
(transitions size = anotherState transitions size) ifFalse: [ ^ false ].
transitions do: [:t |
(anotherState transitions contains: [:at | at = t]) ifFalse: [ ^ false ].
].
^ true
!
canBeIsomorphicTo: anotherState
(name == anotherState name) ifFalse: [ ^ false ].
(priority == anotherState priority) ifFalse: [ ^ false ].
(multivalue == anotherState multivalue) ifFalse: [ ^ false ].
(final == anotherState final) ifFalse: [ ^ false ].
(transitions size == anotherState transitions size) ifFalse: [ ^ false ].
(retval = anotherState retval) ifFalse: [ ^ false ].
^ true
!
equals: anotherState
(self == anotherState) ifTrue: [ ^ true ].
(anotherState class == PEGFsaState) ifFalse: [ ^ false ].
(retval = anotherState retval) ifFalse: [ ^ false ].
(multivalue = anotherState multivalue) ifFalse: [ ^ false ].
(self isFinal = anotherState isFinal) ifFalse: [ ^ false ].
(self hasPriority and: [anotherState hasPriority]) ifTrue: [
(priority == anotherState priority) ifFalse: [ ^ false ].
].
(transitions size == anotherState transitions size) ifFalse: [ ^ false ].
anotherState transitions do: [ :t |
(transitions contains: [ :e | e equals: t]) ifFalse: [ ^ false ]
].
^ true
!
hash
^ retval hash bitXor: (
priority hash bitXor: (
multivalue hash bitXor:
"JK: Size is not the best option here, but it one gets infinite loops otherwise"
transitions size hash)).
!
isIsomorphicTo: anotherState resolvedSet: set
(self == anotherState) ifTrue: [ ^ true ].
(name == anotherState name) ifFalse: [ ^ false ].
(priority == anotherState priority) ifFalse: [ ^ false ].
(multivalue == anotherState multivalue) ifFalse: [ ^ false ].
(retval = anotherState retval) ifFalse: [ ^ false ].
(final = anotherState final) ifFalse: [ ^ false ].
(transitions size = anotherState transitions size) ifFalse: [ ^ false ].
transitions do: [:t |
(anotherState transitions contains: [:at | t isIsomorphicto: at]) ifFalse: [ ^ false ].
].
^ true
! !
!PEGFsaState methodsFor:'copying'!
postCopy
super postCopy.
transitions := (transitions collect: [ :t | t copy ]).
retval := retval copy.
! !
!PEGFsaState methodsFor:'gt'!
gtName
| gtName |
gtName := name.
self hasPriority ifTrue: [
gtName := gtName asString, ',', self priority asString.
].
^ gtName
! !
!PEGFsaState methodsFor:'initialization'!
initialize
super initialize.
transitions := OrderedCollection new.
multivalue := false.
! !
!PEGFsaState methodsFor:'modifications'!
addTransition: t
self assert: (transitions identityIncludes: t) not.
transitions add: t
!
decreasePriority
(self isFinal and: [ self hasPriority not ]) ifTrue: [
priority := 0.
].
priority isNil ifFalse: [
priority := priority - 1
]
!
removeTransition: t
self assert: (transitions includes: t).
transitions remove: t
! !
!PEGFsaState methodsFor:'printing'!
printNameOn: aStream
self name isNil
ifTrue: [ aStream print: self hash ]
ifFalse: [ aStream nextPutAll: self name ]
!
printOn: aStream
super printOn: aStream.
aStream nextPut: $(.
self printNameOn: aStream.
aStream nextPut: Character space.
aStream nextPutAll: self identityHash asString.
self isFinal ifTrue: [
aStream nextPutAll: ' FINAL'.
].
aStream nextPut: (Character codePoint: 32).
aStream nextPutAll: priority asString.
aStream nextPut: $)
! !
!PEGFsaState methodsFor:'testing'!
canHavePPCId
^ true
!
hasEqualPriorityTo: state
"nil - nil"
(self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ].
"nil - priority"
(self hasPriority) ifFalse: [ ^ false ].
"priority - nil"
state hasPriority ifFalse: [ ^ false ].
"priority - priority"
^ self priority = state priority
!
hasHigherPriorityThan: state
"nil - nil"
(self hasPriority not and: [state hasPriority not]) ifTrue: [ ^ true ].
"nil - priority"
(self hasPriority) ifFalse: [ ^ false ].
"priority - nil"
state hasPriority ifFalse: [ ^ true ].
"priority - priority"
^ self priority > state priority
!
hasPriority
^ priority isNil not
!
isFailure
^ self isFinal and: [ retval class == PEGFsaFailure ]
!
isFinal
final isNil ifTrue: [ ^ false ].
final ifTrue: [
" self assert: self hasPriority. "
^ true
].
^ false
!
isMultivalue
^ multivalue
! !
!PEGFsaState methodsFor:'transformation'!
determinize
^ self determinize: Dictionary new.
!
determinize: dictionary
self transitionPairs do: [ :pair |
self assert: (pair first destination = pair second destination) not.
(pair first overlapsWith: pair second) ifTrue: [
self determinizeOverlap: pair first second: pair second joinDictionary: dictionary
]
].
!
determinizeOverlap: t1 second: t2 joinDictionary: dictionary
| pair t1Prime t2Prime tIntersection |
pair := PEGFsaPair with: t1 with: t2.
(dictionary includes: pair) ifTrue: [ self error: 'should not happen'.].
dictionary at: pair put: nil.
tIntersection := t1 join: t2 joinDictionary: dictionary.
t1Prime := PEGFsaTransition new
destination: t1 destination;
characterSet: (t1 complement: t2);
yourself.
t2Prime := PEGFsaTransition new
destination: t2 destination;
characterSet: (t2 complement: t1);
yourself.
self removeTransition: t1.
self removeTransition: t2.
tIntersection isEpsilon ifFalse: [ self addTransition: tIntersection ].
t1Prime isEpsilon ifFalse: [ self addTransition: t1Prime ].
t2Prime isEpsilon ifFalse: [ self addTransition: t2Prime ].
dictionary at: pair put: (Array
with: tIntersection
with: t1Prime
with: t2Prime
)
!
join: state
^ self join: state joinDictionary: Dictionary new
!
join: state joinDictionary: dictionary
| pair newState |
pair := PEGFsaPair with: self with: state.
(dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ].
newState := PEGFsaState new.
dictionary at: pair put: newState.
self joinFinal: state newState: newState.
self joinPriority: state newState: newState.
self joinRetval: state newState: newState.
self joinName: state newState: newState.
newState transitions addAll: (self transitions collect: #copy).
newState transitions addAll: (state transitions collect: #copy).
newState determinize: dictionary.
^ dictionary at: pair put: newState
!
joinFinal: state newState: newState
(self hasEqualPriorityTo: state) ifTrue: [
^ newState final: (self isFinal or: [ state isFinal ]).
].
(self hasHigherPriorityThan: state) ifTrue: [
^ newState final: self isFinal.
].
newState final: state isFinal.
!
joinName: state newState: newState
newState name: self name asString, '-', state name asString.
!
joinPriority: state newState: newState
(self hasHigherPriorityThan: state) ifTrue: [
newState priority: self priority.
^ self
].
newState priority: state priority.
!
joinRetval: state newState: newState
self isFinal ifFalse: [ ^ newState retval: state retval ].
state isFinal ifFalse: [ ^ newState retval: self retval ].
(self priority = state priority) ifTrue: [
newState multivalue: true.
^ newState retval: { self retval . state retval }.
].
"Both are final"
self priority isNil ifTrue: [
^ newState retval: state retval.
].
state priority isNil ifTrue: [
^ newState retval: self retval.
].
(self priority > state priority) ifTrue: [
^ newState retval: self retval.
].
^ newState retval: state retval.
! !