compilers-parsers.st

編譯器的語法產生器

Object subclass: #AbstractParser
	instanceVariableNames: 'scanner prevToken requestor failBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compilers-Parsers'!
AbstractParser comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

This class represents abstract parsing behavior.

Instance Variables:

	scanner <a scanner class>	- this parser''s scanner
	prevToken <String + Symbol>	- the last token scanned
	requestor <Controller + Object>	- the object invoking the parser, errors are reported to this object
	failBlock <Block>		- this block is evaluated before the parse is aborted'!


!AbstractParser methodsFor: 'state accessing'!

failBlock

	^failBlock!

failBlock: argument 

	failBlock := argument!

prevToken

	^prevToken!

prevToken: argument 

	prevToken := argument!

requestor

	^requestor!

requestor: argument 

	requestor := argument!

scanner

	^scanner!

scanner: argument 

	scanner := argument! !

!AbstractParser methodsFor: 'scanning'!

endOfInput
	"Some parsers may use the eof token while others may use the eof token type."

	self subclassResponsibility!

endOfInputToken
	"Answer the token used by my scanner to represent the end of the input."

	^self scanner endOfInputToken!

endOfInputTokenType
	"Answer the token type used by my scanner to represent the end of the input."

	^self scanner endOfInputTokenType!

initScannerSource: aString 
	"The scanner is responsible for scanning the first token (i.e. for priming the token 
	buffers)."

	self scanner scanSource: aString!

nextToken

	^self scanner tokenType!

nextTokenValue

	^self scanner token!

scanToken
	"Subclasses may not always want the previous token value and may override this 
	method for efficiency."

	self prevToken: self nextTokenValue.
	self scanner scanToken! !

!AbstractParser methodsFor: 'private'!

scannerClass
	"Answer the preferred class of scanners for this kind of parser."

	self subclassResponsibility! !

!AbstractParser methodsFor: 'initialization'!

init

	self scanner: self scannerClass new! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AbstractParser class
	instanceVariableNames: ''!


!AbstractParser class methodsFor: 'instance creation'!

new

	^super new init! !

AbstractParser subclass: #TableDrivenParser
	instanceVariableNames: 'parseTable transcript treeBuilder '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compilers-Parsers'!
TableDrivenParser comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I am an abstract class representing table (FSA) driven parsers.


Instance Variables:
	parseTable	<LL1ParserTable | LRParserState> - basic parsing mechanism.
	transcript		<TranslatorGenerator | UndefinedObject> - status messages get sent here.
	treeBuilder	<ParseTreeBuilder> - used in the construction of abstract syntax trees.'!


!TableDrivenParser methodsFor: 'scanning'!

endOfInput
	"Use the eof token type."

	^self endOfInputTokenType!

endOfInputTokenType
	"Answer the token type used by my scanner to represent the end of the input."

	^self scanner endOfInputTokenType! !

!TableDrivenParser methodsFor: 'state accessing'!

parseTable

	^parseTable!

parseTable: argument 

	parseTable := argument!

requestor

	^requestor!

requestor: argument 

	requestor := argument!

transcript

	^transcript!

transcript: argument 

	transcript := argument!

treeBuilder

	^treeBuilder!

treeBuilder: argument 

	treeBuilder := argument! !

!TableDrivenParser methodsFor: 'testing'!

performsLeftmostDerivation
	"This is the default, let subclasses override."

	^false!

performsRightmostDerivation
	"This is the default, let subclasses override."

	^false! !

!TableDrivenParser methodsFor: 'public access'!

parse: aString ifFail: aBlock 

	self failBlock: aBlock.
	self exceptionHandlers
		handleDo: 
			[self initScannerSource: aString.
			^self parse]!

parseAndTrace: aString ifFail: aBlock 

	self failBlock: aBlock.
	"Make sure we don't accidently write to someone else's window."
	self transcript: nil.
	self exceptionHandlers
		handleDo: 
			[self initScannerSource: aString.
			^self traceParse]!

