"{ Package: 'stx:goodies/smaCC' }"

"{ NameSpace: SmaCC }"

Object subclass:#SmaCCEdge
	instanceVariableNames:'toNode characters'
	classVariableNames:'IsExpressions'
	poolDictionaries:''
	category:'SmaCC-Scanner Generator'
!

SmaCCEdge comment:'SmaCCEdge represents a transition in a Finite Automata (directed graph). It is labeled with the characters (possibly none, indicating an epsilon transition) that cause the transition.

Instance Variables:
	characters	<SortedCollection of: Character>	The characters that cause the transition. Note that there are no duplicates and all characters are sorted.
	toNode	<SmaCCNode>	The node that this is transitioning to.'
!


!SmaCCEdge class methodsFor:'instance creation'!

to: aNode on: aStringOrNil 
	| edge |
	edge := self new.
	edge to: aNode on: aStringOrNil.
	^edge
! !

!SmaCCEdge class methodsFor:'class initialization'!

generateCharacterSetFor: aSelector 
        | stream |
        stream := WriteStream on: UnicodeString new.
        0 to: SmaCCGrammar maximumCharacterValue
                do: 
                        [:i | 
                        | ch |
                        ch := Character value: i.
                        (ch perform: aSelector) ifTrue: [stream nextPut: ch]].
        ^stream contents

    "Modified: / 26-05-2006 / 22:16:27 / janfrog"
!

initializeIsExpressions
    "Creates a map from sets of characters to selectors that start with 'is' on Character. This allows generated scanners to take
     full advantage of selectors that are already implemented on Character"
    
    |selectors|

    IsExpressions := Dictionary new.
    selectors := OrderedCollection new.

    "This code ensures that any extension isXXX methods will not
     be taken"
    Character methodDictionary do:
                [:method| | selector |
                selector := method selector.
                ((selector startsWith:'is') and:[method numArgs = 0 and:[method package == Character package]])
                    ifTrue:[selectors add:selector]].

    selectors do:[:sel | 
        |string|

        string := self generateCharacterSetFor:sel.
        string isEmpty ifFalse:[
            IsExpressions at:string put:sel
        ]
    ]

    "Modified: / 15-02-2010 / 16:57:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!SmaCCEdge methodsFor:'accessing'!

mergeWith: anEdge 
	characters := String withAll: ((characters , anEdge characters) asSet 
						asSortedCollection: [:a :b | a asInteger < b asInteger])
!

to
	^toNode
! !

!SmaCCEdge methodsFor:'comparing'!

< anEdge
        "required for ST/X, where SortedCollection uses < to compare"

        ^self to id < anEdge to id
!

<= anEdge 
	^self to id <= anEdge to id
!

= anEdge 
	self class = anEdge class ifFalse: [^false].
	^self to = anEdge to and: [self characters = anEdge characters]
!

hash
	^(self to hash bitShift: 14) bitXor: characters hash
! !

!SmaCCEdge methodsFor:'compiling'!

closestIsExpression
	"Attempts to find the #is selector that most closely matches the character set that this edge transitions on."

	| expressions closest |
	expressions := IsExpressions keys 
				select: [:each | (each reject: [:ch | self includesCharacter: ch]) isEmpty].
	expressions isEmpty ifTrue: [^nil].
	closest := IsExpressions 
				at: (expressions asSortedCollection: [:a :b | a size > b size]) first.
	(self minMaxPairsWithout: closest) size 
		<= (self minMaxPairsWithout: nil) size ifFalse: [^nil].
	^closest
!

expression
	| stream isSelector |
	stream := WriteStream on: (String new: 128).
	stream nextPut: $(.
	characters size = SmaCCGrammar maximumCharacterValue 
		ifTrue: [self outputInvertedMatchOn: stream]
		ifFalse: 
			[isSelector := self outputClosestIsMethodOn: stream.
			self outputExpressionOn: stream without: isSelector].
	stream nextPut: $).
	^stream contents
!

minMaxPairsWithout: aSelector 
	"Converts a list of characters into a collection of pairs representing the minimum and maximum of each sequence.
	The list is first filtered to include only those characters that fail aSelector."

	| start last pairs charsLeft |
	charsLeft := aSelector isNil 
				ifTrue: [characters]
				ifFalse: [characters reject: [:ch | ch perform: aSelector]].
	pairs := OrderedCollection new.
	charsLeft isEmpty ifTrue: [^pairs].
	last := charsLeft first.
	start := nil.
	charsLeft do: 
			[:each | 
			last asInteger + 1 = each asInteger 
				ifFalse: 
					[start notNil ifTrue: [pairs add: (Array with: start with: last)].
					start := each].
			last := each].
	pairs add: (Array with: start with: last).
	^pairs
