-- OneCasabaParserImpl.mesa
-- last edit September 18, 1984 9:00:29 am PDT
-- Sturgis, June 3, 1986 3:07:05 pm PDT
DIRECTORY
IO USING[STREAM, CharClass, Close, GetCard, GetCedarTokenRope, GetTokenRope, int, PutF, PutRope, card, RIS, rope, RopeFromROS, ROS, SP, SkipWhitespace, TokenKind],
KipperSupport USING[CreateKipperer, CreateUnKipperer, Kipperer, UnKipperer],
OneCasabaParser USING[State],
OneCasabaParserData USING[KipperParserTableBodyRef, UnKipperParserTableBodyRef],
OneCasabaParserPrivate USING[ParserTableBody, SymbolTable, SymbolTableBody, SymbolCell, SymbolCellBody, TokenTable, TokenTableBody, TokenCell, TokenCellBody, TokenCase, ActionTable, ActionTableBody, ActionCell, ActionCellBody, Action],
Rope USING[Equal, Fetch, Length, ROPE, Substr];
OneCasabaParserImpl: CEDAR PROGRAM IMPORTS IO, KipperSupport, OneCasabaParserData, Rope EXPORTS OneCasabaParser =
BEGIN OPEN IO, KipperSupport, OneCasabaParser, OneCasabaParserData, OneCasabaParserPrivate, Rope;
-- first the procedures for creating parser info on streams
RecordKipperedParserTableOnStream: PUBLIC PROC[s: STREAM, genInfo: PROC[
recordSymbol: PROC[symbol: ROPE],
recordUniqueToken: PROC[name: ROPE, spelling: ROPE],
recordGenericToken: PROC[name: ROPE, class: ROPE],
recordShift: PROC[state: State, terminalSeq: ROPE, newState: State],
recordReduction: PROC[state: State, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL],
recordAcceptance: PROC[state: State, terminalSeq: ROPE],
recordStartState: PROC[state: State]]] =
BEGIN
table: ParserTable ← BuildParserTable[genInfo];
kipperer: Kipperer ← CreateKipperer[s];
KipperParserTableBodyRef[kipperer, table];
Close[s];
END;
RecordReadableParserTableOnStream: PUBLIC PROC[s: STREAM, genInfo: PROC[
recordSymbol: PROC[symbol: ROPE],
recordUniqueToken: PROC[name: ROPE, spelling: ROPE],
recordGenericToken: PROC[name: ROPE, class: ROPE],
recordShift: PROC[state: State, terminalSeq: ROPE, newState: State],
recordReduction: PROC[state: State, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL],
recordAcceptance: PROC[state: State, terminalSeq: ROPE],
recordStartState: PROC[state: State]]] =
BEGIN
LocalRecordSymbol: PROC[symbol: ROPE] =
{PutF[s, "sy %g ", rope[symbol]]};
LocalRecordUniqueToken: PROC[name: ROPE, spelling: ROPE] =
{PutF[s, "ut %g %g ", rope[name], rope[spelling]]};
LocalRecordGenericToken: PROC[name: ROPE, class: ROPE] =
{PutF[s, "gt %g %g ", rope[name], rope[class]]};
LocalRecordShift: PROC[state: State, terminalSeq: ROPE, newState: State] =
{PutF[s, "sh %g <%g> %g ", card[state], rope[terminalSeq], card[newState]]};
LocalRecordReduction: PROC[state: State, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL] =
{PutF[s, "rd %g <%g> %g %g %g ", card[state], rope[terminalSeq], rope[leftSide], card[ruleNumber], card[ruleSize]]};
LocalRecordAcceptance: PROC[state: State, terminalSeq: ROPE] =
{PutF[s, "ac %g <%g> ", card[state], rope[terminalSeq]]};
LocalRecordStartState: PROC[state: State] = {PutF[s, "start %g ", card[state]]};
genInfo[LocalRecordSymbol, LocalRecordUniqueToken, LocalRecordGenericToken, LocalRecordShift, LocalRecordReduction, LocalRecordAcceptance, LocalRecordStartState];
PutRope[s, " end "];
END;

