collections-graphnodes.st

編譯器的語法產生器

		put: newStartState.
	unprocessedStates add: newStartState.
	[unprocessedStates isEmpty]
		whileFalse: 
			[currState := unprocessedStates removeFirst.
			multiState := multiStateMap keyAtValue: currState.
			(self computeTransitionMapFor: multiState)
				associationsDo: 
					[:assoc | 
					ch := assoc key.
					transitStates := assoc value.
					newMultiState := self stateSetClass new.
					transitStates do: [:ts | newMultiState addAll: (epsilonClosures at: ts)].
					(multiStateMap includesKey: newMultiState)
						ifTrue: 
							["previously encountered state"
							newState := multiStateMap at: newMultiState]
						ifFalse: 
							["make a new state"
							newState := self newDFSAStateFor: newMultiState.
							multiStateMap at: newMultiState put: newState.
							unprocessedStates add: newState].
					currState goto: newState on: ch]].
	^newStartState spaceOptimize!

computeEpsilonClosureOf: stateSet 
	"Answer the set of states that can be reached from those in stateSet by epsilon 
	transitions alone."

	(stateSet includes: self)
		ifFalse: 
			[stateSet add: self.
			(self edgeLabelMap at: self epsilon ifAbsent: [^self])
				do: [:state | state computeEpsilonClosureOf: stateSet]]!

computeEpsilonClosures
	"Answer a Dictionary from states to their corresponding closures."

	| closures |
	closures := Dictionary new.
	self states do: [:state | closures at: state put: state epsilonClosure].
	^closures!

computeTransitionMapFor: multiState 
	"Answer a transition map (minus any epsilon transitons) for multiState, 
	a collection of states."

	| newMap |
	newMap := SetDictionary new.
	multiState do: [:state | state copyTransitionsTo: newMap].
	newMap removeKey: self epsilon ifAbsent: [].
	^newMap!

epsilonClosure
	"Answer the set of states that can be reached from me by epsilon transitions 
	alone."

	| states |
	states := self stateSetClass new.
	self computeEpsilonClosureOf: states.
	^states! !

!FSAState methodsFor: 'minimizing'!

asMinimalDFSA
	"Answer a new minimal deterministic version of myself. 
	NOTE: the recipient of the DFSA should send the spaceOptimize 
	message to the DFSA.
	
	Based on Algorithm 3.3 from 'Principles of Compiler Design', 
	by Aho and Ullman, 1977."

	| dfsa states statePartitionMap oldPartition newPartition |
	dfsa := self asDeterministicFSA.
	states := dfsa states.
	newPartition := self computeInitialPartitionFor: states.
	oldPartition := Set new.
	[newPartition size = oldPartition size]
		whileFalse: 
			[oldPartition := newPartition.
			statePartitionMap := self computeStatePartitionMapFor: states using: oldPartition.
			self computePartitionTransitionsFor: states using: statePartitionMap.
			newPartition := self computeNewPartitionFor: oldPartition using: statePartitionMap].
	^self
		computeNewDFSAFor: oldPartition
		using: statePartitionMap
		startState: dfsa!

asNearMinimalDFSAWithUniqueTokenClasses
	"Answer a new almost minimal deterministic version of myself. The result is not always 
	minimal due to the extra constraint that final state partitions containing final states for two 
	different token classes must be split. This allows the DFSA to properly handle overlapping 
	token classes.  NOTE: the recipient of the DFSA should send the spaceOptimize 
	message to the DFSA.
	
	Based on Algorithm 3.3 from 'Principles of Compiler Design', 
	by Aho and Ullman, 1977."

	| dfsa states statePartitionMap oldPartition newPartition |
	dfsa := self asDeterministicFSA.
	states := dfsa states.
	newPartition := self computeNearMinimalInitialPartitionFor: states.
	oldPartition := Set new.
	[newPartition size = oldPartition size]
		whileFalse: 
			[oldPartition := newPartition.
			statePartitionMap := self computeStatePartitionMapFor: states using: oldPartition.
			self computePartitionTransitionsFor: states using: statePartitionMap.
			newPartition := self computeNewPartitionFor: oldPartition using: statePartitionMap].
	^self
		computeNewDFSAFor: oldPartition
		using: statePartitionMap
		startState: dfsa!

computeInitialPartitionFor: states 
	"Partition states into final and nonfinal states."

	| finalStates nonFinalStates |
	finalStates := states select: [:state | state isFSAFinalState].
	nonFinalStates := states reject: [:state | state isFSAFinalState].
	^nonFinalStates isEmpty
		ifTrue: [Set with: finalStates]
		ifFalse: [Set with: nonFinalStates with: finalStates]!

