Object subclass: #TreeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Graph Nodes'! TreeNode comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= This abstract class provides the framework for both destructive and non-destructive tree traversals in which references to locally global objects are available without being explicitly passed as arguments. Concrete subclasses must implement methods for traversing childrenDo: "Evaluate the argument block with each of my children." updateChildrenUsing: "Replace my children with the result of evaluating the argument block with the corresponding child."'! !TreeNode methodsFor: 'traversing'! childrenDo: aBlock "Evaluate aBlock for each of my children. This message should be reimplemented by my subclasses." ^self "default"! preorderDo: preBlock updateUsing: postBlock "Perform a traversal on myself and my children. The preBlock is evaluated when first entering a node. My children are replaced with the results of the traversal. Thus, this message can be used to generate objects or alter my structure, whereas postorderDo: can only be used to examine my structure. This message may be used in the following manner. a := aMethodNode preorderDo: [:node | node msg1] updateUsing: [:node | node msg2: globalRef]" preBlock value: self. self updateChildrenUsing: [:child | child preorderDo: preBlock updateUsing: postBlock]. ^postBlock value: self! updateChildrenUsing: aBlock "Replace my children according to the value of aBlock. This message should be reimplemented by my subclasses." ^self "default"! updateCopyUsing: aBlock "Perform a postorder traversal on a copy of myself and my children, replacing my children with the results of the traversal. Thus, this message can be used to generate objects or alter my structure, whereas postorderDo: can only be used to examine my structure. This message may be used in the following manner. a := aMethodNode updateCopyUsing: [:node | node msg: globalRef]" | newNode | newNode := self copy. newNode updateChildrenUsing: [:child | child updateCopyUsing: aBlock]. ^aBlock value: newNode! updateUsing: aBlock "Perform a postorder traversal on myself and my children, replacing my children with the results of the traversal. Thus, this message can be used to generate objects or alter my structure, whereas postorderDo: can only be used to examine my structure. This message may be used in the following manner. a := aMethodNode updateUsing: [:node | node msg: globalRef]" self updateChildrenUsing: [:child | child updateUsing: aBlock]. ^aBlock value: self! ! !TreeNode methodsFor: 'copying'! copyTree "Answer a copy of this tree." ^self copy updateChildrenUsing: [:child | child copyTree]! ! !TreeNode methodsFor: 'enumerating'! postorderDo: aBlock "Perform a postorder traversal on myself and my children. This message may be used for examining the nodes of a tree for the purpose of gathering data or altering data fields. To alter the structure of the tree see traverseDo:. One of the main advantages of this message is that it allows all nodes of the tree 'global' access to objects referenced in aBlock. Before, such arguments had to be passed explitely as arguments. This message may be used as follows. aMethodNode postorderDo: [:node | node enc: encoder root: self]" self childrenDo: [:child | child postorderDo: aBlock]. aBlock value: self! preorderDo: preBlock postorderDo: postBlock "Perform a traversal on myself and my children. The preBlock is evaluated when entering a node and postBlock is evaluated just before leaving. See comment in postorderDo:." preBlock value: self. self childrenDo: [:child | child preorderDo: preBlock postorderDo: postBlock]. postBlock value: self! ! Object subclass: #GraphNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Graph Nodes'! GraphNode comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I am an abstract class of graph nodes.'! GraphNode subclass: #DirectedGraphNode instanceVariableNames: 'predecessors ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Graph Nodes'! DirectedGraphNode comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I maintain a collection of my predecessor nodes. Instance Variables: predecessors '! !DirectedGraphNode methodsFor: 'state accessing'! predecessors ^predecessors! predecessors: argument predecessors := argument! ! !DirectedGraphNode methodsFor: 'initialization'! init self predecessors: OrderedCollection new! ! !DirectedGraphNode methodsFor: 'modifying'! addPredecessor: node self predecessors add: node! removePredecessor: node self predecessors remove: node ifAbsent: [self error: 'precedessor not found']! removePredecessor: node ifAbsent: aBlock self predecessors remove: node ifAbsent: [^aBlock value]! ! !DirectedGraphNode methodsFor: 'enumerating'! predecessorsDo: aBlock "Evaluate aBlock with each of my predecessors." self predecessors do: aBlock! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DirectedGraphNode class instanceVariableNames: ''! !DirectedGraphNode class methodsFor: 'instance creation'! new ^super new init! ! DirectedGraphNode subclass: #NodeLabeledDigraphNode instanceVariableNames: 'label ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Graph Nodes'! NodeLabeledDigraphNode comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I add labels to my nodes. Node labels are assumed to be unique (see LabeledDigraph) although hashing and such is still done based on the node itself. Instance Variables: label '! !NodeLabeledDigraphNode methodsFor: 'state accessing'! label ^label! label: argument label := argument! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! NodeLabeledDigraphNode class instanceVariableNames: ''! !NodeLabeledDigraphNode class methodsFor: 'instance creation'! label: arg1 | newMe | newMe := self new. newMe label: arg1. ^newMe! ! GraphNode subclass: #EdgeLabeledDigraphNode instanceVariableNames: 'edgeLabelMap ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Graph Nodes'! EdgeLabeledDigraphNode 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. Instance Variables: edgeLabelMap '! !EdgeLabeledDigraphNode methodsFor: 'accessing'! successors ^self edgeLabelMap elements! ! !EdgeLabeledDigraphNode methodsFor: 'state accessing'! edgeLabelMap ^edgeLabelMap! edgeLabelMap: argument edgeLabelMap := argument! ! !EdgeLabeledDigraphNode methodsFor: 'initialization'! init self edgeLabelMap: SetDictionary new! ! !EdgeLabeledDigraphNode methodsFor: 'enumerating'! successorsDo: aBlock self successors do: aBlock! successorsExceptSelfDo: aBlock (self successors reject: [:succ | succ = self]) do: aBlock! ! !EdgeLabeledDigraphNode methodsFor: 'modifying'! addSuccessor: node withEdgeLabeled: label self edgeLabelMap at: label add: node! ! !EdgeLabeledDigraphNode methodsFor: 'printing'! printOn: aStream self hash printOn: aStream. aStream nextPutAll: ': '; crtab. self edgeLabelMap associationsDo: [:assoc | assoc key printOn: aStream. aStream nextPutAll: ' ==> '. assoc value hash printOn: aStream. aStream crtab]! ! !EdgeLabeledDigraphNode methodsFor: 'converting'! spaceOptimizeMap "Assumes self edgeLabelMap isDeterministic. Note: doing this will dissable the messages #successors, #addSuccessor:withEdgeLabeled:, and any senders of them, since they assume a SetDictionary." self edgeLabelMap: self edgeLabelMap asDictionary! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! EdgeLabeledDigraphNode class instanceVariableNames: ''! !EdgeLabeledDigraphNode class methodsFor: 'instance creation'! new ^super new init! ! EdgeLabeledDigraphNode subclass: #FSAState instanceVariableNames: 'stateID ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Graph Nodes'! FSAState comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I am a general state in a finite state automata.'! !FSAState methodsFor: 'state accessing'! stateID ^stateID! stateID: id stateID := id! ! !FSAState methodsFor: 'testing'! hasStateID ^self stateID notNil! ! !FSAState methodsFor: 'building'! goto: aState on: transitionSymbol self addSuccessor: aState withEdgeLabeled: transitionSymbol! ! !FSAState methodsFor: 'private'! collectStatesIn: stateSet "Add myself and all states reachable from me to stateSet. If I'm the start state of an fsa then all my states are added." (stateSet includes: self) ifFalse: [stateSet add: self. self successorsExceptSelfDo: [:succ | succ collectStatesIn: stateSet]]! dfsaFinalStateClass ^FSAFinalState! dfsaStateClass ^FSAState! endOfInputToken "Answer a token representing the end of the input." ^Character endOfInput! epsilon "Answer an object used to represent the empty string (epsilon)." ^EpsilonNode epsilon! newDFSAStateFor: multiState "Answer a new dfsa state that will represent the argument, a collection of states. Make sure to transfer any final state information to the new state." | newFinalState finalStates | (finalStates := multiState select: [:state | state isFSAFinalState]) isEmpty ifTrue: [^self dfsaStateClass new] ifFalse: [newFinalState := self dfsaFinalStateClass new. finalStates do: [:fs | fs literalTokens do: [:lit | newFinalState addLiteralToken: lit]. fs tokenClasses do: [:tc | newFinalState addTokenClass: tc]]. ^newFinalState]! nilOutStateIDs "Set my stateID to nil, likewise with all my successors." self stateID notNil ifTrue: [self stateID: nil. self successorsDo: [:succ | succ nilOutStateIDs]]! partitionTransitionMapClass ^PartitionTransitionMap! stateSetClass ^ItemSet! ! !FSAState methodsFor: 'removing nondeterminism'! asDeterministicFSA "Answer a new deterministic version of myself. Based on Algorithm 3.1 from 'Principles of Compiler Design', by Aho and Ullman, 1977." | multiStateMap unprocessedStates newStartState currState ch transitStates multiState epsilonClosures newMultiState newState | epsilonClosures := self computeEpsilonClosures. multiStateMap := Dictionary new. unprocessedStates := Set new. newStartState := self newDFSAStateFor: (epsilonClosures at: self). multiStateMap at: (epsilonClosures at: self) 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 - the literal tokens I recognize. tokenClasses - 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 '! !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!