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]; }; }. 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 RETURN[tokenKind, tokenText, position] -- implicit ΚŒ˜codešœ4Οk™7KšœH™HKšœ ™#K™1K™—š ˜ Kšœœœ˜Kšœœ;œ˜XKšœœQ˜gKšœœ œ ˜$Kšœœm˜‚K˜—šΟnœœ˜!Kšœ œ˜)Kšœ˜Kšœ˜Kšœœœ˜K˜Kšž œœœœœœœ˜RKšžœœœœœœœœ˜DK˜šΠbnœœœ œœNœœœœœœœ˜ΕKšœ œ ˜/Kšœœœœ˜AKšœœ˜Kšœ(œ˜@Kšœœ˜Kšžœœ œœ˜%Kšœ"œ%˜JKš œœœœœœ˜K˜šžœœœœ˜;Kšœœœœ˜KK˜,Kš œœœœœ˜GKšœ˜K˜—šŸœ(˜6Kšœœ˜š˜šœ>˜Cšœœ˜Kšœ˜K˜KšœΟc˜'Kšœ˜ Kšœ˜—Kšœ˜—Kšœ6˜6K˜1Kšœœœ!˜LKšœ˜—Kšœ!  ™2Kšœ˜K˜—šžœ*˜9Kš œ œ"œ)œ œ œ˜ šœ˜Kšœ œ=˜Nšœ˜Kšœœ#˜6Kšœœ>œ ˜XKšœ˜——Kšœ˜K˜—šž œ$˜0Kš œ œ"œ*œ œ˜“K˜DKšœ˜K˜—K˜1KšœQ˜QKšœ ˜ Kšœ˜Kšœ˜K˜—Kšœ˜K˜——…— b