computeNearMinimalInitialPartitionFor: states 
	"Partition states into nonfinal, literal final, and common token class final state partitions."

	| finalStates nonFinalStates partition tokenClasses literalTokens tc |
	finalStates := states select: [:state | state isFSAFinalState].
	nonFinalStates := states reject: [:state | state isFSAFinalState].
	partition := nonFinalStates isEmpty
				ifTrue: [Set new]
				ifFalse: [Set with: nonFinalStates].
	tokenClasses := SetDictionary new.
	literalTokens := Set new.
	finalStates do: 
		[:finalState | 
		(tc := finalState tokenClasses) size > 1 ifTrue: [self error: 'multiple token class states are not currently supported'].
		tc size = 0
			ifTrue: [literalTokens add: finalState]
			ifFalse: [tokenClasses at: tc first tokenType add: finalState]].
	literalTokens isEmpty ifFalse: [partition add: literalTokens].
	tokenClasses isEmpty ifFalse: [partition addAll: tokenClasses].
	^partition!

computeNewDFSAFor: partition using: statePartitionMap startState: startState 
	"Answer a new dfsa whose states represent partitions and whose transitions are 
	computed from the statePartitionMap. The state for the partition containing 
	startState is the new start state.  NOTE: the recipient of the DFSA should send
	the spaceOptimize message to the DFSA."

	| newStateMap partitionRepresentativeState newState ch st newStartState |
	newStateMap := IdentityDictionary new.
	partition do: [:part | newStateMap at: part put: (self newDFSAStateFor: part)].
	partition do: 
		[:part | 
		partitionRepresentativeState := part first.
		newState := newStateMap at: part.
		(statePartitionMap at: partitionRepresentativeState) transitionMap
			associationsDo: 
				[:assoc | 
				ch := assoc key.
				st := newStateMap at: assoc value.
				newState goto: st on: ch]].
	newStartState := newStateMap at: (statePartitionMap at: startState) partition.
	^newStartState!

computeNewPartitionFor: oldPartition using: statePartitionMap 
	"Answer a new state partition that is a refinement of oldPartition based on 
	partition transitions. An old partition is split into partitions of states with 
	equivalent partition transition maps."

	| newPartition partCopy initialState newPart |
	newPartition := Set new.
	oldPartition do: 
		[:part | 
		partCopy := part copy.
		[partCopy isEmpty]
			whileFalse: 
				[initialState := partCopy removeFirst.
				newPart := self stateSetClass with: initialState.
				partCopy copy do: [:state | ((statePartitionMap at: initialState)
						hasSameTransitionMapAs: (statePartitionMap at: state))
						ifTrue: 
							[partCopy remove: state.
							newPart add: state]].
				newPartition add: newPart]].
	^newPartition!

computePartitionTransitionsFor: states using: statePartitionMap 
	"For each state in states compute its partition-based transition map, 
	i.e. a transition map from characters to partitions."

	| char targetPartition |
	states do: [:state | state edgeLabelMap
			associationsDo: 
				[:assoc | 
				char := assoc key.
				targetPartition := (statePartitionMap at: (state transitionFor: char)) partition.
				(statePartitionMap at: state)
					goto: targetPartition on: char]]!

computeStatePartitionMapFor: states using: partition 
	"Answer a Dictionary mapping each state to an object containing its 
	corresponding partition and a partition-based transition map for the state."

	| statePartitionMap |
	statePartitionMap := Dictionary new.
	states do: [:state | statePartitionMap at: state put: (self partitionTransitionMapClass forPartition: (partition detect: [:par | par includes: state]))].
	^statePartitionMap! !

!FSAState methodsFor: 'exception handling'!

endOfInputErrorString

	^'end of input encountered'!

raiseNoTransitionExceptionErrorString: aString 

	self class noTransitionSignal raiseErrorString: aString!

standardErrorString

	^'illegal character encountered:  '! !

!FSAState methodsFor: 'state transitions'!

copyTransitionsTo: transitionMap 

	self edgeLabelMap associationsDo: [:assoc | transitionMap at: assoc key addAll: assoc value]!

