--- a/compiler/PEGFsaState.st Fri Jul 31 14:07:31 2015 +0100
+++ b/compiler/PEGFsaState.st Mon Aug 17 12:56:02 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
Object subclass:#PEGFsaState
- instanceVariableNames:'name retval priority transitions final multivalue'
+ instanceVariableNames:'name infos transitions'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-FSA'
@@ -17,6 +17,14 @@
^ self basicNew initialize.
! !
+!PEGFsaState class methodsFor:'as yet unclassified'!
+
+named: aName
+ ^ self new
+ name: aName;
+ yourself
+! !
+
!PEGFsaState methodsFor:'accessing'!
destination
@@ -28,20 +36,42 @@
^ (transitions collect: #destination) asIdentitySet
!
+failure: boolean
+ self info failure: boolean
+!
+
final
- ^ final
+ ^ self info final
!
-final: anObject
- final := anObject
+final: boolean
+ self info final: boolean
+!
+
+infoFor: retval
+ ^ infos at: retval
+!
+
+infoFor: retval ifAbsent: block
+ ^ infos at: retval ifAbsent: block
+!
+
+isFsaFailure
+ ^ self isFinal and: [ self info isFsaFailure ]
!
multivalue
- ^ multivalue
+ <resource: #obsolete>
+ ^ self isMultivalue
+
+ "Modified: / 17-08-2015 / 12:03:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
multivalue: anObject
- multivalue := anObject
+ self flag: 'JK: Obsolete?'.
+ "multivalue := anObject"
+
+ "Modified: / 17-08-2015 / 12:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
name
@@ -52,16 +82,16 @@
name := anObject asString
!
-prefix
- ^ 'state'
-!
-
priority
- ^ priority
+ ^ self info priority
!
priority: anObject
- priority := anObject
+ self info priority: anObject
+!
+
+priorityFor: retval
+ ^ (self infoFor: retval) priority
!
priorityIfNone: value
@@ -69,23 +99,31 @@
!
retval
- ^ retval
+ self assert: self isMultivalue not.
+ ^ infos keys anyOne
!
retval: anObject
- retval := anObject
+ | info |
+ info := self info.
+ infos removeAll.
+ infos at: anObject put: info.
!
retvalAsCollection
- ^ self isMultivalue ifTrue: [
- self retval
- ] ifFalse: [
- Array with: self retval
- ]
+ ^ infos keys
+!
+
+retvals
+ ^ infos keys
!
-suffix
- ^ ''
+retvalsAndInfosDo: twoArgBlock
+ infos keysAndValuesDo: twoArgBlock
+!
+
+stateInfos
+ ^ infos values
!
transitions
@@ -94,6 +132,35 @@
!PEGFsaState methodsFor:'analysis'!
+collectNonEpsilonTransitionsOf: state to: collection
+ state transitions do: [ :t |
+ t isEpsilon ifTrue: [
+ self collectNonEpsilonTransitionsOf: t destination to: collection
+ ] ifFalse: [
+ collection add: t
+ ]
+ ].
+ ^ collection
+!
+
+nonEpsilonTransitionPairs
+ | size pairs collection |
+ pairs := OrderedCollection new.
+
+ collection := OrderedCollection new.
+ self collectNonEpsilonTransitionsOf: self to: collection.
+ size := collection size.
+
+ 1 to: (size - 1) do: [ :index1 |
+ (index1 + 1 to: size) do: [ :index2 |
+ pairs add: (PEGFsaPair
+ with: (collection at: index1)
+ with: (collection at: index2)).
+ ]
+ ].
+ ^ pairs
+!
+
reachableStates
| openSet |
openSet := IdentitySet new.
@@ -117,16 +184,15 @@
transitionPairs
| size pairs collection |
size := transitions size.
- pairs := OrderedCollection new: (size - 1) * size / 2.
+ pairs := OrderedCollection new.
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 add: (PEGFsaPair
+ with: (collection at: index1)
+ with: (collection at: index2)).
]
].
^ pairs
@@ -136,13 +202,14 @@
= anotherState
(self == anotherState) ifTrue: [ ^ true ].
- (self class == anotherState class) ifFalse: [ ^ true ].
+ (self class == anotherState class) ifFalse: [ ^ false ].
(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 ].
+
+ (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ self retvals do: [:retval |
+ ((self infoFor: retval) = (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
+ ].
(transitions size = anotherState transitions size) ifFalse: [ ^ false ].
transitions do: [:t |
@@ -154,25 +221,35 @@
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 ].
+
+ (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ self retvals do: [:retval |
+ ((self infoFor: retval) = (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
+ ].
^ true
!
equals: anotherState
+ self error: 'deprecated'.
+ "
+ JK: there is a bit mess between equals, isomorphic and =
+
+ JK: I should clean it, but the idea behind is:
+ - for minimization, I use equals
+ - for comparing, I use canBeIsomorphicTo: (because it can handle nested structures)
+ - I have no idea, why I override = O:)
+ "
+
(self == anotherState) ifTrue: [ ^ true ].
- (anotherState class == PEGFsaState) ifFalse: [ ^ false ].
+ (self class == anotherState class) 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 ].
+ (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
+ self retvals do: [:retval |
+ ((self infoFor: retval) equals: (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]
].
(transitions size == anotherState transitions size) ifFalse: [ ^ false ].
@@ -184,22 +261,20 @@
!
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)).
+ "JK: Size is not the best option here, but it one gets infinite loops otherwise"
+ ^ infos hash bitXor: transitions size hash
!
isIsomorphicTo: anotherState resolvedSet: set
+ self error: 'depracated?'.
(self == anotherState) ifTrue: [ ^ true ].
- (name == anotherState name) ifFalse: [ ^ false ].
+" (name == anotherState name) ifFalse: [ ^ false ].
(priority == anotherState priority) ifFalse: [ ^ false ].
- (multivalue == anotherState multivalue) ifFalse: [ ^ false ].
+ (multivalue == anotherState isMultivalue) 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 ].
@@ -211,22 +286,60 @@
!PEGFsaState methodsFor:'copying'!
postCopy
+ | newInfos |
super postCopy.
transitions := (transitions collect: [ :t | t copy ]).
- retval := retval copy.
+
+ newInfos := IdentityDictionary new.
+ infos keysAndValuesDo: [ :key :value |
+ newInfos at: key put: value copy
+ ].
+
+ infos := newInfos.
! !
!PEGFsaState methodsFor:'gt'!
gtName
- | gtName |
- gtName := name.
-
+ | gtStream |
+ gtStream := '' writeStream.
+ self printNameOn: gtStream.
+
self hasPriority ifTrue: [
- gtName := gtName asString, ',', self priority asString.
+ self retvalsAndInfosDo: [ :retval :info |
+ gtStream nextPut: (Character codePoint: 13).
+ gtStream nextPutAll: retval asString.
+ gtStream nextPutAll: '->'.
+ info printOn: gtStream.
+ ].
].
- ^ gtName
+ ^ gtStream contents trim
+! !
+
+!PEGFsaState methodsFor:'ids'!
+
+defaultName
+ ^ #state
+!
+
+hasName
+ ^ name isNil not
+!
+
+prefix
+ ^ nil
+!
+
+suffix
+ ^ nil
+! !
+
+!PEGFsaState methodsFor:'infos'!
+
+info
+ self assert: infos size = 1.
+ ^ infos anyOne
! !
!PEGFsaState methodsFor:'initialization'!
@@ -235,22 +348,59 @@
super initialize.
transitions := OrderedCollection new.
- multivalue := false.
+
+ infos := IdentityDictionary new.
+ infos at: nil put: PEGFsaStateInfo new.
! !
!PEGFsaState methodsFor:'modifications'!
+addInfo: info for: retval
+ infos removeKey: nil ifAbsent: [ "not a big deal" ].
+ infos at: retval put: info
+!
+
addTransition: t
self assert: (transitions identityIncludes: t) not.
transitions add: t
!
decreasePriority
+ self decreasePriorityBy: 1.
+!
+
+decreasePriorityBy: value
(self isFinal and: [ self hasPriority not ]) ifTrue: [
- priority := 0.
+ self error: 'Final States Should have priority!!'
].
- priority isNil ifFalse: [
- priority := priority - 1
+
+ self priority isNil ifFalse: [
+ self priority: self priority - value
+ ]
+!
+
+join: state
+ ^ self join: state joinDictionary: Dictionary new
+!
+
+mergeInfo: state into: newState
+ self info merge: state info into: newState info.
+!
+
+mergeTransitions
+ | toRemove |
+ toRemove := OrderedCollection new.
+ self transitionPairs do:[ :pair |
+ (pair first destination = pair second destination) ifTrue: [
+ (pair first isPredicateTransition not and: [pair second isPredicateTransition not]) ifTrue: [
+ pair first mergeWith: pair second.
+ toRemove add: pair second.
+ ]
+ ]
+ ].
+
+ toRemove do: [ :t |
+ self removeTransition: t
]
!
@@ -259,6 +409,94 @@
transitions remove: t
! !
+!PEGFsaState methodsFor:'modifications - determinization'!
+
+determinize
+ ^ PEGFsaAbstractDeterminizator new determinizeState: self
+!
+
+join: state joinDictionary: dictionary
+ | pair newState |
+ self error: 'deprecated'.
+ pair := PEGFsaPair with: self with: state.
+ (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ].
+
+ newState := PEGFsaState new.
+
+ dictionary at: pair put: newState.
+
+ self joinRetval: state into: newState.
+ self joinName: state into: newState.
+ self joinTransitions: state into: newState.
+
+ newState determinize: dictionary.
+
+ ^ dictionary at: pair put: newState
+!
+
+joinInfo: state into: newState
+ self info join: state info into: newState info.
+!
+
+joinName: state into: newState
+ newState name: self name asString, '_', state name asString.
+!
+
+joinRetval: state into: newState
+ "Different retvals cannot merge their info"
+ (self hasDifferentRetvalThan: state) ifTrue: [
+ newState addInfo: self info for: self retval.
+ newState addInfo: state info for: state retval.
+ ^ self
+ ].
+
+
+ (self hasHigherPriorityThan: state) ifTrue: [
+ newState retval: self retval
+ ].
+
+ (state hasHigherPriorityThan: self) ifTrue: [
+ newState retval: state retval
+ ].
+
+ (state priority == self priority) ifTrue: [
+ self hasRetval ifTrue: [newState retval: self retval].
+ state hasRetval ifTrue: [newState retval: state retval].
+ ].
+
+ self joinInfo: state into: newState.
+!
+
+joinTransitions: state into: newState
+ newState isMultivalue ifTrue: [
+ newState transitions addAll: (self transitions collect: #copy).
+ newState transitions addAll: (state transitions collect: #copy).
+ ^ self
+ ].
+
+ newState hasPriority ifFalse: [
+ newState transitions addAll: (self transitions collect: #copy).
+ newState transitions addAll: (state transitions collect: #copy).
+ ^ self
+ ].
+
+
+ self assert: newState hasPriority.
+
+ "This is a part when low priority branches are cut"
+ (self priority == newState priority) ifTrue: [
+ newState transitions addAll: (self transitions collect: #copy).
+ ] ifFalse: [
+ newState transitions addAll: (self transitions select: [ :t | t priority > newState priority ] thenCollect: #copy)
+ ].
+
+ (state priority == newState priority) ifTrue: [
+ newState transitions addAll: (state transitions collect: #copy).
+ ] ifFalse: [
+ newState transitions addAll: (state transitions select: [ :t | t priority > newState priority ] thenCollect: #copy)
+ ].
+! !
+
!PEGFsaState methodsFor:'printing'!
printNameOn: aStream
@@ -273,11 +511,14 @@
self printNameOn: aStream.
aStream nextPut: Character space.
aStream nextPutAll: self identityHash asString.
- self isFinal ifTrue: [
- aStream nextPutAll: ' FINAL'.
+
+ self retvalsAndInfosDo: [ :retval :info |
+ retval printOn: aStream.
+ aStream nextPutAll: '->'.
+ info printOn: aStream.
+ aStream nextPutAll: ';'.
].
- aStream nextPut: (Character codePoint: 32).
- aStream nextPutAll: priority asString.
+
aStream nextPut: $)
! !
@@ -287,129 +528,58 @@
^ true
!
+hasDifferentRetvalThan: anotherState
+ "returns true only if both hav retval and both retvals are different"
+ self hasRetval ifFalse: [ ^ false ].
+ anotherState hasRetval ifFalse: [ ^ false ].
+
+ "`retval value` is called in order to obtain retval from FsaFailure (if any)"
+ ^ (self retval value == anotherState retval value) not
+!
+
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
+ ^ self info hasEqualPriorityTo: state info
!
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
+ ^ self info hasHigherPriorityThan: state info
!
hasPriority
- ^ priority isNil not
+ ^ self stateInfos anySatisfy: [ :info | info hasPriority ]
+!
+
+hasRetval
+ ^ self retval isNil not
+!
+
+hasZeroPriorityOnly
+ ^ self stateInfos allSatisfy: [ :si | si hasPriority not or: [ si priority == 0 ] ].
!
isFailure
+ self error: 'Obsolete?'.
+ "
^ self isFinal and: [ retval class == PEGFsaFailure ]
+ "
+
+ "Modified: / 17-08-2015 / 12:01:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isFinal
- final isNil ifTrue: [ ^ false ].
-
- final ifTrue: [
-" self assert: self hasPriority. "
- ^ true
- ].
-
- ^ false
+ ^ self stateInfos anySatisfy: [ :info | info isFinal ].
!
isMultivalue
- ^ multivalue
+ ^ infos size > 1
+!
+
+isStub
+ ^ false
! !
!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 ]).