<<>>
    <<CedarNumericTypesImpl.mesa>>
        <<Copyright Ó 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Sturgis, September 13, 1989 11:46:03 am PDT>>
        <<Last changed by Theimer on July 16, 1989 4:27:30 pm PDT>>
        <<Hopcroft July 26, 1989 10:23:52 am PDT>>
        <<Spreitze, January 9, 1992 9:54 am PST>>
        <<Laurie Horton, January 29, 1992 10:17 am PST>>
        <<Katsuyuki Komatsu January 6, 1993 10:42 am PST>>

    DIRECTORY
        CedarCode USING[CodeToDoBinaryOp, Code, CodeToCoerce, ConcatCode, CodeToMakeAMNode, CodeToDoUnaryOp, CreateCedarNode, 
        GetDataFromNode, GetTypeOfNode, OperationsBody, Operator],
        CCTypes USING[BinaryTargetTypes, CCError, CCErrorCase, CCTypeProcs, ConformanceCheck, CreateCedarType, GetBooleanType, 
        GetCedarNumericType, GetGroundTypeClass, GetNodeType, GetProcDataFromGroundType, GetProcDataFromType, GetWrongType, LR, 
        Operator, SetCedarNumericType],
        CedarNumericTypes USING[NumericDescriptor],
        CedarOtherPureTypes USING[CreateBooleanNode],
        CirioTypes USING[BasicTypeInfo, CompilerContext, Mem, Node, Type, TypeClass, TypedCode],
        Convert USING[RopeFromCard, RopeFromInt, RopeFromReal],
        IO,
        Rope;

    CedarNumericTypesImpl: CEDAR PROGRAM
        IMPORTS CedarCode, CCTypes, CedarOtherPureTypes, Convert, IO
        EXPORTS CedarNumericTypes
    = BEGIN OPEN CCTypes, CedarCode, CedarNumericTypes, CirioTypes;

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

    GetNumericType: PROC[desc: NumericDescriptor, cc: CC] RETURNS[t: CirioTypes.Type] = {
        t _ CCTypes.GetCedarNumericType[desc, cc, FALSE];
        IF t=NIL THEN t _ CreateNumericType[desc, cc, NIL];
        RETURN};

    CreateNumericType: PUBLIC PROC[desc: NumericDescriptor, cc: CC, bti: CirioTypes.BasicTypeInfo] RETURNS[CirioTypes.Type] = {
        nominal: CirioTypes.Type _ CCTypes.GetCedarNumericType[desc, cc, FALSE];
        IF nominal=NIL OR (bti#NIL AND NARROW[CCTypes.GetProcDataFromType[nominal], NumericType].bti=NIL) THEN {
            nominal _ CreateCedarType[$numeric, NumericCCTypeProcs, IndirectNumericCCTypeProcs, cc, NEW[NumericTypePrivate _ 
            [NEW[NumericDescriptor _ desc], bti]] ];
            CCTypes.SetCedarNumericType[cc, desc, nominal]};
        RETURN[nominal]};

    NumericType: TYPE ~ REF NumericTypePrivate;
    NumericTypePrivate: TYPE ~ RECORD [
        desc: REF NumericDescriptor,
        bti: CirioTypes.BasicTypeInfo];

    GetDescriptorFromCedarNumericType: PUBLIC PROC[type: CirioTypes.Type, cc: CC] RETURNS[REF NumericDescriptor] = {
        gtd: REF ANY _ GetProcDataFromGroundType[type, cc];
        WITH gtd SELECT FROM
            nt: NumericType => RETURN[nt.desc];
            ENDCASE => RETURN[NIL]};


    NumericCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
        checkConformance: NumericCheckConformance,
        binaryOperandTypes: NumericBinaryOperandTypes,
        asIndexSet: NumericAsIndexSet,
        operand: NumericOperand,
        coerceToType: NumericCoerceToType,
        binaryOp: NumericBinaryOp,
        unaryOp: NumericUnaryOp,
        nAryOperandType: NumericNAryOperandType,
        nAryOp: NumericNAryOp,
        getNElements: NumericalGetNElements,
        printType: NumericalPrintType
        ]];

    IndirectNumericCCTypeProcs: REF CCTypeProcs _ NEW[CCTypeProcs _[
        createIndirectNode: NumericCreateIndirect,
        getBitSize: NumericBitSize,
        printType: NumericalPrintType
        ]];

    NumericCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
        nt: NumericType ~ NARROW[procData];
        IF nt.bti=NIL THEN CCE[cirioError, "bti-less numeric type asked to createIndirect"];
        RETURN nt.bti.createIndirectNode[nt.bti, cc, indirectType, targetType, mem]};

    NumericBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
        nt: NumericType ~ NARROW[procData];
        IF nt.bti=NIL THEN CCE[cirioError, "bti-less numeric type asked to getBitSize"];
        RETURN nt.bti.getBitSize[nt.bti, cc, indirectType, targetType]};

        <<valType was the control parameter>>
    NumericCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
        BEGIN
        WITH GetProcDataFromGroundType[varType, cc] SELECT FROM
            varNT: NumericType => {
                valNT: NumericType _ NARROW[GetProcDataFromGroundType[valType, cc]];
                RETURN[IF NDEqual[valNT.desc^, varNT.desc^] THEN yes ELSE no];
                };
            ENDCASE => RETURN[no];
        END;

        <<By the time we get here, the left operand type is numeric and both operands are suitable for the given op.  Therefore, the right 
        operand should also be numeric or amnode>>
        <<Note: experiments by Russ Atkinson November 7, 1988 show that mul and div behave differently on mixed signed/unsigned 32 bit 
        arguments.  I have choosen to not allow any mixed signed/unsigned 32 bit arguments.>>
        <<Remark: Perhaps this can be combined with NumericNAryOperandType.  At least, there are several pieces of code that occur here 
        several times and there several times that could be made into procedures.>>
    NumericBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
        BEGIN
        leftNT: NumericType _ NARROW[procData];
        leftDesc: REF NumericDescriptor _ leftNT.desc;
        rightClass: TypeClass _ GetGroundTypeClass[right, cc];

        SELECT op FROM
            $plus, $minus, $div, $mult, $mod, $le, $lt, $eq, $ne, $gt, $ge =>
                SELECT rightClass FROM
                    $wrong, $amnode => RETURN[[right, right]];
                    $numeric =>
                        BEGIN
                        rightNT: NumericType _ NARROW[GetProcDataFromGroundType[right, cc]];
                        rightDesc: REF NumericDescriptor _ rightNT.desc;

                        WITH leftDesc SELECT FROM
                            realLeft: REF real NumericDescriptor => RETURN[[left, left]];
                            signedLeft: REF signed NumericDescriptor => 
                                WITH rightDesc SELECT FROM
                                    realRight: REF real NumericDescriptor => RETURN[[right, right]];
                                    signedRight: REF signed NumericDescriptor => 
                                        BEGIN -- we must actually construct a new type since the given ones might be subranges
                                        maxBits: INT _ MAX[signedLeft.nBits, signedRight.nBits];
                                        maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                        RETURN[[maxType, maxType]];
                                        END;
                                    unsignedRight: REF unsigned NumericDescriptor => 
                                        BEGIN
                                        <<we must watch out for signed/unsigned problems with comparisons>>
                                        <<and what do we use as a max type for <INT32, CARD32>>>
                                        SELECT op FROM
                                            $plus, $minus, $div, $mult, $mod => 
                                                BEGIN
                                                maxBits: INT _ MAX[signedLeft.nBits, unsignedRight.nBits];
                                                IF (maxBits = 32) AND (signedLeft.nBits = unsignedRight.nBits) THEN
                                                    CCE[operation, "signed/unsigned error"]; -- signed/unsigned client error
                                                IF signedLeft.nBits = unsignedRight.nBits THEN
                                                    BEGIN -- must both be 16 bit operands, so either 32 bit target type will do
                                                    maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                                    RETURN[[maxType, maxType]];
                                                    END;
                                                IF signedLeft.nBits = 32 THEN
                                                    BEGIN -- go for signed as other must be 16 bit operand
                                                    maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                                    RETURN[[maxType, maxType]];
                                                    END;
                                                IF unsignedRight.nBits = 32 THEN
                                                    BEGIN -- go for unsigned as other must be 16 bit operand
                                                    maxType: Type _ GetNumericType[[maxBits, unsigned[full[]]], cc];
                                                    RETURN[[maxType, maxType]];
                                                    END;
                                                CCE[cirioError] -- shouldn't happen
                                                END;
                                            $le, $lt, $eq, $ne, $gt, $ge => CCE[operation, "signed/unsigned error"]; -- signed/unsigned client error
                                            ENDCASE => CCE[cirioError]; -- shouldn't happen
                                        END;
                                    ENDCASE => CCE[cirioError]; -- shouldn't happen
                            unsignedLeft: REF unsigned NumericDescriptor =>  
                                WITH rightDesc SELECT FROM
                                    realRight: REF real NumericDescriptor => RETURN[[right, right]];
                                    signedRight: REF signed NumericDescriptor => 
                                        BEGIN
                                        <<we must watch out for signed/unsigned problems with comparisons>>
                                        <<and what do we use as a max type for <CARD32, INT32>>>
                                        SELECT op FROM
                                            $plus, $minus, $div, $mult, $mod => 
                                                BEGIN
                                                maxBits: INT _ MAX[unsignedLeft.nBits, signedRight.nBits];
                                                IF (maxBits = 32) AND (unsignedLeft.nBits = signedRight.nBits) THEN
                                                    CCE[operation, "signed/unsigned error"]; -- signed/unsigned client error
                                                IF unsignedLeft.nBits = signedRight.nBits THEN
                                                    BEGIN -- must both be 16 bit operands, so either 32 bit target type will do
                                                    maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                                    RETURN[[maxType, maxType]];
                                                    END;
                                                IF unsignedLeft.nBits = 32 THEN
                                                    BEGIN -- go for unsigned as other must be 16 bit operand
                                                    maxType: Type _ GetNumericType[[maxBits, unsigned[full[]]], cc];
                                                    RETURN[[maxType, maxType]];
                                                    END;
                                                IF signedRight.nBits = 32 THEN
                                                    BEGIN -- go for signed as other must be 16 bit operand
                                                    maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                                    RETURN[[maxType, maxType]];
                                                    END;
                                                CCE[cirioError] -- shouldn't happen
                                                END;
                                            $le, $lt, $eq, $ne, $gt, $ge => CCE[operation, "signed/unsigned error"]; -- signed/unsigned client error
                                            ENDCASE => CCE[cirioError]; -- shouldn't happen
                                        END;
                                    unsignedRight: REF unsigned NumericDescriptor =>  
                                        BEGIN -- we must actually construct a new type since the given ones might be subranges
                                        maxBits: INT _ MAX[unsignedLeft.nBits, unsignedRight.nBits];
                                        maxType: Type _ GetNumericType[[maxBits, unsigned[full[]]], cc];
                                        RETURN[[maxType, maxType]];
                                        END;
                                    ENDCASE => CCE[cirioError]; -- shouldn't happen;
                            ENDCASE => CCE[cirioError]; -- shouldn't happen

                        END;
                    ENDCASE => CCE[cirioError]; -- shouldn't happen

                ENDCASE => CCE[cirioError]; -- shouldn't happen?
        END;

    NumericAsIndexSet: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] =
        BEGIN
        nt: NumericType _ NARROW[procData];
        desc: REF NumericDescriptor _ nt.desc;
        WITH desc SELECT FROM
            sd: REF full signed NumericDescriptor =>
                <<this is a GLITCH in the Cedar language.>>
                    <<I am told that it was introduced to make SEQUENCE n: INTEGER OF FOO produce a sequence that is indexed starting from 0.  I don't 
                    know if it also applies to INT32.>>
                SELECT sd.nBits FROM
                    16 => RETURN[GetNumericType[[16, signed[subRange[0, LAST[INTEGER]]]], cc]];
                    ENDCASE => RETURN[type];
            ENDCASE => RETURN[type];
        END;

        <<tc.type is numeric>>
    NumericOperand: 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];
            $and, $or, $not => RETURN[[tc.code, GetWrongType[cc]]];
            ENDCASE => CCE[cirioError]; -- shouldn't happen
        END;

        <<tc.type is numeric>>
        <<we take the following simplistic view.  If the two type descriptors are equal, we return tc.  If they are different, some cases 
        do not allow any run time coercion, we generate an operation error.  For the moment, we will generate coercions in 
        situations that we should generate an error.  That will lead to a run time error that we could have caught at compile time.>>
    NumericCoerceToType: 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]]];
            $numeric =>
                BEGIN
                targetNT: NumericType _ NARROW[GetProcDataFromGroundType[targetType, cc]];
                targetDescriptor: REF NumericDescriptor _ targetNT.desc;
                sourceNT: NumericType _ NARROW[procData];
                sourceDescriptor: REF NumericDescriptor _ sourceNT.desc;
                IF NDEqual[targetDescriptor^, sourceDescriptor^] THEN RETURN[tc]
                    ELSE
                        WITH sourceDescriptor SELECT FROM
                            realSource: REF real NumericDescriptor =>
                                CCE[operation]; -- target must be discrete numeric, else we would have equal descriptors
                            signedSource: REF signed NumericDescriptor => RETURN[[ConcatCode[tc.code, CodeToCoerce[tc.type, targetType]], targetType]];
                            unsignedSource: REF unsigned NumericDescriptor => RETURN[
                                [ConcatCode[tc.code, CodeToCoerce[tc.type, targetType]], targetType]];
                            ENDCASE => CCE[cirioError];
                        END;
            ENDCASE => CCE[typeConformity];
        END;


        <<for numeric operations we assume that the target type is left.type>>
    NumericBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN
        targetType: CirioTypes.Type _
            SELECT op FROM
                $plus, $minus, $div, $mult, $mod => left.type,
                $le, $lt, $eq, $gt, $ge => GetBooleanType[cc],
                ENDCASE => CCE[cirioError]; -- shouldn't happen
        leftNT: NumericType _ NARROW[procData];
        leftDescriptor: REF NumericDescriptor _ leftNT.desc;
        rightNT: NumericType _ NARROW[GetProcDataFromGroundType[right.type, cc]];
        rightDescriptor: REF NumericDescriptor _ rightNT.desc;
        RETURN[[ConcatCode[
            left.code, ConcatCode[
            right.code, 
            CodeToDoBinaryOp[op, left.type, right.type]]], targetType]];
        END;

    NumericUnaryOp: PROC[op: Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN
        targetType: CirioTypes.Type _
            SELECT op FROM
                $plus, $minus => arg.type,
                ENDCASE => CCE[cirioError]; -- shouldn't happen
        RETURN[[ConcatCode[
            arg.code, 
            CodeToDoUnaryOp[op, arg.type]], targetType]];
        END;

        <<By the time we get here, typeSoFar is numeric and nextType is suitable for the given op.>>
    NumericNAryOperandType: PROC[op: Operator, typeSoFar, nextType: Type, cc: CC, procData: REF ANY] RETURNS[Type] =
        BEGIN
        soFarNT: NumericType _ NARROW[procData];
        soFarDesc: REF NumericDescriptor _ soFarNT.desc;
        nextClass: TypeClass _ GetGroundTypeClass[nextType, cc];

        SELECT nextClass FROM
            $wrong, $amnode => RETURN[nextType];
            $numeric => 
                BEGIN
                nextNT: NumericType _ NARROW[GetProcDataFromGroundType[nextType, cc]];
                nextDesc: REF NumericDescriptor _ nextNT.desc;

                WITH soFarDesc SELECT FROM
                    realSoFar: REF real NumericDescriptor => RETURN[typeSoFar];
                    signedSoFar: REF signed NumericDescriptor =>
                        WITH nextDesc SELECT FROM
                            realNext: REF real NumericDescriptor => RETURN[nextType];
                            signedNext: REF signed NumericDescriptor =>
                                BEGIN
                                <<we must actually construct a new type since the given ones might be subranges>>
                                maxBits: INT _ MAX[signedSoFar.nBits, signedNext.nBits];
                                maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                RETURN[maxType];
                                END;
                            unsignedNext: REF unsigned NumericDescriptor => CCE[operation, "signed/unsigned error"]; -- signed/unsigned client error
                            ENDCASE => CCE[cirioError]; -- shouldn't happen
                    unsignedSoFar: REF unsigned NumericDescriptor =>
                        WITH nextDesc SELECT FROM
                            realNext: REF real NumericDescriptor => RETURN[nextType];
                            signedNext: REF signed NumericDescriptor => CCE[operation, "signed/unsigned error"];
                                <<signed/unsigned client error>>
                            unsignedNext: REF unsigned NumericDescriptor =>
                                BEGIN
                                <<we must actually construct a new type since the given ones might be subranges>>
                                maxBits: INT _ MAX[unsignedSoFar.nBits, unsignedNext.nBits];
                                maxType: Type _ GetNumericType[[maxBits, signed[full[]]], cc];
                                RETURN[maxType];
                                END;
                            ENDCASE => CCE[cirioError]; -- shouldn't happen
                    ENDCASE => CCE[cirioError]; -- shouldn't happen
                END;
            ENDCASE => CCE[cirioError]; -- shouldn't happen
        END;

            <<assumes that args is non empty>>
            <<assumes that all arguments have same type>>
    NumericNAryOp: PROC[op: Operator, args: LIST OF TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
        BEGIN
        targetType: CirioTypes.Type _ args.first.type;
        nt: NumericType _ NARROW[procData];
        descriptor: REF NumericDescriptor _ nt.desc;
        code: Code _ args.first.code;

        FOR ltc: LIST OF TypedCode _ args.rest, ltc.rest WHILE ltc # NIL DO
            argNT: NumericType _ NARROW[GetProcDataFromGroundType[ltc.first.type, cc]];
            argDescriptor: REF NumericDescriptor _argNT.desc; 
            IF NOT NDEqual[argDescriptor^, descriptor^] THEN CCE[cirioError]; -- shouldn't happen
            code _ ConcatCode[code, ltc.first.code];
            code _ ConcatCode[code, CodeToDoBinaryOp[op, targetType, ltc.first.type]];
            ENDLOOP;

        RETURN[[code, targetType]];
        END;

    NumericalGetNElements: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[CARD] =
        BEGIN
        nt: NumericType _ NARROW[procData];
        descriptor: REF NumericDescriptor _ nt.desc;
        WITH d: descriptor SELECT FROM
            signed => 
                WITH sd: d SELECT FROM
                    full => 
                        SELECT sd.nBits FROM
                            <BITS[CARD] => RETURN[2**sd.nBits];
                            =BITS[CARD] => RETURN[LAST[CARD]];
                                <<WRONG!! we should be returning LAST[CARD]+1, but of course we can't represent that as a CARD.  Perhaps I should change this 
                                interface?  On the other hand, the only current user is Show applied to an array, and all this will 
                                do is prevent us from seeing all the entries, something we would never do.>>
                            ENDCASE => CCE[cirioError];
                    subRange => RETURN[sd.top-sd.bottom+1];
                    ENDCASE => CCE[cirioError];

            unsigned => 
                WITH sd: d SELECT FROM
                    full => 
                        SELECT sd.nBits FROM
                            <BITS[CARD] => RETURN[2**sd.nBits];
                            =BITS[CARD] => RETURN[LAST[CARD]];
                                <<WRONG!! we should be returning LAST[CARD]+1, but of course we can't represent that as a CARD.  Perhaps I should change this 
                                interface?  On the other hand, the only current user is Show applied to an array, and all this will 
                                do is prevent us from seeing all the entries, something we would never do.>>
                            ENDCASE => CCE[cirioError];
                    subRange => RETURN[sd.top-sd.bottom+1];
                    ENDCASE => CCE[cirioError];

            ENDCASE => CCE[cirioError];
        END;

    NumericalPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
        nt: NumericType _ NARROW[procData];
        descriptor: REF NumericDescriptor _ nt.desc;
        WITH d: descriptor SELECT FROM
            real =>
                to.PutRope["REAL"];
            signed => 
                WITH sd: d SELECT FROM
                    full => 
                        SELECT sd.nBits FROM
                            << 8 => to.PutRope["CHAR"]; -- The arm for signed full 8-bit descriptors will never be taken, because nothing creates a signed full 
                            8-bit CCTypes.NumericDescriptor.  In Cedar, CHAR is distinct from the numeric types.>>
                            16 => to.PutRope["INT16"];
                            32 => to.PutRope["INT"];
                            64 => to.PutRope["DINT"];
                            ENDCASE => CCE[cirioError];
                    subRange => to.PutF["INT[%g..%g]", [integer[sd.bottom]], [integer[sd.top]] ];
                    ENDCASE => CCE[cirioError];

            unsigned => 
                WITH sd: d SELECT FROM
                    full => 
                        SELECT sd.nBits FROM
                             8 => to.PutRope["BYTE"];
                            16 => to.PutRope["CARD16"];
                            32 => to.PutRope["CARD"];
                            64 => to.PutRope["DCARD"];
                            ENDCASE => CCE[cirioError];
                    subRange => to.PutF["CARD[%g..%g]", [cardinal[sd.bottom]], [cardinal[sd.top]] ];
                    ENDCASE => CCE[cirioError];

            ENDCASE => CCE[cirioError];
        };


    <<Useful Code>>

        NDEqual: PUBLIC PROC[left, right: NumericDescriptor] RETURNS[eq: BOOLEAN] = {
            IF left.nBits#right.nBits THEN RETURN[FALSE];
            WITH lf: left SELECT FROM
                real => RETURN[right.primary = real];
                signed => WITH r: right SELECT FROM
                    real, unsigned => RETURN[FALSE];
                    signed => WITH llf: lf SELECT FROM
                        full => RETURN[r.secondary = full];
                        subRange => WITH rr: r SELECT FROM
                            full => RETURN[FALSE];
                            subRange => RETURN[llf.bottom=rr.bottom AND llf.top = rr.top];
                            ENDCASE => CCE[cirioError]; -- shouldn't happen;
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    ENDCASE => CCE[cirioError]; -- shouldn't happen
                unsigned => WITH r: right SELECT FROM
                    real, signed => RETURN[FALSE];
                    unsigned => WITH llf: lf SELECT FROM
                        full => RETURN[r.secondary = full];
                        subRange => WITH rr: r SELECT FROM
                            full => RETURN[FALSE];
                            subRange => RETURN[llf.bottom=rr.bottom AND llf.top = rr.top];
                            ENDCASE => CCE[cirioError]; -- shouldn't happen;
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    ENDCASE => CCE[cirioError]; -- shouldn't happen
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            };

        NDHash: PUBLIC PROC [nd: NumericDescriptor] RETURNS [CARDINAL] ~ {
            sum: CARDINAL _ LOOPHOLE[nd.nBits, CARD] + nd.primary.ORD*257;
            WITH x: nd SELECT FROM
                real => NULL;
                signed => {
                    sum _ sum + x.secondary.ORD*65;
                    WITH y: x SELECT FROM
                        full => NULL;
                        subRange => sum _ sum + LOOPHOLE[y.bottom, CARD]*3 + LOOPHOLE[y.top, CARD]*17;
                        ENDCASE => ERROR;
                    };
                unsigned => {
                    sum _ sum + x.secondary.ORD*65;
                    WITH y: x SELECT FROM
                        full => NULL;
                        subRange => sum _ sum + y.bottom*3 + y.top*17;
                        ENDCASE => ERROR;
                    };
                ENDCASE => ERROR;
            RETURN[sum]};

        NDFormat: PUBLIC PROC [nd: NumericDescriptor] RETURNS [Rope.ROPE] ~ {
            WITH x: nd SELECT FROM
                real => RETURN IO.PutFR["[%g, real[]]", [integer[x.nBits]] ];
                signed => WITH y: x SELECT FROM
                    full => RETURN IO.PutFR["[%g, signed[full[]]]", [integer[x.nBits]] ];
                    subRange => RETURN IO.PutFR["[%g, signed[subrange[%g, %g]]]", [integer[x.nBits]], [integer[y.bottom]], [integer[y.top]] ];
                    ENDCASE => ERROR;
                unsigned => WITH y: x SELECT FROM
                    full => RETURN IO.PutFR["[%g, unsigned[full[]]]", [integer[x.nBits]] ];
                    subRange => RETURN IO.PutFR["[%g, unsigned[subrange[%g, %g]]]", [integer[x.nBits]], [cardinal[y.bottom]], [cardinal[y.top]] ];
                    ENDCASE => ERROR;
                ENDCASE => ERROR};

    <<nodes>>

        Node: TYPE = CirioTypes.Node;


        CreateNumericNode: PUBLIC PROC[type: Type, rep: REF ANY] RETURNS[Node] =
            BEGIN
            RETURN[CreateCedarNode[NumericalOps, type, rep]];
            END;

        NumericalOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[
            examineBoolean: NumericalExamineBoolean,
            coerce: NumericalCoerce,
            binaryOp: NumericalBinaryOp,
            unaryOp: NumericalUnaryOp,
            asIndex: NumericalAsIndex,
            show: NumericalShow,
            getNodeRepresentation: NumericalGetRepresentation
            ]];

                <<NOTE: these implementations could use some vetting>>

        NumericalExamineBoolean: PROC[node: Node, cc: CC] RETURNS[BOOLEAN] =
            {CCE[cirioError]}; -- shouldn't happen

        NumericalCoerce: PROC[sourceType, targetType: Type, node: Node, cc: CC] RETURNS[Node] =
            BEGIN
            expectedSourceNT: NumericType
                _ NARROW[GetProcDataFromGroundType[sourceType, cc]];
            expectedSourceDescriptor: REF NumericDescriptor _ expectedSourceNT.desc;
            actualSourceNT: NumericType
                _ NARROW[GetProcDataFromGroundType[CedarCode.GetTypeOfNode[node], cc]];
            actualSourceDescriptor: REF NumericDescriptor _ actualSourceNT.desc;
            targetNT: NumericType
                _ NARROW[GetProcDataFromGroundType[targetType, cc]];
            targetDescriptor: REF NumericDescriptor _ targetNT.desc;

            CheckEqualDescriptors[expectedSourceDescriptor, actualSourceDescriptor];

            WITH targetDescriptor SELECT FROM
                td: REF real NumericDescriptor => 
                    BEGIN
                    targetReal: REAL _ 0.0;
                    WITH CedarCode.GetDataFromNode[node] SELECT FROM
                        lit: REF REAL => targetReal _ lit^;
                        lit: REF INT => targetReal _ lit^;
                        lit: REF CARD =>
                            BEGIN  -- must be a large CARD
                            reduced: CARD _ (lit^ - CARD[LAST[INT]])-CARD[1];
                            reducedReal: REAL _ reduced;
                            targetReal _ (reducedReal+REAL[LAST[INT]])+1.0;
                            END;
                        ENDCASE  => CCE[cirioError]; -- shouldn't happen;
                    RETURN[CreateNumericNode[targetType, NEW[REAL _ targetReal]]];
                    END;
                td: REF signed NumericDescriptor =>
                    BEGIN
                    targetINT: INT;
                    WITH CedarCode.GetDataFromNode[node] SELECT FROM
                        lit: REF REAL => CCE[cirioError]; -- shouldn't happen (we don't coerce from REAL to non REAL)
                        lit: REF INT => targetINT _ lit^;
                        lit: REF CARD => 
                            IF lit^ > CARD[LAST[INT]] THEN CCE[operation, "bounds check"] -- bounds check--
                                ELSE targetINT _ INT[lit^];
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    WITH td SELECT FROM
                        f: REF full signed NumericDescriptor => NULL;
                        sr: REF subRange signed NumericDescriptor =>
                            BEGIN
                            IF targetINT < sr.bottom THEN CCE[operation, "bounds check"]; -- bounds check
                            IF targetINT > sr.top THEN CCE[operation, "bounds check"]; -- bounds check
                            END;
                        ENDCASE;
                    RETURN[CreateNumericNode[targetType, NEW[INT _ targetINT]]];
                    END;
                td: REF unsigned NumericDescriptor =>
                    BEGIN
                    targetCARD: CARD;
                    WITH CedarCode.GetDataFromNode[node] SELECT FROM
                        lit: REF REAL => CCE[cirioError]; -- shouldn't happen (we don't coerce from REAL to non REAL)
                        lit: REF INT =>
                            BEGIN
                            IF lit^ < 0 THEN CCE[operation, "bounds check"]; -- bounds check
                            targetCARD _ CARD[lit^];
                            END;
                        lit: REF CARD => targetCARD _ lit^;
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    WITH td SELECT FROM
                        f: REF full unsigned NumericDescriptor => NULL;
                        sr: REF subRange unsigned NumericDescriptor =>
                            BEGIN
                            IF targetCARD < sr.bottom THEN CCE[operation, "bounds check"]; -- bounds check
                            IF targetCARD > sr.top THEN CCE[operation, "bounds check"]; -- bounds check
                            END;
                        ENDCASE;
                    RETURN[CreateNumericNode[targetType, NEW[CARD _ targetCARD]]];
                    END;
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            END;

        NumericalBinaryOp: PROC[op: CCTypes.Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
            BEGIN
            leftTNt: NumericType _ NARROW[GetProcDataFromGroundType[leftType, cc]];
            leftNNt: NumericType _ NARROW[GetProcDataFromGroundType[CedarCode.GetTypeOfNode[leftNode], cc]];
            rightTNt: NumericType _ NARROW[GetProcDataFromGroundType[rightType, cc]];
            rightNNt: NumericType _ NARROW[GetProcDataFromGroundType[CedarCode.GetTypeOfNode[rightNode], cc]];
            leftDescriptor: REF NumericDescriptor _ leftTNt.desc;

            CheckEqualDescriptors[leftDescriptor, leftNNt.desc];
            CheckEqualDescriptors[rightTNt.desc, rightNNt.desc];
            CheckEqualDescriptors[leftDescriptor, rightNNt.desc];
                <<it is my belief that these types will always be the same>>

            WITH leftDescriptor SELECT FROM
                ld: REF real NumericDescriptor => 
                    BEGIN
                    lr: REF REAL _ NARROW[CedarCode.GetDataFromNode[leftNode]];
                    rr: REF REAL _ NARROW[CedarCode.GetDataFromNode[rightNode]];
                    SELECT op FROM
                        $plus, $minus, $mult, $div, $mod, $max, $min =>
                            BEGIN
                            newREAL: REAL _ SELECT op FROM
                                $plus => lr^+rr^,
                                $minus => lr^-rr^,
                                $mult => lr^*rr^,
                                $div => lr^/rr^,
                                <<mod => lr^ MOD rr^,  - -  what happens here?>>
                                $max => MAX[lr^, rr^],
                                $min => MIN[lr^, rr^],
                                ENDCASE => CCE[cirioError];
                            RETURN[CreateNumericNode[leftType, NEW[REAL _ newREAL]]];
                            END;
                        $le, $lt, $eq, $ne, $gt, $ge =>
                            BEGIN
                            newBoolean: BOOLEAN _ SELECT op FROM
                                $le => lr^ <= rr^,
                                $lt => lr^ < rr^,
                                $eq => lr^ = rr^,
                                $ne => lr^ # rr^,
                                $gt => lr^ > rr^,
                                $ge => lr^ >= rr^,
                                ENDCASE => CCE[cirioError];
                            RETURN[CedarOtherPureTypes.CreateBooleanNode[newBoolean, cc]];
                            END;
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    END;
                ld: REF full signed NumericDescriptor => 
                    BEGIN
                    li: REF INT _ NARROW[CedarCode.GetDataFromNode[leftNode]];
                    ri: REF INT _ NARROW[CedarCode.GetDataFromNode[rightNode]];
                    SELECT op FROM
                        $plus, $minus, $mult, $div, $mod, $max, $min =>
                            BEGIN
                            newINT: INT _ SELECT op FROM
                                $plus => li^+ri^,
                                $minus => li^-ri^,
                                $mult => li^*ri^,
                                $div => li^/ri^,
                                $mod => li^ MOD ri^,
                                $max => MAX[li^, ri^],
                                $min => MIN[li^, ri^],
                                ENDCASE => CCE[cirioError];
                            RETURN[CreateNumericNode[leftType, NEW[INT _ newINT]]];
                            END;
                        $le, $lt, $eq, $ne, $gt, $ge =>
                            BEGIN
                            newBoolean: BOOLEAN _ SELECT op FROM
                                $le => li^ <= ri^,
                                $lt => li^ < ri^,
                                $eq => li^ = ri^,
                                $ne => li^ # ri^,
                                $gt => li^ > ri^,
                                $ge => li^ >= ri^,
                                ENDCASE => CCE[cirioError];
                            RETURN[CedarOtherPureTypes.CreateBooleanNode[newBoolean, cc]];
                            END;
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    END;
                ld: REF subRange signed NumericDescriptor => CCE[cirioError]; -- shouldn't happen
                ld: REF full unsigned NumericDescriptor => 
                    BEGIN
                    lc: REF CARD _ NARROW[CedarCode.GetDataFromNode[leftNode]];
                    rc: REF CARD _ NARROW[CedarCode.GetDataFromNode[rightNode]];
                    SELECT op FROM
                        $plus, $minus, $mult, $div, $mod, $max, $min =>
                            BEGIN
                            newCARD: CARD _ SELECT op FROM
                                $plus => lc^+rc^,
                                $minus => lc^-rc^,
                                $mult => lc^*rc^,
                                $div => lc^/rc^,
                                $mod => lc^ MOD rc^,
                                $max => MAX[lc^, rc^],
                                $min => MIN[lc^, rc^],
                                ENDCASE => CCE[cirioError];
                            RETURN[CreateNumericNode[leftType, NEW[CARD _ newCARD]]];
                            END;
                        $le, $lt, $eq, $ne, $gt, $ge =>
                            BEGIN
                            newBoolean: BOOLEAN _ SELECT op FROM
                                $le => lc^ <= rc^,
                                $lt => lc^ < rc^,
                                $eq => lc^ = rc^,
                                $ne => lc^ # rc^,
                                $gt => lc^ > rc^,
                                $ge => lc^ >= rc^,
                                ENDCASE => CCE[cirioError];
                            RETURN[CedarOtherPureTypes.CreateBooleanNode[newBoolean, cc]];
                            END;
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    END;
                ld: REF subRange unsigned NumericDescriptor => CCE[cirioError]; -- shouldn't happen
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            END;

        NumericalUnaryOp: PROC[op: CCTypes.Operator, type: Type, node: Node, cc: CC] RETURNS[Node] =
            BEGIN
            nt: NumericType _ NARROW[GetProcDataFromGroundType[type, cc]];
            descriptor: REF NumericDescriptor _ nt.desc;

            WITH descriptor SELECT FROM
                d: REF real NumericDescriptor => 
                    BEGIN
                    r: REF REAL _ NARROW[CedarCode.GetDataFromNode[node]];
                    newREAL: REAL _ SELECT op FROM
                        $plus =>r^,
                        $minus => -r^,
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    RETURN[CreateNumericNode[type, NEW[REAL _ newREAL]]];
                    END;
                d: REF full signed NumericDescriptor => 
                    BEGIN
                    i: REF INT _ NARROW[CedarCode.GetDataFromNode[node]];
                    newINT: INT _ SELECT op FROM
                        $plus => i^,
                        $minus => -i^,
                        ENDCASE => CCE[cirioError]; -- shouldn't happen
                    RETURN[CreateNumericNode[type, NEW[INT _ newINT]]];
                    END;
                d: REF subRange signed NumericDescriptor => CCE[cirioError]; -- shouldn't happen
                d: REF full unsigned NumericDescriptor => 
                    BEGIN
                    c: REF CARD _ NARROW[CedarCode.GetDataFromNode[node]];
                    newCARD: CARD _ SELECT op FROM
                        $plus => c^,
                        $minus => -c^,
                        ENDCASE => CCE[cirioError];
                    RETURN[CreateNumericNode[type, NEW[CARD _ newCARD]]];
                    END;
                d: REF subRange unsigned NumericDescriptor => CCE[cirioError]; -- shouldn't happen
                ENDCASE => CCE[cirioError]; -- shouldn't happen
            END;


        NumericalAsIndex: PROC[type: Type, node: Node, cc: CC] RETURNS[CARD] =
            BEGIN
            nt: NumericType _ NARROW[GetProcDataFromGroundType[CedarCode.GetTypeOfNode[node], cc]];
            descriptor: REF NumericDescriptor _ nt.desc;

            WITH descriptor SELECT FROM
                d: REF full signed NumericDescriptor =>
                    BEGIN
                    val: REF INT32 _ NARROW[CedarCode.GetDataFromNode[node]];
                    RETURN[val^];
                    END;
                d: REF subRange signed NumericDescriptor =>
                    BEGIN
                    val: REF INT32 _ NARROW[CedarCode.GetDataFromNode[node]];
                    index: INT32 _ val^ - d.bottom;
                    RETURN[index];
                    END;
                d: REF full unsigned NumericDescriptor =>
                    BEGIN
                    val: REF CARD32 _ NARROW[CedarCode.GetDataFromNode[node]];
                    RETURN[val^];
                    END;
                d: REF subRange unsigned NumericDescriptor =>
                    BEGIN
                    val: REF CARD32 _ NARROW[CedarCode.GetDataFromNode[node]];
                    index: CARD32 _ val^ - d.bottom;
                    RETURN[index];
                    END;
                ENDCASE => CCE[cirioError];
            END;


        NumericalShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] =
            BEGIN
            nt: NumericType _ NARROW[GetProcDataFromGroundType[CedarCode.GetTypeOfNode[node], cc]];
            descriptor: REF NumericDescriptor _ nt.desc;

            WITH descriptor SELECT FROM
                d: REF real NumericDescriptor =>
                    to.PutRope[Convert.RopeFromReal[NARROW[CedarCode.GetDataFromNode[node], REF REAL]^]];
                d: REF full signed NumericDescriptor =>
                    to.PutRope[Convert.RopeFromInt[NARROW[CedarCode.GetDataFromNode[node], REF INT]^]];
                d: REF subRange signed NumericDescriptor =>
                    to.PutRope[Convert.RopeFromInt[NARROW[CedarCode.GetDataFromNode[node], REF INT]^]];
                d: REF full unsigned NumericDescriptor =>
                    to.PutRope[Convert.RopeFromCard[NARROW[CedarCode.GetDataFromNode[node], REF CARD]^]];
                d: REF subRange unsigned NumericDescriptor =>
                    to.PutRope[Convert.RopeFromCard[NARROW[CedarCode.GetDataFromNode[node], REF CARD]^]];
                ENDCASE => CCE[cirioError]; -- shouldn't happen

            END;

        NumericalGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
            {RETURN[CedarCode.GetDataFromNode[node]]};

        CheckEqualDescriptors: PROC[left, right: REF NumericDescriptor] =
            {IF NOT NDEqual[left^, right^] THEN CCE[cirioError]};


    END..