parseAndTrace: aString on: aTranscript ifFail: aBlock 

	self failBlock: aBlock.
	self transcript: aTranscript.
	self exceptionHandlers
		handleDo: 
			[self initScannerSource: aString.
			^self traceParse]!

parseForAST: aString ifFail: aBlock 

	self failBlock: aBlock.
	self exceptionHandlers
		handleDo: 
			[self initScannerSource: aString.
			^self parseForAST]!

parseForDerivationTree: aString ifFail: aBlock 

	self failBlock: aBlock.
	self exceptionHandlers
		handleDo: 
			[self initScannerSource: aString.
			^self parseForDerivationTree]!

parseForShamAST: aString ifFail: aBlock 

	self failBlock: aBlock.
	self exceptionHandlers
		handleDo: 
			[self initScannerSource: aString.
			^self parseForShamAST]! !

!TableDrivenParser methodsFor: 'parsing'!

parse

	self subclassResponsibility!

parseForAST

	| builder |
	builder := self treeBuilder reset.
	^self parseWithTreeBuilder: builder!

parseForDerivationTree

	^self parseWithTreeBuilder: self derivationTreeBuilderClass new!

parseForShamAST

	| builder |
	builder := self treeBuilder reset.
	builder setShamMode.
	^self parseWithTreeBuilder: builder!

traceParse

	self subclassResponsibility! !

!TableDrivenParser methodsFor: 'private'!

derivationTreeBuilderClass

	^DerivationTreeBuilder!

myParseTable

	^self class parseTable!

scannerClass
	"Translator generator tools may initially create an 'abstract' parser and 'plug-in' 
	a scanner. This allows instances of these abstract parsers to be used in this 
	fashion. Ultimately, the tools will create concrete scanner and parser classes 
	with the proper links established."

	^Object!

treeBuilderClass
	"Different tree builders can either be plugged in or subclasses can override this 
	method."

	^AbstractSyntaxTreeBuilder! !

!TableDrivenParser methodsFor: 'tracing'!

cr

	self show: '
'!

defaultTranscript

	^Transcript!

show: aString 

	(self transcript isNil
		ifTrue: [self defaultTranscript]
		ifFalse: [self transcript])
		show: aString!

showCR: aString 

	self show: aString , '
'! !

!TableDrivenParser methodsFor: 'exception handling'!

abort

	| block |
	block := self failBlock.
	self failBlock: nil.
	^block value!

exceptionHandlers
	"Answer a HandlerList that will catch and handle scanner and parser errors."

	| handlers |
	handlers := HandlerList new.
	handlers on: self scannerErrorSignal
		handle: 
			[:ex | 
			self requestor notNil
				ifTrue: 
					[self requestor insertAndSelect: 'SCANNER ERROR: ' , ex errorString , ' ->' at: self scanner errorPosition.
					self requestor activate].
			self abort].
	handlers on: self parserErrorSignal
		handle: 
			[:ex | 
			self requestor notNil
				ifTrue: 
					[self requestor insertAndSelect: '<- PARSER ERROR: ' , ex errorString at: self scanner errorPosition.
					self requestor activate].
			self abort].
	^handlers!

parserErrorSignal

	self subclassResponsibility!

scannerErrorSignal

	^FSAState noTransitionSignal! !

!TableDrivenParser methodsFor: 'converting'!

spaceOptimize

	self parseTable spaceOptimize! !

!TableDrivenParser methodsFor: 'initialization'!

init

	super init.
	self parseTable: self myParseTable.
	self treeBuilder: self treeBuilderClass new! !

!TableDrivenParser methodsFor: 'scanner/parser generation'!

classInitializationMethodTextForClassNamed: name spec: grammarSpec 

	^self subclassResponsibility!

createParserClassNamed: name category: category spec: grammarSpec 

	| parserClass |
	parserClass := self defaultParserClass
				subclass: name asSymbol
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: category.
	parserClass comment: self generatedParserClassComment.
	parserClass class compile: (self classInitializationMethodTextForClassNamed: name spec: grammarSpec)
		classified: 'class initialization'.
	parserClass initialize.
	^parserClass!