!

outputClosestIsMethodOn: stream 
	| expr |
	expr := self closestIsExpression.
	expr isNil ifFalse: [stream nextPutAll: 'currentCharacter ' , expr].
	^expr
!

outputExpressionFor: aPair on: stream 
	aPair first == aPair last 
		ifTrue: [^self outputMatchSingleCharacter: aPair first on: stream].
	aPair first = (Character value: 0) 
		ifTrue: [^self outputMatchLessThan: aPair last on: stream].
	aPair last = (Character value: SmaCCGrammar maximumCharacterValue) 
		ifTrue: [^self outputMatchGreaterThan: aPair first on: stream].
	self outputMatchRange: aPair on: stream
!

outputExpressionOn: aStream without: aSelector 
	| pairs |
	pairs := self minMaxPairsWithout: aSelector.
	pairs isEmpty ifTrue: [^self].
	aSelector notNil ifTrue: [aStream nextPutAll: ' or: ['].
	pairs do: [:each | self outputExpressionFor: each on: aStream]
		separatedBy: [aStream nextPutAll: ' or: ['].
	aStream next: pairs size - 1 put: $].
	aSelector notNil ifTrue: [aStream nextPut: $]]
!

outputInvertedMatchOn: aStream 
	| char |
	char := Character value: ((0 to: SmaCCGrammar maximumCharacterValue) 
						detect: [:each | (characters includes: (Character value: each)) not]).
	aStream
		nextPutAll: 'currentCharacter ~~ ';
		nextPutAll: char storeString
!

outputMatchGreaterThan: aCharacter on: stream 
	stream
		nextPutAll: 'currentCharacter >= ';
		nextPutAll: aCharacter storeString
!

outputMatchLessThan: aCharacter on: stream 
	stream
		nextPutAll: 'currentCharacter <= ';
		nextPutAll: aCharacter storeString
!

outputMatchRange: aPair on: stream 
	stream
		nextPutAll: '(currentCharacter between: ';
		nextPutAll: aPair first storeString;
		nextPutAll: ' and: ';
		nextPutAll: aPair last storeString;
		nextPutAll: ')'
!

outputMatchSingleCharacter: aCharacter on: stream 
	stream
		nextPutAll: 'currentCharacter == ';
		nextPutAll: aCharacter storeString
! !

!SmaCCEdge methodsFor:'initialize-release'!

to: aNode on: aStringOrNil 
	toNode := aNode.
	characters := aStringOrNil
! !

!SmaCCEdge methodsFor:'printing'!

printOn: aStream 
	aStream
		nextPutAll: '---';
		nextPutAll: (characters ifNil: ['""']);
		nextPutAll: '--->';
		nextPutAll: toNode printString
! !

!SmaCCEdge methodsFor:'private'!

characters
	^characters
!

removeCharacters: aCollection 
	characters := characters 
				reject: [:each | self does: aCollection includeCharacter: each]
! !

!SmaCCEdge methodsFor:'public'!

conflictsWith: anEdge 
	^characters anySatisfy: [:each | anEdge characters includes: each]
!

does: aString includeCharacter: aCharacter 
	| start stop mid |
	start := 1.
	stop := aString size.
	stop = 0 ifTrue: [^false].
	
	[mid := (start + stop) // 2.
	mid == start] whileFalse: 
				[(aString at: mid) asInteger < aCharacter asInteger 
					ifTrue: [start := mid]
					ifFalse: [stop := mid]].
	^(aString at: start) == aCharacter or: [(aString at: stop) == aCharacter]
!

includesCharacter: aCharacter 
	^self does: characters includeCharacter: aCharacter
!

isEmpty
	^characters isEmpty
!

isEpsilonTransition
	^characters isNil
! !

!SmaCCEdge class methodsFor:'documentation'!

version
    ^ '$Header: /opt/data/cvs/stx/goodies/smaCC/SmaCC__SmaCCEdge.st,v 1.2 2006-05-28 20:08:49 vranyj1 Exp $'
!

version_SVN
    ^ '$Id$'
! !