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 - this parser''s scanner prevToken - the last token scanned requestor - the object invoking the parser, errors are reported to this object failBlock - 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 - basic parsing mechanism. transcript - status messages get sent here. treeBuilder - 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* - basic parsing mechanism, a CFSM. finalState - 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. [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 - 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 the current token hereType the "type" of the current token hereMark position in source stream (mark) where this token began prevToken* size in chars of the previous token parsed prevMark mark of previous token class provides a context for the text being parsed encoder which uses tables to decode tokens parseNode intermediate result of current parse (for use by subclasses) lastTempMark mark of last temp; points to vert bar, or last char of pattern if no temps declared correctionDelta 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 "notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!!" ^self notify: aString at: scanner mark + correctionDelta! ! !RecursiveDescentParser methodsFor: 'private'! init: sourceString notifying: req failBlock: aBlock requestor := req. failBlock := aBlock. correctionDelta := 0. scanner := self preferredScannerClass new. scanner scan: sourceString notifying: self. prevMark := hereMark := scanner mark. self advance! initEncoder self subclassResponsibility! initEncoder: anEncoder encoder := anEncoder! preferredScannerClass ^self class preferredScannerClass! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! RecursiveDescentParser class instanceVariableNames: ''! !RecursiveDescentParser class methodsFor: 'accessing'! preferredScannerClass "Answer with a scanner class which is appropiate for scanning tokens used by this compiler class. Should be overwritten by subclasses." self subclassResponsibility! ! TableDrivenParser subclass: #LL1Parser instanceVariableNames: 'startSymbol ' classVariableNames: '' poolDictionaries: '' category: 'Compilers-Parsers'! LL1Parser comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I am an LL(1) parser. Instance Variables: parseTable* - basic parsing mechanism. startSymbol - my grammars start symbol. * inherited from AbstractParser'! !LL1Parser methodsFor: 'state accessing'! startSymbol ^startSymbol! startSymbol: argument startSymbol := argument! ! !LL1Parser methodsFor: 'private'! epsilon "Answer an object used to represent the empty string (epsilon)." ^''! myStartSymbol ^self class startSymbol! parserErrorSignal ^LLParserTable noTransitionSignal! ! !LL1Parser methodsFor: 'exception handling'! raiseExceptionExpectedToken: aString self raiseNoTransitionExceptionErrorString: 'expecting ' , aString! raiseExceptionUnparsedTokens self raiseNoTransitionExceptionErrorString: 'unparsed tokens remaining in input'! raiseNoTransitionExceptionErrorString: aString self parserErrorSignal raiseErrorString: aString! ! !LL1Parser methodsFor: 'parsing'! parse | stack prod | stack := Stack new. stack push: self startSymbol. [stack isEmpty] whileFalse: [stack top isTerminal ifTrue: [stack top = self nextToken ifTrue: [stack pop. self scanToken] ifFalse: [self raiseExceptionExpectedToken: stack top symbol]] ifFalse: [prod := self productionAtNonterminal: stack pop andTerminal: self nextToken. prod rightHandSide reverseDo: [:sym | stack push: sym]]]. self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]! parseForDerivationTreeAlternative "Derivation trees can be build efficiently during a top-down parse. This method implements this option (see parseForDerivationTree)." | stack prod root parent node | stack := Stack new. root := DerivationTreeNode symbol: self startSymbol. stack push: root. [stack isEmpty] whileFalse: [stack top isTerminal ifTrue: [stack top symbol = self nextToken ifTrue: [stack pop. self scanToken] ifFalse: [self raiseExceptionExpectedToken: stack top symbol]] ifFalse: [prod := self productionAtNonterminal: stack top symbol andTerminal: self nextToken. parent := stack pop. prod rightHandSide isEmpty ifTrue: [node := DerivationTreeNode symbol: self epsilon. parent addChild: node] ifFalse: [prod rightHandSide reverseDo: [:sym | node := DerivationTreeNode symbol: sym. parent addFirstChild: node. stack push: node]]]]. self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]. ^root! parseWithTreeBuilder: parseTreeBuilder "Rather than building the tree top-down during the parse, it's easier to save the productions on a stack and build the tree bottom-up after parsing." | stack productionStack | productionStack := Stack new. stack := Stack new. stack push: self startSymbol. [stack isEmpty] whileFalse: [stack top isTerminal ifTrue: ["cancel matching tokens" stack top = self nextToken ifTrue: [stack pop. self scanToken] ifFalse: [self raiseExceptionExpectedToken: stack top]] ifFalse: ["expand nonterminal" productionStack push: (self productionAtNonterminal: stack pop andTerminal: self nextToken) @ self nextTokenValue. productionStack top x rightHandSide reverseDo: [:sym | stack push: sym]]]. self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]. productionStack do: [:prod | self prevToken: prod y. parseTreeBuilder processProduction: prod x forParser: self]. ^parseTreeBuilder result! productionAtNonterminal: nont andTerminal: term ^self parseTable productionAtNonterminal: nont andTerminal: term! traceParse | stack prod | self cr; cr; showCR: 'LL Parser trace of: ' , self scanner contents; cr. stack := OrderedCollection new. stack addFirst: self startSymbol. [stack isEmpty] whileFalse: [stack first isTerminal ifTrue: [stack first = self nextToken ifTrue: [self showCR: 'cancel ''' , stack first asString, ''' from input'. stack removeFirst. self scanToken] ifFalse: [self error: 'raise exception: top of stack = ''' , stack first asString , ''' next token = ''' , self nextToken asString, '''']] ifFalse: [prod := self productionAtNonterminal: stack first andTerminal: self nextToken. self showCR: 'apply production ' , prod printString. stack removeFirst. prod rightHandSide reverseDo: [:sym | stack addFirst: sym]]]. self nextToken = self endOfInput ifFalse: [self raiseExceptionUnparsedTokens]! ! !LL1Parser methodsFor: 'testing'! performsLeftmostDerivation ^true! ! !LL1Parser methodsFor: 'initialization'! init super init. self startSymbol: self myStartSymbol! ! !LL1Parser methodsFor: 'scanner/parser generation'! classInitializationMethodTextForClassNamed: name spec: grammarSpec | ws | ws := self newStreamForMethodRendering. ws nextPutAll: 'initialize "' , name , ' initialize " '. ws cr. ws nextPutAll: ' " ' , grammarSpec , ' " '. ws nextPut: $". grammarSpec do: [:ch | "double embedded double-quote characters" ws nextPut: ch. ch = $" ifTrue: [ws nextPut: $"]]. ws nextPut: $". ws nextPutAll: ' | llParserTable table gp | '. ws nextPutAll: self parseTable buildParseTable. ws nextPutAll: ' self parseTable: llParserTable . '. ws nextPutAll: ' self startSymbol: '. self startSymbol printOn: ws. ^ws contents! ! !LL1Parser methodsFor: 'converting'! fastParser ^OptimizedLL1Parser buildFrom: self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! LL1Parser class instanceVariableNames: 'startSymbol '! !LL1Parser class methodsFor: 'instance creation'! parseTable: table startSymbol: sym | newParser | newParser := self new. newParser parseTable: table. newParser startSymbol: sym. ^newParser! ! !LL1Parser class methodsFor: 'state accessing'! startSymbol ^startSymbol! startSymbol: argument startSymbol := argument! ! LL1Parser subclass: #OptimizedLL1Parser instanceVariableNames: 'nonterminals terminals ' classVariableNames: 'NoTransitionSignal ' poolDictionaries: '' category: 'Compilers-Parsers'! OptimizedLL1Parser comment: '================================================= Copyright (c) 1992 by Justin O. Graver. All rights reserved (with exceptions). For complete information evaluate "Object tgenCopyright." ================================================= I am an LL(1) parser represented efficiently in Array table format. Instance variables: tokenTypeTable - the integer mapping for terminals and nonterminals'! !OptimizedLL1Parser 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: '! ! !OptimizedLL1Parser methodsFor: 'private'! parseError self raiseNoTransitionExceptionErrorString: (scanner tokenType == self endOfInputToken ifTrue: [self endOfInputErrorString] ifFalse: [self standardErrorString , '''' , scanner tokenType printString , ''''])! ! !OptimizedLL1Parser methodsFor: 'accessing'! myNonterminals ^self class nonterminals! myTerminals ^self class terminals! myTokenTypeTable ^self class tokenTypeTable! ! !OptimizedLL1Parser methodsFor: 'initialization'! init super init. self nonterminals: self myNonterminals. self terminals: self myTerminals! ! !OptimizedLL1Parser methodsFor: 'parsing'! productionAtNonterminal: nont andTerminal: term | nontIndex termIndex prod | nontIndex := self nonterminals indexOf: nont. termIndex := self terminals indexOf: term. ^(prod := (self parseTable at: nontIndex) at: termIndex) isNil ifTrue: [self raiseNoTransitionExceptionErrorString: (term = self endOfInputToken ifTrue: [self endOfInputErrorString] ifFalse: [self standardErrorString , '''' , term printString , ''''])] ifFalse: [prod]! ! !OptimizedLL1Parser 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 nonterminals , self terminals , transSyms asOrderedCollection asArray! reconstructOn: aStream | prodTable n | prodTable := self mapProductionToInteger. aStream nextPutAll: 'prodTable := '. prodTable reconstructOn: aStream. aStream period; crtab; nextPutAll: 'self nonterminals: (prodTable copyFrom: 1 to: '; nextPutAll: (n := self nonterminals size) printString; nextPutAll: ').'; crtab; nextPutAll: 'self terminals: (prodTable copyFrom: '; nextPutAll: (n + 1) printString; nextPutAll: ' to: '; nextPutAll: (self terminals size + n) printString; nextPutAll: ').'; crtab; nextPutAll: 'table := '. self parseTable reconstructOn: aStream using: prodTable. aStream period; crtab; nextPutAll: 'self constructParseTable: table with: prodTable.'; crtab; nextPutAll: 'self startSymbol: '. self startSymbol printOn: aStream! ! !OptimizedLL1Parser 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! ! !OptimizedLL1Parser methodsFor: 'converting'! changeToObjectTable: llParseTable | terms objectTable | self nonterminals: llParseTable keys asOrderedCollection asArray. terms := Set new. llParseTable do: [:row | row associationsDo: [:assoc | terms add: assoc key. assoc value rightHandSide do: [:sym | sym isTerminal ifTrue: [terms add: sym]]]]. self terminals: terms asOrderedCollection asArray. objectTable := Array new: self nonterminals size. ^self convert: llParseTable to: objectTable! convert: llParseTable to: objectTable | nonterms terms row | nonterms := self nonterminals. terms := self terminals. llParseTable associationsDo: [:assoc1 | row := Array new: terms size. objectTable at: (nonterms indexOf: assoc1 key) put: row. assoc1 value associationsDo: [:assoc2 | row at: (terms indexOf: assoc2 key) put: assoc2 value]]. ^objectTable! convertToTable: ll1Parser self scanner: ll1Parser scanner fastScanner. self parseTable: (self changeToObjectTable: ll1Parser parseTable). self treeBuilder: ll1Parser treeBuilder. self startSymbol: ll1Parser startSymbol! ! !OptimizedLL1Parser methodsFor: 'state accessing'! nonterminals ^nonterminals! nonterminals: arg nonterminals := arg! terminals ^terminals! terminals: arg terminals := arg! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OptimizedLL1Parser class instanceVariableNames: 'nonterminals terminals '! !OptimizedLL1Parser class methodsFor: 'class initialization'! initialize "OptimizedLL1Parser initialize" self noTransitionSignal: (Signal new nameClass: self message: #noTransitionSymbol)! ! !OptimizedLL1Parser class methodsFor: 'instance creation'! buildFrom: ll1Parser ^self new convertToTable: ll1Parser! ! !OptimizedLL1Parser class methodsFor: 'state accessing'! nonterminals ^nonterminals! nonterminals: arg nonterminals := arg! noTransitionSignal ^NoTransitionSignal! noTransitionSignal: arg NoTransitionSignal := arg! terminals ^terminals! terminals: arg terminals := arg! ! !OptimizedLL1Parser 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))! ! TableDrivenParser initialize! OptimizedLR1Parser initialize! OptimizedLL1Parser initialize!