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

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaTransition
	instanceVariableNames:'characterSet destination priority'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-FSA'
!

!PEGFsaTransition methodsFor:'accessing'!

characterSet
    ^ characterSet
!

characterSet: anObject
    characterSet := anObject
!

destination
    ^ destination
!

destination: anObject
    destination := anObject
!

priority
    ^ priority
!

priority: anObject
    priority := anObject
! !

!PEGFsaTransition methodsFor:'comparing'!

= anotherTransition
    "
    Please note the identity comparison on destination
    If you use equality instead of identy, you will get infinite loop.

    So much for comparison by now :)	
    "
    (self == anotherTransition) ifTrue: [ ^ true ].
    (self class == anotherTransition class) ifFalse: [ ^ false ].

    (destination == anotherTransition destination) ifFalse: [ ^ false ].
    (priority == anotherTransition priority) ifFalse: [ ^ false ].
    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
    
    ^ true
!

canBeIsomorphicTo: anotherTransition
    (priority == anotherTransition priority) ifFalse: [ ^ false ].
    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
    
    ^ true
!

equals: anotherTransition
    "this method is used for minimization of the FSA"
    
    (self == anotherTransition) ifTrue: [ ^ true ].

    (destination == anotherTransition destination) ifFalse: [ ^ false ].
    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].

    "JK: If character set and destination are the same, priority does not really matter"
    ^ true
!

hash
    ^ destination hash bitXor: (priority hash bitXor: characterSet hash)
!

isIsomorphicTo: object resolvedSet: set
    (set includes: (PEGFsaPair with: self with: object)) ifTrue: [ 
        ^ true
    ].
    set add: (PEGFsaPair with: self with: object).

    (self == object) ifTrue: [ ^ true ].
    (self class == object class) ifFalse: [ ^ false ].

    (priority == object priority) ifFalse: [ ^ false ].
    (characterSet = object characterSet) ifFalse: [ ^ false ].
    (destination isIsomorphicTo: object destination resolvedSet: set) ifFalse: [ ^ false ].
    
    ^ true
! !

!PEGFsaTransition methodsFor:'copying'!

postCopy
    super postCopy.
    characterSet := characterSet copy.
! !

!PEGFsaTransition methodsFor:'gt'!

gtName
    | gtName |
    gtName := self characterSetAsString.
    priority < 0 ifTrue: [ gtName := gtName, ',', priority asString ].
    ^ gtName
! !

!PEGFsaTransition methodsFor:'initialization'!

initialize
    super initialize.
    characterSet := Array new: 255 withAll: false.
    priority := 0.
! !

!PEGFsaTransition methodsFor:'modifications'!

addCharacter: character
    characterSet at: character codePoint put: true
!

decreasePriority
    priority := priority - 1
! !

!PEGFsaTransition methodsFor:'printing'!

characterSetAsString
    | stream |
    stream := WriteStream on: ''.
    self printCharacterSetOn: stream.
    ^ stream contents
!

printCharacterSetOn: stream
    self isEpsilon ifTrue: [ 
        stream nextPutAll: '<epsilon>'.
        ^ self
    ].

    stream nextPut: $[.
    32 to: 127 do: [ :index |
        (characterSet at: index) ifTrue: [ 
            stream nextPut: (Character codePoint: index)
        ]
    ].
    stream nextPut: $].
!

printOn: stream
    self printCharacterSetOn: stream.
    stream nextPutAll: ' ('.
    priority printOn: stream.
    stream nextPutAll: ')'.		
    stream nextPutAll: '-->'.
    destination printOn: stream.
    stream nextPutAll: '(ID: '.
    stream nextPutAll: self identityHash asString.
    stream nextPutAll: ')'.
! !

!PEGFsaTransition methodsFor:'set operations'!

complement: transition
    | complement |
    complement := Array new: 255.
    
    1 to: 255 do: [ :index |
        complement
            at: index 
            put: ((self characterSet at: index) and: [(transition characterSet at: index) not])
    ].

    ^ complement
!

disjunction: transition
    | disjunction |
    disjunction := Array new: 255.
    
    1 to: 255 do: [ :index |
        disjunction
            at: index 
            put: ((self characterSet at: index) xor: [transition characterSet at: index])
    ].

    ^ disjunction
!

intersection: transition
    | intersection |
    intersection := Array new: 255.
    
    1 to: 255 do: [ :index |
        intersection
            at: index 
            put: ((self characterSet at: index) and: [transition characterSet at: index])
    ].

    ^ intersection
!

union: transition
    | union |
    union := Array new: 255.
    
    1 to: 255 do: [ :index |
        union
            at: index 
            put: ((self characterSet at: index) or: [transition characterSet at: index])
    ].

    ^ union
! !

!PEGFsaTransition methodsFor:'testing'!

accepts: character
    ^ characterSet at: character codePoint
!

isEpsilon
    ^ characterSet allSatisfy: [ :e | e not ]
!

overlapsWith: transition
    ^ (self intersection: transition) anySatisfy: [ :bool | bool ]
! !

!PEGFsaTransition methodsFor:'transformation'!

join: transition
    ^ self join: transition joinDictionary: Dictionary new.
!

join: transition joinDictionary: dictionary
    | newDestination newTransition |
"	pair := PEGFsaPair with: self with: transition.
    (dictionary includesKey: pair) ifTrue: [ ^ dictionary at: pair ].
    dictionary at: pair put: nil.
"	
    newDestination := self destination join: transition destination joinDictionary: dictionary.
    newDestination isNil ifTrue: [ self error: 'What a cycle!! I wonder, how does this happened!!' ].
    
    newTransition := PEGFsaTransition new.
    newTransition destination: newDestination.
    newTransition characterSet: (self intersection: transition).
    newTransition priority: (self priority min: transition priority).
    
"	^ dictionary at: pair put: newTransition"
    ^ newTransition 
!

mergeWith: transition
    | union |
    self assert: destination = transition destination.
    
    union := self union: transition.
    self characterSet: union
! !