
    <<PSMathImpl.mesa>>
        <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, March 27, 1987 4:38:52 pm PST>>

    <<PostScript implementation: arithmetic, math, boolean operators.>>
    <<>>
    DIRECTORY
        PS,
        Basics USING [DoubleAnd, DoubleNot, DoubleOr, DoubleShift, DoubleXor],
        Random USING [Create, NextInt],
        Real USING [Ceiling, Fix, Floor, RealException],
        RealFns USING [ArcTanDeg, CosDeg, Ln, Log, Power, SinDeg, SqRt];

    PSMathImpl: CEDAR PROGRAM
    IMPORTS Basics, PS, Random, Real, RealFns
    ~ BEGIN OPEN PS;
<<Arithmetic and math operators>>
    Add: PROC [num1, num2: Num] RETURNS [Num] ~ {
        WITH n1: num1 SELECT FROM
            int => WITH n2: num2 SELECT FROM
                int => {
                    int1: INT ~ n1.int;
                    int2: INT ~ n2.int;
                    int3: INT ~ int1+int2;
                    IF (int1<0)#(int2<0) OR (int2<0)=(int3<0) THEN RETURN [[int[int3]]]
                    ELSE RETURN [[real[REAL[int1]+REAL[int2]]]];
                    };
                real => RETURN [[real[REAL[n1.int]+n2.real]]];
                ENDCASE;
            real => WITH n2: num2 SELECT FROM
                int => RETURN [[real[n1.real+REAL[n2.int]]]];
                real => RETURN [[real[n1.real+n2.real]]];
                ENDCASE;
            ENDCASE;
        ERROR;
        };

    Sub: PROC [num1, num2: Num] RETURNS [Num] ~ {
        WITH n1: num1 SELECT FROM
            int => WITH n2: num2 SELECT FROM
                int => {
                    int1: INT ~ n1.int;
                    int2: INT ~ n2.int;
                    int3: INT ~ int1-int2;
                    IF (int1<0)=(int2<0) OR (int2<0)#(int3<0) THEN RETURN [[int[int3]]]
                    ELSE RETURN [[real[REAL[int1]-REAL[int2]]]];
                    };
                real => RETURN [[real[REAL[n1.int]-n2.real]]];
                ENDCASE;
            real => WITH n2: num2 SELECT FROM
                int => RETURN [[real[n1.real-REAL[n2.int]]]];
                real => RETURN [[real[n1.real-n2.real]]];
                ENDCASE;
            ENDCASE;
        ERROR;
        };

    Mul: PROC [num1, num2: Num] RETURNS [Num] ~ {
        WITH n1: num1 SELECT FROM
            int => WITH n2: num2 SELECT FROM
                int => {
                    int1: INT ~ n1.int;
                    int2: INT ~ n2.int;
                    int3: INT ~ int1*int2;
                    real3: REAL ~ REAL[int1]*REAL[int2];
                    <<********** fix this **********>>
                    IF int3=real3 THEN RETURN [[int[int3]]]
                    ELSE RETURN [[real[REAL[int1]*REAL[int2]]]];
                    };
                real => RETURN [[real[REAL[n1.int]*n2.real]]];
                ENDCASE;
            real => WITH n2: num2 SELECT FROM
                int => RETURN [[real[n1.real*REAL[n2.int]]]];
                real => RETURN [[real[n1.real*n2.real]]];
                ENDCASE;
            ENDCASE;
        ERROR;
        };

    Abs: PROC [num: Num] RETURNS [Num] ~ {
        WITH n: num SELECT FROM
            int => {
                IF n.int#INT.FIRST THEN RETURN [[int[ABS[n.int]]]]
                ELSE RETURN [[real[ABS[REAL[n.int]]]]];
                };
            real => RETURN [[real[ABS[n.real]]]];
            ENDCASE;
        ERROR;
        };

    Neg: PROC [num: Num] RETURNS [Num] ~ {
        WITH n: num SELECT FROM
            int => {
                IF n.int#INT.FIRST THEN RETURN [[int[-n.int]]]
                ELSE RETURN [[real[-REAL[n.int]]]];
                };
            real => RETURN [[real[-n.real]]];
            ENDCASE;
        ERROR;
        };

