ThreeC4SupportImpl.mesa: October 1, 1985 9:43:28 am PDT
Copyright Ó 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Sturgis, May 9, 1986 4:07:38 pm PDT
Bill Jackson (bj) October 19, 1988 4:32:29 pm PDT
DIRECTORY
Basics USING [ BITAND ],
IO USING [ card, Close, EndOfStream, GetCedarTokenRope, PutF, rope, STREAM, TokenKind ],
OneCasabaParser USING [ GetSourceTokenProc, Parse, ParserTable, ShowGenericShiftProc, ShowReduceProc ],
Rope USING [ Length, ROPE, Substr ],
ThreeC4Support USING [ LinkProcType, SeeProdLinkArray, SeeProdLinkArrayBody, TokenLinkArray, TokenLinkArrayBody, ShowParseSteps ];
ThreeC4SupportImpl: CEDAR PROGRAM
IMPORTS Basics, IO, OneCasabaParser, Rope
EXPORTS ThreeC4Support ~ {
OPEN ThreeC4Support;
ROPE: TYPE ~ Rope.ROPE;
GetSourceInfo: PUBLIC SIGNAL RETURNS [ sourcePosition, sourceLength: INT ] ~ CODE;
GetReportStream: PUBLIC SIGNAL RETURNS [ stream: IO.STREAM ] ~ CODE;
ParseOneStream: PUBLIC PROC [ from: IO.STREAM, table: OneCasabaParser.ParserTable, setUpLinks: LinkProcType, nProductions: INT, debugFlags: NAT, debuggingTextTo: IO.STREAM ] RETURNS [ REF ANY ] ~ {
StuffCase: TYPE ~ { shift, reduction, trying };
Stuff: TYPE ~ RECORD [ doing: StuffCase, code: NAT, text: ROPE ];
charPosition: INT ← 0;
genericTokenLinkArray: TokenLinkArray ← NEW[TokenLinkArrayBody];
last100Index: NAT ← 1;
Last100: ARRAY [1..100] OF REF Stuff;
prodLinkArray: SeeProdLinkArray ← NEW[SeeProdLinkArrayBody[nProductions]];
stack: LIST OF REF ANY ← NIL;
Record: PROC [ case: StuffCase, code: NAT, text: ROPE ] ~ {
IF ( Last100[last100Index] = NIL ) THEN Last100[last100Index] ← NEW[Stuff];
Last100[last100Index]^ ← [case, code, text];
last100Index ← IF ( last100Index < 100 ) THEN last100Index.SUCC ELSE 1;
};
GetSourceToken: OneCasabaParser.GetSourceTokenProc ~ {
charsSkipped: NAT;
DO
[tokenKind, tokenText, charsSkipped] ← from.GetCedarTokenRope[FALSE
! IO.EndOfStream => {
tokenKind ← tokenEOF;
tokenText ← "tokenEOF";
charsSkipped ← 0; -- this last is a lie
CONTINUE;
}
];
charPosition ← position ← charPosition + charsSkipped;
charPosition ← charPosition + tokenText.Length[];
IF ( tokenKind # tokenCOMMENT )
THEN RETURN[tokenKind, tokenText, position];
ENDLOOP;
RETURN[tokenKind, tokenText, position] -- implicit
};
SeeGenericShift: OneCasabaParser.ShowGenericShiftProc ~ {
IF ( Basics.BITAND[debugFlags, ShowParseSteps] # 0 )
THEN debuggingTextTo.PutF["\tshift %g:%g\n", IO.card[code], IO.rope[text] ]
ELSE Record[shift, code, text];
IF ( kind # tokenROPE )
THEN stack ← CONS[genericTokenLinkArray[kind][text, firstCharPosition], stack]
ELSE {
withoutQuotes: ROPE ← text.Substr[1, text.Length[]-2];
stack ← CONS[genericTokenLinkArray[kind][withoutQuotes, firstCharPosition.SUCC], stack]
};
};
SeeReduction: OneCasabaParser.ShowReduceProc ~ {
IF ( Basics.BITAND[debugFlags, ShowParseSteps] # 0 )
THEN debuggingTextTo.PutF["\treduce by %g\n", IO.card[rule]]
ELSE Record[reduction, rule, ""];
stack ← prodLinkArray.links[rule][stack, firstCharPosition, length];
};
setUpLinks[prodLinkArray, genericTokenLinkArray];
[] ← OneCasabaParser.Parse[table, GetSourceToken, SeeReduction, SeeGenericShift];
from.Close[];
RETURN[stack.first];
};
}.