-- now the types and procedures for building an internal parsetable from parser descriptions on a stream
ParserTable: TYPE = REF ParserTableBody;
ParserTableBody: PUBLIC TYPE = OneCasabaParserPrivate.ParserTableBody;
BuildParserTableFromKipperedStream: PUBLIC PROC[s: STREAM] RETURNS[ParserTable] =
{RETURN[UnKipperParserTableBodyRef[CreateUnKipperer[s]]]};
BuildParserTableFromReadableStream: PUBLIC PROC[s: STREAM] RETURNS[ParserTable] =
BEGIN
GenInfo: PROC[
recordSymbol: PROC[ROPE],
recordUniqueToken: PROC[ROPE, ROPE],
recordGenericToken: PROC[ROPE, ROPE],
recordShift: PROC[State, ROPE, State],
recordReduction: PROC[State, ROPE, ROPE, CARDINAL, CARDINAL],
recordAcceptance: PROC[State, ROPE],
recordStartState: PROC[State]] =
BEGIN
Break: PROC [char: CHAR] RETURNS [CharClass] =
{RETURN[IF char = SP THEN sepr ELSE other]};
WHILE TRUE DO
firstToken: ROPE ← GetTokenRope[s, Break].token;
GetTermSeq: PROC RETURNS[ROPE] =
BEGIN
text: ROPE;
[] ← SkipWhitespace[s];
text ← GetTokenRope[s, Break].token;
RETURN[Substr[text, 1, Length[text]-2]];
END;
SkipAndGetCard: PROC RETURNS[CARDINAL] =
BEGIN
[] ← SkipWhitespace[s];
RETURN[GetCard[s]];
END;
SELECT TRUE FROM
Equal[firstToken, "sy"] =>
recordSymbol[GetTokenRope[s, Break].token];
Equal[firstToken, "ut"] =>
BEGIN
name: ROPE ← GetTokenRope[s, Break].token;
spelling: ROPE ← GetTokenRope[s, Break].token;
recordUniqueToken[name, spelling]
END;
Equal[firstToken, "gt"] =>
BEGIN
name: ROPE ← GetTokenRope[s, Break].token;
class: ROPE ← GetTokenRope[s, Break].token;
recordGenericToken[name, class];
END;
Equal[firstToken, "sh"] =>
BEGIN
state: CARDINAL ← SkipAndGetCard[];
terms: ROPE ← GetTermSeq[];
newState: CARDINAL ← SkipAndGetCard[];
recordShift[state, terms, newState];
END;
Equal[firstToken, "rd"] =>
BEGIN
state: CARDINAL ← SkipAndGetCard[];
terms: ROPE ← GetTermSeq[];
leftSide: ROPE ← GetTokenRope[s, Break].token;
ruleNumber: CARDINAL ← SkipAndGetCard[];
ruleSize: CARDINAL ← SkipAndGetCard[];
recordReduction[state, terms, leftSide, ruleNumber, ruleSize];
END;
Equal[firstToken, "ac"] =>
BEGIN
state: CARDINAL ← SkipAndGetCard[];
terms: ROPE ← GetTermSeq[];
recordAcceptance[state, terms];
END;
Equal[firstToken, "start"] =>
recordStartState[SkipAndGetCard[]];
Equal[firstToken, "end"] => EXIT;
ENDCASE => ERROR;
ENDLOOP;
END;
RETURN[BuildParserTable[GenInfo]];
END;
BuildParserTable: PROC[genInfo: PROC[
recordSymbol: PROC[name: ROPE],
recordUniqueToken: PROC[name: ROPE, spelling: ROPE],
recordGenericToken: PROC[name: ROPE, class: ROPE],
recordShift: PROC[state: State, terminalSeq: ROPE, newState: State],
recordReduction: PROC[state: State, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL],
recordAcceptance: PROC[state: State, terminalSeq: ROPE],
recordStartState: PROC[state: State]]] RETURNS[ParserTable] =
BEGIN
table: ParserTable ← CreateParserTable[];
LocalRecordSymbol: PROC[symbol: ROPE] = {RecordSymbol[table, symbol]};
LocalRecordUniqueToken: PROC[name: ROPE, spelling: ROPE] ={RecordUniqueToken[table, name, spelling]};
LocalRecordGenericToken: PROC[name: ROPE, class: ROPE] = {RecordGenericToken[table, name, class]};
LocalRecordShift: PROC[state: State, terminalSeq: ROPE, newState: State] =
{RecordShift[table, state, terminalSeq, newState]};
LocalRecordReduction: PROC[state: State, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL] =
{RecordReduction[table, state, terminalSeq, leftSide, ruleNumber, ruleSize]};
LocalRecordAcceptance: PROC[state: State, terminalSeq: ROPE] =
{RecordAcceptance[table, state, terminalSeq]};
LocalRecordStartState: PROC[state: State] = {RecordStartState[table, state]};
genInfo[LocalRecordSymbol, LocalRecordUniqueToken, LocalRecordGenericToken, LocalRecordShift, LocalRecordReduction, LocalRecordAcceptance, LocalRecordStartState];
AnalyzeActions[table];
RETURN[table]
END;
CreateParserTable: PROC RETURNS[ParserTable] =
BEGIN
table: ParserTable ← NEW[ParserTableBody];
RecordSymbol[table, ""]; -- the empty seq
RecordTokenInfo[table, "", tokenEOF, "", generic];
RETURN[table];
END;
AnalyzeActions: PROC[table: ParserTable] =
BEGIN
actionTable: ActionTable;
next: ActionCell;
nShiftReduceConflicts: INT ← 0;
nReduceReduceConflicts: INT ← 0;
NoteShiftReduce: PROC[terminal: CARDINAL, ruleNumber: CARDINAL] =
{nShiftReduceConflicts ← nShiftReduceConflicts+1};
NoteShiftAccept: PROC[terminal: CARDINAL] =
{nShiftReduceConflicts ← nShiftReduceConflicts+1};
NoteReduceAccept: PROC[terminal: CARDINAL, ruleNumber: CARDINAL] =
{nReduceReduceConflicts ← nReduceReduceConflicts+1};
NoteReduceReduce: PROC[terminal: CARDINAL, ruleNumber1, ruleNumber2: CARDINAL] =
{nReduceReduceConflicts ← nReduceReduceConflicts+1};
IF table.actionTable # NIL THEN ERROR;
actionTable ← table.actionTable ← NEW[ActionTableBody[table.nActions]];
FOR I: CARDINAL IN [0..actionTable.nSlots) DO actionTable.actions[I] ← NIL ENDLOOP;
FOR action: ActionCell ← table.unAnalyzedActions, next WHILE action # NIL DO
hash: CARDINAL ← HashOneAction[action.state, action.terminal];
hashCode: CARDINAL ← hash MOD actionTable.nSlots;
next ← action.next;
action.next ← actionTable.actions[hashCode];
actionTable.actions[hashCode] ← action;
ENDLOOP;
table.unAnalyzedActions ← NIL;
-- now remove any ambiguities
-- resolve shift/reduce by shift
-- resolve reduce/reduce to the lowest production number
FOR I: CARDINAL IN [0..actionTable.nSlots) DO
previousTo1: ActionCell ← NIL;
action1: ActionCell← NIL;
action1Next: ActionCell ← NIL;
FOR action1 ← actionTable.actions[I], action1Next WHILE action1 # NIL DO
previousTo2: ActionCell ← action1;
action2: ActionCell ← NIL;
action2Next: ActionCell ← NIL;
action1Next ← action1.next;
FOR action2 ← action1.next, action2Next WHILE action2 # NIL DO
action2Next ← action2.next;
IF action1.state = action2.state AND action1.terminal = action2.terminal THEN
BEGIN -- we have a conflict
SELECT action1.action FROM
shift =>
SELECT action2.action FROM
shift => ERROR;
reduce =>
BEGIN
NoteShiftReduce[action1.terminal, action2.ruleNumber];
GOTO remove2;
END;
accept =>
BEGIN
NoteShiftAccept[action1.terminal];
GOTO remove2;
END;
ENDCASE => ERROR;
reduce =>
SELECT action2.action FROM
shift =>
BEGIN
NoteShiftReduce[action1.terminal, action1.ruleNumber];
GOTO remove1;
END;
reduce =>
BEGIN
NoteReduceReduce[action1.terminal, action1.ruleNumber, action2.ruleNumber];
IF action1.ruleNumber < action2.ruleNumber THEN GOTO remove2 ELSE GOTO remove1;
END;
accept =>
BEGIN
NoteReduceAccept[action1.terminal, action1.ruleNumber];
GOTO remove1;
END;
ENDCASE => ERROR;
accept =>
SELECT action2.action FROM
shift =>
BEGIN
NoteShiftAccept[action1.terminal];
GOTO remove2;
END;
reduce =>
BEGIN
NoteReduceAccept[action1.terminal, action2.ruleNumber];
GOTO remove2;
END;
accept => ERROR;
ENDCASE => ERROR;
ENDCASE => ERROR;
EXITS
remove1 =>
BEGIN
IF previousTo2 = action1 THEN previousTo2 ← previousTo1;
action1 ← action1Next;
action1Next ← action1.next;
IF previousTo1 # NIL THEN previousTo1.next ← action1 ELSE actionTable.actions[I] ← action1;
END;
remove2 =>
BEGIN
action2 ← action2Next;
action2Next ← IF action2 # NIL THEN action2.next ELSE NIL;
previousTo2.next ← action2;
END;
END;
previousTo2 ← action2;
ENDLOOP;
previousTo1 ← action1;
ENDLOOP;
ENDLOOP;
-- now report any conflicts that have been artificially removed
IF nReduceReduceConflicts # 0 OR nShiftReduceConflicts # 0 THEN
BEGIN
reportStream: IO.STREAM ← GetReportStream[];
-- using GetReportStream for a slightly bastardized purpose
-- the definitions file says it will only be called during parse, and I don't want to change the definitions file
IO.PutF[reportStream, "\N\NWARNING\N"];
IF nReduceReduceConflicts # 0 THEN IO.PutF[reportStream, "\T%g reduce/reduce conflicts removed\N", IO.int[nReduceReduceConflicts]];
IF nShiftReduceConflicts # 0 THEN IO.PutF[reportStream, "\T%g shift/reduce conflicts removed\N\N", IO.int[nShiftReduceConflicts]];
END;
END;
RecordSymbol: PROC[table: ParserTable, name: ROPE] =
BEGIN
IF table.symbolTable # NIL THEN ERROR; -- must record all symbols before any actions
table.unAnalyzedSymbols ← NEW[SymbolCellBody←[name, table.nSymbols, table.unAnalyzedSymbols]];
table.nSymbols ← table.nSymbols+1;
END;
RecordUniqueToken: PROC[table: ParserTable, name: ROPE, spelling: ROPE] =
BEGIN
spellingStream: STREAM ← RIS[spelling];
kind: TokenKind;
-- the following hack is because GetCedarToken fails on |
-- of course, the scanner will still fail if it ever sees a |
IF Equal[spelling, "|"] THEN
BEGIN
kind ← tokenSINGLE;
END
ELSE
BEGIN
kind ← GetCedarTokenRope[spellingStream].tokenKind;
END;
Close[spellingStream];
IF kind # tokenID AND NOT HashKind[kind].includeRope THEN ERROR;
RecordTokenInfo[table, name, kind, spelling, unique];
END;
RecordGenericToken: PROC[table: ParserTable, name: ROPE, class: ROPE] =
BEGIN
kind: TokenKind ← DecodeTokenKind[class];
IF kind # tokenID AND HashKind[kind].includeRope THEN ERROR;
RecordTokenInfo[table, name, kind, "", generic];
END;
RecordShift: PROC[table: ParserTable, state: State, terminalSeq: ROPE, newState: State] =
BEGIN
IF table.symbolTable = NIL THEN AnalyzeSymbols[table];
table.unAnalyzedActions ← NEW[ActionCellBody ←[
state: state,
terminal: LookUpSymbol[table.symbolTable, terminalSeq],
action: shift,
nextState: newState,
ruleNumber: 0,
leftSide: 0,
ruleSize: 0,
next: table.unAnalyzedActions]];
table.nActions ← table.nActions+1;
END;
RecordReduction: PROC[table: ParserTable, state: State, terminalSeq: ROPE, leftSide: ROPE, ruleNumber: CARDINAL, ruleSize: CARDINAL] =
BEGIN
IF table.symbolTable = NIL THEN AnalyzeSymbols[table];
table.unAnalyzedActions ← NEW[ActionCellBody ←[
state: state,
terminal: LookUpSymbol[table.symbolTable, terminalSeq],
action: reduce,
nextState: 0,
ruleNumber: ruleNumber,
leftSide: LookUpSymbol[table.symbolTable, leftSide],
ruleSize: ruleSize,
next: table.unAnalyzedActions]];
table.nActions ← table.nActions+1;
END;
RecordAcceptance: PROC[table: ParserTable, state: State, terminalSeq: ROPE] =
BEGIN
IF table.symbolTable = NIL THEN AnalyzeSymbols[table];
table.unAnalyzedActions ← NEW[ActionCellBody ←[
state: state,
terminal: LookUpSymbol[table.symbolTable, terminalSeq],
action: accept,
nextState: 0,
ruleNumber: 0,
leftSide: 0,
ruleSize: 0,
next: table.unAnalyzedActions]];
table.nActions ← table.nActions+1;
END;
RecordStartState: PROC[table: ParserTable, state: State] =
{table.startState ← state};
RecordTokenInfo: PROC[table: ParserTable, name: ROPE, kind: TokenKind, spelling: ROPE, case: TokenCase] =
BEGIN
IF table.tokenTable # NIL THEN ERROR; -- must record all tokens before any actions
table.unAnalyzedTokens ← NEW[TokenCellBody←[name, 0, kind, spelling, case, table.unAnalyzedTokens]];
table.nTokens ← table.nTokens+1;
END;
HashOneAction: PROC[state: CARDINAL, terminal: CARDINAL] RETURNS[hash: CARDINAL] = INLINE
{RETURN[(state*terminal) MOD 256]};
HashKind: PROC[kind: TokenKind] RETURNS[hash: CARDINAL, includeRope: BOOLEAN] =
BEGIN
SELECT kind FROM
tokenERROR => RETURN[0, FALSE];
tokenID => RETURN[1, TRUE];
tokenDECIMAL => RETURN[2, FALSE];
tokenOCTAL => RETURN[3, FALSE];
tokenHEX => RETURN[4, FALSE];
tokenREAL => RETURN[5, FALSE];
tokenROPE => RETURN[6, FALSE];
tokenCHAR => RETURN[7, FALSE];
tokenATOM => RETURN[8, FALSE];
tokenSINGLE => RETURN[9, TRUE];
tokenDOUBLE => RETURN[10, TRUE];
tokenCOMMENT => RETURN[11, FALSE];
tokenEOF => RETURN[12, FALSE];
ENDCASE => ERROR;
END;
DecodeTokenKind: PROC[class: ROPE] RETURNS[TokenKind] =
BEGIN
SELECT TRUE FROM
Equal[class, "tokenERROR"] => RETURN[tokenERROR];
Equal[class, "tokenID"] => RETURN[tokenID];
Equal[class, "tokenDECIMAL"] => RETURN[tokenDECIMAL];
Equal[class, "tokenOCTAL"] => RETURN[tokenOCTAL];
Equal[class, "tokenHEX"] => RETURN[tokenHEX];
Equal[class, "tokenREAL"] => RETURN[tokenREAL];
Equal[class, "tokenROPE"] => RETURN[tokenROPE];
Equal[class, "tokenCHAR"] => RETURN[tokenCHAR];
Equal[class, "tokenATOM"] => RETURN[tokenATOM];
Equal[class, "tokenSINGLE"] => RETURN[tokenSINGLE];
Equal[class, "tokenDOUBLE"] => RETURN[tokenDOUBLE];
Equal[class, "tokenCOMMENT"] => RETURN[tokenCOMMENT];
Equal[class, "tokenEOF"] => RETURN[tokenEOF];
ENDCASE => ERROR;
END;
AnalyzeSymbols: PROC[table: ParserTable] =
BEGIN
symbolTable: SymbolTable;
next: SymbolCell;
IF table.symbolTable # NIL THEN ERROR;
symbolTable ← table.symbolTable ← NEW[SymbolTableBody[table.nSymbols]];
FOR I: CARDINAL IN [0..symbolTable.nSlots) DO symbolTable.symbols[I] ← NIL ENDLOOP;
FOR symbol: SymbolCell ← table.unAnalyzedSymbols, next WHILE symbol # NIL DO
hash: CARDINAL ← HashOneSymbol[symbol.name];
hashCode: CARDINAL ← hash MOD symbolTable.nSlots;
next ← symbol.next;
symbol.next ← symbolTable.symbols[hashCode];
symbolTable.symbols[hashCode] ← symbol;
ENDLOOP;
table.unAnalyzedSymbols ← NIL;
AnalyzeTokens[table];
END;
LookUpSymbol: PROC[symbolTable: SymbolTable, name: ROPE] RETURNS[code: CARDINAL] =
BEGIN
hash: CARDINAL ← HashOneSymbol[name];
hashCode: CARDINAL ← hash MOD symbolTable.nSlots;
FOR symbol: SymbolCell ← symbolTable.symbols[hashCode], symbol.next WHILE symbol # NIL DO
IF Equal[symbol.name, name] THEN RETURN[symbol.code];
ENDLOOP;
ERROR;
END;
HashOneSymbol: PROC[rope: ROPE] RETURNS[hash: CARDINAL] =
BEGIN
hash ← 0;
FOR I: INT IN [0..Length[rope]) DO
hash ← hash + LOOPHOLE[Fetch[rope, I], CARDINAL];
ENDLOOP;
END;
AnalyzeTokens: PROC[table: ParserTable] =
BEGIN
tokenTable: TokenTable;
next: TokenCell;
IF table.tokenTable # NIL THEN ERROR;
tokenTable ← table.tokenTable ← NEW[TokenTableBody[table.nTokens]];
FOR token: TokenCell ← table.unAnalyzedTokens, next WHILE token # NIL DO
spellingHash: CARDINAL ← TokenHash[token.kind, token.spelling].hash;
spellingHashCode: CARDINAL ← spellingHash MOD tokenTable.nSlots;
next ← token.next;
token.symbolCode ← LookUpSymbol[table.symbolTable, token.name];
token.next ← tokenTable.tokens[spellingHashCode];
tokenTable.tokens[spellingHashCode] ← token;
IF token.kind = tokenID AND token.case = generic THEN
BEGIN
IF tokenTable.idToken # NIL THEN ERROR;
tokenTable.idToken ← token;
END;
ENDLOOP;
table.unAnalyzedTokens ← NIL;
END;
-- following routines are intended for the output of the GetCedarToken routine in IO.mesa
LookUpCedarToken: PROC[tokenTable: TokenTable, kind: TokenKind, text: ROPE] RETURNS[code: CARDINAL, info: ROPE, case: TokenCase] =
BEGIN
includeTextInHash: BOOLEAN;
hash: CARDINAL;
hashCode: CARDINAL;
[hash, includeTextInHash] ← TokenHash[kind, text];
hashCode ← hash MOD tokenTable.nSlots;
IF includeTextInHash THEN
FOR token: TokenCell ← tokenTable.tokens[hashCode], token.next WHILE token # NIL DO
IF token.kind = kind AND Equal[token.spelling, text] THEN RETURN[token.symbolCode, NIL, token.case];
ENDLOOP
ELSE
FOR token: TokenCell ← tokenTable.tokens[hashCode], token.next WHILE token # NIL DO
IF token.kind = kind THEN RETURN[token.symbolCode, text, token.case];
ENDLOOP;
IF kind = tokenID AND tokenTable.idToken # NIL THEN RETURN[tokenTable.idToken.symbolCode, text, tokenTable.idToken.case];
ERROR;
END;
TokenHash: PROC[kind: TokenKind, text: ROPE] RETURNS[hash: CARDINAL, includeTextInHash: BOOLEAN] =
BEGIN
[hash, includeTextInHash] ← HashKind[kind];
IF includeTextInHash AND text # NIL THEN
FOR I: INT IN [0..Length[text]) DO
hash ← hash + LOOPHOLE[Fetch[text, I], CARDINAL];
ENDLOOP;
END;
LookUpAction: PROC[actionTable: ActionTable, state: State, terminalCode: CARDINAL] RETURNS[ActionCell] =
BEGIN
hash: CARDINAL ← HashOneAction[state, terminalCode];
hashCode: CARDINAL ← hash MOD actionTable.nSlots;
FOR action: ActionCell ← actionTable.actions[hashCode], action.next WHILE action # NIL DO
IF action.state = state AND action.terminal = terminalCode THEN
RETURN[action];
ENDLOOP;
RETURN[NIL];
END;
-- finally the code for actually performing a parse
StackCell: TYPE = REF StackCellBody;
StackCellBody: TYPE = RECORD[
state: State,
firstPosition, length: INT,
next: StackCell];
ReductionCell: TYPE = REF ReductionCellBody;
ReductionCellBody: TYPE = RECORD[
case: ReductionCellCase,
firstCharPosition: INT,
-- if reduce case
rule: CARDINAL,
length: INT,
-- if shift
code: CARDINAL,
text: ROPE,
tokenCase: TokenCase,
tokenKind: TokenKind,
previous: ReductionCell, -- always a shift
stack: StackCell, -- as it appears just after applying this shift
-- if accept
-- nothing
-- all cases
next: ReductionCell];
ReductionCellCase: TYPE = {reduction, shift, accept};
SimpleTryTokenCase: TYPE = {reduction, shift, accept, fail};
SourceTokenCell: TYPE = REF SourceTokenCellBody;
SourceTokenCellBody: TYPE = RECORD[
kind: TokenKind,
text: ROPE,
position: INT,
next: SourceTokenCell];
TrialTokenCell: TYPE = REF TrialTokenCellBody;
TrialTokenCellBody: TYPE = RECORD[
kind: TokenKind,
text: ROPE,
next: TrialTokenCell];
MaxTrialInserts: INT ← 4;
MaxSkip: INT ← 4;
MinSuccesses: INT ← 4;
DesiredSuccesses: INT ← 12;
FoundAFix: ERROR = CODE;
GetReportStream: PUBLIC SIGNAL RETURNS[IO.STREAM] = CODE;
UnRecoverableSyntaxError: PUBLIC ERROR = CODE;
Parse: PUBLIC PROC[
 table: ParserTable,
 getSourceToken: PROC RETURNS[tokenKind: TokenKind, tokenText: ROPE, position: INT],
 showReduce: PROC[rule: CARDINAL, firstCharPosition: INT, length: INT],
 showGenericShift: PROC[code: CARDINAL, kind: TokenKind, text: ROPE, firstCharPosition: INT],
 showNonGenericShift: PROC[text: ROPE, firstCharPosition: INT]]
