--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaTransition.st Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,265 @@
+"{ 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
+! !
+