t-gen-regularexpressionnodes.st

編譯器的語法產生器

	"Replace my children according to the value of aBlock."

	self children: (self children collect: aBlock)! !

!EnnaryRegExprNode methodsFor: 'building parse trees'!

addChildrenFirst: anOrderedCollection 

	self children addAllFirst: anOrderedCollection!

addChildrenInitial: anOrderedCollection 

	self children addAll: anOrderedCollection! !

!EnnaryRegExprNode methodsFor: 'initialization'!

init

	self children: OrderedCollection new! !

!EnnaryRegExprNode methodsFor: 'converting'!

asPureRegExpr
	"Answer a new version of the receiver consisting of only characters, 
	concatenations, alternations, and (star) closures. Also, eliminate single 
	child alternations and concatenations."

	| newKids |
	self children size = 1 ifTrue: [^self children first asPureRegExpr].
	newKids := OrderedChildren new.
	self childrenDo: [:child | newKids add: child asPureRegExpr].
	^self species children: newKids! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

EnnaryRegExprNode class
	instanceVariableNames: ''!


!EnnaryRegExprNode class methodsFor: 'instance creation'!

children: arg1 

	| newMe |
	newMe := super new.
	newMe children: arg1.
	^newMe!

new

	^super new init! !

EnnaryRegExprNode subclass: #ConcatenationNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'T-gen-Regular Expression Nodes'!
ConcatenationNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent the concatenation of two or more regular expressions, i.e. child1 child2 ... childN.'!


!ConcatenationNode methodsFor: 'printing'!

printOn: aStream 

	self children do: 
		[:child | 
		child printOn: aStream.
		child == self children last ifFalse: [aStream space]]! !

!ConcatenationNode methodsFor: 'converting'!

asFSAStartingAt: startState endingAt: finalState 

	| prevState newState |
	prevState := startState.
	self children do: [:child | child == self children last
			ifTrue: [child asFSAStartingAt: prevState endingAt: finalState]
			ifFalse: 
				[newState := self fsaStateClass new.
				child asFSAStartingAt: prevState endingAt: newState.
				prevState := newState]]! !

!ConcatenationNode methodsFor: 'transforming'!

transformUsing: lhsNames withLHS: lhsNode alpha: alphaNodes gamma: gammaNodes 
	"Transform productions of the form 'A -> alpha (beta)op gamma'. 
	Transform AlternationNodes at the last possible moment to minimize 
	the number of new nonterminals created. Transform all consequitive 
	operator nodes right to left to avoid unnecessary 'tail-splitting', which 
	increases the grammar size."

	| node |
	node := self children reverseDetect: [:child | child needsTransforming]
				ifNone: [self children reverseDetect: [:child | child isAlternationNode]
						ifNone: [^OrderedCollection new]].
	alphaNodes addAllLast: self children.
	self children reverseDo: [:child | child == node
			ifTrue: 
				[alphaNodes removeLast.
				^node
					transformUsing: lhsNames
					withLHS: lhsNode
					alpha: alphaNodes
					gamma: gammaNodes]
			ifFalse: [gammaNodes addFirst: alphaNodes removeLast]].
	self error: 'Control should never reach this point.'! !

!ConcatenationNode methodsFor: 'testing'!

isConcatenationNode

	^true! !

!ConcatenationNode methodsFor: 'collecting'!

collectSymbol

	^self children collect: [:sym | sym asGrammarSymbol]! !

!ConcatenationNode methodsFor: 'building parse trees'!

concatenateWith: node

	^node concatenateWithCatNode: self!

concatenateWithCatNode: node

	node children addAllLast:  children.
	^node!

concatenateWithNonCatNode: node

	self children addFirst: node.
	^self! !

EnnaryRegExprNode subclass: #AlternationNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'T-gen-Regular Expression Nodes'!
AlternationNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent the alternation of two or more regular expressions, i.e. child1 | child2 | ... | childN.'!


!AlternationNode methodsFor: 'printing'!

printOn: aStream 

	aStream nextPut: $(.
	self children do: 
		[:child | 
		child printOn: aStream.
		child == self children last ifFalse: [aStream nextPutAll: ' | ']].
	aStream nextPut: $)! !

