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

"{ NameSpace: Smalltalk }"

Object subclass:#PEGFsaTransition

	instanceVariableNames:'characterSet destination priority'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-FSA'

!

!PEGFsaTransition class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!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

! !