Portability fix: override #new for class that implements #initialize
#initialize is not sent by default.
"{ 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
! !