
    <<CParserimpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Hopcroft June 12, 1989 5:57:12 pm PDT>>
        <<Coolidge, July 12, 1990 3:52 pm PDT>>
        <<Laurie Horton, November 8, 1991 4:02 pm PST>>

    DIRECTORY
        Commander USING[CommandProc, Register],
        CParser USING [CParseTree, CParseTreeBody, ProductionNames],
        IO USING[char, Close, EndOfStream,  GetTokenRope, IDProc, int, PutF, real, RIS, rope, STREAM, TokenKind],
        Lexer USING [GetCTokenInit, GetCTokenRope, GetCTokenRopeAndValue],
        OneCasabaParser USING[BuildParserTableFromKipperedStream, GetReportStream, Parse, ParserTable],
        PFS USING [PathFromRope, StreamOpen],
        PFSNames USING [PATH],
        Rope USING[Length, ROPE, Substr];

    CParserImpl: CEDAR PROGRAM
        IMPORTS Commander, IO, Lexer, OneCasabaParser, PFS, Rope
        EXPORTS CParser ~ {

        ROPE: TYPE ~ Rope.ROPE;


        ParseFromFile: Commander.CommandProc ~ {
            parseTree: CParser.CParseTree;
            filename:PFSNames.PATH;
            sourceStream:IO.STREAM;
            commandLineStream: IO.STREAM _ IO.RIS[cmd.commandLine];
            tableStream: IO.STREAM _ PFS.StreamOpen[PFS.PathFromRope["c.kipperedParseTables"]];
            table: OneCasabaParser.ParserTable _ OneCasabaParser.BuildParserTableFromKipperedStream[tableStream];
            IO.Close[tableStream];
            filename _ PFS.PathFromRope[IO.GetTokenRope[commandLineStream,IO.IDProc].token];
            IO.Close[commandLineStream];
            sourceStream _ PFS.StreamOpen[filename];
            parseTree _ MakeCParseTree[table, sourceStream, cmd.out];
            PrintParseTree[cmd.out, parseTree];
            };

        ProductionNameRopes: ARRAY [0..ORD[LAST[CParser.ProductionNames]]] OF Rope.ROPE = ["Start", "PrintResult", "Expressionone", 
        "Expressionmore", "AssignmentExpressioncond", "AssignmentExpressioneq", "AssignmentExpressionmuleq", 
        "AssignmentExpressiondiveq", "AssignmentExpressionmodeq", "AssignmentExpressionaddeq", "AssignmentExpressionsubeq", 
        "AssignmentExpressionshiftleq", "AssignmentExpressionshiftreq", "AssignmentExpressionandeq", "AssignmentExpressionxoreq", 
        "AssignmentExpressionoreq", "ConditionalExpressionone", "ConditionalExpressionmore", "LogicalOrExpressionone", 
        "LogicalOrExpressionmore", "LogicalAndExpressionone", "LogicalAndExpressionmore", "InclusiveOrExpressionone", 
        "InclusiveOrExpressionmore", "ExclusiveOrExpressionone", "ExclusiveOrExpressionmore", "AndExpressionone", 
        "AndExpressionmore", "EqualityExpressionrel", "EqualityExpressioneq", "EqualityExpressionneq", "RelationalExpressionone", 
        "RelationalExpressionlt", "RelationalExpressiongt", "RelationalExpressionle", "RelationalExpressionge", 
        "ShiftExpressionadd", "ShiftExpressionleft", "ShiftExpressionright", "AdditiveExpressionmul", "AdditiveExpressionadd", 
        "AdditiveExpressionsub", "MultiplicativeExpressioncast", "MultiplicativeExpressionmul", "MultiplicativeExpressiondiv", 
        "MultiplicativeExpressionmod", "CastExpressionunary", "CastExpressioncast", "UnaryExpressionpost", "UnaryExpressioninc", 
        "UnaryExpressiondec", "UnaryExpressionand", "UnaryExpressionptr", "UnaryExpressionadd", "UnaryExpressionsub", 
        "UnaryExpressionbnot", "UnaryExpressionlnot", "UnaryExpressionsizeexpr", "UnaryExpressionsizetype", 
        "PostfixExpressionprimary", "PostfixExpressionarray", "PostfixExpressioncall", "PostfixExpressionrecord", 
        "PostfixExpressionrecptr", "PostfixExpressioninc", "PostfixExpressiondec", "PrimaryExpressionid", "PrimaryExpressionconst", 
        "PrimaryExpressionstring", "PrimaryExpressionparen", "TypeNamevoid", "TypeNamechar", "TypeNameshort", "TypeNameint", 
        "TypeNamelong", "TypeNamefloat", "TypeNamedouble", "TypeNamesigned", "TypeNameunsigned", "ArgumentExpressionListone", 
        "ArgumentExpressionListmore", "Constantint", "Constantchar", "Constantfloat", "Constantenum",

            <<Terminal type names must be added after the production type elements>>
            "IntegerConstant", "CharacterConstant", "FloatingConstant", "String", "Identifier"];

        MakeCParseTree: PUBLIC PROC[table: OneCasabaParser.ParserTable, source: IO.STREAM, out:IO.STREAM] RETURNS [parseTree: 
        CParser.CParseTree] ~ {
            partialValues: LIST OF CParser.CParseTree _ NIL;
            textPosition: INT _ 0;
            newSource: IO.STREAM _ source;
            newOut:IO.STREAM _ out;

            SupplySourceToken: PROC RETURNS [tokenKind: IO.TokenKind, tokenText: ROPE, position: INT] ~ {
                charsSkipped: INT;
                <<temp:Rope.ROPE;>>
                WHILE TRUE DO
                    [tokenKind, tokenText, charsSkipped] _ Lexer.GetCTokenRope[newSource, FALSE
                        ! IO.EndOfStream => {
                            tokenKind _ tokenEOF;
                            tokenText _ "";
                            charsSkipped _ 0;
                            CONTINUE}
                        ];
                    textPosition _ textPosition + charsSkipped;
                    position _ textPosition;
                    textPosition _ textPosition + Rope.Length[tokenText];

                    <<temp _ SELECT tokenKind FROM>>
                        <<tokenDECIMAL => "tokenDECIMAL",>>
                        <<tokenCHAR => "tokenCHAR",>>
                        <<tokenREAL => "tokenREAL",>>
                        <<tokenROPE => "tokenROPE",>>
                        <<tokenID => "tokenID",>>
                        <<tokenEOF => "tokenEOF",>>
                        <<tokenERROR => "tokenERROR",>>
                        <<tokenSINGLE => "tokenSINGLE",>>
                        <<tokenDOUBLE => "tokenDOUBLE",>>
                        <<tokenCOMMENT => "tokenCOMMENT",>>
                        <<tokenOCTAL => "tokenOCTAL",>>
                        <<tokenHEX => "tokenHEX",>>
                        <<ENDCASE => "Unknown";>>
                    <<IO.PutF[newOut,"token: %g = %g\n",>>
                        <<IO.rope[temp],>>
                        <<IO.rope[tokenText]];>>

                    IF tokenKind # tokenCOMMENT THEN RETURN [tokenKind, tokenText, position];
                    ENDLOOP

                };

            SeeGenericShift: PROC [code: CARDINAL, kind: IO.TokenKind, text: ROPE, firstCharPosition: INT] ~ {
                temp:CParser.CParseTree;
                textStream:IO.STREAM _ IO.RIS[text];
                tokenKind:IO.TokenKind;
                tokenValue:REF ANY;
                charsSkipped:INT;
                token:Rope.ROPE;
                [tokenKind, token, charsSkipped, tokenValue] _ Lexer.GetCTokenRopeAndValue[textStream, FALSE];
                IO.Close[textStream];
                SELECT tokenKind FROM
                    tokenDECIMAL => {
                        temp _ NEW[CParser.CParseTreeBody[1]] ;
                        <<_ [production:IntegerConstant, children:NULL]];>>
                        temp^.production _ IntegerConstant;
                        temp^.children[0] _ tokenValue;
                        partialValues _ CONS[temp, partialValues];
                        };
                    tokenCHAR => {
                        temp _ NEW[CParser.CParseTreeBody[1]];
                        <<_ [production:CharacterConstant, children:NULL]];>>
                        temp^.production _ CharacterConstant;
                        temp^.children[0] _ tokenValue;
                        partialValues _ CONS[temp, partialValues];
                        };
                    tokenREAL => {
                        temp _ NEW[CParser.CParseTreeBody[1]];
                        <<_ [production:FloatingConstant, children:NULL]];>>
                        temp^.production _ FloatingConstant;
                        temp^.children[0] _ tokenValue;
                        partialValues _ CONS[temp, partialValues];
                        };
                    tokenROPE => {
                        temp _ NEW[CParser.CParseTreeBody[1]];
                        <<_ [production:String, children:NULL]];>>
                        temp^.production _ String;
                        temp^.children[0] _ tokenValue;
                        partialValues _ CONS[temp, partialValues];
                        };
                    tokenID => {
                        temp _ NEW[CParser.CParseTreeBody[1]];
                        <<_ [production:Identifier, children:NULL]];>>
                        temp^.production _ Identifier;
                        temp^.children[0] _ text;
                        partialValues _ CONS[temp, partialValues]
                        };
                    ENDCASE => ERROR;
                <<IO.PutF[newOut,"Generic shift %g = %g\n",
                IO.rope[ProductionNameRopes[ORD[temp^.production]]],
                IO.rope[NARROW[temp^.children[0],Rope.ROPE]]]>>
                };

            SeeReduce: PROC[rule: CARDINAL, firstCharPosition: INT, length: INT] ~ {
                temp:CParser.CParseTree;
                SELECT CParser.ProductionNames[VAL[rule]] FROM
                    <<Two operand productions:>>
                    Expressionmore, AssignmentExpressioneq, AssignmentExpressionmuleq,
                    AssignmentExpressiondiveq,
                    AssignmentExpressionmodeq, AssignmentExpressionaddeq, AssignmentExpressionsubeq,
                    AssignmentExpressionshiftleq, AssignmentExpressionshiftreq,
                    AssignmentExpressionandeq, AssignmentExpressionxoreq, AssignmentExpressionoreq,
                    LogicalOrExpressionmore,  LogicalAndExpressionmore, InclusiveOrExpressionmore,
                    ExclusiveOrExpressionmore, AndExpressionmore, EqualityExpressioneq,
                    EqualityExpressionneq, RelationalExpressionlt, RelationalExpressiongt,
                    RelationalExpressionle, RelationalExpressionge, ShiftExpressionleft,
                    ShiftExpressionright, AdditiveExpressionadd, AdditiveExpressionsub,
                    MultiplicativeExpressionmul, MultiplicativeExpressiondiv,
                    MultiplicativeExpressionmod,  CastExpressioncast, 
                    PostfixExpressionarray, PostfixExpressioncall, PostfixExpressionrecord,
                    PostfixExpressionrecptr, ArgumentExpressionListmore => {
                        <<IO.PutF[newOut,"Two operand\n"];>>
                        temp _ NEW[CParser.CParseTreeBody[2]];
                        << _ [production:ProductionNames[VAL[rule]], children:NULL]];>>
                        temp^.production _ CParser.ProductionNames[VAL[rule]];
                        temp^.children[1] _ partialValues.first;
                        temp^.children[0] _ partialValues.rest.first;
                        partialValues _ CONS[temp, partialValues.rest.rest]
                        };
                    <<One operand productions:>>
                    UnaryExpressioninc, UnaryExpressiondec, UnaryExpressionand, UnaryExpressionptr,
                    UnaryExpressionsub, UnaryExpressionbnot, UnaryExpressionlnot,
                    UnaryExpressionsizeexpr, UnaryExpressionsizetype, PostfixExpressioninc,
                    PostfixExpressiondec => {
                        temp _ NEW[CParser.CParseTreeBody[1]];
                        << _ [production:ProductionNames[VAL[rule]], children:NULL]];>>
                        temp^.production _ CParser.ProductionNames[VAL[rule]];
                        temp^.children[0] _ partialValues.first;
                        partialValues _ CONS[temp, partialValues.rest]
                        };
                    <<No operand productions:>>
                    Start, TypeNamevoid, TypeNamechar, TypeNameshort, TypeNameint, TypeNamelong,
                    TypeNamefloat, TypeNamedouble, TypeNamesigned, TypeNameunsigned, UnaryExpressionadd => {
                        temp _ NEW[CParser.CParseTreeBody[0]];
                        << _ [production:ProductionNames[VAL[rule]], children:NULL]];>>
                        temp^.production _ CParser.ProductionNames[VAL[rule]];
                        partialValues _ CONS[temp, partialValues]
                        };
                    <<Three operand productions:>>
                    ConditionalExpressionmore => {
                        temp _ NEW[CParser.CParseTreeBody[3]];
                        << _ [production:ProductionNames[VAL[rule]], children:NULL]];>>
                        temp^.production _ CParser.ProductionNames[VAL[rule]];
                        temp^.children[2] _ partialValues.first;
                        temp^.children[1] _ partialValues.rest.first;
                        temp^.children[0] _ partialValues.rest.rest.first;
                        partialValues _ CONS[temp, partialValues.rest.rest.rest]
                        };
                    <<No operation productions:>>
                    PrintResult, Expressionone, AssignmentExpressioncond, 
                    ConditionalExpressionone, 
                    LogicalOrExpressionone, LogicalAndExpressionone,
                    InclusiveOrExpressionone, ExclusiveOrExpressionone,
                    AndExpressionone, EqualityExpressionrel, RelationalExpressionone,
                    ShiftExpressionadd, AdditiveExpressionmul, MultiplicativeExpressioncast,
                    CastExpressionunary, UnaryExpressionpost, PostfixExpressionprimary,
                    PrimaryExpressionid, PrimaryExpressionconst, 
                    PrimaryExpressionstring, PrimaryExpressionparen, ArgumentExpressionListone,
                    Constantint, Constantchar, Constantfloat, Constantenum => {};
                    ENDCASE => ERROR;
                    <<IO.PutF[newOut,"Reduce rule %g\n",IO.rope[ProductionNameRopes[ORD[rule]]]]>>
                };

            Lexer.GetCTokenInit[];
            [] _ OneCasabaParser.Parse[table, SupplySourceToken, SeeReduce, SeeGenericShift, NIL
                ! OneCasabaParser.GetReportStream => RESUME[out]
                ];
            parseTree _  partialValues.first;
            RETURN[parseTree]
            };

        SpaceRope: PROC [i:INT] RETURNS [r:Rope.ROPE] ~ {
            template:Rope.ROPE = "                                                                               ";
            RETURN [Rope.Substr[template, 0, i]]
            };

        PrintParseTree: PUBLIC PROC [outStream:IO.STREAM, parseTree:REF ANY, depth:INT _ 0] RETURNS [] ~ {
            IF parseTree # NIL THEN {
                IO.PutF[outStream,"%g%g", IO.rope[SpaceRope[depth]], 
                IO.rope[ProductionNameRopes[ORD[NARROW[parseTree, CParser.CParseTree]^.production]]]];
                SELECT NARROW[parseTree, CParser.CParseTree]^.production FROM
                    <<Two operand productions:>>
                    Expressionmore, AssignmentExpressioneq, AssignmentExpressionmuleq,
                    AssignmentExpressiondiveq,
                    AssignmentExpressionmodeq, AssignmentExpressionaddeq, AssignmentExpressionsubeq,
                    AssignmentExpressionshiftleq, AssignmentExpressionshiftreq,
                    AssignmentExpressionandeq, AssignmentExpressionxoreq, AssignmentExpressionoreq,
                    LogicalOrExpressionmore,  LogicalAndExpressionmore, InclusiveOrExpressionmore,
                    ExclusiveOrExpressionmore, AndExpressionmore, EqualityExpressioneq,
                    EqualityExpressionneq, RelationalExpressionlt, RelationalExpressiongt,
                    RelationalExpressionle, RelationalExpressionge, ShiftExpressionleft,
                    ShiftExpressionright, AdditiveExpressionadd, AdditiveExpressionsub,
                    MultiplicativeExpressionmul, MultiplicativeExpressiondiv,
                    MultiplicativeExpressionmod,  CastExpressioncast, 
                    PostfixExpressionarray, PostfixExpressioncall, PostfixExpressionrecord,
                    PostfixExpressionrecptr, ArgumentExpressionListmore => {
                        IO.PutF[outStream,"\n"];
                        PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[0], depth+2];
                        PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[1], depth+2];
                        };
                    <<One operand productions:>>
                    UnaryExpressioninc, UnaryExpressiondec, UnaryExpressionand, UnaryExpressionptr,
                    UnaryExpressionsub, UnaryExpressionbnot, UnaryExpressionlnot,
                    UnaryExpressionsizeexpr, UnaryExpressionsizetype, PostfixExpressioninc,
                    PostfixExpressiondec, PrimaryExpressionparen => {
                        IO.PutF[outStream,"\n"];
                        PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[0], depth+2]
                        };
                    <<No operand productions:>>
                    Start, TypeNamevoid, TypeNamechar, TypeNameshort, TypeNameint, TypeNamelong,
                    TypeNamefloat, TypeNamedouble, TypeNamesigned, TypeNameunsigned => {
                        IO.PutF[outStream,"\n"]
                        };
                    <<Three operand productions:>>
                    ConditionalExpressionmore => {
                        IO.PutF[outStream,"\n"];
                        PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[0], depth+2];
                        PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[1], depth+2];
                        PrintParseTree[outStream, NARROW[parseTree, CParser.CParseTree]^.children[2], depth+2]
                        };
                    <<No operation productions:>>
                    PrintResult, Expressionone, AssignmentExpressioncond, 
                    ConditionalExpressionmore,
                    LogicalOrExpressionone, LogicalAndExpressionone,
                    InclusiveOrExpressionone, ExclusiveOrExpressionone,
                    AndExpressionone, EqualityExpressionrel, RelationalExpressionone,
                    ShiftExpressionadd, AdditiveExpressionmul, MultiplicativeExpressioncast,
                    CastExpressionunary, UnaryExpressionpost, PostfixExpressionprimary,
                    PrimaryExpressionid, PrimaryExpressionconst, 
                    PrimaryExpressionstring, PrimaryExpressionparen, ArgumentExpressionListone,
                    Constantint, Constantchar, Constantfloat, Constantenum => ERROR;
                    <<Terminals>>
                    IntegerConstant => 
                        IO.PutF[outStream," = %g\n", IO.int[NARROW[NARROW[parseTree, CParser.CParseTree]^.children[0], REF INT]^]];
                    CharacterConstant =>
                        IO.PutF[outStream," = %g\n", IO.char[NARROW[NARROW[parseTree, CParser.CParseTree]^.children[0], REF CHAR]^]];
                    FloatingConstant =>
                        IO.PutF[outStream," = %g\n", IO.real[NARROW[NARROW[parseTree, CParser.CParseTree]^.children[0], REF REAL]^]];
                    String =>
                        IO.PutF[outStream," = %g\n", IO.rope[NARROW[NARROW[parseTree, CParser.CParseTree].children[0], Rope.ROPE]]];
                    Identifier =>
                        IO.PutF[outStream," = %g\n", IO.rope[NARROW[NARROW[parseTree, CParser.CParseTree].children[0], Rope.ROPE]]]
                    ENDCASE => ERROR
                    }
            ELSE 
                IO.PutF[outStream,"Empty tree\n"]
        };
    <<main code>>

    Commander.Register["Parse", ParseFromFile];

    }...