Truncate: PROC [x: REAL] RETURNS [z: REAL] ~ {
    z _ Real.Fix[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Ceiling: PROC [x: REAL] RETURNS [z: REAL] ~ {
    z _ Real.Ceiling[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Floor: PROC [x: REAL] RETURNS [z: REAL] ~ {
    z _ Real.Floor[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Round: PROC [x: REAL] RETURNS [REAL] ~ {
    RETURN [Floor[x+0.5]];
};


    Padd: PROC [self: Root] ~ {
        num2: Num ~ PopNum[self];
        num1: Num ~ PopNum[self];
    PushNum[self, Add[num1, num2]];
        };

    Psub: PROC [self: Root] ~ {
        num2: Num ~ PopNum[self];
        num1: Num ~ PopNum[self];
    PushNum[self, Sub[num1, num2]];
        };

    Pmul: PROC [self: Root] ~ {
        num2: Num ~ PopNum[self];
        num1: Num ~ PopNum[self];
    PushNum[self, Mul[num1, num2]];
        };

    Pdiv: PROC [self: Root] ~ {
        n2: REAL ~ PopReal[self];
        n1: REAL ~ PopReal[self];
        PushReal[self, n1/n2];
        };

    Pidiv: PROC [self: Root] ~ {
        int2: INT ~ PopInt[self];
        int1: INT ~ PopInt[self];
        PushInt[self, int1/int2];
        };

    Pmod: PROC [self: Root] ~ {
        int2: INT ~ PopInt[self];
        int1: INT ~ PopInt[self];
        PushInt[self, int1 MOD int2];
        };

    Pabs: PROC [self: Root] ~ {
        num: Num ~ PopNum[self];
    PushNum[self, Abs[num]];
        };

    Pneg: PROC [self: Root] ~ {
        num: Num ~ PopNum[self];
    PushNum[self, Neg[num]];
        };

    Pceiling: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            integer => NULL;
            real => PushReal[self, Ceiling[PopReal[self]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Pfloor: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            integer => NULL;
            real => PushReal[self, Floor[PopReal[self]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Pround: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            integer => NULL;
            real => PushReal[self, Round[PopReal[self]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Ptruncate: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            integer => NULL;
            real => PushReal[self, Truncate[PopReal[self]]];
            ENDCASE => ERROR Error[typecheck];
        };

    Psqrt: PROC [self: Root] ~ {
        num: REAL ~ PopReal[self];
        PushReal[self, RealFns.SqRt[num]];
        };

    Patan: PROC [self: Root] ~ {
        den: REAL ~ PopReal[self];
        num: REAL ~ PopReal[self];
        PushReal[self, RealFns.ArcTanDeg[num, den]];
        };

    Pcos: PROC [self: Root] ~ {
        angle: REAL ~ PopReal[self];
        PushReal[self, RealFns.CosDeg[angle]];
        };

    Psin: PROC [self: Root] ~ {
        angle: REAL ~ PopReal[self];
        PushReal[self, RealFns.SinDeg[angle]];
        };

    Pexp: PROC [self: Root] ~ {
        exponent: REAL ~ PopReal[self];
        base: REAL ~ PopReal[self];
        PushReal[self, RealFns.Power[base, exponent]];
        };

    Pln: PROC [self: Root] ~ {
        num: REAL ~ PopReal[self];
        PushReal[self, RealFns.Ln[num]];
        };

    Plog: PROC [self: Root] ~ {
        num: REAL ~ PopReal[self];
        PushReal[self, RealFns.Log[10, num]];
        };

    Prand: PROC [self: Root] ~ {
        int: INT ~ Random.NextInt[self.random];
        PushInt[self, int];
        };

    Psrand: PROC [self: Root] ~ {
        int: INT ~ PopInt[self];
        self.random _ Random.Create[seed: int];
        };

    Prrand: PROC [self: Root] ~ {
        ERROR Error[unimplemented];
        };

<<Boolean and bitwise operators>>
    Pand: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            boolean => {
                bool2: BOOL ~ PopBool[self];
                bool1: BOOL ~ PopBool[self];
                PushBool[self, bool1 AND bool2];
                };
            integer => {
                int2: INT ~ PopInt[self];
                int1: INT ~ PopInt[self];
                PushInt[self, Basics.DoubleAnd[[li[int1]], [li[int2]]].li];
                };
            ENDCASE => ERROR Error[typecheck];
        };

    Pnot: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            boolean => {
                bool1: BOOL ~ PopBool[self];
                PushBool[self, NOT bool1];
                };
            integer => {
                int1: INT ~ PopInt[self];
                PushInt[self, Basics.DoubleNot[[li[int1]]].li];
                };
            ENDCASE => ERROR Error[typecheck];
        };

    Por: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            boolean => {
                bool2: BOOL ~ PopBool[self];
                bool1: BOOL ~ PopBool[self];
                PushBool[self, bool1 OR bool2];
                };
            integer => {
                int2: INT ~ PopInt[self];
                int1: INT ~ PopInt[self];
                PushInt[self, Basics.DoubleOr[[li[int1]], [li[int2]]].li];
                };
            ENDCASE => ERROR Error[typecheck];
        };

    Pxor: PROC [self: Root] ~ {
        SELECT TopType[self] FROM
            boolean => {
                bool2: BOOL ~ PopBool[self];
                bool1: BOOL ~ PopBool[self];
                PushBool[self, bool1 # bool2];
                };
            integer => {
                int2: INT ~ PopInt[self];
                int1: INT ~ PopInt[self];
                PushInt[self, Basics.DoubleXor[[li[int1]], [li[int2]]].li];
                };
            ENDCASE => ERROR Error[typecheck];
        };

    Pbitshift: PROC [self: Root] ~ {
        shift: INT ~ PopInt[self];
        int1: INT ~ PopInt[self];
        IF shift NOT IN INTEGER THEN PushInt[self, 0]
        ELSE PushInt[self, Basics.DoubleShift[[li[int1]], shift].li];
        };


<<Registered primitives>>
true: Any ~ AnyFromBool[TRUE];
false: Any ~ AnyFromBool[FALSE];

MathPrimitives: PROC [self: Root] ~ {
    Register[self, "add", Padd];
    Register[self, "div", Pdiv];
    Register[self, "idiv", Pidiv];
    Register[self, "mod", Pmod];
    Register[self, "mul", Pmul];
    Register[self, "sub", Psub];
    Register[self, "abs", Pabs];
    Register[self, "neg", Pneg];
    Register[self, "ceiling", Pceiling];
    Register[self, "floor", Pfloor];
    Register[self, "round", Pround];
    Register[self, "truncate", Ptruncate];
    Register[self, "sqrt", Psqrt];
    Register[self, "atan", Patan];
    Register[self, "cos", Pcos];
    Register[self, "sin", Psin];
    Register[self, "exp", Pexp];
    Register[self, "ln", Pln];
    Register[self, "log", Plog];
    Register[self, "rand", Prand];
    Register[self, "srand", Psrand];
    Register[self, "rrand", Prrand];
    Register[self, "and", Pand];
    Register[self, "not", Pnot];
    Register[self, "or", Por];
    Register[self, "xor", Pxor];
    Register[self, "bitshift", Pbitshift];
    RegisterVal[self, "true", true];
    RegisterVal[self, "false", false];
};

RegisterPrimitives[MathPrimitives];

END.