!AlternationNode methodsFor: 'converting'!

asFSAStartingAt: startState endingAt: finalState 

	self children do: [:child | child asFSAStartingAt: startState endingAt: finalState]! !

!AlternationNode methodsFor: 'transforming'!

transformUsing: lhsNames withLHS: lhsNode 
	"I am a top-level node (e.g. A : B | C | D). Break-up the 
	right-hand-side into separate productions and answer a collection 
	of these productions."

	| newProds |
	newProds := OrderedCollection new.
	self childrenDo: [:child | newProds add: (self productionNodeClass leftHandSide: lhsNode rightHandSides: child)].
	^newProds!

transformUsing: lhsNames withLHS: lhsNode alpha: alphaNodes gamma: gammaNodes 
	"Transform productions of the form 'A -> alpha ( beta1 | beta2 ) gamma' 
	into 'A -> alpha beta1 gamma' and 'A -> alpha beta2 gamma'."

	| newProds |
	newProds := OrderedCollection new.
	self childrenDo: [:beta | newProds add: (self createNewProductionWithLHS: lhsNode andRHS: ((OrderedCollection new)
					addAllLast: alphaNodes copy;
					addLast: beta;
					addAllLast: gammaNodes copy;
					yourself))].
	^newProds! !

!AlternationNode methodsFor: 'testing'!

isAlternationNode

	^true! !

!AlternationNode methodsFor: 'private'!

processTransformation: lhs 
	| newNode prods |
	prods := OrderedCollection new.
	children do: 
		[:node | 
		newNode := RRPGProductionNode new.
		newNode leftHandSide: lhs.
		newNode rightHandSides: (RRPGRightHandSideNode new symbols: node).
		prods add: newNode].
	^prods! !

!AlternationNode methodsFor: 'building parse trees'!

alternateWith: node

	^node alternateWithAltNode: self!

alternateWithAltNode: node

	node children addAllLast:  children.
	^node!

alternateWithNonAltNode: node

	self children addFirst: node.
	^self! !

