hg/stx-goodies-petitparser: comparison compiler/PEGFsaState.st

equal deleted inserted replaced

-:1e45d3c96ec5
+:b5316ef15274
 "{ Package: 'stx:goodies/petitparser/compiler' }"
 "{ NameSpace: Smalltalk }"
 Object subclass:#PEGFsaState
-	instanceVariableNames:'name retval priority transitions final multivalue'
+	instanceVariableNames:'name infos transitions'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'PetitCompiler-FSA'
 !
+!PEGFsaState class methodsFor:'instance creation'!
+new
+"return an initialized instance"
+^ self basicNew initialize.
+! !
+!PEGFsaState class methodsFor:'as yet unclassified'!
+named: aName
+^ self new
+name: aName;
+yourself
+! !
 !PEGFsaState methodsFor:'accessing'!
 destination
 self assert: transitions size = 1.
 ^ transitions anyOne destination
 destinations
 ^ (transitions collect: #destination) asIdentitySet
 !
+failure: boolean
+self info failure: boolean
+!
 final
-^ final
+^ self info final
 !
-final: anObject
+final: boolean
-final := anObject
+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
 ^ name
 !
 name: anObject
 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
 ^ self hasPriority ifTrue: [ self priority ] ifFalse: [ value ]
 !
 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: [
+^ infos keys
-self retval
+!
-] ifFalse: [
-Array with: self retval
+retvals
-]
+^ infos keys
 !
-suffix
+retvalsAndInfosDo: twoArgBlock
-^ ''
+	infos keysAndValuesDo: twoArgBlock
+!
+stateInfos
+^ infos values
 !
 transitions
 ^ transitions
 ! !
 !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.
 self reachableStatesOpenSet: openSet.
 !
 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
+pairs add: (PEGFsaPair
-first: (collection at: index1);
+with: (collection at: index1)
-second: (collection at: index2);
+with: (collection at: index2)).
-yourself).
 ]
 ].
 ^ pairs
 ! !
 !PEGFsaState methodsFor:'comparing'!
 = 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 ].
+(self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
-(retval = anotherState retval) ifFalse: [ ^ false ].
+self retvals do: [:retval |
-(final = anotherState final) ifFalse: [ ^ false ].
+((self infoFor: retval) = (anotherState infoFor: retval  ifAbsent: [ ^ false ])) 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 ].
+(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: [
+(self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].
-(priority == anotherState priority) ifFalse: [ ^ false ].
+self retvals do: [:retval |
+((self infoFor: retval) equals: (anotherState infoFor: retval ifAbsent: [ ^ false ])) 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: (
+"JK: Size is not the best option here, but it one gets infinite loops otherwise"
-priority hash bitXor: (
+^ infos hash bitXor: transitions size hash
-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 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 ].
 ].
 ! !
 !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 |
+|  gtStream |
-gtName := name.
+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.
-^ gtName
+gtStream nextPutAll: '->'.
+info printOn: gtStream.
+].
+].
+^ 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'!
 initialize
 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
 ]
 !
 removeTransition: t
 self assert: (transitions includes: t).
 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
 super printOn: aStream.
 aStream nextPut: $(.
 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 nextPut: (Character codePoint: 32).
+aStream nextPutAll: '->'.
-aStream nextPutAll: priority asString.
+info printOn: aStream.
+aStream nextPutAll: ';'.
+].
 aStream nextPut: $)
 ! !
 !PEGFsaState methodsFor:'testing'!
 canHavePPCId
 ^ 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 info hasEqualPriorityTo: state info
-(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 info hasHigherPriorityThan: state info
-(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
+^ 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 ].
+^ self stateInfos anySatisfy: [ :info | info isFinal ].
+!
-final ifTrue: [
-"		self assert: self hasPriority. "
+isMultivalue
-^ true
+^ infos size > 1
-].
+!
+isStub
 ^ 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 ]).
 ].

changeset 515	b5316ef15274
parent 502	1e45d3c96ec5
child 516	3b81c9e53352
child 524	f6f68d32de73