compilers-parsers.st

編譯器的語法產生器

	[currState = self finalState or: [(action := self actionAt: currState) = self acceptSymbol]]
		whileFalse: 
			[currState := action isGrammarProduction
						ifTrue: 
							["reduce"
							stack pop: action rightHandSide size.
							nextState := self at: stack top transitionFor: action leftHandSide.
							self showCR: 'reduce by ' , action printString , ' then goto state ' , nextState hash printString.
							nextState]
						ifFalse: 
							["shift"
							self showCR: 'shift on ''' , self nextToken asString, ''' to state ' , action hash printString.
							self scanToken.
							action].
			stack push: currState]! !

!LR1Parser methodsFor: 'lalr analysis'!

lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar 

	^self parseTable lalr1AnalyzeConflicts: stateSet originalGrammar: aGrammar! !

!LR1Parser methodsFor: 'private'!

myFinalState

	^self class finalState!

parserErrorSignal

	^LRParserState noTransitionSignal! !

!LR1Parser methodsFor: 'testing'!

performsRightmostDerivation

	^true! !

!LR1Parser methodsFor: 'initialization'!

init

	super init.
	self finalState: self myFinalState! !

!LR1Parser methodsFor: 'converting'!

fastParser

	^OptimizedLR1Parser buildFrom: self! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

LR1Parser class
	instanceVariableNames: 'finalState '!


!LR1Parser class methodsFor: 'instance creation'!

parseTable: table finalState: state 

	| newParser |
	newParser := self new.
	newParser parseTable: table.
	newParser finalState: state.
	^newParser! !

!LR1Parser class methodsFor: 'state accessing'!

finalState

	^finalState!

finalState: argument 

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

I am an LR parser represented efficietly in Array table form.

Instance variables:
	tokenTypeTable <Array of: String>	- the integer mapping of terminals and nonterminals'!


!OptimizedLR1Parser methodsFor: 'state accessing'!

tokenTypeTable

	^tokenTypeTable!

tokenTypeTable: arg 

	tokenTypeTable := arg! !

!OptimizedLR1Parser methodsFor: 'reconstructing'!

mapProductionToInteger
	"Answer an Array of all grammar symbols - nonterminals, terminals, 
	and translation symbols."

	| transSyms |
	transSyms := Set new.
	parseTable do: [:row | row do: [:ea | ea isGrammarProduction ifTrue: [ea hasTranslation ifTrue: [transSyms add: ea translationSymbol]]]].
	^self tokenTypeTable , transSyms asOrderedCollection asArray!

reconstructOn: aStream 
	"Recreate a parse table and a token type table"

	| prodTable |
	prodTable := self mapProductionToInteger.
	aStream nextPutAll: 'prodTable := '.
	prodTable reconstructOn: aStream.
	aStream
		period;
		crtab;
		nextPutAll: 'self tokenTypeTable:  (prodTable copyFrom: 1 to:  ';
		nextPutAll: tokenTypeTable size printString;
		nextPutAll: ').';
		crtab;
		nextPutAll: 'table := '.
	self parseTable reconstructOn: aStream using: prodTable.
	aStream
		period;
		crtab;
		nextPutAll: 'self constructParseTable: table  with: prodTable.';
		crtab;
		nextPutAll: 'self finalState: '.
	self finalState printOn: aStream! !

!OptimizedLR1Parser methodsFor: 'private'!

parseError

	self raiseNoTransitionExceptionErrorString: (scanner tokenType == self endOfInputToken
			ifTrue: [self endOfInputErrorString]
			ifFalse: [self standardErrorString , '''' , scanner tokenType printString , ''''])! !

!OptimizedLR1Parser methodsFor: 'exception handling'!

endOfInputErrorString

	^'end of input encountered'!

parserErrorSignal

	^self class noTransitionSignal!

raiseNoTransitionExceptionErrorString: aString 

	self parserErrorSignal raiseErrorString: aString!

scannerErrorSignal

	^OptimizedScanner noTransitionSignal!

standardErrorString

	^'unexpected token encountered:  '! !

!OptimizedLR1Parser methodsFor: 'converting'!

assignNextIDAfter: id toSuccessorOf: state 

	| nextID nextState |
	nextID := id + 1.
	state edgeLabelMap
		associationsDo: 
			[:assoc | 
			tokenTypeTable add: assoc key.
			nextState := assoc value.
			nextState stateID isNil
				ifTrue: 
					[nextState stateID: nextID.
					nextID := self assignNextIDAfter: nextID toSuccessorOf: nextState]].
	state reduceMap associationsDo: [:assoc | tokenTypeTable add: assoc key].
	^nextID!

changeToObjectTable: lrParserState 

	| sizePlusOne objectTable |
	lrParserState stateID notNil ifTrue: [lrParserState nilOutStateIDs].
	lrParserState stateID: self startState.
	self tokenTypeTable: Set new.
	sizePlusOne := self assignNextIDAfter: self startState toSuccessorOf: lrParserState.
	self tokenTypeTable: tokenTypeTable asOrderedCollection asArray.
	objectTable := Array new: sizePlusOne - 1.
	^self convert: lrParserState to: objectTable!

convert: state to: objectTable 
	"I try to create a table that maps state ( represented by integer ) to state or state to 
	production"

	| arr nextState |
	arr := Array new: self tokenTypeTable size.
	objectTable at: state stateID put: arr.
	state edgeLabelMap
		associationsDo: 
			[:assoc | 
			nextState := assoc value.
			(objectTable at: nextState stateID) isNil ifTrue: [self convert: nextState to: objectTable].
			arr at: (tokenTypeTable indexOf: assoc key)
				put: nextState stateID].
	state reduceMap associationsDo: [:assoc | arr at: (tokenTypeTable indexOf: assoc key)
			put: assoc value first].
	^objectTable!

convertToTable: lr1Parser 

	self scanner: lr1Parser scanner fastScanner.
	self parseTable: (self changeToObjectTable: lr1Parser parseTable).
	self treeBuilder:  lr1Parser treeBuilder.
	self finalState: lr1Parser finalState stateID! !

!OptimizedLR1Parser methodsFor: 'scanner/parser generation'!

classInitializationMethodTextForClassNamed: name spec: grammarSpec
 | ws |
 ws := self newStreamForMethodRendering.
 ws
  nextPutAll: 'initialize';
  crtab;
  nextPut: $";
  nextPutAll: name;
  nextPutAll: ' initialize"';
  crtab;
  nextPut: $".
 grammarSpec do:
  [:ch |
  "double embedded double-quote characters"
  ws nextPut: ch.
  ch = $" ifTrue: [ws nextPut: $"]].
 ws
  nextPut: $";
  cr;
  crtab;
  nextPutAll: '| table prodTable |';
  crtab.
 self reconstructOn: ws.
 ^ws contents! !

!OptimizedLR1Parser methodsFor: 'parsing'!

actionAt: currState 

	| action |
	(action := (parseTable at: currState)
				at: (tokenTypeTable indexOf: self nextToken)) isNil ifTrue: [(scanner finalStateTable includes: currState)
			ifTrue: [^#accept]
			ifFalse: [self parseError]].
	^action!

at: currState transitionFor: symbol 

	| value |
	(value := (parseTable at: currState)
				at: (tokenTypeTable indexOf: symbol)) isNil ifTrue: [self raiseNoTransitionExceptionErrorString: (symbol = self endOfInputToken
				ifTrue: [self endOfInputErrorString]
				ifFalse: [self standardErrorString , '''' , symbol printString , ''''])].
	^value! !

!OptimizedLR1Parser methodsFor: 'initialization'!

init

	super init.
	self tokenTypeTable: self myTokenTypeTable! !

!OptimizedLR1Parser methodsFor: 'accessing'!

myTokenTypeTable

	^self class tokenTypeTable!

startState

	^1! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

OptimizedLR1Parser class
	instanceVariableNames: 'tokenTypeTable '!


!OptimizedLR1Parser class methodsFor: 'class initialization'!

initialize
	"OptimizedLR1Parser initialize"

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

!OptimizedLR1Parser class methodsFor: 'state accessing'!

noTransitionSignal

	^NoTransitionSignal!

noTransitionSignal: argument 

	NoTransitionSignal := argument!

tokenTypeTable

	^tokenTypeTable!

tokenTypeTable: arg 

	tokenTypeTable := arg! !

!OptimizedLR1Parser class methodsFor: 'reconstructing'!

constructGrammarProduction: arg with: prodTable 

	| rhs |
	(arg at: 2) isEmpty
		ifTrue: [rhs := OrderedCollection new]
		ifFalse: 
			[rhs := OrderedCollection new.
			(arg at: 2)
				do: [:ea | rhs addLast: (prodTable at: ea)]].
	^GrammarProduction leftHandSide: (prodTable at: (arg at: 1))
		rightHandSide: rhs!

constructParseTable: table with: prodTable 

	| ea row |
	parseTable := Array new: table size.
	1 to: table size do: 
		[:index | 
		row := Array new: (table at: index) size.
		parseTable at: index put: row.
		1 to: (table at: index) size do: 
			[:i | 
			ea := (table at: index)
						at: i.
			ea isNil ifFalse: [ea isInteger
					ifTrue: [row at: i put: ea]
					ifFalse: [ea size == 2
							ifTrue: [row at: i put: (self constructGrammarProduction: ea with: prodTable)]
							ifFalse: [row at: i put: (self constructTransductionGrammarProduction: ea with: prodTable)]]]]]!

constructTransductionGrammarProduction: arg with: prodTable 

	| rhs |
	(arg at: 2) isEmpty
		ifTrue: [rhs := OrderedCollection new]
		ifFalse: 
			[rhs := OrderedCollection new.
			(arg at: 2)
				do: [:ea | rhs addLast: (prodTable at: ea)]].
	^TransductionGrammarProduction
		leftHandSide: (prodTable at: (arg at: 1))
		rightHandSide: rhs
		translationSymbol: (prodTable at: (arg at: 3))! !

!OptimizedLR1Parser class methodsFor: 'instance creation'!

buildFrom: fsaParser

	^self new convertToTable: fsaParser! !

AbstractParser subclass: #RecursiveDescentParser
	instanceVariableNames: 'here hereType hereMark prevMark class encoder parseNode lastTempMark correctionDelta '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compilers-Parsers'!
RecursiveDescentParser 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 creating objects from textual representations using a recursive descent parse.
This class is what used to be called ''NewCompiler'' in old TS implementations.  It has not been rewritten to reflect its new place in the compiler framework in order to maintain compatibility with the old TS subclasses.  When they are rewritten (when the Tektronix implementation is abandoned) this class should be also.

Instance Variables:
	here			<Object> the current token
	hereType		<Symbol> the "type" of the current token 
	hereMark		<Integer> position in source stream (mark) where this token began
	prevToken*	<Integer> size in chars of the previous token parsed
	prevMark		<Integer> mark of previous token
	class			<Class> provides a context for the text being parsed
	encoder		<Encoder> which uses tables to decode tokens
	parseNode	<ParseNode> intermediate result of current parse (for use by subclasses)
	lastTempMark <Integer> mark of last temp;
						points to vert bar, or last char of pattern if no temps declared
	correctionDelta	<Integer> offset of corrected code relative to source stream
						owing to interactive corrections so far.

* inherited from AbstractParser, but with new semantics.'!


!RecursiveDescentParser methodsFor: 'public access'!

compile: textOrStream encodeIn: anEncoder notifying: aRequestor ifFail: aBlock 
	"Answer with the result of the compilation. NOTE: information may be added 
	to the argument anEncoder during the course of this compilation."

	| result |
	self
		init: textOrStream
		notifying: aRequestor
		failBlock: aBlock.
	class isNil ifTrue: [class := Object].		"some methods rely on class being non-nil"
	self initEncoder: anEncoder.
	result := self parse.
	encoder := failBlock := requestor := parseNode := nil.		"break cycles & mitigate refct overflow"
	^result!

compile: textOrStream in: aClass encodeIn: anEncoder notifying: aRequestor ifFail: aBlock 
	"Answer the result of compiling the text in the context of aClass. NOTE: 
	information 
	may be added to the argument anEncoder during the course of this compilation."

	class := aClass.
	^self
		compile: textOrStream
		encodeIn: anEncoder
		notifying: aRequestor
		ifFail: aBlock!

compile: textOrStream in: aClass notifying: aRequestor ifFail: aBlock 
	"Answer the result of compiling the text in the context of aClass."

	class := aClass.
	^self
		compile: textOrStream
		notifying: aRequestor
		ifFail: aBlock!

compile: textOrStream notifying: aRequestor ifFail: aBlock 
	"Answer with the result of the compilation."

	| result |
	self
		init: textOrStream
		notifying: aRequestor
		failBlock: aBlock.
	class isNil ifTrue: [class := Object].		"some methods rely on class being non-nil"
	self initEncoder.
	result := self parse.
	encoder := failBlock := requestor := parseNode := nil.		"break cycles & mitigate refct overflow"
	^result! !

!RecursiveDescentParser methodsFor: 'parsing'!

parse
	"This is the top level method that controls the (recursive descent) parse."

	self subclassResponsibility! !

!RecursiveDescentParser methodsFor: 'comparing'!

match: type 
	"Answer with true if next tokens type matches"

	hereType == type
		ifTrue: 
			[self advance.
			^true].
	^false!

matchToken: thing 
	"matches the token, not its type"

	here = thing
		ifTrue: 
			[self advance.
			^true].
	^false! !

!RecursiveDescentParser methodsFor: 'scanning'!

advance

	| this |
	prevMark := hereMark.		"Now means prev size"
	prevToken := hereType == #number | (hereType == #string)
				ifTrue: [scanner mark - prevMark]
				ifFalse: [here size].
	this := here.
	here := scanner nextToken.
	hereType := scanner nextTokenType.
	hereMark := scanner mark.
	scanner scanToken.
	^this!

bareEndOfLastToken

	^prevMark + prevToken - 1 + correctionDelta max: 0!

endOfInput
	"Use the eof token."

	^self endOfInputToken!

endOfLastToken

	hereType == #doIt ifTrue: [^prevMark + prevToken + 1 + correctionDelta].
	scanner atEnd ifTrue: [^prevMark + prevToken + correctionDelta].
	^prevMark + prevToken - 1 + correctionDelta!

reset
	"Reinitialize the scanner and the parse."

	scanner reset.
	prevMark := hereMark := scanner mark.
	self advance!

startOfNextToken
	"return starting position in source of next token"

	hereType == #doIt ifTrue: [^scanner position + 1 + correctionDelta].
	^hereMark + correctionDelta! !

!RecursiveDescentParser methodsFor: 'error handling'!

abort

	| exitBlock |
	encoder == nil
		ifFalse: 
			[encoder release.
			encoder := nil].		"break cycle"
	exitBlock := failBlock.
	failBlock := nil.
	^exitBlock value!

editor

	^requestor!

expected: aString 
	"Notify a problem at token 'here'"

	scanner atEnd ifTrue: [hereMark := hereMark + 1].
	hereType == #doIt ifTrue: [hereMark := hereMark + 1].
	^self notify: aString , ' expected ->' at: hereMark + correctionDelta!

notify: aString 
	"Notify problem at token before 'here'"

	^self notify: aString , ' ->' at: prevMark + correctionDelta!

notify: aString at: position 
	"If the editor is nil, pop up a SyntaxError, otherwise have the editor insert 
	aString."

	| editor |
	editor := self editor.
	Cursor normal show.
	editor == nil
		ifTrue: [SyntaxError
				errorInClass: class
				withCode: (scanner contents
						copyReplaceFrom: position
						to: position - 1
						with: aString)
				errorString: aString]
		ifFalse: [editor insertAndSelect: aString at: (position max: 1)].
	self abort!

offEnd: aString