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

"{ NameSpace: Smalltalk }"

PEGFsaTransition subclass:#PEGFsaCharacterTransition
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-FSA'
!

!PEGFsaCharacterTransition methodsFor:'accessing'!

acceptsCodePoint: codePoint
    self assert: codePoint isInteger.
    (codePoint < 1) ifTrue: [ ^ false ].
    ^ characterSet at: codePoint
!

beginOfRange
    characterSet withIndexDo: [ :e :index | 
        e ifTrue: [ ^ index ]
    ].
    self error: 'should not happend'
!

character
 	self assert: (self isSingleCharacter).
	characterSet withIndexDo: [ :e :index | e ifTrue: [ ^ Character codePoint: index ] ].
	self error: 'should not happen'.
!

characterSet
    ^ characterSet
!

characterSet: anObject
    characterSet := anObject
!

endOfRange
    | change |
    change := false.
    characterSet withIndexDo: [ :e :index | 
        e ifTrue: [ change := true ].
        (e not and: [ change ]) ifTrue: [ ^ index - 1]
    ].
    ^ characterSet size
!

notCharacter
    self assert: self isNotSingleCharacter.
    characterSet withIndexDo: [ :value :index | value ifFalse: [ ^ Character codePoint: index ] ].
    ^ self error: 'should not happen'
! !

!PEGFsaCharacterTransition 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 :)	
    "
    super = anotherTransition ifFalse: [ ^ false ].
    (characterSet = anotherTransition characterSet) ifFalse: [ ^ false ].
    
    ^ true
!

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

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

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

hash
    ^ super hash bitXor: characterSet hash
! !

!PEGFsaCharacterTransition methodsFor:'copying'!

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

!PEGFsaCharacterTransition methodsFor:'gt'!

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

!PEGFsaCharacterTransition methodsFor:'initialization'!

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

!PEGFsaCharacterTransition methodsFor:'modifications'!

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

!PEGFsaCharacterTransition methodsFor:'printing'!

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

printCharacterSetOn: stream
    (self isLetter) ifTrue: [ 
        stream nextPutAll: '#letter'.
        ^ self
    ].

    (self isWord) ifTrue: [ 
        stream nextPutAll: '#word'.
        ^ self
    ].


    stream nextPut: $[.
    32 to: 126 do: [ :index |
        (characterSet at: index) ifTrue: [ 
            ((Character codePoint: index) == $") ifTrue: [ 
                stream nextPutAll: '""'.
            ] ifFalse: [ 
                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: ')'.
! !

!PEGFsaCharacterTransition 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.
    
    transition isPredicateTransition ifTrue: [ ^ intersection  ].
    transition isEpsilonTransition ifTrue: [ self error: 'Dont know!!' ].
    
    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
! !

!PEGFsaCharacterTransition methodsFor:'testing'!

accepts: character
    self assert: character isCharacter.
    ^ self acceptsCodePoint: character codePoint
!

isAny
    ^ characterSet allSatisfy: [ :e | e ]
!

isCharacterTransition
    ^ true
!

isDigit
    characterSet withIndexDo: [ :value :index | 
        (Character codePoint: index) isDigit == value ifFalse: [ ^ false ]
    ].
    ^ true
!

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

isEpsilon
    ^ false
!

isLetter
    characterSet withIndexDo: [ :value :index | 
        (Character codePoint: index) isLetter == value ifFalse: [ ^ false ]
    ].
    ^ true
!

isNotSingleCharacter
    ^ (characterSet select: [ :e | e not ]) size == 1
!

isSingleCharacter
    ^ (characterSet select: [ :e | e ]) size == 1
!

isSingleRange
    | changes previous |
    changes := 0.
    previous := false.
    characterSet do: [ :e | 
        (e == previous) ifFalse: [ changes := changes + 1 ].
        previous := e.
    ].
    ^ changes < 3
!

isWord
    characterSet withIndexDo: [ :value :index | 
        (Character codePoint: index) isAlphaNumeric == value ifFalse: [ ^ false ]
    ].
    ^ true
!

overlapsWith: transition
    transition isCharacterTransition ifFalse: [ ^ false ].
    self isEpsilon ifTrue: [ ^ true ].
    transition isEpsilon ifTrue: [ ^ true ].
    
    ^ (self intersection: transition) anySatisfy: [ :bool | bool ]
! !

!PEGFsaCharacterTransition 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 := PEGFsaCharacterTransition 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
! !