<> <> <> <> <<>> 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; <> }; 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]; }; }.