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

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaState
	instanceVariableNames:'name retval priority transitions final multivalue'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-FSA'
!

!PEGFsaState class methodsFor:'instance creation'!

new
    "return an initialized instance"

    ^ self basicNew initialize.
! !

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