file MTParserImpl.mesa
derived from ProtoParser.mesa
HGM, May 31, 1984 10:58:42 pm PDT
Satterthwaite, June 6, 1983 2:40 pm
Nichols, July 13, 1983 6:12 pm
DIRECTORY
IO: TYPE USING [STREAM],
MTP1: TYPE --P1-- USING [ActionSeq, ActionStack, AssignDescriptors, EvalInit, Index, LinkSeq, LinkStack, nullNTValue, ProcessError, ProcessQueue, ScanInit, ScannerProc, ScanReset, StateSeq, StateStack, Token, TValue, Value, ValueSeq, ValueStack],
MTParseTable: TYPE ParseTable USING [ActionEntry, ActionTag, defaultMarker, endMarker, finalState, initialState, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef,NTDefaultsRef, NTIndex, NTState, NTSymbol, ProdDataRef, State, TableRef,TActionsRef, TIndex, TLengthsRef, TStartsRef, TSymbol, TSymbolsRef],
SafeStorage USING [GetSystemZone];
MTParserImpl: CEDAR PROGRAM
IMPORTS MTP1, SafeStorage
EXPORTS MTP1 = {
Cedar/Mesa parser with error recovery
OPEN P1~~MTP1, MTParseTable;
table installation
tablePtr: TableRef;
transition tables for terminal input symbols
tStart: TStartsRef;
tLength: TLengthsRef;
tSymbol: TSymbolsRef;
tAction: TActionsRef;
transition tables for nonterminal input symbols
nStart: NStartsRef;
nLength: NLengthsRef;
nSymbol: NSymbolsRef;
nAction: NActionsRef;
ntDefaults: NTDefaultsRef;
production information
prodData: ProdDataRef;
InstallParseTable: PUBLIC SAFE PROC [base: TableRef] = TRUSTED {
tablePtr ← base;
tStart ← @tablePtr[tablePtr.parseTable.tStart];
tLength ← @tablePtr[tablePtr.parseTable.tLength];
tSymbol ← @tablePtr[tablePtr.parseTable.tSymbol];
tAction ← @tablePtr[tablePtr.parseTable.tAction];
nStart ← @tablePtr[tablePtr.parseTable.nStart];
nLength ← @tablePtr[tablePtr.parseTable.nLength];
nSymbol ← @tablePtr[tablePtr.parseTable.nSymbol];
nAction ← @tablePtr[tablePtr.parseTable.nAction];
ntDefaults ← @tablePtr[tablePtr.parseTable.ntDefaults];
prodData ← @tablePtr[tablePtr.parseTable.prodData];
};
parser state
errorLimit: NAT = 25;
scanTag: ActionTag = [FALSE, 0];
inputSymbol: TSymbol;
inputLoc: P1.Index;
inputValue: P1.TValue;
lastToken: P1.Token;
nullSymbol: TSymbol = 0;
zone: ZONE ← NIL;
s: P1.StateStack ← NIL;
l: P1.LinkStack ← NIL;
v: P1.ValueStack ← NIL;
top: CARDINAL;
q: P1.ActionStack ← NIL;
qI: CARDINAL;
initialization/termination
ParseInit: PROC [scratchZone: ZONE] = INLINE {
zone ← scratchZone;
s ← NIL; q ← NIL; ExpandStack[500]; ExpandQueue[250];
};
ParseReset: PROC = INLINE {
EraseQueue[]; EraseStack[];
zone ← NIL};
-- * * * * Main Parsing Procedures * * * * --
Parse: PUBLIC PROC [source: IO.STREAM, Input: P1.ScannerProc]
RETURNS [complete: BOOL, nTokens, nErrors: NAT] = TRUSTED {
currentState: State;
i, valid, m: CARDINAL;  -- stack pointers
action: ActionEntry;
ParseInit[SafeStorage.GetSystemZone[]];
P1.ScanInit[source];
P1.EvalInit;
nErrors ← 0; complete ← TRUE;
i ← top ← valid ← 0; qI ← 0;
s[0] ← currentState ← initialState; lastToken.class ← nullSymbol;
[[inputSymbol, inputValue, inputLoc]] ← Input[];
WHILE currentState # finalState AND inputSymbol # endMarker DO
BEGIN
tI: TIndex ← tStart[currentState];
FOR tI IN [tI .. tI + tLength[currentState]) DO
SELECT tSymbol[tI] FROM inputSymbol, defaultMarker => EXIT ENDCASE;
REPEAT
FINISHED => GO TO SyntaxError;
ENDLOOP;
action ← tAction[tI];
IF ~action.tag.reduce THEN { -- scan or scan reduce entry
IF qI > 0 THEN {
FOR k: CARDINAL IN (valid..i] DO s[k] ← s[top+(k-valid)] ENDLOOP;
P1.ProcessQueue[qI, top]; qI ← 0};
IF (top ← valid ← i ← i+1) >= s.length THEN ExpandStack[256];
lastToken.class ← inputSymbol;
v[i] ← [t~inputValue, n~P1.nullNTValue]; l[i] ← inputLoc;
[[inputSymbol, inputValue, inputLoc]] ← Input[]};
WHILE action.tag # scanTag DO
IF qI >= q.length THEN ExpandQueue[256];
q[qI] ← action; qI ← qI + 1;
i ← i-action.tag.pLength;
currentState ← s[IF i > valid THEN top+(i-valid) ELSE (valid ← i)];
BEGIN
lhs: NTSymbol = prodData[action.transition].lhs;
IF currentState <= NTState.LAST THEN {
nI: NTIndex ← nStart[currentState];
FOR nI IN [nI..nI+nLength[currentState]) DO
IF lhs = nSymbol[nI] THEN {action ← nAction[nI]; GO TO nFound};
ENDLOOP};
action ← ntDefaults[lhs];
EXITS
nFound => NULL;
END;
i ← i+1;
ENDLOOP;
IF (m ← top+(i-valid)) >= s.length THEN ExpandStack[256];
s[m] ← currentState ← action.transition;
EXITS
SyntaxError => {
nErrors ← nErrors + 1;
-- Collect up all the parser State and save it.
P1.ProcessError[top, inputValue];
EXIT;
};
END;
ENDLOOP;
P1.ProcessQueue[qI, top];
nErrors ← nErrors + ([nTokens~nTokens] ← P1.ScanReset[]).nErrors;
ParseReset[];
RETURN};
ExpandStack: PROC [delta: NAT] = {
oldSize: NAT = (IF s = NIL THEN 0 ELSE s.length);
newSize: NAT = oldSize + delta;
newS: P1.StateStack = zone.NEW[P1.StateSeq[newSize]];
newL: P1.LinkStack = zone.NEW[P1.LinkSeq[newSize]];
newV: P1.ValueStack = zone.NEW[P1.ValueSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO
newS[i] ← s[i]; newL[i] ← l[i]; newV[i] ← v[i] ENDLOOP;
EraseStack[];
s ← newS; l ← newL; v ← newV;
P1.AssignDescriptors[qd~q, vd~v, ld~l, pp~prodData]};
EraseStack: PROC = {
IF s # NIL THEN TRUSTED {zone.FREE[@v]; zone.FREE[@l]; zone.FREE[@s]}};
ExpandQueue: PROC [delta: NAT] = {
oldSize: NAT = (IF q = NIL THEN 0 ELSE q.length);
newSize: NAT = oldSize + delta;
newQ: P1.ActionStack = zone.NEW[P1.ActionSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO newQ[i] ← q[i] ENDLOOP;
EraseQueue[];
q ← newQ;
P1.AssignDescriptors[qd~q, vd~v, ld~l, pp~prodData]};
EraseQueue: PROC = {IF q # NIL THEN TRUSTED {zone.FREE[@q]}};
}.