OrderedCollection variableSubclass: #OrderedChildren instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'T-gen-Parse Trees'! OrderedChildren comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= It is often helpful to create a node that has a arbitrary (but flat) collection of nodes as a child. My instances provide containers for these "collection children". In other words, I am a collection that acts like a single parse tree node.'! !OrderedChildren methodsFor: 'building parse trees'! addChildrenFirst: anOrderedCollection self addAllFirst: anOrderedCollection! addChildrenInitial: anOrderedCollection self addAll: anOrderedCollection! addChildrenLast: anOrderedCollection self addAllLast: anOrderedCollection! setAttribute: value self shouldNotImplement! ! TreeNode subclass: #ParseTreeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'T-gen-Parse Trees'! ParseTreeNode comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I am an abstract class that provides the framework for parse tree nodes, basically just a reminder that the following messages may need to be implemented by concrete subclasses: addChildrenFirst: addChildrenInitial: addChildrenLast: setAttribute:'! !ParseTreeNode methodsFor: 'building parse trees'! addChildrenFirst: anOrderedCollection "Subclasses should implement this message." self shouldNotImplement! addChildrenInitial: anOrderedCollection "Subclasses should implement this message." self shouldNotImplement! addChildrenLast: anOrderedCollection "Subclasses should implement this message." self shouldNotImplement! setAttribute: value "Subclasses should implement this message." self shouldNotImplement! ! Object subclass: #ParseTreeBuilder instanceVariableNames: 'stack ' classVariableNames: '' poolDictionaries: '' category: 'T-gen-Parse Trees'! ParseTreeBuilder comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= This is an abstract class that provides a framework for building parse trees during parsing. Parse trees are built in a bottom-up fashion during parsing by processing key productions, and with the help of a stack. In general, a key production has the form: A -> N1 N2 ... Nk => symbol where A and the Ni are nonterminals (terminals may be interspersed freely in the right-hand side) and symbol is the production directive (or translation symbol). Since trees are built bottom-up, the information flow in a production is from the right-hand side to the left-hand side. When a production is ready to be processed, the top of the stack contains objects (parse trees) associated with the right-hand-side nonterminals of the production. Processing a production involves replacing these objects with a single object representing (associated with) the left-hand-side nonterminal. This can be thought of as computing a value for A as a function of the values of the Ni''s, i.e. value(A) = fcn(value(N1), value(N2), ..., value(Nk)). Default functions are defined in my concrete subclasses but users may define their own production processing functions by creating a new subclass and implementing appropriate messages. This enables users to have direct control over exactly how parse trees are built. Instance Variables: stack - holds intermediate node values during production processing.'! !ParseTreeBuilder methodsFor: 'initialization'! init self stack: Stack new! ! !ParseTreeBuilder methodsFor: 'state accessing'! stack ^stack! stack: argument stack := argument! ! !ParseTreeBuilder methodsFor: 'accessing'! popStack ^self stack pop! pushStack: anObject ^self stack push: anObject! result "Answer the root of the tree build by this tree builder." self stack size = 1 ifFalse: [self error: 'incorrectly built tree']. ^self popStack! ! !ParseTreeBuilder methodsFor: 'production processing'! addChildrenFirst: children to: aNode "Add children, as the new first children, to aNode and answer aNode." aNode addChildrenFirst: children. ^aNode! addChildrenLast: children to: aNode "Add children, as the new last children, to aNode and answer aNode." aNode addChildrenLast: children. ^aNode! answerArgument: arg ^arg! answerNil ^nil! makeNewNode: stringOrSymbol "Answer a new parse tree node representing the argument." self subclassResponsibility! makeNewNode: stringOrSymbol withAttribute: value "Answer a new parse tree node and initialize its attribute value using the setAttribute: message." | newNode | newNode := self makeNewNode: stringOrSymbol. newNode setAttribute: value. ^newNode! makeNewNode: stringOrSymbol withChildren: children "Answer a new parse tree node and initialize its children using the addChildrenInitial: message." | newNode | newNode := self makeNewNode: stringOrSymbol. newNode addChildrenInitial: children. ^newNode! ! !ParseTreeBuilder methodsFor: 'tree building'! popArgNodesForProduction: grammarProd fromParser: parser "Answer a collection of nodes from my stack required for processing grammarProd. The order for collecting nodes is parser dependent." | nodes | nodes := OrderedCollection new. grammarProd numberOfRhsNonterminals timesRepeat: (parser performsLeftmostDerivation ifTrue: [[nodes add: self popStack]] ifFalse: [[nodes addFirst: self popStack]]). ^nodes! processProduction: grammarProd forParser: parser "This is the main driver for production processing. The actual production processing messages are sent indirectly by grammarProd." self pushStack: (grammarProd hasSingleTokenClassRhs ifTrue: [grammarProd computeResultNodeFor: self withTokenClassValue: parser prevToken] ifFalse: [grammarProd computeResultNodeFor: self withArgNodes: (self popArgNodesForProduction: grammarProd fromParser: parser)])! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ParseTreeBuilder class instanceVariableNames: ''! !ParseTreeBuilder class methodsFor: 'instance creation'! new ^super new init! ! ParseTreeBuilder subclass: #DerivationTreeBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'T-gen-Parse Trees'! DerivationTreeBuilder comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= This concrete class is used for building derivation trees for a parse. It uses homogeneous DerivationTreeNodes for all nodes and a specialized production processor.'! !DerivationTreeBuilder methodsFor: 'tree building'! epsilon "Answer an object used to represent the empty string (epsilon)." ^''! processProduction: grammarProd forParser: parser "This is simple and straightforward to implement, so do it all here." | parent child | parent := DerivationTreeNode symbol: grammarProd leftHandSide. grammarProd rightHandSide isEmpty ifTrue: [child := DerivationTreeNode symbol: self epsilon. parent addChild: child] ifFalse: [parser performsLeftmostDerivation ifTrue: [grammarProd rightHandSide do: [:sym | child := sym isTerminal ifTrue: [DerivationTreeNode symbol: sym] ifFalse: [self popStack]. parent addChild: child]] ifFalse: [grammarProd rightHandSide reverseDo: [:sym | child := sym isTerminal ifTrue: [DerivationTreeNode symbol: sym] ifFalse: [self popStack]. parent addFirstChild: child]]]. self pushStack: parent! ! ParseTreeNode subclass: #DerivationTreeNode instanceVariableNames: 'symbol children ' classVariableNames: '' poolDictionaries: '' category: 'T-gen-Parse Trees'! DerivationTreeNode comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I represent an arbitrary node in a derivation or abstract tree. (It would be nice to expand this concept so that heterogeneous parse trees could be built.) Instance Variables: symbol - node attribute. children '! !DerivationTreeNode methodsFor: 'state accessing'! children ^children! children: argument children := argument! symbol ^symbol! symbol: argument symbol := argument! ! !DerivationTreeNode methodsFor: 'printing'! printOn: aStream self printOn: aStream level: 0! printOn: aStream dots: anInteger anInteger timesRepeat: [aStream nextPutAll: ' . ']! printOn: aStream level: level self printOn: aStream dots: level. self symbol printOn: aStream. aStream cr. self childrenDo: [:child | child printOn: aStream level: level + 1]! ! !DerivationTreeNode methodsFor: 'initialization'! init self children: OrderedCollection new! ! !DerivationTreeNode methodsFor: 'traversing'! childrenDo: aBlock self children do: aBlock! updateChildrenUsing: aBlock "Replace my children according to the value of aBlock." self children: (self children collect: [:child | aBlock value: child])! ! !DerivationTreeNode methodsFor: 'testing'! isNonterminal ^self symbol isNonterminal! isTerminal ^self symbol isTerminal! ! !DerivationTreeNode methodsFor: 'manipulating children'! addChild: aNode self addLastChild: aNode! addFirstChild: aNode self children addFirst: aNode! addLastChild: aNode self children addLast: aNode! ! !DerivationTreeNode methodsFor: 'building parse trees'! addChildrenFirst: anOrderedCollection anOrderedCollection reverseDo: [:child | self addFirstChild: child]! addChildrenInitial: anOrderedCollection self children: anOrderedCollection copy! addChildrenLast: anOrderedCollection anOrderedCollection reverseDo: [:child | self addLastChild: child]! setAttribute: value self symbol: value! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DerivationTreeNode class instanceVariableNames: ''! !DerivationTreeNode class methodsFor: 'instance creation'! symbol: aSymbol | newNode | newNode := self new init. newNode symbol: aSymbol. ^newNode! ! ParseTreeBuilder subclass: #AbstractSyntaxTreeBuilder instanceVariableNames: 'shamMode ' classVariableNames: '' poolDictionaries: '' category: 'T-gen-Parse Trees'! AbstractSyntaxTreeBuilder comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I build parse trees by creating specific objects for each kind of node as indicated by the parser directives in grammar productions. Parser directives currently fall into one of three groups: node (class) names, special directives, and arbitrary message selectors. For a node name, a new instance of the specified node is created and given the values associated with the right-hand side nonterminals, if any, as its children. The special directive ''nil'' simply returns nil. The directive liftRightChild adds any nodes preceeding the right-most node as children to the right-most node, and returns the right-most node. The directive liftLeftChild works in an analogous fashion. Arbitrary message selectors must take the same number of arguments as there are right-hand-side nodes and are invoked as a builder message, thus allowing users to define their own tree-building messages. Productions of the form ''A -> => symbol'' are treated specially. The symbol can be either a node name or a one-argument message selector. If it is a node name then create a new instance of that node with the specified attribute value. If it is a message selector then invoke the corresponding operation on the builder with the specified value. Instance Variables: shamMode - If true DerivationTreeNode-based ASTs are built, otherwise specific ParseTreeNode-based ASTs are built.'! !AbstractSyntaxTreeBuilder methodsFor: 'tree building'! makeNewNode: stringOrSymbol "The argument represents the name of a node class. If in sham mode answer a new derivation tree node for the argument, otherwise answer a new instance of that class." ^self shamMode ifTrue: [DerivationTreeNode symbol: stringOrSymbol] ifFalse: [(Smalltalk at: stringOrSymbol asSymbol ifAbsent: [self error: 'no class named ' , stringOrSymbol]) new]! ! !AbstractSyntaxTreeBuilder methodsFor: 'accessing'! setNormalMode self shamMode: false! setShamMode self shamMode: true! ! !AbstractSyntaxTreeBuilder methodsFor: 'state accessing'! shamMode ^shamMode! shamMode: argument shamMode := argument! ! !AbstractSyntaxTreeBuilder methodsFor: 'initialization'! init super init. self setNormalMode! reset "Empty the node stack and set to normal mode." self init! !