EnnaryRegExprNode subclass: #AlternationRangeNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'T-gen-Regular Expression Nodes'!
AlternationRangeNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent the alternation of two or more atomic regular expressions.  My specification encorporates the use of character ranges, e.g. [a-z] (= a | b | c | ... | z).  My children are either simple characters or character ranges, e.g. [a-z0-9!!@#] or [aeiou] (vowels).'!


!AlternationRangeNode methodsFor: 'printing'!

printOn: aStream 

	aStream nextPut: $[.
	self children do: [:child | child printOn: aStream].
	aStream nextPut: $]! !

!AlternationRangeNode methodsFor: 'building parse trees'!

addChildrenInitial: anOrderedCollection 

	anOrderedCollection size = 1
		ifTrue: [self children: anOrderedCollection removeFirst]
		ifFalse: [self error: 'wrong number of children']! !

!AlternationRangeNode methodsFor: 'converting'!

asPureRegExpr
	"Answer a new version of the receiver consisting of only characters, 
	concatenations, alternations, and (star) closures. Also, eliminate single 
	child alternations and concatenations."

	| kids |
	kids := OrderedChildren new.
	self characters do: [:char | kids add: (self makeCharNodeFor: char)].
	^self alternationNodeClass children: kids! !

!AlternationRangeNode methodsFor: 'accessing'!

characters
	"Answer the Set of Characters I represent."

	| chars |
	chars := Set new.
	self childrenDo: [:child | child addCharsTo: chars].
	^chars! !

!AlternationRangeNode methodsFor: 'private'!

makeCharNodeFor: aChar 
	"Answer a new CharacterNode for aChar."

	^self characterNodeClass charSpec: (String with: aChar)! !

AlternationRangeNode subclass: #ComplementedAlternationRangeNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'T-gen-Regular Expression Nodes'!
ComplementedAlternationRangeNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent the alternation of two or more atomic regular expressions (specified as the complement of an alternation range).  I take the complement of the universe of printable characters only, e.g. ~[aeiou] (all non-vowel printable characters).'!


!ComplementedAlternationRangeNode methodsFor: 'printing'!

printOn: aStream 

	aStream nextPut: $~.
	super printOn: aStream! !

!ComplementedAlternationRangeNode methodsFor: 'accessing'!

characters
	"Answer the Set of Characters I represent."

	| chars |
	chars := self characterUniverse.
	chars removeAll: super characters.
	^chars!

characterUniverse
	"Answer a collection of printable characters."

	^((32 to: 126)
		collect: [:ea | Character value: ea]) asSet! !

UnaryRegExprNode subclass: #StarClosureNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'T-gen-Regular Expression Nodes'!
StarClosureNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent the regular expression ''(expr)*'' which denotes zero or more repetitions of ''expr''.'!


!StarClosureNode methodsFor: 'printing'!

printOn: aStream 

	aStream nextPut: $(.
	self onlyChild printOn: aStream.
	aStream nextPutAll: ')*'! !

!StarClosureNode methodsFor: 'converting'!

asFSAStartingAt: startState endingAt: finalState 

	| middleState |
	middleState := self fsaStateClass new.
	startState goto: middleState on: self epsilon.
	middleState goto: finalState on: self epsilon.
	self onlyChild asFSAStartingAt: middleState endingAt: middleState!

asPureRegExpr
	"Answer a new version of the receiver consisting of only characters, 
	concatenations, alternations, and (star) closures."

	^self starClosureNodeClass onlyChild: self onlyChild asPureRegExpr! !

!StarClosureNode methodsFor: 'transforming'!

transformUsing: lhsNames withLHS: lhsNode alpha: alphaNodes gamma: gammaNodes 
	"Transform productions of the form 'A -> alpha beta* gamma' 
	into 'A -> alpha B', 'B -> beta B', and 'B -> gamma'."

	| newProds newLHS |
	newProds := OrderedCollection new.
	newLHS := self newNonterminalFrom: lhsNode excluding: lhsNames.
	newProds add: (self createNewProductionWithLHS: lhsNode andRHS: (alphaNodes addLast: newLHS; yourself)).
	newProds add: (self createNewProductionWithLHS: newLHS andRHS: (OrderedCollection
					with: self onlyChild
					with: newLHS)).
	newProds add: (self createNewProductionWithLHS: newLHS andRHS: gammaNodes).
	^newProds! !

UnaryRegExprNode subclass: #PlusClosureNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'T-gen-Regular Expression Nodes'!
PlusClosureNode comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I represent the regular expression ''(expr)+'' which denotes ''expr (expr)*''.'!


!PlusClosureNode methodsFor: 'printing'!

printOn: aStream 

	aStream nextPut: $(.
	self onlyChild printOn: aStream.
	aStream nextPutAll: ')+'! !

!PlusClosureNode methodsFor: 'converting'!

asPureRegExpr
	"Answer a new version of the receiver consisting of only characters, 
	concatenations, alternations, and (star) closures."

	^self concatenationNodeClass children: (OrderedChildren with: self onlyChild asPureRegExpr with: (self starClosureNodeClass onlyChild: self onlyChild asPureRegExpr))! !

!PlusClosureNode methodsFor: 'transforming'!

transformUsing: lhsNames withLHS: lhsNode alpha: alphaNodes gamma: gammaNodes 
	"Transform productions of the form 'A -> alpha beta+ gamma' 
	into 'A -> alpha B', 'B -> beta B', and 'B -> beta gamma'."

	| newProds newLHS |
	newProds := OrderedCollection new.
	newLHS := self newNonterminalFrom: lhsNode excluding: lhsNames.
	newProds add: (self createNewProductionWithLHS: lhsNode andRHS: (alphaNodes addLast: newLHS; yourself)).
	newProds add: (self createNewProductionWithLHS: newLHS andRHS: (OrderedCollection
					with: self onlyChild copy
					with: newLHS)).
	newProds add: (self createNewProductionWithLHS: newLHS andRHS: (gammaNodes addFirst: self onlyChild copy; yourself)).
	^newProds! !
EscapedCharNode initialize!