<<>>
    <<CirioSyntacticOperationsImpl.mesa>>
        <<Copyright Ó 1990 by Xerox Corporation.  All rights reserved.>>
        <<Sturgis, March 5, 1989 4:13:52 pm PST>>
        <<Last changed by Theimer on August 9, 1989 11:58:40 pm PDT>>
        <<Hopcroft July 26, 1989 11:02:10 am PDT>>
        <<Last tweaked by Mike Spreitzer on May 3, 1991 2:17 pm PDT>>
    <<>>
    <<Started: November 5, 1988 3:31:32 pm PST>>
    <<Sturgis: November 5, 1988 3:51:33 pm PST>>
    <<>>
    DIRECTORY
        CCTypes USING[Apply, ApplyOperand, BinaryOp, BinaryOperandTypes, BinaryTargetTypes, CCError, CCErrorCase, CoerceToType, Conforms, 
        Constructor, ExtractIdField, GetBooleanType, GetAnyTargetType, GetRTargetType, GetIndirectType, Index, IndexOperand, Load, 
        LoadIdVal, NAryOp, NAryOperandType, Operand, Operator, PairConstructor, SelectIdField, Storable, Store, TypeOp, TypeOp2, 
        TypeOp2OperandType, UnaryOp],
        CedarCode USING[ConcatCode, CodeToLoadContentsOfAMNode, CodeToLoadGlobalFrame, CodeToPop, CopyCode, GetTypeOfNode, NullCode],
        CedarCodeExtras USING [CodeToDoPoppedCond],
        CCirioSyntacticOperations,
        CirioSyntacticOperations USING[NameArgPair, ParseTreeFunctions],
        CirioTypes USING[Code, CompilerContext, Node, Type, TypedCode],
        RefTypes USING[CreateNilRefNode],
        Rope USING[ROPE];

    CirioSyntacticOperationsImpl: CEDAR PROGRAM
        IMPORTS CCTypes, CedarCode, CedarCodeExtras, RefTypes
        EXPORTS CCirioSyntacticOperations, CirioSyntacticOperations, CirioTypes, CedarCode
    = BEGIN OPEN CCTypes, CirioTypes;

    CCE: ERROR[case: CCTypes.CCErrorCase _ syntax, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;
    <<>>
    <<We begin with the objectized ParseTree implementation>>
    <<>>
    ParseTree: TYPE = REF ParseTreeBody;
    ParseTreeBody: PUBLIC TYPE = RECORD[
        functions: REF ParseTreeFunctions,
        data: REF ANY];

    ParseTreeFunctions: TYPE = CirioSyntacticOperations.ParseTreeFunctions;

    CreateParseTree: PUBLIC PROC[functions: REF ParseTreeFunctions, data: REF ANY] RETURNS[ParseTree] =
        {RETURN[NEW[ParseTreeBody_[functions, data]]]};

    NilParseTree: PUBLIC PROC [tree: ParseTree] RETURNS [BOOLEAN] =
        {RETURN [tree.data = NIL]};

    CompileForRHS: PUBLIC PROC[tree: ParseTree, nominalTarget: CirioTypes.Type, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[tree.functions.compileForRHS[tree, nominalTarget, cc, tree.data]]};

    CompileForLHS: PUBLIC PROC[tree: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[tree.functions.compileForLHS[tree, cc, tree.data]]};

    CompileAsFieldExtraction: PUBLIC PROC[tree: ParseTree, fieldContext: CirioTypes.Type, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[tree.functions.compileAsFieldExtraction[tree, fieldContext, cc, tree.data]]};

    CompileAsFieldSelection: PUBLIC PROC[tree: ParseTree, fieldIndirectContext: CirioTypes.Type, cc: CompilerContext] 
    RETURNS[TypedCode] =
        {RETURN[tree.functions.compileAsFieldExtraction[tree, fieldIndirectContext, cc, tree.data]]};

    ShowParseTree: PUBLIC PROC [tree: ParseTree, cc: CompilerContext] RETURNS [Rope.ROPE] = {RETURN [tree.functions.showParseTree[tree, 
    cc, tree.data]]};


    <<Following are the general syntactic operations>>

    RHSBinaryOp: PUBLIC PROC[op: Operator, left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        <<op one of: plus, minus, div, mult, mod, le, lt, eq, gt, ge, and, or>>
        BEGIN
        leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
        rightTC: TypedCode _ CompileForRHS[right, leftTC.type, cc];
        tc1: TypedCode _ Operand[op, left, leftTC, cc];
        tc2: TypedCode _ Operand[op, right, rightTC, cc];
        targetTypes: BinaryTargetTypes _ BinaryOperandTypes[op, tc1.type, tc2.type, cc];
        tc3: TypedCode _ CoerceToType[targetTypes.tLeft, tc1, cc];
        tc4: TypedCode _ CoerceToType[targetTypes.tRight, tc2, cc];
        RETURN[BinaryOp[op, tc3, tc4, cc]]; 
        END;

    RHSUnaryOp: PUBLIC PROC[op: Operator, arg: ParseTree, cc: CompilerContext] RETURNS[TypedCode] ~ {
        argTC: TypedCode _ SELECT op FROM
            $address => CompileForLHS[arg, cc],
            ENDCASE => CompileForRHS[arg, GetAnyTargetType[cc], cc];
        RETURN AddUnaryOp[argTC, op, cc]};

    AddUnaryOp: PUBLIC PROC [argTC: TypedCode, op: Operator, cc: CompilerContext] RETURNS [TypedCode] ~ {
        tc1: TypedCode ~ Operand[op, unary, argTC, cc];
        RETURN[UnaryOp[op, tc1, cc]]};

    RHSnAryOp: PUBLIC PROC[op: Operator, args: LIST OF ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        <<op one of: max, min>>
        <<assumes that args is NOT empty>>
        BEGIN
        tcs1: LIST OF TypedCode _ NIL;
        tcs1Last: LIST OF TypedCode _ NIL;
        tType: Type;
        argCode: LIST OF TypedCode _ NIL;
        lastArgCode: LIST OF TypedCode _ NIL;


        FOR lpt: LIST OF ParseTree _ args, lpt.rest WHILE lpt # NIL DO
            tc: TypedCode _ CompileForRHS[lpt.first, GetAnyTargetType[cc], cc];
            tc1: TypedCode _ Operand[op, nary, tc, cc];
            tc1Cell: LIST OF TypedCode _ LIST[tc1];
            IF tcs1 = NIL THEN tcs1 _ tc1Cell ELSE tcs1Last.rest _ tc1Cell;
            tcs1Last _ tc1Cell;
            ENDLOOP;

        tType _ NAryOperandType[op, tcs1.first.type, tcs1.first.type, cc];

        FOR ltc: LIST OF TypedCode _ tcs1.rest, ltc.rest WHILE ltc # NIL DO
            tType _ NAryOperandType[op, tType, ltc.first.type, cc];
            ENDLOOP;

        FOR ltc: LIST OF TypedCode _ tcs1, ltc.rest WHILE ltc # NIL DO
            argtc: TypedCode _ CoerceToType[tType, ltc.first, cc];
            cell: LIST OF TypedCode _ LIST[argtc];
            IF argCode = NIL THEN argCode _ cell ELSE lastArgCode.rest _ cell;
            lastArgCode _ cell;
            ENDLOOP;

        RETURN[NAryOp[op, argCode, cc]];
        END;

    RHSTypeOp: PUBLIC PROC[op: Operator, type: Type, cc: CompilerContext] RETURNS[TypedCode] =
        <<op one of: size, bits, bytes, units, words, first, last>>
        BEGIN
        RETURN[TypeOp[op, type, cc]];
        END;

    RHSTypeOp2: PUBLIC PROC[op: Operator, type: Type, param: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        eType: Type _ TypeOp2OperandType[op, type, cc];
        paramTC: TypedCode _ CompileForRHS[param, eType, cc];
        tc1: TypedCode _ CoerceToType[eType, paramTC, cc];
        RETURN[TypeOp2[op, type, tc1, cc]];
        END;

    RHSAssignment: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        ltc1: TypedCode _ CompileForLHS[left, cc];
        storageType: Type _ CCTypes.GetRTargetType[ltc1.type, cc];
        rtc1: TypedCode _ CompileForRHS[right, storageType, cc];
        targetTypes: BinaryTargetTypes _ BinaryOperandTypes[$assign, ltc1.type, rtc1.type, cc];
        ltc2: TypedCode _ CoerceToType[targetTypes.tLeft, ltc1, cc];
        rtc2: TypedCode _ CoerceToType[targetTypes.tRight, rtc1, cc];
        IF NOT Storable[rtc2.type, ltc2.type, cc] THEN CCE[cirioError, "not storable"];
        RETURN[Store[rtc2, ltc2, cc]];
        END;

    RHSBinOpAssignment: PUBLIC PROC[op: Operator, left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        ltc1l: TypedCode _ CompileForLHS[left, cc];
        ltc1r: TypedCode _ Load[[CedarCode.CopyCode[ltc1l.code], ltc1l.type], cc];
        storageType: Type _ CCTypes.GetRTargetType[ltc1l.type, cc];
        rtc1: TypedCode _ CompileForRHS[right, storageType, cc];
        tcOpL1: TypedCode ~ Operand[op, left, ltc1r, cc];
        tcOpR1: TypedCode ~ Operand[op, right, rtc1, cc];
        opTypes: BinaryTargetTypes _ BinaryOperandTypes[op, tcOpL1.type, tcOpR1.type, cc];
        ltc2r: TypedCode _ CoerceToType[opTypes.tLeft, ltc1r, cc];
        rtc2: TypedCode _ CoerceToType[opTypes.tRight, rtc1, cc];
        otc1: TypedCode _ BinaryOp[op, ltc2r, rtc2, cc];
        asgnTypes: BinaryTargetTypes _ BinaryOperandTypes[$assign, ltc1l.type, otc1.type, cc];
        ltc2l: TypedCode _ CoerceToType[asgnTypes.tLeft, ltc1l, cc];
        otc2: TypedCode _ CoerceToType[asgnTypes.tRight, otc1, cc];
        IF NOT Storable[rtc2.type, ltc2l.type, cc] THEN CCE[cirioError];
        RETURN[Store[otc2, ltc2l, cc]];
        END;

    RHSDot: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
        tc1: TypedCode _ Operand[$dot, unary, leftTC, cc];
        rightTC: TypedCode _ CompileAsFieldExtraction[right, tc1.type, cc];
        RETURN[[CedarCode.ConcatCode[tc1.code, rightTC.code], rightTC.type]];
        END;

    RHSApply: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
        ltc1: TypedCode _ Operand[$apply, left, leftTC, cc];
        rtc1: TypedCode _ ApplyOperand[ltc1.type, right, cc];
        RETURN[Apply[ltc1, rtc1, cc]];
        END;

    RHSCons: PUBLIC PROC [list: ParseTree, targetType: Type, cc: CompilerContext] RETURNS [TypedCode] =
        BEGIN
        ltc: TypedCode _ TypeOp[$cons, targetType, cc];
        rtc: TypedCode _ ApplyOperand[targetType, list, cc];
        RETURN [Apply[ltc, rtc, cc]];
        END;

    RHSConstructor: PUBLIC PROC[list: LIST OF ParseTree, targetType: Type, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[CCTypes.Constructor[list, targetType, cc]]};

    RHSPairConstructor: PUBLIC PROC[list: LIST OF CirioSyntacticOperations.NameArgPair, targetType: Type, cc: CompilerContext] 
    RETURNS[TypedCode] =
        {RETURN[CCTypes.PairConstructor[list, targetType, cc]]};

        <<why is this different from dot?  similar questions apply to LHSFieldIdentifier.>>
    RHSFieldIdentifier: PUBLIC PROC[id: Rope.ROPE, fieldContext: Type, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        tc1: TypedCode _ Operand[$extractId, unary, [CedarCode.NullCode[], fieldContext], cc];
        tc2: TypedCode _ ExtractIdField[id, tc1.type, cc];
        code: Code _ CedarCode.ConcatCode[tc1.code, tc2.code];
        RETURN[[code, tc2.type]];
        END;
            <<>>
    RHSIdentifier: PUBLIC PROC[id: Rope.ROPE, targetType: Type, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[LoadIdVal[id, targetType, cc]]};

        <<We choose an implementation which is insensitive to the pointer type, now that we have a NIL REF TYPE.  The old implementation 
        depended on a Type Proc called LoadNil, which was specific to each pointer type.>>
    RHSNil: PUBLIC PROC[pointerType: Type, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[RHSLiteral[RefTypes.CreateNilRefNode[cc], cc]]};

    RHSLiteral: PUBLIC PROC[literalValue: CirioTypes.Node, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        code: CirioTypes.Code _ CedarCode.CodeToLoadContentsOfAMNode[literalValue];
        type: Type _ CedarCode.GetTypeOfNode[literalValue];
        RETURN[[code, type]];
        END;

    RHSGlobalFrame: PUBLIC PROC [name: Rope.ROPE, nToSkip: INT, cc: CompilerContext] RETURNS[TypedCode] ~ {
        code: CirioTypes.Code _ CedarCode.CodeToLoadGlobalFrame[name, nToSkip];
        type: Type _ CCTypes.GetBooleanType[cc];
        RETURN [[code, type]]};

    RHSComma: PUBLIC PROC [left, right: ParseTree, cc: CompilerContext] RETURNS [TypedCode] ~ 
        BEGIN
        leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
        rightTC: TypedCode _  CompileForRHS[right, GetAnyTargetType[cc], cc];
        RETURN[[CedarCode.ConcatCode[CedarCode.ConcatCode[leftTC.code, CedarCode.CodeToPop[1]], rightTC.code], rightTC.type]];
        END;

    RHSCond: PUBLIC PROC [test, trueCase, falseCase: ParseTree, cc: CompilerContext] RETURNS [TypedCode] ~ {
        testTC: TypedCode ~ CompileForRHS[test, GetAnyTargetType[cc], cc];
        trueCaseTC: TypedCode ~ CompileForRHS[trueCase, GetAnyTargetType[cc], cc];
        falseCaseTC: TypedCode ~ CompileForRHS[falseCase, trueCaseTC.type, cc];
        bogon1: Type ~ GetIndirectType[falseCaseTC.type];
        IF NOT Conforms[trueCaseTC.type, bogon1, cc] THEN CCE[unimplemented, "if-then-else only implemented for conforming TRUE-case and 
        FALSE-case TYPEs"];
        RETURN [[CedarCodeExtras.CodeToDoPoppedCond[testTC.code, trueCaseTC.code, falseCaseTC.code], trueCaseTC.type]]};

    LHSFieldIdentifier: PUBLIC PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CompilerContext] RETURNS[TypedCode] =
        {RETURN[SelectIdField[id, fieldIndirectContext, cc]]};

    LHSIdentifier: PUBLIC PROC[id: Rope.ROPE, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        nameScopeNode: CirioTypes.Node _ cc.nameScope;
        nameScope: TypedCode _ [
            code: CedarCode.CodeToLoadContentsOfAMNode[nameScopeNode],
            type: CedarCode.GetTypeOfNode[nameScopeNode]];
        select: TypedCode _ SelectIdField[id, nameScope.type, cc];
        RETURN[
            [CedarCode.ConcatCode[
                nameScope.code,
                select.code],
            select.type]];
        END;

        <<We assume that firstIndirect produces an indirect to a pointer style value (e.g., a ref, a pointer, ...).  In this case, 
        finalIndirect produces an indirect through which to store a value.>>
    LHSDot: PUBLIC PROC[left: ParseTree, id: Rope.ROPE, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        firstIndirect: TypedCode _ CompileForLHS[left, cc];
        tc2: TypedCode _ Operand[$selectId, unary, firstIndirect, cc];
        finalIndirect: TypedCode _ SelectIdField[id, tc2.type, cc];
        RETURN[
            [CedarCode.ConcatCode[
                firstIndirect.code,
                finalIndirect.code],
            finalIndirect.type]];
        END;

        <<We assume that firstIndirect produces an indirect to a pointer style value (e.g., a ref, a pointer, ...).  In this case, 
        finalIndirect produces an indirect through which to store a value.>>
    LHSuparrow: PUBLIC PROC[left: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        firstIndirect: TypedCode _ CompileForLHS[left, cc];
        tc2: TypedCode _ Operand[$leftSideuparrow, unary, firstIndirect, cc];
        finalIndirect: TypedCode _ UnaryOp[$leftSideuparrow, tc2, cc];
        RETURN[finalIndirect];
        END;

    LHSapply: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
        BEGIN
        firstIndirect: TypedCode _ CompileForLHS[left, cc];
        ltc2: TypedCode _ Operand[$index, left, firstIndirect, cc];
        rtc1: TypedCode _ IndexOperand[ltc2.type, right, cc];
        finalIndirect: TypedCode _ Index[ltc2, rtc1, cc];
        RETURN[finalIndirect];
        END;


    END..