ruberon/source/ARITH.ob07

MODULE ARITH;

IMPORT STRINGS, UTILS IN "./utils/UTILS.ob07", LISTS;


CONST

    tINTEGER* = 1;  tREAL* = 2;  tSET*    = 3;
    tBOOLEAN* = 4;  tCHAR* = 5;  tWCHAR*  = 6;
    tSTRING*  = 7;

    opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5;
    opIN* = 6; opIS* = 7;


TYPE

    VALUE* = RECORD

        typ*:      INTEGER;

        int:       INTEGER;
        float:     REAL;
        set:       SET;
        bool:      BOOLEAN;

        string*:   LISTS.ITEM

    END;


VAR

    digit: ARRAY 256 OF INTEGER;


PROCEDURE Int* (v: VALUE): INTEGER;
    VAR
        res: INTEGER;

    BEGIN

        CASE v.typ OF
        |tINTEGER, tCHAR, tWCHAR:
            res := v.int
        |tSET:
            res := UTILS.Long(ORD(v.set))
        |tBOOLEAN:
            res := ORD(v.bool)
        END

        RETURN res
    END Int;


PROCEDURE getBool* (v: VALUE): BOOLEAN;
    BEGIN
        ASSERT(v.typ = tBOOLEAN);

        RETURN v.bool
    END getBool;


PROCEDURE Float* (v: VALUE): REAL;
    BEGIN
        ASSERT(v.typ = tREAL);

        RETURN v.float
    END Float;


PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;
        RETURN (a <= i.int) & (i.int <= b)
    END range;


PROCEDURE check* (v: VALUE): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        CASE v.typ OF
        |tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)
        |tCHAR:    res := range(v, 0, 255)
        |tWCHAR:   res := range(v, 0, 65535)
        |tREAL:    res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)
        END

        RETURN res
    END check;


PROCEDURE isZero* (v: VALUE): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        CASE v.typ OF
        |tINTEGER: res := v.int = 0
        |tREAL:    res := v.float = 0.0
        END

        RETURN res
    END isZero;


PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
    VAR
        value: INTEGER;
        i:     INTEGER;
        d:     INTEGER;

    BEGIN
        error := 0;
        value := 0;

        i := 0;
        WHILE STRINGS.digit(s[i]) & (error = 0) DO
            d := digit[ORD(s[i])];
            IF value <= (UTILS.maxint - d) DIV 10 THEN
                value := value * 10 + d;
                INC(i)
            ELSE
                error := 1
            END
        END;

        IF error = 0 THEN
            v.int := value;
            v.typ := tINTEGER;
            IF ~check(v) THEN
                error := 1
            END
        END

    END iconv;


PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
    VAR
        value: INTEGER;
        i:     INTEGER;
        n:     INTEGER;
        d:     INTEGER;

    BEGIN
        ASSERT(STRINGS.digit(s[0]));

        error := 0;
        value := 0;

        n := -1;
        i := 0;
        WHILE (s[i] # "H") & (s[i] # "X") & (s[i] # "h") & (s[i] # "x") & (error = 0) DO

            d := digit[ORD(s[i])];
            IF (n = -1) & (d # 0) THEN
                n := i
            END;

            IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
                error := 2
            ELSE
                value := value * 16 + d;
                INC(i)
            END

        END;

        value := UTILS.Long(value);

        IF ((s[i] = "X") OR (s[i] = "x")) & (n # -1) & (i - n > 4) THEN
            error := 3
        END;

        IF error = 0 THEN
            v.int := value;
            IF (s[i] = "X") OR (s[i] = "x") THEN
                v.typ := tCHAR;
                IF ~check(v) THEN
                    v.typ := tWCHAR;
                    IF ~check(v) THEN
                        error := 3
                    END
                END
            ELSE
                v.typ := tINTEGER;
                IF ~check(v) THEN
                    error := 2
                END
            END
        END

    END hconv;


PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;
    BEGIN
        CASE op OF
        |"+": a := a + b
        |"-": a := a - b
        |"*": a := a * b
        |"/": a := a / b
        END

        RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)
    END opFloat2;


PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
    VAR
        value:    REAL;
        exp10:    REAL;
        i, n, d:  INTEGER;
        minus:    BOOLEAN;

    BEGIN
        error := 0;
        value := 0.0;
        minus := FALSE;
        n := 0;

        exp10 := 0.0;
        WHILE (error = 0) & (STRINGS.digit(s[i]) OR (s[i] = ".")) DO
            IF s[i] = "." THEN
                exp10 := 1.0;
                INC(i)
            ELSE
                IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") & opFloat2(exp10, 10.0, "*") THEN
                    INC(i)
                ELSE
                    error := 4
                END
            END
        END;

        IF ~opFloat2(value, exp10, "/") THEN
            error := 4
        END;

        IF (s[i] = "E") OR (s[i] = "e") THEN
            INC(i)
        END;

        IF (s[i] = "-") OR (s[i] = "+") THEN
            minus := s[i] = "-";
            INC(i)
        END;

        WHILE (error = 0) & STRINGS.digit(s[i]) DO
            d := digit[ORD(s[i])];
            IF n <= (UTILS.maxint - d) DIV 10 THEN
                n := n * 10 + d;
                INC(i)
            ELSE
                error := 5
            END
        END;

        exp10 := 1.0;
        WHILE (error = 0) & (n > 0) DO
            IF opFloat2(exp10, 10.0, "*") THEN
                DEC(n)
            ELSE
                error := 4
            END
        END;

        IF error = 0 THEN
            IF minus THEN
                IF ~opFloat2(value, exp10, "/") THEN
                    error := 4
                END
            ELSE
                IF ~opFloat2(value, exp10, "*") THEN
                    error := 4
                END
            END
        END;

        IF error = 0 THEN
            v.float := value;
            v.typ := tREAL;
            IF ~check(v) THEN
                error := 4
            END
        END

    END fconv;


PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER);
    BEGIN
        v.typ := tCHAR;
        v.int := ord
    END setChar;


PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER);
    BEGIN
        v.typ := tWCHAR;
        v.int := ord
    END setWChar;


PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
    VAR
        error: BOOLEAN;

    BEGIN
        IF (a > 0) & (b > 0) THEN
            error := a > UTILS.maxint - b
        ELSIF (a < 0) & (b < 0) THEN
            error := a < UTILS.minint - b
        ELSE
            error := FALSE
        END;

        IF ~error THEN
            a := a + b
        ELSE
            a := 0
        END

        RETURN ~error
    END addInt;


PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
    VAR
        error: BOOLEAN;

    BEGIN
        IF (a > 0) & (b < 0) THEN
            error := a > UTILS.maxint + b
        ELSIF (a < 0) & (b > 0) THEN
            error := a < UTILS.minint + b
        ELSIF (a = 0) & (b < 0) THEN
            error := b = UTILS.minint
        ELSE
            error := FALSE
        END;

        IF ~error THEN
            a := a - b
        ELSE
            a := 0
        END

        RETURN ~error
    END subInt;


PROCEDURE lg2 (x: INTEGER): INTEGER;
    VAR
        n: INTEGER;

    BEGIN
        ASSERT(x > 0);

        n := UTILS.Log2(x);
        IF n = -1 THEN
            n := 255
        END

        RETURN n
    END lg2;


PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN;
    VAR
        error:    BOOLEAN;
        min, max: INTEGER;

    BEGIN
        min := UTILS.minint;
        max := UTILS.maxint;

        IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN
            error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b))

        ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN
            error := (a = min) OR (b = min);
            IF ~error THEN
                IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN
                    error := ABS(a) > max DIV ABS(b)
                END
            END

        ELSE
            error := FALSE
        END;

        IF ~error THEN
            a := a * b
        ELSE
            a := 0
        END

        RETURN ~error
    END mulInt;


PROCEDURE _ASR (x, n: INTEGER): INTEGER;
        RETURN ASR(UTILS.Long(x), n)
    END _ASR;


PROCEDURE _LSR (x, n: INTEGER): INTEGER;
        RETURN UTILS.Long(LSR(UTILS.Short(x), n))
    END _LSR;


