diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/PEGFsaTransition.st
--- /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
+! !
+