--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PEGFsaCharacterTransition.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,326 @@
+"{ 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
+! !
+