PROCEDURE _LSL (x, n: INTEGER): INTEGER;
        RETURN UTILS.Long(LSL(x, n))
    END _LSL;


PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
    BEGIN
        x := UTILS.Short(x);
        x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
        RETURN UTILS.Long(x)
    END _ROR1_32;


PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
    BEGIN
        x := x MOD 65536;
        x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
        RETURN UTILS.Long(x)
    END _ROR1_16;


PROCEDURE _ROR (x, n: INTEGER): INTEGER;
    BEGIN

        CASE UTILS.bit_diff OF
        |0: x := ROR(x, n)
        |16, 48:
            n := n MOD 16;
            WHILE n > 0 DO
                x := _ROR1_16(x);
                DEC(n)
            END
        |32:
            n := n MOD 32;
            WHILE n > 0 DO
                x := _ROR1_32(x);
                DEC(n)
            END
        END

        RETURN x
    END _ROR;


PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
    VAR
        success: BOOLEAN;

    BEGIN
        success := TRUE;

        CASE op OF
        |"+": success := addInt(a.int, b.int)
        |"-": success := subInt(a.int, b.int)
        |"*": success := mulInt(a.int, b.int)
        |"/": success := FALSE
        |"D": a.int := a.int DIV b.int
        |"M": a.int := a.int MOD b.int
        |"L": a.int := _LSL(a.int, b.int)
        |"A": a.int := _ASR(a.int, b.int)
        |"O": a.int := _ROR(a.int, b.int)
        |"R": a.int := _LSR(a.int, b.int)
        |"m": a.int := MIN(a.int, b.int)
        |"x": a.int := MAX(a.int, b.int)
        END;
        a.typ := tINTEGER

        RETURN success & check(a)
    END opInt;


PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR);
    BEGIN
        s[0] := CHR(c.int);
        s[1] := 0X
    END charToStr;


PROCEDURE opSet* (VAR a: VALUE; b: VALUE; op: CHAR);
    BEGIN
        CASE op OF
        |"+": a.set := a.set + b.set
        |"-": a.set := a.set - b.set
        |"*": a.set := a.set * b.set
        |"/": a.set := a.set / b.set
        END;
        a.typ := tSET
    END opSet;


PROCEDURE opFloat* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
    BEGIN
        a.typ := tREAL
        RETURN opFloat2(a.float, b.float, op) & check(a)
    END opFloat;


PROCEDURE ord* (VAR v: VALUE);
    BEGIN
        CASE v.typ OF
        |tCHAR, tWCHAR:
        |tBOOLEAN: v.int := ORD(v.bool)
        |tSET:     v.int := UTILS.Long(ORD(v.set))
        END;
        v.typ := tINTEGER
    END ord;


PROCEDURE odd* (VAR v: VALUE);
    BEGIN
        v.typ := tBOOLEAN;
        v.bool := ODD(v.int)
    END odd;


PROCEDURE bits* (VAR v: VALUE);
    BEGIN
        v.typ := tSET;
        v.set := BITS(v.int)
    END bits;


PROCEDURE abs* (VAR v: VALUE): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        res := FALSE;

        CASE v.typ OF
        |tREAL:
            v.float := ABS(v.float);
            res := TRUE
        |tINTEGER:
            IF v.int # UTILS.minint THEN
                v.int := ABS(v.int);
                res := TRUE
            END
        END

        RETURN res
    END abs;


PROCEDURE floor* (VAR v: VALUE): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        v.typ := tINTEGER;
        res := (FLT(UTILS.minint) <= v.float) & (v.float <= FLT(UTILS.maxint));
        IF res THEN
            v.int := FLOOR(v.float)
        END

        RETURN res
    END floor;


PROCEDURE flt* (VAR v: VALUE);
    BEGIN
        v.typ := tREAL;
        v.float := FLT(v.int)
    END flt;


