<<>>
    <<WalkCParseTreesImpl.mesa>>
        <<Copyright Ó 1990 by Xerox Corporation.  All rights reserved.>>
        <<Hopcroft, July 27, 1989 11:22:51 am PDT>>
        <<Last tweaked by Mike Spreitzer on August 14, 1991 7:31 am PDT>>

    DIRECTORY
        CCirioSyntacticOperations USING [AddUnaryOp, RHSComma, RHSCond],
        CCTypes USING [CCError, CCErrorCase, GetAnyTargetType, Operator],
        CirioTypes USING [CompilerContext, Node, Type, TypedCode],
        CParser USING [CParseTree, ProductionNames],
        CirioSyntacticOperations USING [CreateParseTree, LHSDot, LHSFieldIdentifier, LHSIdentifier, ParseTree, ParseTreeFunctions, 
        RHSAssignment, RHSBinaryOp, RHSBinOpAssignment, RHSDot, RHSFieldIdentifier, RHSIdentifier, RHSLiteral, RHSUnaryOp],
        CNumericTypes USING [CreateNumericNode, CreateNumericType, NumericDescriptorBody],
        IO USING [PutFR],
        Rope USING [ROPE],
        WalkCParseTrees USING [];

    WalkCParseTreesImpl: CEDAR PROGRAM
        IMPORTS CCirioSyntacticOperations, CCTypes, CirioSyntacticOperations, CNumericTypes, IO
        EXPORTS WalkCParseTrees
    = {OPEN CCSO:CCirioSyntacticOperations, CSO:CirioSyntacticOperations;

        CC: TYPE = CirioTypes.CompilerContext;
        Type: TYPE = CirioTypes.Type;
        CCError: ERROR[case: CCTypes.CCErrorCase _ syntax, msg:Rope.ROPE _ NIL] _ CCTypes.CCError;

        CreatePPTreeParseTree: PUBLIC PROC [cptree:CParser.CParseTree, cc:CC] RETURNS [CSO.ParseTree] ~ {
            RETURN [CSO.CreateParseTree[PTF, cptree]]
            };

        PTF: REF CSO.ParseTreeFunctions _ NEW[CSO.ParseTreeFunctions _ [
            compileForRHS: CompileCPTExpForRHS,
            compileForLHS: CompileCPTExpForLHS,
            compileAsFieldExtraction: CompileCPTExpAsFieldExtraction,
            compileAsFieldSelection: CompileCPTExpAsFieldSelection]];

        CompileCPTExpForLHS: PROC [tree:CSO.ParseTree, cc:CC, data:REF ANY] RETURNS [CirioTypes.TypedCode] ~ {
            cptree: CParser.CParseTree _ NARROW[data];
            SELECT cptree.production FROM
                PostfixExpressionrecord => {
                    left:CSO.ParseTree ~ CreatePPTreeParseTree[NARROW[cptree^.children[0]], cc];
                    idTree: CParser.CParseTree ~ NARROW[cptree[1]];
                    IF idTree.production # Identifier THEN CCError[operation, "non-identifier to right of dot in LHS expression"];
                    RETURN CSO.LHSDot[left, NARROW[idTree[0]], cc]};
                Identifier => {
                    RETURN[CSO.LHSIdentifier[NARROW[cptree.children[0], Rope.ROPE], cc]]
                    };
                ENDCASE => ERROR CCError[unimplemented, IO.PutFR["Left-hand expressions using the %g production are not supported yet", 
                [rope[ProductionNameRope[cptree.production]]] ]];

            };
        CompileCPTExpForRHS: PROC [tree:CSO.ParseTree, nominalTarget:Type, cc:CC, data:REF ANY] RETURNS [CirioTypes.TypedCode] ~ {
            cptree: CParser.CParseTree _ NARROW[data];
            RhsBinary: PROC [op: CCTypes.Operator] RETURNS [CirioTypes.TypedCode] ~ {
                left:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[0]], cc];
                right:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[1]], cc];
                RETURN[CSO.RHSBinaryOp[op, left, right, cc]]};
            OpAssign: PROC [op: CCTypes.Operator] RETURNS [CirioTypes.TypedCode] ~ {
                left:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[0]], cc];
                right:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[1]], cc];
                RETURN[CSO.RHSBinOpAssignment[op, left, right, cc]]};
            SELECT cptree.production FROM
                InclusiveOrExpressionmore => RETURN RhsBinary[$bitor];
                ExclusiveOrExpressionmore => RETURN RhsBinary[$bitxor];
                AndExpressionmore => RETURN RhsBinary[$bitand];
                ShiftExpressionleft => RETURN RhsBinary[$bitshiftleft];
                ShiftExpressionright => RETURN RhsBinary[$bitshiftright];
                LogicalOrExpressionmore => RETURN RhsBinary[$or];
                LogicalAndExpressionmore => RETURN RhsBinary[$and];
                EqualityExpressionneq => RETURN RhsBinary[$ne];
                EqualityExpressioneq => RETURN RhsBinary[$eq];
                RelationalExpressionlt => RETURN RhsBinary[$lt];
                RelationalExpressiongt => RETURN RhsBinary[$gt];
                RelationalExpressionle => RETURN RhsBinary[$le];
                RelationalExpressionge => RETURN RhsBinary[$ge];
                AdditiveExpressionadd => RETURN RhsBinary[$plus];
                AdditiveExpressionsub => RETURN RhsBinary[$minus];
                MultiplicativeExpressionmul => RETURN RhsBinary[$mult];
                MultiplicativeExpressiondiv => RETURN RhsBinary[$div];
                MultiplicativeExpressionmod => RETURN RhsBinary[$mod];
                ConditionalExpressionmore => {
                    testPT: CSO.ParseTree ~ CreatePPTreeParseTree[NARROW[cptree.children[0]], cc];
                    trueCasePT: CSO.ParseTree ~ CreatePPTreeParseTree[NARROW[cptree.children[1]], cc];
                    falseCasePT: CSO.ParseTree ~ CreatePPTreeParseTree[NARROW[cptree.children[2]], cc];
                    RETURN CCSO.RHSCond[testPT, trueCasePT, falseCasePT, cc]};
                AssignmentExpressioneq => {
                    left:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[0]], cc];
                    right:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[1]], cc];
                    RETURN[CSO.RHSAssignment[left, right, cc]]
                    };
                AssignmentExpressionmuleq => RETURN OpAssign[$mult];
                AssignmentExpressiondiveq => RETURN OpAssign[$div];
                AssignmentExpressionmodeq => RETURN OpAssign[$mod];
                AssignmentExpressionaddeq => RETURN OpAssign[$plus];
                AssignmentExpressionsubeq => RETURN OpAssign[$minus];
                AssignmentExpressionshiftleq => RETURN OpAssign[$bitshiftleft];
                AssignmentExpressionshiftreq => RETURN OpAssign[$bitshiftright];
                AssignmentExpressionandeq => RETURN OpAssign[$bitand];
                AssignmentExpressionxoreq => RETURN OpAssign[$bitxor];
                AssignmentExpressionoreq => RETURN OpAssign[$bitor];
                Expressionmore => {
                    <<Note: the left subtree must be evaluated before the right so that the comma operator>>
                    <<works correctly.>>
                    left:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[0]], cc];
                    right:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[1]], cc];
                    RETURN[CCSO.RHSComma[left, right, cc]]
                    };
                CastExpressioncast, UnaryExpressionsub, UnaryExpressionbnot, UnaryExpressionlnot, UnaryExpressionptr => {
                    op:CCTypes.Operator _ SELECT cptree^.production FROM
                        CastExpressioncast => $cast,
                        UnaryExpressionsub => $minus,
                        UnaryExpressionbnot => $bitnot,
                        UnaryExpressionlnot => $not,
                        UnaryExpressionptr =>  $uparrow,
                        ENDCASE => CCError[cirioError];
                    oprnd:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[0]],cc];
                    RETURN[CSO.RHSUnaryOp[op, oprnd, cc]]
                    };
                PostfixExpressionrecord => {
                    left:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[0]], cc];
                    right:CSO.ParseTree _ CreatePPTreeParseTree[NARROW[cptree^.children[1]], cc];
                    RETURN[CSO.RHSDot[left, right, cc]];
                    };
                PostfixExpressionarray => {
                    sum: CirioTypes.TypedCode ~ RhsBinary[$plus];
                    RETURN CCSO.AddUnaryOp[sum, $uparrow, cc]};
                IntegerConstant, FloatingConstant, CharacterConstant => {
                    RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[cptree,cc],cc]]
                    };
                Identifier => {
                    RETURN[CSO.RHSIdentifier[NARROW[cptree.children[0], Rope.ROPE], CCTypes.GetAnyTargetType[cc], cc]]
                    };
                ENDCASE => ERROR CCError[unimplemented, IO.PutFR["Right-hand expressions using the %g production are not supported yet", 
                [rope[ProductionNameRope[cptree.production]]] ]];

            };

        CompileCPTExpAsFieldSelection: PROC[tree: CSO.ParseTree, fieldIndirectContext: CirioTypes.Type, cc: CC, data: REF ANY] 
        RETURNS[CirioTypes.TypedCode] =
            BEGIN
            cptree: CParser.CParseTree _ NARROW[data];
            RETURN[CSO.LHSFieldIdentifier[NARROW[cptree.children[0], Rope.ROPE], fieldIndirectContext, cc]];
            END;

        CompileCPTExpAsFieldExtraction: PROC[tree: CSO.ParseTree, fieldContext: CirioTypes.Type, cc: CC, data: REF ANY] 
        RETURNS[CirioTypes.TypedCode] =
            BEGIN
            cptree: CParser.CParseTree _ NARROW[data];
            RETURN[CSO.RHSFieldIdentifier[NARROW[cptree.children[0], Rope.ROPE], fieldContext, cc]];
            END;


        CreateNodeFromLiteral: PROC [cptree:CParser.CParseTree, cc:CC] RETURNS [CirioTypes.Node] ~ {
            type: Type _ CreateCLiteralType[cptree, cc];
            SELECT cptree^.production FROM
                IntegerConstant => 
                    RETURN[CNumericTypes.CreateNumericNode[type, 
                    NARROW[cptree^.children[0], REF INT]]];
                FloatingConstant =>
                    RETURN[CNumericTypes.CreateNumericNode[type,
                    NARROW[cptree^.children[0], REF REAL]]]; 
                CharacterConstant =>
                    RETURN[CNumericTypes.CreateNumericNode[type, 
                    NARROW[cptree^.children[0], REF CHAR]]]; 
                ENDCASE => CCTypes.CCError[unimplemented, IO.PutFR["Literals using the %g production are not supported (yet)", 
                [rope[ProductionNameRope[cptree.production]]] ]];
            };

        CreateCLiteralType: PROC [cptree:CParser.CParseTree, cc:CC] RETURNS [CirioTypes.Type] ~ {
            SELECT cptree^.production FROM
                IntegerConstant => RETURN[CNumericTypes.CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody _ [primary: signed, secondary: 
                integer]], cc, NIL]];
                FloatingConstant => RETURN[CNumericTypes.CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody _ [primary: float]], cc, NIL]];
                CharacterConstant => {
                    RETURN[CNumericTypes.CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody _ [primary: unsigned, secondary: character]], cc, 
                    NIL]]
                    };
                ENDCASE =>CCTypes.CCError[unimplemented, IO.PutFR["Literals using the %g production are not supported (yet)", 
                [rope[ProductionNameRope[cptree.production]]] ]];
            };

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

        }..