instanceVariableNames:'name infos transitions'

!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

! !

failure: boolean

    self info failure: boolean

!

    ^ self info final

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 ]

    <resource: #obsolete>

    ^ self isMultivalue

    "Modified: / 17-08-2015 / 12:03:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    self flag: 'JK: Obsolete?'.

    "multivalue := anObject"

    "Modified: / 17-08-2015 / 12:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    ^ self info priority

    self info priority: anObject

!

priorityFor: retval

    ^ (self infoFor: retval) priority

    self assert: self isMultivalue not.

    ^ infos keys anyOne

    | info |

    info := self info.

    infos removeAll.

    infos at: anObject put: info.

    ^ infos keys

!

retvals

    ^ infos keys

retvalsAndInfosDo: twoArgBlock

 	infos keysAndValuesDo: twoArgBlock

!

stateInfos

    ^ infos values

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

!

    pairs := OrderedCollection new.

            pairs add: (PEGFsaPair 

                with: (collection at: index1)

                with: (collection at: index2)).

    (self class == anotherState class) ifFalse: [ ^ false ].

    (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].

    self retvals do: [:retval |

        ((self infoFor: retval) = (anotherState infoFor: retval  ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]

    ].

    (self stateInfos size == anotherState stateInfos size) ifFalse: [ ^ false ].

    self retvals do: [:retval |

        ((self infoFor: retval) = (anotherState infoFor: retval ifAbsent: [ ^ false ])) ifFalse: [ ^ false ]

    ].

    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 class == anotherState class) 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 ]

    "JK: Size is not the best option here, but it one gets infinite loops otherwise"

    ^ infos hash bitXor: transitions size hash

    self error: 'depracated?'.

"	(name == anotherState name) ifFalse: [ ^ false ].

    (multivalue == anotherState isMultivalue) ifFalse: [ ^ false ].

"

    | newInfos |

    newInfos := IdentityDictionary new.

    infos keysAndValuesDo: [ :key :value | 

        newInfos at: key put: value copy

    ].

    infos := newInfos.

    |  gtStream |

    gtStream := '' writeStream.

    self printNameOn: gtStream.

        self retvalsAndInfosDo: [ :retval :info | 

            gtStream nextPut: (Character codePoint: 13). 

            gtStream nextPutAll: retval asString.

            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

    infos := IdentityDictionary new.

    infos at: nil put: PEGFsaStateInfo new.

addInfo: info for: retval

    infos removeKey: nil ifAbsent: [ "not a big deal" ].

    infos at: retval put: info

!

    self decreasePriorityBy: 1.

!

decreasePriorityBy: value

        self error: 'Final States Should have priority!!'

    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

!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)

    ].

! !