<<>>
    <<CedarOtherPureTypesImpl.mesa>>
        <<Copyright Ó 1991 by Xerox Corporation.  All rights reserved.>>
        <<Sturgis, February 7, 1990 12:05:46 pm PST>>
        <<Last changed by Theimer on July 16, 1989 4:21:30 pm PDT>>
        <<Hopcroft July 26, 1989 10:41:50 am PDT>>
        <<Last tweaked by Mike Spreitzer on January 9, 1992 6:50 pm PST>>
        <<Laurie Horton, September 13, 1991 11:31 am PDT>>

    DIRECTORY
        AmpersandContext USING[MakeNodeFromNode],
        CedarCode USING[Code, ConcatCode, CodeToMakeAMNode, CodeToDoBinaryOp, CodeToDoUnaryOp, CodeToDoUnpopedCond, 
        CodeToLoadContentsOfAMNode, CodeToLoadThroughIndirect, CodeToPop, CodeToStoreUnpopped, CreateCedarNode, GetDataFromNode, 
        GetNodeRepresentation, GetTypeOfNode, NullCode, OperationsBody, Operator],
        CCTypes USING[BinaryTargetTypes, CCError, CCErrorCase, CCTypeProcs, ConformanceCheck, CreateCedarType, GetAnyTargetType, 
        GetBooleanType, GetCharType, GetGroundTypeClass, GetIndirectType, GetNodeType, GetProcDataFromGroundType, 
        GetProcDataFromType, GetRopeType, GetRTargetType, GetTypeRepresentation, GetWrongType, LoadIdVal, LR, SetBooleanType, 
        SetCharType, sia],
        CedarNumericTypes USING[CreateNumericNode, CreateNumericType, GetDescriptorFromCedarNumericType, NumericDescriptor],
        CedarOtherPureTypes USING[EnumeratedTypeProcs, RopeInfo, TransparentNodeInfo, TransparentTypeInfo],
        CirioSyntacticOperations USING[ParseTree],
        CirioTypes USING[BasicTypeInfo, Code, CompilerContext, Mem, Node, Type, TypeClass, TypedCode, TypeIsntNil],
        Convert USING[RopeFromChar],
        IO,
        Rope,
        StructuredStreams;

    CedarOtherPureTypesImpl: CEDAR PROGRAM
        IMPORTS AmpersandContext, CCTypes, CedarCode, CedarNumericTypes, CirioTypes, Convert, IO, Rope, StructuredStreams
        EXPORTS CedarOtherPureTypes
    = BEGIN OPEN CCTypes, CedarCode, CirioTypes, SS:StructuredStreams;

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

    CreateBooleanType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] = {
        nominal: Type _ CCTypes.GetBooleanType[cc];
        IF nominal = NIL THEN CCTypes.SetBooleanType[cc,
            nominal _ CreateCedarType[$Boolean, BooleanCCTypeProcs, BooleanIndirectTypeProcs, cc, bti]];
        RETURN[nominal]};

    BooleanIndirectTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
        createIndirectNode: BooleanCreateIndirect,
        getBitSize: BooleanBitSize
        ]];

    BooleanCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
        checkConformance: BooleanCheckConformance,
        binaryOperandTypes: BooleanBinaryOperandTypes,
        operand: BooleanOperand,
        coerceToType: BooleanCoerceToType,
        binaryOp: BooleanTypeBinaryOp,
        unaryOp: BooleanTypeUnaryOp,
        printType: BooleanPrintType
        ]];

    BooleanCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
        bti: BasicTypeInfo ~ NARROW[procData];
        RETURN bti.createIndirectNode[bti, cc, indirectType, targetType, mem]};

    BooleanBitSize: PROC [indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS [CARD] ~ {
        bti: BasicTypeInfo ~ NARROW[procData];
        RETURN bti.getBitSize[bti, cc, indirectType, targetType]};

        <<valType was the control parameter>>
    BooleanCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
        {IF GetGroundTypeClass[varType, cc] = $Boolean THEN RETURN[yes] ELSE RETURN[no]};

        <<By the time we get here, the left operand type is Boolean and both operands are suitable for the given op.  Therefore, the right 
        operand should also be Boolean or amnode>>
    BooleanBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
        BEGIN
        rightClass: TypeClass _ GetGroundTypeClass[right, cc];

        SELECT rightClass FROM
            <<$wrong, $amnode => RETURN[[right, right]];>>
            $Boolean => 
                SELECT op FROM
                    $assign => CCE[cirioError]; -- shouldn't happen
                    ENDCASE => RETURN[[right, right]];
            ENDCASE => CCE[cirioError]; -- shouldn't happen
        END;

        <<tc.type is Boolean>>
    BooleanOperand: PROC[op: Operator, lr: LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN
        SELECT op FROM
            $plus, $minus, $div, $mult, $mod, $le, $lt, $eq, $gt, $ge, $max, $min =>
                RETURN[[tc.code, GetWrongType[cc]]];
            $and, $or, $not => RETURN[tc];
            ENDCASE => CCE[cirioError]; -- shouldn't happen
        END;

        <<tc.type is Boolean>>
    BooleanCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN
        targetClass: TypeClass _ GetGroundTypeClass[targetType, cc];
        SELECT targetClass FROM
            $wrong => RETURN[[tc.code, GetWrongType[cc]]];
            $amnode =>
                RETURN[[ConcatCode[tc.code, CodeToMakeAMNode[tc.type]], GetNodeType[cc]]];
            $Boolean => RETURN[tc];
            ENDCASE => CCE[cirioError]; -- shouldn't happen (or can it occur due to a client type error?)
        END;

    BooleanTypeBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN -- assumes that both arguments have Boolean type

        code: Code _ SELECT op FROM
            $and =>
                CodeToDoUnpopedCond[
                    left.code,
                        ConcatCode[CodeToPop[1], right.code],
                        NullCode[]], 
            $or =>
                CodeToDoUnpopedCond[
                    left.code,
                        NullCode[], 
                        ConcatCode[CodeToPop[1], right.code]],
            ENDCASE => CCE[cirioError]; -- shouldn't happen
        RETURN[[code, left.type]];
        END;

    BooleanTypeUnaryOp: PROC[op: Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN
        RETURN[[ConcatCode[
            arg.code, 
            CodeToDoUnaryOp[op, arg.type]], arg.type]];
        END;

    BooleanPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]
        = {to.PutRope["BOOLEAN"]};


    <<>>
    <<Char type>>

        CreateCharType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] = {
            nominal: Type _ CCTypes.GetCharType[cc];
            IF nominal = NIL THEN CCTypes.SetCharType[cc,
                nominal _ CreateCedarType[$char, CharCCTypeProcs, CharIndirectProcs, cc, bti]];
            RETURN[nominal]};

        CharIndirectProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
            createIndirectNode: CharCreateIndirect,
            getBitSize: CharBitSize
            ]];

        CharCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
            checkConformance: CharCheckConformance,
            binaryOperandTypes: CharBinaryOperandTypes,
            operand: CharOperand,
            binaryOp: CharTypeBinaryOp,
            printType: CharPrintType
            ]];

        CharCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
            bti: BasicTypeInfo ~ NARROW[procData];
            RETURN bti.createIndirectNode[bti, cc, indirectType, targetType, mem]};

        CharBitSize: PROC [indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS [CARD] ~ {
            bti: BasicTypeInfo ~ NARROW[procData];
            RETURN bti.getBitSize[bti, cc, indirectType, targetType]};

            <<valType was the control parameter>>
        CharCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
            {IF GetGroundTypeClass[varType, cc] = $char THEN RETURN[yes] ELSE RETURN[no]};

            <<By the time we get here, the left operand type is Char and both operands are suitable for the given op.  Therefore, the right 
            operand should also be Char or amnode>>
        CharBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
            BEGIN
            rightClass: TypeClass _ GetGroundTypeClass[right, cc];

            SELECT rightClass FROM
                <<$wrong, $amnode => RETURN[[right, right]];>>
                $numeric =>
                    SELECT op FROM
                        $plus, $minus =>
                            BEGIN
                            descriptor: REF CedarNumericTypes.NumericDescriptor _ CedarNumericTypes.GetDescriptorFromCedarNumericType[right, cc];
                            WITH descriptor SELECT FROM
                                signed: REF signed CedarNumericTypes.NumericDescriptor =>
                                    BEGIN
                                    IF signed.nBits > 16 THEN CCE[operation];
                                    RETURN[[left, right]];
                                    END;
                                unsigned: REF unsigned CedarNumericTypes.NumericDescriptor =>
                                    BEGIN
                                    IF unsigned.nBits > 16 THEN CCE[operation];
                                    RETURN[[left, right]];
                                    END;
                                ENDCASE => CCE[operation];
                            END;
                        ENDCASE => CCE[operation]; 
                $char => 
                    SELECT op FROM
                        $minus => RETURN[[left, right]];
                        ENDCASE => CCE[operation];
                ENDCASE => CCE[operation];
            END;

            <<tc.type is Char>>
        CharOperand: PROC[op: Operator, lr: LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN
            SELECT op FROM
                $plus =>
                    IF lr = left THEN RETURN[tc] ELSE CCE[operation];
                $minus =>
                    IF lr = left OR lr = right THEN RETURN[tc] ELSE CCE[operation];
                ENDCASE => CCE[operation];
            END;


        CharTypeBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN

            code: Code _ ConcatCode[
                left.code,
                ConcatCode[
                    right.code,
                    CodeToDoBinaryOp[op, left.type, right.type]]];

            type: Type;

            SELECT op FROM
                $plus => type _ left.type;
                $minus =>
                    BEGIN
                    rightClass: TypeClass _ GetGroundTypeClass[right.type, cc];
                    SELECT rightClass FROM
                        $numeric => type _ left.type;
                        $char => type _ CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL];
                        ENDCASE => CCE[cirioError];
                    END;
                ENDCASE => CCE[cirioError];


            RETURN[[code, type]];
            END;

        CharPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]
            = {to.PutRope["CHAR"]};


    <<Unknown Type>>

        <<We offer the following for unknown types.  The idea is to permit the printing out of data structures that contain values with 
        unknown types.  That is, we should be able to manipulate the remainder of the data structure.  We invent the type: 
        UnknownType.  So long as we never try to do anything significant with such a value, we should be alright.  These public 
        procedures are exported to CCTypes.>>

        CreateUnknownType: PUBLIC PROC[cc: CC, explanation: ROPE _ NIL] RETURNS[Type]
            = {RETURN[CreateCedarType[$unknown, UnknownCCTypeProcs, IndirectUnknownCCTypeProcs, cc, explanation]]};

        IndirectUnknownCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
            createIndirectNode: IndirectCreate]];

        UnknownCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
            printType: PrintUnknownType]];

        PrintUnknownType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] ~ {
            explanation: ROPE ~ NARROW[CCTypes.GetProcDataFromType[type]];
            to.PutRope["<unknown type"];
            IF explanation#NIL THEN {
                SS.Bp[to, lookLeft, CCTypes.sia, " "];
                to.PutF["(%g)", [rope[explanation]] ]};
            to.PutChar['>];
            RETURN};

        IndirectCreate: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
            explanation: ROPE ~ NARROW[procData];
            RETURN CreateIndirectToAnUnknownType[targetType, explanation, cc]};

        TransparentTypeInfo: TYPE ~ CedarOtherPureTypes.TransparentTypeInfo;

        CreateTransparentType: PUBLIC PROC[cc: CC, tti: TransparentTypeInfo] RETURNS[Type]
            ~ {RETURN[CreateCedarType[$transparent, TransparentCCTypeProcs, IndirectTransparentCCTypeProcs, cc, tti]]};

        TransparentCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
            printType: PrintTransparentType]];

        IndirectTransparentCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
            createIndirectNode: TransparentCreateIndirect,
            getBitSize: TransparentBitSize,
            load: TransparentTypeLoad,
            store: TransparentTypeStore,
            printType: PrintTransparentType]];

        TransparentCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
            tti: TransparentTypeInfo ~ NARROW[procData];
            RETURN tti.createIndirectNode[tti, cc, indirectType, targetType, mem]};

        TransparentBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
            tti: TransparentTypeInfo ~ NARROW[procData];
            RETURN[tti.bits]};

        TransparentTypeLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] ~ {
            code: Code _ ConcatCode[
                indirect.code,
                CodeToLoadThroughIndirect[indirect.type]];
            type: Type _ GetRTargetType[indirect.type, cc];
            RETURN[[code, type]]};

        TransparentTypeStore: PROC[value, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] ~ {
            code: Code _ ConcatCode[
                indirect.code,
                ConcatCode[
                    value.code,
                    CodeToStoreUnpopped[indirect.type, value.type]]];
            RETURN[[code, value.type]]};

        PrintTransparentType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] ~ {
            tti: TransparentTypeInfo ~ NARROW[CCTypes.GetProcDataFromType[type]];
            SELECT printDepth FROM
                >2 => to.PutF["<transparent %g, %g bits>", [rope[tti.intro]], [integer[tti.bits]] ];
                ENDCASE => to.PutF["<%g-bit transparent>", [integer[tti.bits]] ]};

    <<Enumerated Types>>
        <<>>
        <<>>
        EnumeratedTypeDescriptor: TYPE  = RECORD[
            nValues: INT,
            bottomIndex: INT,
            topIndex: INT,
            procs: REF EnumeratedTypeProcs,
            procsData: REF ANY];

            <<index belongs to [0..nValues)>>
        EnumeratedTypeProcs: TYPE = CedarOtherPureTypes.EnumeratedTypeProcs;

        CreateEnumeratedType: PUBLIC PROC[nValues: INT, procs: REF EnumeratedTypeProcs, procsData: REF ANY, cc: CC] RETURNS[Type] =
            BEGIN
            desc: REF EnumeratedTypeDescriptor _ NEW[EnumeratedTypeDescriptor _ [nValues, 0, nValues-1, procs, procsData]];
            RETURN[CCTypes.CreateCedarType[$enumerated, EnumeratedCCTypeProcs, IndirectEnumeratedCCTypeProcs, cc, desc]];
            END;

        CreateEnumeratedSubtype: PUBLIC PROC[baseType: Type, bottomIndex, topIndex: INT, cc: CC] RETURNS[Type] =
            BEGIN
            baseDesc: REF EnumeratedTypeDescriptor _ NARROW[GetProcDataFromGroundType[baseType, cc]];
            desc: REF EnumeratedTypeDescriptor _ NEW[EnumeratedTypeDescriptor _ [baseDesc.nValues, bottomIndex, topIndex, baseDesc.procs, 
            baseDesc.procsData]];
            IF bottomIndex < baseDesc.bottomIndex THEN CCE[cirioError];
            IF topIndex > baseDesc.topIndex THEN CCE[cirioError];
            RETURN[CCTypes.CreateCedarType[$enumerated, EnumeratedCCTypeProcs, NIL, cc, desc]];
            END;


        EnumeratedCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _ [
            checkConformance: EnumeratedCheckConformance,
            binaryOperandTypes: EnumeratedBinaryOperandTypes,
            asIndexSet: EnumeratedAsIndexSet,
            operand: EnumeratedOperand,
            coerceToType: EnumeratedCoerceToType,
            binaryOp: EnumeratedBinaryOp,
            unaryOp: EnumeratedUnaryOp,
            loadIdVal: EnumeratedLoadIdVal,
            getNElements: EnumeratedGetNElements,
            getTypeRepresentation: EnumeratedGetTypeRepresentation,
            printType: EnumeratedPrintType
            ]];

        IndirectEnumeratedCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _ [
            createIndirectNode: EnumeratedCreateIndirect,
            getBitSize: EnumeratedBitSize,
            printType: EnumeratedPrintType
            ]];

        EnumeratedCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
            desc: REF EnumeratedTypeDescriptor ~ NARROW[procData];
            RETURN desc.procs.createIndirectNode[desc.procsData, cc, indirectType, targetType, mem]};

        EnumeratedBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
            desc: REF EnumeratedTypeDescriptor ~ NARROW[procData];
            RETURN desc.procs.getBitSize[desc.procsData, cc, indirectType, targetType]};

            <<valType was the control parameter>>
        EnumeratedCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
            BEGIN
            valDesc: REF EnumeratedTypeDescriptor _ NARROW[procData];
            WITH GetProcDataFromGroundType[varType, cc] SELECT FROM
                varDesc: REF EnumeratedTypeDescriptor =>
                    RETURN[IF valDesc.procs.comparePaint[valDesc.procsData, varDesc.procs.getPaint[varDesc.procsData]] THEN yes ELSE no];
                ENDCASE => RETURN[no];
            END;


            <<By the time we get here, the left operand type is enumerated and both operands are suitable for the given op.  Therefore, the 
            right operand should also be enumerated or amnode>>
        EnumeratedBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
            BEGIN
            rightClass: TypeClass _ GetGroundTypeClass[right, cc];

            SELECT rightClass FROM
                <<$wrong, $amnode => RETURN[[right, right]];>>
                $enumerated => 
                    SELECT op FROM
                        $assign => CCE[cirioError]; -- shouldn't happen
                        ENDCASE => RETURN[[right, right]];
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            END;

        EnumeratedAsIndexSet: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] = {RETURN[type]};

            <<tc.type is Enumerated>>
        EnumeratedOperand: PROC[op: Operator, lr: LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN
            SELECT op FROM
                $plus, $minus, $div, $mult, $mod, $and, $or, $not =>
                    RETURN[[tc.code, GetWrongType[cc]]];
                $le, $lt, $eq, $gt, $ge, $max, $min => RETURN[tc];
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            END;

            <<tc.type is Enumerated>>
        EnumeratedCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN
            targetClass: TypeClass _ GetGroundTypeClass[targetType, cc];
            SELECT targetClass FROM
                $wrong => RETURN[[tc.code, GetWrongType[cc]]];
                $amnode =>
                    RETURN[[ConcatCode[tc.code, CodeToMakeAMNode[tc.type]], GetNodeType[cc]]];
                $enumerated => RETURN[tc];
                ENDCASE => CCE[cirioError]; -- shouldn't happen (or can it occur due to a client type error?)
            END;

        EnumeratedBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN -- assumes that both arguments have enumerated type and that the operator is a relation

            code: Code _ CedarCode.ConcatCode[
                left.code,
                CedarCode.ConcatCode[
                    right.code,
                    CedarCode.CodeToDoBinaryOp[op, left.type, right.type]]];
            RETURN[[code, CCTypes.GetBooleanType[cc]]];
            END;

        EnumeratedUnaryOp: PROC[op: Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN -- such operations as succ and pred.
            RETURN[[ConcatCode[
                arg.code, 
                CodeToDoUnaryOp[op, arg.type]], arg.type]];
            END;

            <<we look to see if the id is one of the values of the enumerated type, otherwise we fall back on the default code.>>
        EnumeratedLoadIdVal: PROC[id: Rope.ROPE, targetType: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN
            desc: REF EnumeratedTypeDescriptor _ NARROW[procData];

                <<I forsee trouble.  The targetType might not be appropriate.  I have to rethink my default mechanism.  For this case, I could hide 
                the Type in the desc, but that would create cycles.  (Probably I already have cycles).>>
            FOR I: INT IN [desc.bottomIndex..desc.topIndex] DO
                IF Rope.Equal[id, desc.procs.indexToId[I, desc.procsData]] THEN
                    BEGIN
                    node: Node _ CreateEnumeratedTypeNode[targetType, id, cc];
                    code: CirioTypes.Code _ CedarCode.CodeToLoadContentsOfAMNode[node];
                    RETURN[[code, targetType]];
                    END;
                ENDLOOP;

            <<the id was not an element of the enumerated type, so fall back on default mechanism.>>

            RETURN[CCTypes.LoadIdVal[id, targetType, cc, CCTypes.GetAnyTargetType[cc]]];
            END;

        EnumeratedGetNElements: PROC [type: Type, cc: CC, procData: REF ANY] RETURNS [CARD] =
            BEGIN
            desc: REF EnumeratedTypeDescriptor _ NARROW[procData];
            RETURN [desc.nValues];
            END;

        EnumeratedGetTypeRepresentation: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[REF ANY] =
            BEGIN
            desc: REF EnumeratedTypeDescriptor _ NARROW[procData];
            RETURN[desc.procsData];
            END;

        EnumeratedPrintType: PROC [to: IO.STREAM, type: Type, printDepth, printWidth: INT, cc: CC, procData: REF ANY] = {
            desc: REF EnumeratedTypeDescriptor _ NARROW[procData];
            to.PutChar['{];
            FOR i: INT IN [0 .. desc.topIndex-desc.bottomIndex] DO
                IF i>0 THEN {to.PutChar[',]; SS.Bp[to, lookLeft, CCTypes.sia, " "]};
                IF i>printWidth THEN {to.PutRope["..."]; EXIT};
                to.PutRope[desc.procs.indexToId[desc.bottomIndex+i, desc.procsData]];
                ENDLOOP;
            to.PutChar['}];
            RETURN};


    <<>>
    <<Rope Types>>

        CreateRopeType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] =
            BEGIN
            nominal: Type _ CCTypes.GetRopeType[cc];
            IF nominal # NIL THEN RETURN[nominal];
            RETURN[CreateCedarType[$rope, RopeCCTypeProcs, IndirectRopeCCTypeProcs, cc, bti]];
            END;

            <<At the moment we permit no operations.  Perhaps later we want apply, so that we can do rope[10] to read the 10'th character in 
            the rope?  Does the current Cedar debuger supply that operation?>>
        RopeCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
            printType: RopePrintType
            ]];

        IndirectRopeCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
            createIndirectNode: RopeCreateIndirect,
            getBitSize: RopeBitSize,
            printType: RopePrintType
            ]];

        RopeCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
            bti: BasicTypeInfo ~ NARROW[procData];
            RETURN bti.createIndirectNode[bti, cc, indirectType, targetType, mem]};

        RopeBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
            bti: BasicTypeInfo ~ NARROW[procData];
            RETURN bti.getBitSize[bti, cc, indirectType, targetType]};

        RopePrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]
            = {to.PutRope["ROPE"]};

    <<Boolean Nodes>>


        CreateBooleanNode: PUBLIC PROC[val: BOOLEAN, cc: CC] RETURNS[Node] =
            {RETURN[CreateCedarNode[BooleanOps, CCTypes.GetBooleanType[cc], NEW[BOOLEAN _ val]]]};

        BooleanOps: REF OperationsBody _ NEW[OperationsBody _[
            makeAMNode: BooleanMakeAMNode,
            examineBoolean: BooleanExamineBoolean,
            coerce: BooleanCoerce,
            binaryOp: BooleanBinaryOp,
            unaryOp: BooleanUnaryOp,
            show: BooleanShow,
            getNodeRepresentation: BooleanGetNodeRepresentation
            ]];


        BooleanMakeAMNode: PROC[sourceType: Type, node: Node, cc: CC] RETURNS[Node] =
            {RETURN[AmpersandContext.MakeNodeFromNode[node, cc]]};

        BooleanExamineBoolean: PROC[node: Node, cc: CC] RETURNS[BOOLEAN] =
            {RETURN[NARROW[CedarCode.GetDataFromNode[node], REF BOOLEAN]^]};

        BooleanCoerce: PROC[sourceType, targetType: Type, node: Node, cc: CC] RETURNS[Node] =
            {CCE[cirioError]}; -- shouldn't happen

            <<THIS IS ALL WRONG.  THE GENERATED CODE should do a test and avoid evaluating the second argument if the first argument determines 
            the answer.!!!!>>
        BooleanBinaryOp: PROC[op: Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
            BEGIN -- can assume that both operands are Boolean
            left: REF BOOLEAN _ NARROW[CedarCode.GetDataFromNode[leftNode]];
            right: REF BOOLEAN _ NARROW[CedarCode.GetDataFromNode[rightNode]];
            result: BOOLEAN _ SELECT op FROM
                $and => left^ AND right^,
                $or => left^ OR right^,
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            CCE[cirioError]; -- this code should not be called
            <<RETURN[CreateBooleanNode[result, cc]];>>
            END;

        BooleanUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] =
            BEGIN
            arg: REF BOOLEAN _ NARROW[CedarCode.GetDataFromNode[node]];
            SELECT op FROM
                $not => RETURN[CreateBooleanNode[NOT arg^, cc]];
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            END;

        BooleanShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC]
            = {to.PutRope[IF NARROW[CedarCode.GetDataFromNode[node], REF BOOLEAN]^ THEN "TRUE" ELSE "FALSE"]};

        BooleanGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
            {RETURN[CedarCode.GetDataFromNode[node]]};
    <<>>
    <<>>
    <<Char nodes>>

        CreateCharNode: PUBLIC PROC[val: CHAR, cc: CC] RETURNS[Node] =
            {RETURN[CreateCedarNode[CharOps, CCTypes.GetCharType[cc], NEW[CHAR _ val]]]};

        CharOps: REF OperationsBody _ NEW[OperationsBody _[
            makeAMNode: CharMakeAMNode,
            binaryOp: CharBinaryOp,
            show: CharShow,
            getNodeRepresentation: CharGetRepresentation
            ]];

        CharMakeAMNode: PROC[sourceType: Type, node: Node, cc: CC] RETURNS[Node] =
            {RETURN[AmpersandContext.MakeNodeFromNode[node, cc]]};

            <<There are three possibilities: char+numeric, char-numeric, and char-char.>>
        CharBinaryOp: PROC[op: Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
            BEGIN -- we will do the computation in INT and then convert back to char at end

            leftChar: REF CHAR _ NARROW[CedarCode.GetNodeRepresentation[leftNode, cc]];
            leftVal: INT _ ORD[leftChar^];
            rightNodeType: Type _ CedarCode.GetTypeOfNode[rightNode];


            RightValAsNumeric: PROC RETURNS[INT] =
                BEGIN
                rightDescriptor: REF CedarNumericTypes.NumericDescriptor _ CedarNumericTypes.GetDescriptorFromCedarNumericType[rightNodeType, cc];
                WITH rightDescriptor SELECT FROM
                    signed: REF signed CedarNumericTypes.NumericDescriptor =>
                        BEGIN
                        rightVal: REF INT _ NARROW[CedarCode.GetNodeRepresentation[rightNode, cc]];
                        RETURN[rightVal^];
                        END;
                    unsigned: REF unsigned CedarNumericTypes.NumericDescriptor =>
                        BEGIN
                        rightVal: REF CARD _ NARROW[CedarCode.GetNodeRepresentation[rightNode, cc]];
                        lastInt: CARD _ LAST[INT];
                        IF rightVal^ > lastInt THEN CCE[cirioError]; -- it was supposed to be a small numeric, and we are supposed to have checked that.
                        RETURN[rightVal^];
                        END;
                    ENDCASE => CCE[cirioError];
                END;

            ModifiedChar: PROC[mod: INT] RETURNS[Node] =
                BEGIN
                newVal: INT _ leftVal+mod;
                IF newVal < 0 OR newVal > 377B THEN CCE[operation, "bounds fault"];
                RETURN[CreateCharNode[VAL[INTEGER[newVal]], cc]];
                END;

            SELECT op FROM
                $plus => 
                    BEGIN --  GetGroundTypeClass[rightNodeType] must be $numeric and small.
                    rightVal: INT _ RightValAsNumeric[];
                    RETURN[ModifiedChar[rightVal]];
                    END;
                $minus =>
                    BEGIN
                    rightClass: TypeClass _ GetGroundTypeClass[rightNodeType, cc];
                    SELECT rightClass FROM
                        $numeric => 
                            BEGIN
                            rightVal: INT _ RightValAsNumeric[];
                            RETURN[ModifiedChar[-rightVal]];
                            END;
                        $char => 
                            BEGIN
                            rightChar: REF CHAR _ NARROW[CedarCode.GetNodeRepresentation[rightNode, cc]];
                            rightVal: INT _ ORD[rightChar^];
                            resultVal: INT _ leftVal-rightVal; -- always will be inbounds
                            resultType: Type _ CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL];
                            RETURN[CedarNumericTypes.CreateNumericNode[resultType, NEW[INT_resultVal]]];
                            END;
                        ENDCASE => CCE[cirioError];
                    END;
                ENDCASE => CCE[cirioError];
            END;

        CharShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
            val: CHAR _ NARROW[CedarCode.GetDataFromNode[node], REF CHAR]^;
            to.PutRope[Convert.RopeFromChar[val]];
            };

        CharGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
            {RETURN[CedarCode.GetDataFromNode[node]]};
    <<>>
    <<Unknown Type Nodes, and Indirects thereto>>

        CreateUnknownTypeNode: PUBLIC PROC[type: Type, explanation: ROPE, cc: CC] RETURNS[CirioTypes.Node] =
            {RETURN[CedarCode.CreateCedarNode[UnknownTypeNodeOps, type, explanation]]};

        CreateIndirectToAnUnknownType: PUBLIC PROC[type: Type, explanation: ROPE, cc: CC] RETURNS[CirioTypes.Node] =
            {RETURN[CedarCode.CreateCedarNode[IndirectToUnknownTypeNodeOps, CCTypes.GetIndirectType[type], explanation]]};

        IndirectToUnknownTypeNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[
            load: UnknownIndirectLoad,
            show: UnknownShow]];

        UnknownIndirectLoad: PROC[indirectType: Type, indirectNode: CirioTypes.Node, cc: CC] RETURNS[CirioTypes.Node] =
            BEGIN
            explanation: ROPE ~ NARROW[CedarCode.GetDataFromNode[indirectNode]];
            RETURN[CedarCode.CreateCedarNode [UnknownTypeNodeOps, CCTypes.GetRTargetType [CedarCode.GetTypeOfNode [indirectNode], cc], 
            Rope.Cat["<loaded ", explanation, ">"]]];
            END;

        UnknownTypeNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[
            show: UnknownShow]];

        UnknownShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth, width: INT, cc: CC] = {
            explanation: ROPE ~ NARROW[CedarCode.GetDataFromNode[node]];
            IF depth < 3 THEN {to.PutRope["??"]; RETURN};
            to.PutRope["<node of unknown type"];
            SS.Bp[to, lookLeft, CCTypes.sia, " "];
            to.PutF["(%g)>", [rope[explanation]] ];
            RETURN};

    <<Transparent Type Nodes>>

        TransparentNodeInfo: TYPE ~ CedarOtherPureTypes.TransparentNodeInfo;

        CreateTransparentTypeNode: PUBLIC PROC[type: Type, tni: TransparentNodeInfo, cc: CC] RETURNS[CirioTypes.Node] = {
            RETURN[CedarCode.CreateCedarNode[TransparentTypeNodeOps, type, tni]]};

        TransparentTypeNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[
            show: TransparentShow,
            getNodeRepresentation: TransparentGetNodeRepresentation]];

        TransparentShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth: INT, width: INT, cc: CC] = {
            tni: TransparentNodeInfo ~ NARROW[CedarCode.GetDataFromNode[node]];
            len: INT ~ MIN[tni.val.Length, width];
            to.PutChar['<];
            IF depth>2 THEN {
                type: Type ~ GetTypeOfNode[node];
                tti: TransparentTypeInfo ~ NARROW[GetTypeRepresentation[type, cc]];
                to.PutRope[tti.intro]; to.PutChar[' ]};
            IF tni.lpad#0 OR tni.rpad#0 THEN to.PutF["(lpad=%g, rpad=%g) ", [integer[tni.lpad]], [integer[tni.rpad]] ];
            FOR i: INT IN [0..len) DO to.PutF["%02x", [cardinal[tni.val.InlineFetch[i].ORD]] ] ENDLOOP;
            to.PutChar['>];
            RETURN};

        TransparentGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY]
            ~ {RETURN CedarCode.GetDataFromNode[node]};
    <<>>
    <<Enumerated Type Nodes>>
        <<>>
        EnumeratedNodeInfo: TYPE = REF EnumeratedNodeInfoBody;
        EnumeratedNodeInfoBody: TYPE = RECORD[
            type: Type,
            id: Rope.ROPE,
            index: CARD];

        CreateEnumeratedTypeNode: PUBLIC PROC[type: Type, id: Rope.ROPE, cc: CC] RETURNS[CirioTypes.Node] =
            BEGIN
            desc: REF EnumeratedTypeDescriptor _ NARROW[GetProcDataFromGroundType[type, cc]];
            index: CARD _ desc.procs.idToIndex[id, desc.procsData];
            RETURN[CedarCode.CreateCedarNode[EnumeratedOps, type, NEW[EnumeratedNodeInfoBody _ [type, id, index]]]];
            END;

        CreateEnumeratedTypeNodeFromIndex: PUBLIC PROC[type: Type, index: CARD, cc: CC] RETURNS[CirioTypes.Node] =
            BEGIN
            desc: REF EnumeratedTypeDescriptor _ NARROW[GetProcDataFromGroundType[type, cc]];
            id: Rope.ROPE _ desc.procs.indexToId[index, desc.procsData];
            RETURN[CedarCode.CreateCedarNode[EnumeratedOps, type, NEW[EnumeratedNodeInfoBody _ [type, id, index]]]];
            END;

        EnumeratedOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[
            binaryOp: EnumeratedBinaryNodeOp,
            asIndex: EnumeratedAsIndex,
            show: EnumeratedShow,
            getNodeRepresentation: EnumeratedGetNodeRepresentation
            ]];

        EnumeratedBinaryNodeOp: PROC[op: Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
            BEGIN -- should only be relations
            linfo: EnumeratedNodeInfo _ NARROW[CedarCode.GetDataFromNode[leftNode]];
            rinfo: EnumeratedNodeInfo _ NARROW[CedarCode.GetDataFromNode[rightNode]];
            li: CARD _ linfo.index;
            ri: CARD _ rinfo.index;
            newBoolean: BOOLEAN _ SELECT op FROM
                $lt => li < ri,
                $le => li <= ri,
                $eq => li = ri,
                $ne => li # ri,
                $ge => li >= ri,
                $gt => li > ri,
                ENDCASE => CCE[cirioError];
            RETURN[CreateBooleanNode[newBoolean, cc]];
            END;

            <<(I suspect that we still have to implemented subrange enumerated types.  If so, we will have to make some modifications here.)>>
        EnumeratedAsIndex: PROC[type: Type, node: Node, cc: CC] RETURNS[CARD] =
            BEGIN
            info: EnumeratedNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            RETURN[info.index];
            END;

        EnumeratedShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth: INT, width: INT, cc: CC] = {
            info: EnumeratedNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            to.PutRope[info.id];
            RETURN};

        EnumeratedGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
            BEGIN
            info: EnumeratedNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            RETURN[NEW[CARD _ info.index]];
            END;

    <<Parse Tree types>>
        <<>>
        <<Nodes of this type will be created when we have a node applied to a parse tree (as opposed to a procedure applied to a parse tree 
        or an array applied to a parse tree).>>

        CreateParseTreeType: PUBLIC PROC[cc: CC] RETURNS[Type] =
            BEGIN
            RETURN[CCTypes.CreateCedarType[$parseTree, ParseTreeCCTypeProcs, NIL, cc]];
            END;

        ParseTreeCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _ [
            ]];


    <<Parse Tree Nodes>>

        PTNData: TYPE = RECORD[tree: CirioSyntacticOperations.ParseTree];

        CreateParseTreeNode: PUBLIC PROC[parseTree: CirioSyntacticOperations.ParseTree, cc: CC] RETURNS[Node] =
            {RETURN[CedarCode.CreateCedarNode[ParseTreeOps, CCTypes.GetNodeType[cc], NEW[PTNData _ [parseTree]]]]};

        ParseTreeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[
            examineParseTree: ParseTreeExamineParseTree,
            show: ParseTreeShow
            ]];

        ParseTreeExamineParseTree: PROC[node: Node, cc: CC] RETURNS[CirioSyntacticOperations.ParseTree] =
            {RETURN[NARROW[CedarCode.GetDataFromNode[node], REF PTNData].tree]};

        ParseTreeShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth: INT, width: INT, cc: CC] = {to.PutRope["parseTree"]};

    <<Rope Nodes>>
        <<>>
        RopeInfo: TYPE ~ CedarOtherPureTypes.RopeInfo;

        CreateRopeNode: PUBLIC PROC[val: Rope.ROPE, cc: CC, addr: REF ANY _ NIL] RETURNS[Node] =
            {RETURN[CreateCedarNode[RopeOps, CCTypes.GetRopeType[cc].TypeIsntNil[cc], NEW [RopeInfo _ [val, addr]] ]]};

        RopeOps: REF OperationsBody _ NEW[OperationsBody _[
            show: RopeShow,
            getNodeRepresentation: RopeGetRepresentation
            ]];

        RopeShow: PROC[to: IO.STREAM, node: Node, depth, width: INT, cc: CC] = {
            info: REF RopeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            width _ width * 10; -- For ropes we interprete the printing width to be longer since characters have a very small width compared to 
            other types.
            to.PutF["\"%q%g\"", [rope[info.val.Substr[0, width]]], [rope[IF info.val.Length[] > width THEN "..." ELSE NIL]] ];
            RETURN};

        RopeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
            BEGIN
            info: REF RopeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            RETURN[info];
            END;


    END..