PROCEDURE neg* (VAR v: VALUE): BOOLEAN;
    VAR
        z: VALUE;
        res: BOOLEAN;

    BEGIN
        res := TRUE;

        z.typ := tINTEGER;
        z.int := 0;

        CASE v.typ OF
        |tREAL:     v.float := -v.float
        |tSET:      v.set := -v.set
        |tINTEGER:  res := opInt(z, v, "-"); v := z
        |tBOOLEAN:  v.bool := ~v.bool
        END

        RETURN res
    END neg;


PROCEDURE setbool* (VAR v: VALUE; b: BOOLEAN);
    BEGIN
        v.bool := b;
        v.typ := tBOOLEAN
    END setbool;


PROCEDURE opBoolean* (VAR a: VALUE; b: VALUE; op: CHAR);
    BEGIN
        CASE op OF
        |"&": a.bool := a.bool & b.bool
        |"|": a.bool := a.bool OR b.bool
        END;
        a.typ := tBOOLEAN
    END opBoolean;


PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        res := FALSE;

        IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN
            CASE v.typ OF
            |tINTEGER,
            tWCHAR,
            tCHAR:     res := v.int < v2.int
            |tREAL:     res := v.float < v2.float
            |tBOOLEAN,
            tSET:      error := 1
            END
        ELSE
            error := 1
        END

        RETURN res
    END less;


PROCEDURE equal (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        res := FALSE;

        IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN
            CASE v.typ OF
            |tINTEGER,
            tWCHAR,
            tCHAR:     res := v.int = v2.int
            |tREAL:     res := v.float = v2.float
            |tBOOLEAN:  res := v.bool = v2.bool
            |tSET:      res := v.set = v2.set
            END
        ELSE
            error := 1
        END

        RETURN res
    END equal;


PROCEDURE relation* (VAR v: VALUE; v2: VALUE; op: INTEGER; VAR error: INTEGER);
    VAR
        res: BOOLEAN;

    BEGIN
        error := 0;

        res := FALSE;

        CASE op OF

        |opEQ:
            res := equal(v, v2, error)

        |opNE:
            res := ~equal(v, v2, error)

        |opLT:
            res := less(v, v2, error)

        |opLE:
            res := less(v, v2, error);
            IF error = 0 THEN
                res := equal(v, v2, error) OR res
            END

        |opGE:
            res := ~less(v, v2, error)

        |opGT:
            res := less(v, v2, error);
            IF error = 0 THEN
                res := equal(v, v2, error) OR res
            END;
            res := ~res

        |opIN:
            IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
                IF range(v, 0, UTILS.target.maxSet) THEN
                    res := v.int IN v2.set
                ELSE
                    error := 2
                END
            ELSE
                error := 1
            END

        END;

        IF error = 0 THEN
            v.bool := res;
            v.typ  := tBOOLEAN
        END

    END relation;


PROCEDURE emptySet* (VAR v: VALUE);
    BEGIN
        v.typ := tSET;
        v.set := {}
    END emptySet;


PROCEDURE constrSet* (VAR v: VALUE; a, b: VALUE);
    BEGIN
        v.typ := tSET;
        v.set := {a.int .. b.int}
    END constrSet;


PROCEDURE getInt* (v: VALUE): INTEGER;
    BEGIN
        ASSERT(check(v))

        RETURN v.int
    END getInt;


PROCEDURE setInt* (VAR v: VALUE; i: INTEGER): BOOLEAN;
    BEGIN
        v.int := i;
        v.typ := tINTEGER

        RETURN check(v)
    END setInt;


PROCEDURE concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN;
    VAR
        res: BOOLEAN;

    BEGIN
        res := LENGTH(s) + LENGTH(s1) < LEN(s);
        IF res THEN
            STRINGS.append(s, s1)
        END

        RETURN res
    END concat;


PROCEDURE init;
    VAR
        i: INTEGER;

    BEGIN
        FOR i := 0 TO LEN(digit) - 1 DO
            digit[i] := -1
        END;

        FOR i := ORD("0") TO ORD("9") DO
            digit[i] := i - ORD("0")
        END;

        FOR i := ORD("A") TO ORD("F") DO
            digit[i] := i - ORD("A") + 10
        END
    END init;


BEGIN
    init
END ARITH.