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

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaState

	instanceVariableNames:'name retval priority transitions final multivalue'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-FSA'

!

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

! !