createScannerClassNamed: name category: category spec: tokenSpec 

	^self scanner
		createScannerClassNamed: name
		category: category
		spec: tokenSpec!

createScannerParserClassesNamed: namePrefix category: category tokenSpec: tokenSpec grammarSpec: grammarSpec 
	| parserClass |
	self
		createScannerClassNamed: namePrefix , 'Scanner'
		category: category
		spec: tokenSpec.
	parserClass := self
				createParserClassNamed: namePrefix , 'Parser'
				category: category
				spec: grammarSpec.
	parserClass compile: 'scannerClass
	^' , namePrefix , 'Scanner' classified: 'private'.
	parserClass compile: 'treeBuilderClass
	^' , self treeBuilder class printString classified: 'private'!

defaultParserClass

	^self class!

generatedParserClassComment

	^'This parser class was automatically generated by ', TranslatorGenerator versionName , '.'!

newStreamForMethodRendering
 | ws |
 ws := WriteStream on: (String new: 2048).
 ws policy printCharactersLiterally: true.
 ^ws! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TableDrivenParser class
	instanceVariableNames: 'parseTable '!


!TableDrivenParser class methodsFor: 'class initialization'!

initialize
	"Concrete subclasses must somehow provide a parse table. Subclasses created 
	by automatic means may simply 'plug-in' a dynamically computed parse table. 
	However, if a class that can be filed-out is desired then it is worthwhile to 
	override this initialization method with one that can build the appropriate parse 
	table directly."
	"TableDrivenParser initialize"

	self parseTable: nil! !

!TableDrivenParser class methodsFor: 'state accessing'!

parseTable

	^parseTable!

parseTable: argument 

	parseTable := argument! !

!TableDrivenParser class methodsFor: 'instance creation'!

new

	^super new init! !

TableDrivenParser subclass: #LR1Parser
	instanceVariableNames: 'finalState '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compilers-Parsers'!
LR1Parser comment:
'=================================================
    Copyright (c) 1992 by Justin O. Graver.
    All rights reserved (with exceptions).
    For complete information evaluate "Object tgenCopyright."
=================================================

I am an LR parser.

Instance Variables:
	parseTable*	<LRParserState> - basic parsing mechanism, a CFSM.
	finalState		<LRParserState> - final state of my CFSM.

* inherited from AbstractParser'!


!LR1Parser methodsFor: 'state accessing'!

finalState

	^finalState!

finalState: argument 

	finalState := argument! !

!LR1Parser methodsFor: 'parsing'!

acceptSymbol

	^self lrParserStateClass acceptSymbol!

actionAt: currState 

	^currState actionFor: self nextToken!

at: state transitionFor: symbol 

	^state transitionFor: symbol!

lrParserStateClass

	^LRParserState!

parse

	| stack action currState |
	stack := Stack new.
	currState := self startState.
	stack push: currState.
	[currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
		whileFalse: 
			[currState := action isGrammarProduction
						ifTrue: 
							["reduce"
							stack pop: action rightHandSide size.
							self at: stack top transitionFor: action leftHandSide]
						ifFalse: 
							["shift"
							self scanToken.
							action].
			stack push: currState]!

parseWithTreeBuilder: parseTreeBuilder 

	| stack currState action |
	stack := Stack new.
	currState := self startState.
	stack push: currState.
	[currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
		whileFalse: 
			[currState := action isGrammarProduction
						ifTrue: 
							["reduce"
							stack pop: action rightHandSide size.
							parseTreeBuilder processProduction: action forParser: self.
							self at: stack top transitionFor: action leftHandSide]
						ifFalse: 
							["shift"
							self scanToken.
							action].
			stack push: currState].
	^parseTreeBuilder result!

startState

	^self parseTable!

traceParse

	| stack action currState nextState |
	self
		 cr;
		 cr;
		 showCR: 'LR Parser trace of:  ' , self scanner contents;
		 cr.
	stack := Stack new.
	currState := self startState.
	stack push: currState.