RETURNS[accepted: BOOLEAN] =
BEGIN
-- this uses a scheme obtained orally from Ed Satterthwaite on Nov 7, 1985.
-- I am begining to suspect I have not got the search strategy right, I am breadth first on insertions, but not on deletions?
-- state stack and saved reductions for later play to caller
-- old stack is as the stack appears just before applying firstRed
-- current stack is as the stack appears just after appling the last reduction chained from firstRed
oldStack: StackCell ← NEW[StackCellBody ← [table.startState, 0, 0, NIL]];
currentStack: StackCell ← oldStack;
-- these reduction cells form a linear list from firstRed to LastRed
 -- last shift points into this list.
firstRed: ReductionCell ← NIL;
lastShift: ReductionCell ← NIL; -- always a shift
lastRed: ReductionCell ← NIL;
results in a shift, a single reduction, an acceptance, or a failure
SimpleTryToken: PROC[tokenKind: TokenKind, tokenText: ROPE, position: INT] RETURNS[SimpleTryTokenCase] =
BEGIN
terminalSeqCode: CARDINAL;
terminalSeqInfo: ROPE;
tokenCase: TokenCase;
action: ActionCell;
[terminalSeqCode, terminalSeqInfo, tokenCase] ← LookUpCedarToken[table.tokenTable, tokenKind, tokenText];
action ← LookUpAction[table.actionTable, currentStack.state, terminalSeqCode];
IF action = NIL THEN RETURN[fail];
SELECT action.action FROM
shift =>
BEGIN
redCell: ReductionCell;
currentStack ← NEW[StackCellBody ← [action.nextState, position, Rope.Length[tokenText], currentStack]];
redCell ← NEW[ReductionCellBody← [
shift, position,
, ,
terminalSeqCode, tokenText, tokenCase, tokenKind, lastShift, currentStack,
NIL]];
IF lastRed # NIL THEN lastRed.next ← redCell ELSE firstRed ← redCell;
lastRed ← redCell;
lastShift ← redCell;
RETURN[shift];
END;
reduce =>
BEGIN
shift: ActionCell;
firstPosition: INT ← position;
limitPosition: INT ← IF action.ruleSize = 0 THEN position ELSE currentStack.firstPosition + currentStack.length;
redCell: ReductionCell;
FOR I: CARDINAL IN [0..action.ruleSize) DO
firstPosition ← currentStack.firstPosition;
currentStack ← currentStack.next;
ENDLOOP;
redCell ← NEW[ReductionCellBody←[
reduction, firstPosition,
action.ruleNumber, limitPosition-firstPosition,
, , , , , ,
NIL]];
IF lastRed # NIL THEN lastRed.next ← redCell ELSE firstRed ← redCell;
lastRed ← redCell;
shift ← LookUpAction[table.actionTable, currentStack.state, action.leftSide];
IF shift.action # shift THEN ERROR;
currentStack ← NEW[StackCellBody ← [shift.nextState, firstPosition, limitPosition-firstPosition, currentStack]];
RETURN[reduction]
END;
accept =>
BEGIN
redCell: ReductionCell ← NEW[ReductionCellBody←[
accept, ,
, ,
, , , , , ,
NIL]];
IF lastRed # NIL THEN lastRed.next ← redCell ELSE firstRed ← redCell;
lastRed ← redCell;
RETURN[accept];
END;
ENDCASE => ERROR;
END;
repeats calls on SimpleTryToken, so that all reductions are done, up to and including a shift, acceptance, or failure.
FullTryToken: PROC[tokenKind: TokenKind, tokenText: ROPE, position: INT] RETURNS[SimpleTryTokenCase] =
BEGIN
DO
SELECT SimpleTryToken[tokenKind, tokenText, position] FROM
reduction => LOOP;
shift => RETURN[shift];
accept => RETURN[accept];
fail =>
BEGIN
ResetToShift[];
RETURN[fail];
END;
ENDCASE => ERROR;
ENDLOOP;
END;
ResetStack: PROC =
{currentStack ← oldStack; firstRed ← lastShift ← lastRed ← NIL};
plays successive reductions up to and including a shift or acceptance
Play1TokenWorth: PROC RETURNS[accepted: BOOLEAN] =
BEGIN
DO
SELECT firstRed.case FROM
reduction =>
BEGIN
IF showReduce # NIL THEN showReduce[firstRed.rule, firstRed.firstCharPosition, firstRed.length];
firstRed ← firstRed.next;
IF firstRed = NIL THEN
lastShift ← lastRed ← NIL;
END;
shift =>
BEGIN
IF firstRed.tokenCase = generic THEN
{IF showGenericShift # NIL THEN showGenericShift[firstRed.code, firstRed.tokenKind, firstRed.text, firstRed.firstCharPosition]}
ELSE
{IF showNonGenericShift # NIL THEN showNonGenericShift[firstRed.text, firstRed.firstCharPosition]};
firstRed.previous ← NIL;
oldStack ← firstRed.stack;
firstRed ← firstRed.next;
IF firstRed = NIL THEN
lastShift ← lastRed ← NIL;
RETURN[FALSE];
END;
accept =>
BEGIN
firstRed ← firstRed.next;
IF firstRed = NIL THEN
lastShift ← lastRed ← NIL;
RETURN[TRUE];
END;
ENDCASE => ERROR;
ENDLOOP;
END;
ResetToShift: PROC =
BEGIN
IF lastShift # NIL THEN
{lastRed ← lastShift; lastRed.next ← NIL; currentStack ← lastRed.stack}
ELSE
{lastRed ← NIL; currentStack ← oldStack};
END;
Reset1TokenWorth: PROC =
BEGIN
lastRed ← lastShift;
lastShift ← lastRed.previous;
lastRed.previous ← NIL;
ResetToShift[];
END;
ResetNTokensWorth: PROC[n: CARDINAL] =
{FOR I: CARDINAL IN [0..n) DO Reset1TokenWorth[] ENDLOOP};
-- now we deal with delivery of tokens. this mechanism allows back up and replay of tokens without any assumptions about the ultimate source of tokens
firstToken: SourceTokenCell ← NIL;
currentToken: SourceTokenCell ← NIL;
lastToken: SourceTokenCell ← NIL;
GetToken: PROC RETURNS[TokenKind, ROPE, INT] =
BEGIN
t: SourceTokenCell;
IF currentToken = NIL THEN
BEGIN
currentToken ← NEW[SourceTokenCellBody];
[currentToken.kind, currentToken.text, currentToken.position] ← getSourceToken[];
IF firstToken # NIL THEN lastToken.next ← currentToken ELSE firstToken ← currentToken;
lastToken ← currentToken;
END;
t ← currentToken;
currentToken ← currentToken.next;
RETURN[t.kind, t.text, t.position];
END;
ResetTokens: PROC =
{currentToken ← firstToken};
DeleteOneToken: PROC =
BEGIN
IF currentToken = firstToken THEN currentToken ← firstToken.next;
firstToken ← firstToken.next;
END;
-- syntactic error recovery involves trying the deletion of some incomming tokens and the insertion of other plausable tokens. The following data records current best such attempt as well as the currently explored attempt.
currentInsertions: TrialTokenCell ← NIL;
bestInsertions: TrialTokenCell ← NIL;
bestDeletions: CARDINAL ← 0;
bestScore: INT ← 0;
BackUpOneTrialInsertion: PROC =
{currentInsertions ← currentInsertions.next};
AddOneTrialInsertion: PROC[kind: TokenKind, text: ROPE] =
BEGIN
cell: TrialTokenCell ← NEW[TrialTokenCellBody←[kind, text, currentInsertions]];
currentInsertions ← cell;
END;
RecordTrialScore: PROC[nDeletions: INT, score: INT] =
BEGIN
IF score > bestScore THEN
BEGIN
bestInsertions ← currentInsertions;
bestDeletions ← nDeletions;
bestScore ← score;
END;
END;
RecordFoundFix: PROC[nDeletions: INT] =
BEGIN
bestInsertions ← currentInsertions;
bestDeletions ← nDeletions;
bestScore ← DesiredSuccesses;
END;
ResetTrials: PROC =
BEGIN
currentInsertions ← bestInsertions ← NIL;
bestDeletions ← bestScore ← 0;
END;
PlayTrialInsertions: PROC[for: PROC[TokenKind, ROPE]] =
BEGIN
SubPlayTrialInsertions: PROC[cell: TrialTokenCell] =
BEGIN
IF cell.next # NIL THEN SubPlayTrialInsertions[cell.next];
for[cell.kind, cell.text];
END;
IF bestInsertions # NIL THEN SubPlayTrialInsertions[bestInsertions];
END;
ExploreForBestRecovery: PROC[nInsertsSoFar: INT, tryNDeletions: INT] =
BEGIN
-- first see if we can get away by trying an appropriate number of deletions without any insertions
FOR I: INT IN [0..tryNDeletions) DO [] ← GetToken[] ENDLOOP;
FOR I: INT IN [0..DesiredSuccesses) DO
tKind: TokenKind; tText: ROPE; tPosition: INT;
[tKind, tText, tPosition] ← GetToken[];
SELECT FullTryToken[tKind, tText, tPosition] FROM
shift => IF I+1 # DesiredSuccesses THEN LOOP
ELSE -- we parsed ahead as far as we wanted, go with this
{RecordFoundFix[tryNDeletions]; ResetNTokensWorth[I+1]; FoundAFix[]};
accept => {RecordFoundFix[tryNDeletions]; ResetNTokensWorth[I]; FoundAFix[]};
fail =>
BEGIN -- we couldn't parse as many input tokens as we wanted
IF I >= MinSuccesses THEN -- but we got enough to record
RecordTrialScore[tryNDeletions, I];
ResetNTokensWorth[I];
EXIT;
END;
ENDCASE => ERROR;
ENDLOOP; -- success loop
-- we didn't parse ahead as far as we wanted, so reset
ResetTokens[];
--now try each plausable inserted token, but with one fewer deletions
IF tryNDeletions > 0 THEN
BEGIN
SeeOneTokenToInsert: PROC[kind: TokenKind, text: ROPE] =
BEGIN
AddOneTrialInsertion[kind, text];
SELECT FullTryToken[kind, text, 0] FROM
shift =>
BEGIN
ExploreForBestRecovery[nInsertsSoFar+1, tryNDeletions-1];
Reset1TokenWorth[];
END;
fail => NULL;
accept => ResetToShift[];
ENDCASE => ERROR;
BackUpOneTrialInsertion[];
END;
GenPlausableInsertedTokens[table, currentStack.state, SeeOneTokenToInsert];
-- this might generate FoundAFix, which will be caught by our ultimate caller
END;
END;
-- following is the main loop that drives the parser
successfulTrys: CARDINAL ← 0;
DO
kind: TokenKind; text: Rope.ROPE; position: INT;
[kind, text, position] ← GetToken[];
SELECT FullTryToken[kind, text, position] FROM
shift =>
BEGIN
IF successfulTrys = 0 THEN successfulTrys ← 1
ELSE
BEGIN -- two source tokens in a row have worked, so show first to caller
IF Play1TokenWorth[] THEN ERROR; -- can't produce an acceptance
DeleteOneToken[]; -- from the saved input tokens
END;
END;
accept =>
BEGIN
IF Play1TokenWorth[] THEN
{IF successfulTrys = 1 THEN ERROR ELSE RETURN[TRUE]};
IF successfulTrys # 1 THEN ERROR;
IF Play1TokenWorth[] THEN RETURN[TRUE];
ERROR; -- one of them should have produced an acceptance
END;
fail =>
BEGIN
-- first forget what we have seen
successfulTrys ← 0;
ResetStack[];
ResetTokens[];
ResetTrials[];
-- now conduct an exploration for a replacement
FOR diag: INT IN [0..MaxSkip] DO
ExploreForBestRecovery[0, diag
! FoundAFix => -- found a replacement that results in acceptance or good match
BEGIN
-- we could try to replay the current stack, but it is easier to program using the code for "go with the best".
EXIT
END]
ENDLOOP;
-- didn't not find a replacement that resulted in acceptance or good match
-- so, go with the best
-- (or, did find one, and are defaulting to this code)
BEGIN
reportStream: IO.STREAM ← GetReportStream[];
msgStream: IO.STREAM ← IO.ROS[];
nInsertions: CARDINAL ← 0;
ReportOneInsertion: PROC[kind: TokenKind, text: Rope.ROPE] =
{IO.PutF[msgStream, " %g", IO.rope[text]]};
TryOneTrialInsertion: PROC[kind: TokenKind, text: Rope.ROPE] =
BEGIN
nInsertions ← nInsertions+1;
SELECT FullTryToken[kind, text, 0] FROM
shift, accept => RETURN;
fail => ERROR;
ENDCASE;
END;
ResetStack[];
ResetTokens[];
IO.PutF[msgStream, "\N\NSyntaxError at %g\N", IF firstToken=NIL THEN IO.rope["<unknown place>"] ELSE IO.int[firstToken.position]];
IF bestDeletions # 0 THEN IO.PutF[msgStream, "\Tdeleting"];
FOR I: CARDINAL IN [0..bestDeletions) DO
text: Rope.ROPE;
[, text, ] ← GetToken[];
IO.PutF[msgStream, " %g", IO.rope[text]];
ENDLOOP;
ResetTokens[];
IO.PutF[msgStream, "\Tinserting"];
PlayTrialInsertions[ReportOneInsertion];
IO.PutF[msgStream, "\N\N"];
IO.PutF[reportStream, "%g", IO.rope[IO.RopeFromROS[msgStream]]];
IF bestScore < MinSuccesses THEN UnRecoverableSyntaxError[];
FOR I: CARDINAL IN [0..bestDeletions) DO DeleteOneToken[] ENDLOOP;
PlayTrialInsertions[TryOneTrialInsertion];
FOR I: CARDINAL IN [0..nInsertions) DO
IF Play1TokenWorth[] THEN
{IF I = (nInsertions - 1) THEN RETURN[TRUE] ELSE ERROR};
ENDLOOP;
successfulTrys ← 0;
END;
END;
ENDCASE => ERROR;
ENDLOOP;
END;
GenPlausableInsertedTokens: PROC[table: ParserTable, state: State, for: PROC[TokenKind, ROPE]] =
BEGIN
-- we try each possible terminal token, and generate those that result in a non NIL actionCell
-- eventually we want to control the order in which the terminal tokens are tried
FOR cellX: CARDINAL IN [0..table.tokenTable.nSlots) DO
FOR trialTokenCell: TokenCell ← table.tokenTable.tokens[cellX], trialTokenCell.next WHILE trialTokenCell # NIL DO
actionCell: ActionCell ← LookUpAction[table.actionTable, state, trialTokenCell.symbolCode];
IF actionCell # NIL THEN
BEGIN
text: Rope.ROPE ← IF trialTokenCell.case = unique THEN trialTokenCell.spelling ELSE
SELECT trialTokenCell.kind FROM
tokenID => "id",
tokenDECIMAL, tokenOCTAL, tokenHEX, tokenREAL => "num",
tokenROPE => "rope",
tokenCHAR => "char",
tokenATOM => "atom",
tokenEOF => "eof",
ENDCASE => ERROR;
for[trialTokenCell.kind, text];
END;
ENDLOOP;
ENDLOOP;
END;
END..