"{ Package: 'stx:goodies/petitparser/compiler' }"

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaState

	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

    ^ 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 ]

!

name

    ^ name

!

name: anObject

    name := anObject asString

!

priority

    ^ self info priority

!

priority: anObject

    self info priority: anObject

!

priorityFor: retval

    ^ (self infoFor: retval) priority

!

priorityIfNone: value

    ^ self hasPriority ifTrue: [ self priority ] ifFalse: [ value ]

!

retval

    self assert: self isMultivalue not.

    ^ infos keys anyOne

!

retval: anObject

    | info |

    info := self info.

    infos removeAll.

    infos at: anObject put: info.

!

retvalAsCollection

    ^ infos keys

!

retvals

    ^ infos keys

!

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.

    ^ 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.

    collection := transitions asOrderedCollection.

    1 to: (size - 1) do: [ :index1 |

        (index1 + 1 to: size) do: [ :index2 | 

            pairs add: (PEGFsaPair 

                with: (collection at: index1)

                with: (collection at: index2)).

        ]

    ].

    ^ pairs

! !

!PEGFsaState methodsFor:'comparing'!

= anotherState

    (self == anotherState) ifTrue: [ ^ true ].

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

    (name == anotherState name) 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 |

        (anotherState transitions contains: [:at | at = t]) ifFalse: [ ^ false ].

    ].

    ^ true

!

canBeIsomorphicTo: anotherState

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

    (transitions size == anotherState transitions size) 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 ].

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

    (self isFinal = anotherState isFinal) 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 ].

    anotherState transitions do: [ :t | 

        (transitions contains: [ :e | e equals: t]) ifFalse: [ ^ false ]

    ].

    ^ true

!

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 ].

    (priority == anotherState priority) 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 ].

    ].

    ^ true

! !

!PEGFsaState methodsFor:'copying'!

postCopy

    | newInfos |

    super postCopy.

    transitions := (transitions collect: [ :t | t copy ]).

    newInfos := IdentityDictionary new.

    infos keysAndValuesDo: [ :key :value | 

        newInfos at: key put: value copy

    ].

    infos := newInfos.

! !

!PEGFsaState methodsFor:'gt'!

gtName

    |  gtStream |

    gtStream := '' writeStream.

    self printNameOn: gtStream.

    self hasPriority ifTrue: [ 

        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

! !

!PEGFsaState methodsFor:'initialization'!

initialize

    super initialize.

    transitions := OrderedCollection new.

    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: [ 

        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

    ]

!

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

    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.