transitionFor: aSymbol 

	^self transitionFor: aSymbol ifNone: [self raiseNoTransitionExceptionErrorString: (aSymbol = self endOfInputToken
				ifTrue: [self endOfInputErrorString]
				ifFalse: [self standardErrorString , '''' , aSymbol printString , ''''])]!

transitionFor: aSymbol ifNone: aBlock 

	^self edgeLabelMap at: aSymbol ifAbsent: [^aBlock value]! !

!FSAState methodsFor: 'converting'!

spaceOptimize

	self states do: [:state | state spaceOptimizeMap]! !

!FSAState methodsFor: 'accessing'!

states
	"Answer the Set states reachable from here. 
	If I am the start state this is all my states."

	| states |
	states := self stateSetClass new.
	self collectStatesIn: states.
	^states! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

FSAState class
	instanceVariableNames: 'noTransitionSignal '!


!FSAState class methodsFor: 'instance creation'!

new

	^super new init! !

!FSAState class methodsFor: 'class initialization'!

initialize
	"FSAState initialize"

	self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! !

!FSAState class methodsFor: 'state accessing'!

noTransitionSignal

	^noTransitionSignal!

noTransitionSignal: argument 

	noTransitionSignal := argument! !

FSAState subclass: #FSAFinalState
	instanceVariableNames: 'literalTokens tokenClasses '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Graph Nodes'!
FSAFinalState comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I am a final state of a finite state automata.  If I''m part of a minimal deterministic fsa then it is possible that I represent several final states of some original non-deterministic fsa.  My instance variables are used to distinguish between these various different final states.  Final states for literal tokens (keywords) are represented by name in literalTokens.  Final states for larger token classes are represented by TokenClassifications.  When a token is recognized by this final state, it is first checked against the list of literal tokens.  If not found, it is then classified as belonging to the one token class of which it is a member.  The current implementation does not support overlapping token classes, hence, there can only really be one element in the OrderedCollection.  However, in the future we hope to be able to support overlapping token classes.

Instance Variables:
	literalTokens		<Set of: String> - the literal tokens I recognize.
	tokenClasses 	<OrderedCollection of: TokenClassification> - the token classes I recognize.'!


!FSAFinalState methodsFor: 'initialization'!

init

	super init.
	self literalTokens: Set new.
	self tokenClasses: OrderedCollection new! !

!FSAFinalState methodsFor: 'state accessing'!

literalTokens

	^literalTokens!

literalTokens: argument 

	literalTokens := argument!

tokenClasses

	^tokenClasses!

tokenClasses: argument 

	tokenClasses := argument! !

!FSAFinalState methodsFor: 'state transitions'!

transitionFor: aSymbol 
	"The default for final states is to not raise an exception 
	if no transitions are possible, rather, they answer nil."

	^self transitionFor: aSymbol ifNone: [nil]! !

!FSAFinalState methodsFor: 'testing'!

isFSAFinalState

	^true! !

!FSAFinalState methodsFor: 'token classifying'!

addLiteralToken: literal 

	self literalTokens add: literal!

addTokenClass: tokenClass 
	"Don't add the same tokenClass twice."

	self tokenClasses detect: [:tc | tc tokenType = tokenClass tokenType]
		ifNone: [self tokenClasses size ~~ 0
				ifTrue: [self error: 'Current implementation only handles non-overlapping token classes.']
				ifFalse: [self tokenClasses add: tokenClass]]!

tokenTypeAndActionFor: aString 
	"The current implementation does not handle overlapping token classes. Hence, a final state 
	can only represent a literal or a single token class. Therefore, if not a literal then it must be 
	the token class."

	| tc |
	((self literalTokens includes: aString)
		or: [aString size = 0])
		ifTrue: [^self typeActionHolderClass type: aString action: nil].
	tc := self tokenClasses first.
	^self typeActionHolderClass type: tc tokenType action: tc action! !

!FSAFinalState methodsFor: 'private'!

typeActionHolderClass

	^TokenTypeActionHolder! !

FSAState subclass: #BidirectionalEdgeLabeledDigraphNode
	instanceVariableNames: 'predecessorLabelMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Graph Nodes'!
BidirectionalEdgeLabeledDigraphNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent a node in an edge-labeled digraph.  I maintain edges in both directions, i.e. I can follow edges forwards or backwards.

Instance Variables:

	predecessorLabelMap		<SetDictionary from: labels to: predecessors>'!


!BidirectionalEdgeLabeledDigraphNode methodsFor: 'state accessing'!

predecessorLabelMap

	^predecessorLabelMap!

predecessorLabelMap: argument 

	predecessorLabelMap := argument! !

!BidirectionalEdgeLabeledDigraphNode methodsFor: 'initialization'!

init

	super init.
	self predecessorLabelMap: SetDictionary new! !

!BidirectionalEdgeLabeledDigraphNode methodsFor: 'modifying'!

addPredecessor: node withEdgeLabeled: label 

	self predecessorLabelMap at: label add: node! !

!BidirectionalEdgeLabeledDigraphNode methodsFor: 'accessing'!

predecessors

	^self predecessorLabelMap elements! !

!BidirectionalEdgeLabeledDigraphNode methodsFor: 'enumerating'!

predecessorsDo: aBlock 

	self predecessors do: aBlock!

predecessorsExceptSelfDo: aBlock 

	(self predecessors reject: [:pred | pred = self])
		do: aBlock! !
FSAState initialize!