diff --git a/fn/irrational.fn b/fn/irrational.fn index 4e0ed72..5489186 100644 --- a/fn/irrational.fn +++ b/fn/irrational.fn @@ -1 +1,79 @@ -print(1.5) +// int bigint rational irrational +// left right +// + - * / % ** cmp +let + fn test { + (1.0) { 0.0 } + (n) { 1 + n } + } + bi = 642086031413279956691053384794363; +in + print(1 + 1); + print(1 + bi); + print(1 + 1/2); + print(1 + 0.5); + + print(bi + 1); + print(bi + bi); + print(bi + 1/2); + print(bi + 0.5); + + print(1/2 + 1); + print(1/2 + bi); + print(1/2 + 1/2); + print(1/2 + 0.5); + + print(0.5 + 1); + print(0.5 + bi); + print(0.5 + 1/2); + print(0.5 + 0.5); + print(1 * 1); + print(1 * bi); + print(1 * 1/2); + print(1 * 0.5); + print(bi * 1); + print(bi * bi); + print(bi * 1/2); + print(bi * 0.5); + print(1/2 * 1); + print(1/2 * bi); + print(1/2 * 1/2); + print(1/2 * 0.5); + print(0.5 * 1); + print(0.5 * bi); + print(0.5 * 1/2); + print(0.5 * 0.5); + print(1 / 1); + print(1 / bi); + print(1 / (1/2)); + print(1 / 0.5); + print(bi / 1); + print(bi / bi); + print(bi / (1/2)); + print(bi / 0.5); + print((1/2) / 1); + print((1/2) / bi); + print((1/2) / (1/2)); + print((1/2) / 0.5); + print(0.5 / 1); + print(0.5 / bi); + print(0.5 / (1/2)); + print(0.5 / 0.5); + print(1 ** 1); + // print(1 ** bi); + print(1 ** (1/2)); + print(1 ** 0.5); + print(bi ** 1); + // print(bi ** bi); + print(bi ** (1/2)); + print(bi ** 0.5); + print((1/2) ** 1); + // print((1/2) ** bi); + print((1/2) ** (1/2)); + print((1/2) ** 0.5); + print(0.5 ** 1); + print(0.5 ** bi); + print(0.5 ** (1/2)); + print(0.5 ** 0.5); + // print(sin(0.5)); + print(test(12)); diff --git a/src/arithmetic.c b/src/arithmetic.c index 9785313..2e29336 100644 --- a/src/arithmetic.c +++ b/src/arithmetic.c @@ -34,10 +34,33 @@ #define NUMERATOR 0 #define DENOMINATOR 1 +#define IS_BIGINT(x) ((x).type == VALUE_TYPE_BIGINT) +#define IS_IRRATIONAL(x) ((x).type == VALUE_TYPE_IRRATIONAL) +#define IS_RATIONAL(x) ((x).type == VALUE_TYPE_RATIONAL) +#define IS_STDINT(x) ((x).type == VALUE_TYPE_STDINT) +#define IS_INT(x) (IS_STDINT(x) || IS_BIGINT(x)) + +#ifdef SAFETY_CHECKS +# define ASSERT_RATIONAL(x) ASSERT(IS_RATIONAL(x)) +# define ASSERT_IRRATIONAL(x) ASSERT(IS_IRRATIONAL(x)) +# define ASSERT_BIGINT(x) ASSERT(IS_BIGINT(x)) +# define ASSERT_STDINT(x) ASSERT(IS_STDINT(x)) +# define ASSERT_INT(x) ASSERT(IS_INT(x)) +#else +# define ASSERT_RATIONAL(x) +# define ASSERT_IRRATIONAL(x) +# define ASSERT_BIGINT(x) +# define ASSERT_STDINT(x) +# define ASSERT_INT(x) +#endif + +// coerce adds this to its result if it malloc'd a right value +#define RIGHT_INDICATOR 1024 + typedef Value (*IntegerBinOp)(Value, Value); typedef Value (*ParameterizedBinOp)(IntegerBinOp, Value, Value); -int rational_flag = 0; +static bool arithmetic_initialized = false; static Value One = { .type = VALUE_TYPE_STDINT, @@ -65,26 +88,128 @@ static void ppNumber(Value number) { eprintf("/"); ppNumber(number.val.vec->values[1]); break; + case VALUE_TYPE_IRRATIONAL: + eprintf("%f", number.val.irrational); + break; default: eprintf("??? %d ???", number.type); } } #endif -#define IS_BIGINT(x) ((x).type == VALUE_TYPE_BIGINT) +static Value ratValue(Value numerator, Value denominator) { + Vec *vec = newVec(2); + vec->values[NUMERATOR] = numerator; + vec->values[DENOMINATOR] = denominator; + Value res = rationalValue(vec); + return res; +} + +static Value int_to_irrational(Value *integer) { + ASSERT_INT(*integer); + if (integer->type == VALUE_TYPE_BIGINT) { + return irrationalValue(bigIntToDouble(integer->val.bigint)); + } else { + return irrationalValue(integer->val.stdint); + } +} -static Value intValue(int i) { - Value val; - val.type = VALUE_TYPE_STDINT; - val.val = VALUE_VAL_STDINT(i); - return val; +static Value rational_to_irrational(Value *rational) { + ASSERT_RATIONAL(*rational); + Value numerator = int_to_irrational(&(rational->val.vec->values[NUMERATOR])); + Value denominator = int_to_irrational(&(rational->val.vec->values[DENOMINATOR])); + return irrationalValue(numerator.val.irrational / denominator.val.irrational); } -static Value bigIntValue(BigInt *i) { - Value val; - val.type = VALUE_TYPE_BIGINT; - val.val = VALUE_VAL_BIGINT(i); - return val; +static Value int_to_rational(Value *integer) { + ASSERT_INT(*integer); + Value one = stdintValue(1); + return ratValue(*integer, one); +} + +static Value bigint_to_irrational(Value *v) { + ASSERT_BIGINT(*v); + return irrationalValue(bigIntToDouble(v->val.bigint)); +} + +static Value int_to_bigint(Value *v) { + ASSERT_STDINT(*v); + return bigintValue(bigIntFromInt(v->val.stdint)); +} + +static int coerce(Value *left, Value *right) { + switch(left->type) { + case VALUE_TYPE_RATIONAL: + switch(right->type) { + case VALUE_TYPE_RATIONAL: + return VALUE_TYPE_RATIONAL; + case VALUE_TYPE_IRRATIONAL: + *left = rational_to_irrational(left); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + *right = int_to_rational(right); + return VALUE_TYPE_RATIONAL + RIGHT_INDICATOR; + case VALUE_TYPE_STDINT: + *right = int_to_rational(right); + return VALUE_TYPE_RATIONAL + RIGHT_INDICATOR; + default: + cant_happen("unrecognised right number type %d", right->type); + } + break; + case VALUE_TYPE_IRRATIONAL: + switch(right->type) { + case VALUE_TYPE_RATIONAL: + *right = rational_to_irrational(right); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_IRRATIONAL: + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + *right = bigint_to_irrational(right); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_STDINT: + *right = int_to_irrational(right); + return VALUE_TYPE_IRRATIONAL; + default: + cant_happen("unrecognised right number type %d", right->type); + } + break; + case VALUE_TYPE_BIGINT: + switch(right->type) { + case VALUE_TYPE_RATIONAL: + *left = int_to_rational(left); + return VALUE_TYPE_RATIONAL; + case VALUE_TYPE_IRRATIONAL: + *left = bigint_to_irrational(left); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + return VALUE_TYPE_BIGINT; + case VALUE_TYPE_STDINT: + *right = int_to_bigint(right); + return VALUE_TYPE_BIGINT + RIGHT_INDICATOR; + default: + cant_happen("unrecognised right number type %d", right->type); + } + break; + case VALUE_TYPE_STDINT: + switch(right->type) { + case VALUE_TYPE_RATIONAL: + *left = int_to_rational(left); + return VALUE_TYPE_RATIONAL; + case VALUE_TYPE_IRRATIONAL: + *left = int_to_irrational(left); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + *left = int_to_bigint(left); + return VALUE_TYPE_BIGINT; + case VALUE_TYPE_STDINT: + return VALUE_TYPE_STDINT; + default: + cant_happen("unrecognised right number type %d", right->type); + } + break; + default: + cant_happen("unrecognised left number type %d", left->type); + } } static inline Cmp int_cmp_bb(Value left, Value right) { @@ -95,6 +220,10 @@ static inline Cmp int_cmp_bi(Value left, Value right) { return cmpBigIntInt(left.val.bigint, right.val.stdint); } +static inline Cmp int_cmp_bf(Value left, Value right) { + return cmpBigIntDouble(left.val.bigint, right.val.irrational); +} + static inline Cmp int_cmp_ib(Value left, Value right) { return cmpIntBigInt(left.val.stdint, right.val.bigint); } @@ -105,23 +234,82 @@ static inline Cmp int_cmp_ii(Value left, Value right) { CMP_GT; } -static Cmp int_cmp(Value left, Value right) { - ENTER(int_cmp); +static inline Cmp int_cmp_if(Value left, Value right) { + return left.val.stdint < right.val.irrational ? CMP_LT : + left.val.stdint == right.val.irrational ? CMP_EQ : + CMP_GT; +} + +static inline Cmp int_cmp_fb(Value left, Value right) { + return cmpDoubleBigInt(left.val.stdint, right.val.bigint); +} + +static inline Cmp int_cmp_fi(Value left, Value right) { + return left.val.irrational < right.val.stdint ? CMP_LT : + left.val.irrational == right.val.stdint ? CMP_EQ : + CMP_GT; +} + +static inline Cmp int_cmp_ff(Value left, Value right) { + return left.val.irrational < right.val.irrational ? CMP_LT : + left.val.irrational == right.val.irrational ? CMP_EQ : + CMP_GT; +} + +static Cmp numCmp(Value left, Value right) { + ENTER(numCmp); Cmp res; - if (IS_BIGINT(left)) { - if (IS_BIGINT(right)) { - res = int_cmp_bb(left, right); - } else { - res = int_cmp_bi(left, right); - } - } else { - if (IS_BIGINT(right)) { - res = int_cmp_ib(left, right); - } else { - res = int_cmp_ii(left, right); - } + switch (left.type) { + case VALUE_TYPE_BIGINT: + switch (right.type) { + case VALUE_TYPE_BIGINT: + res = int_cmp_bb(left, right); + break; + case VALUE_TYPE_STDINT: + res = int_cmp_bi(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = int_cmp_bf(left, right); + break; + default: + cant_happen("invalid number type"); + } + break; + case VALUE_TYPE_STDINT: + switch (right.type) { + case VALUE_TYPE_BIGINT: + res = int_cmp_ib(left, right); + break; + case VALUE_TYPE_STDINT: + res = int_cmp_ii(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = int_cmp_if(left, right); + break; + default: + cant_happen("invalid number type"); + } + break; + case VALUE_TYPE_IRRATIONAL: + switch (right.type) { + case VALUE_TYPE_BIGINT: + res = int_cmp_fb(left, right); + break; + case VALUE_TYPE_STDINT: + res = int_cmp_fi(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = int_cmp_ff(left, right); + break; + default: + cant_happen("invalid number type"); + } + break; + default: + cant_happen("invalid number type"); } - LEAVE(int_cmp); + + LEAVE(numCmp); return res; } @@ -130,38 +318,38 @@ static Value safe_add(int a, int b) { if (__builtin_add_overflow(a, b, &c)) { BigInt *big = bigIntFromAddition(a, b); int save = PROTECT(big); - Value res = bigIntValue(big); + Value res = bigintValue(big); UNPROTECT(save); return res; } else { - return intValue(c); + return stdintValue(c); } } -static Value int_add(Value left, Value right) { - ENTER(int_add); +static Value intAdd(Value left, Value right) { + ENTER(intAdd); Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { if (IS_BIGINT(right)) { BigInt *b = addBigInt(left.val.bigint, right.val.bigint); PROTECT(b); - res = bigIntValue(b); + res = bigintValue(b); } else { BigInt *b = addBigIntInt(left.val.bigint, right.val.stdint); PROTECT(b); - res = bigIntValue(b); + res = bigintValue(b); } } else { if (IS_BIGINT(right)) { BigInt *b = addBigIntInt(right.val.bigint, left.val.stdint); PROTECT(b); - res = bigIntValue(b); + res = bigintValue(b); } else { res = safe_add(left.val.stdint, right.val.stdint); } } - LEAVE(int_add); + LEAVE(intAdd); UNPROTECT(save); return res; } @@ -171,32 +359,32 @@ static Value safe_mul(int a, int b) { if (__builtin_mul_overflow(a, b, &c)) { BigInt *big = bigIntFromMultiplication(a, b); int save = PROTECT(big); - Value res = bigIntValue(big); + Value res = bigintValue(big); UNPROTECT(save); return res; } else { - return intValue(c); + return stdintValue(c); } } -static Value int_mul(Value left, Value right) { +static Value intMul(Value left, Value right) { Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { if (IS_BIGINT(right)) { BigInt *bi = mulBigInt(left.val.bigint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { BigInt *bi = mulBigIntInt(left.val.bigint, right.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } } else { if (IS_BIGINT(right)) { BigInt *bi = mulBigIntInt(right.val.bigint, left.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { res = safe_mul(left.val.stdint, right.val.stdint); } @@ -210,32 +398,32 @@ static Value safe_sub(int a, int b) { if (__builtin_sub_overflow(a, b, &c)) { BigInt *big = bigIntFromSubtraction(a, b); int save = PROTECT(big); - Value res = bigIntValue(big); + Value res = bigintValue(big); UNPROTECT(save); return res; } else { - return intValue(c); + return stdintValue(c); } } -static Value int_sub(Value left, Value right) { +static Value intSub(Value left, Value right) { Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { if (IS_BIGINT(right)) { BigInt *bi = subBigInt(left.val.bigint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { BigInt *bi = subBigIntInt(left.val.bigint, right.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } } else { if (IS_BIGINT(right)) { BigInt *bi = subIntBigInt(left.val.stdint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { res = safe_sub(left.val.stdint, right.val.stdint); } @@ -244,7 +432,7 @@ static Value int_sub(Value left, Value right) { return res; } -static Value int_div(Value left, Value right) { +static Value basicIntDiv(Value left, Value right) { Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { @@ -254,14 +442,14 @@ static Value int_div(Value left, Value right) { } BigInt *bi = divBigInt(left.val.bigint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { if (right.val.stdint == 0) { cant_happen("attempted div zero"); } BigInt *bi = divBigIntInt(left.val.bigint, right.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } } else { if (IS_BIGINT(right)) { @@ -270,13 +458,13 @@ static Value int_div(Value left, Value right) { } BigInt *bi = divIntBigInt(left.val.stdint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { if (right.val.stdint == 0) { cant_happen("attempted div zero"); } // division can't overflow - res = intValue(left.val.stdint / right.val.stdint); + res = stdintValue(left.val.stdint / right.val.stdint); } } UNPROTECT(save); @@ -288,32 +476,34 @@ static Value safe_pow(int a, int b) { if (f == HUGE_VALF || f > (float)INT_MAX || f < (float)INT_MIN) { BigInt *big = bigIntFromPower(a, b); int save = PROTECT(big); - Value res = bigIntValue(big); + Value res = bigintValue(big); UNPROTECT(save); return res; } else { - return intValue((int) f); + return stdintValue((int) f); } } -static Value int_pow(Value left, Value right) { +static Value intPow(Value left, Value right) { + ASSERT_INT(left); + ASSERT_INT(right); Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { if (IS_BIGINT(right)) { BigInt *bi = powBigInt(left.val.bigint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { BigInt *bi = powBigIntInt(left.val.bigint, right.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } } else { if (IS_BIGINT(right)) { BigInt *bi = powIntBigInt(left.val.stdint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { res = safe_pow(left.val.stdint, right.val.stdint); } @@ -322,7 +512,9 @@ static Value int_pow(Value left, Value right) { return res; } -static Value int_mod(Value left, Value right) { +static Value intMod(Value left, Value right) { + ASSERT_INT(left); + ASSERT_INT(right); Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { @@ -332,14 +524,14 @@ static Value int_mod(Value left, Value right) { } BigInt *bi = modBigInt(left.val.bigint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { if (right.val.stdint == 0) { cant_happen("attempted mod zero"); } BigInt *bi = modBigIntInt(left.val.bigint, right.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } } else { if (IS_BIGINT(right)) { @@ -348,13 +540,13 @@ static Value int_mod(Value left, Value right) { } BigInt *bi = modIntBigInt(left.val.stdint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { if (right.val.stdint == 0) { cant_happen("attempted mod zero"); } // modulus can't overflow - res = intValue(left.val.stdint % right.val.stdint); + res = stdintValue(left.val.stdint % right.val.stdint); } } UNPROTECT(save); @@ -374,33 +566,33 @@ static int gcd (int a, int b) { return gcd; } -static Value int_gcd(Value left, Value right) { +static Value intGcd(Value left, Value right) { Value res; int save = PROTECT(NULL); if (IS_BIGINT(left)) { if (IS_BIGINT(right)) { BigInt *bi = gcdBigInt(left.val.bigint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { BigInt *bi = gcdBigIntInt(left.val.bigint, right.val.stdint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } } else { if (IS_BIGINT(left)) { BigInt *bi = gcdIntBigInt(left.val.stdint, right.val.bigint); PROTECT(bi); - res = bigIntValue(bi); + res = bigintValue(bi); } else { - res = intValue(gcd(left.val.stdint, right.val.stdint)); + res = stdintValue(gcd(left.val.stdint, right.val.stdint)); } } UNPROTECT(save); return res; } -static void int_neg_in_place(Value *v) { +static void intNegInPlace(Value *v) { if (IS_BIGINT(*v)) { negateBigInt(v->val.bigint); } else { @@ -408,13 +600,14 @@ static void int_neg_in_place(Value *v) { } } -static Value int_neg(Value v) { +static Value intNeg(Value v) { + ASSERT_INT(v); int save = PROTECT(NULL); if (IS_BIGINT(v)) { BigInt *bi = copyBigInt(v.val.bigint); PROTECT(bi); negateBigInt(bi); - v = bigIntValue(bi); + v = bigintValue(bi); } else { v.val.stdint = -(v.val.stdint); } @@ -422,7 +615,16 @@ static Value int_neg(Value v) { return v; } -static bool int_isneg(Value v) { +static Value numNeg(Value v) { + if (IS_IRRATIONAL(v)) { + v.val.irrational = -v.val.irrational; + return v; + } else { + return intNeg(v); + } +} + +static bool intIsNeg(Value v) { if (IS_BIGINT(v)) { return isNegBigInt(v.val.bigint); } else { @@ -431,64 +633,43 @@ static bool int_isneg(Value v) { } //////////////////////// -// rational operations +// bigint operations //////////////////////// -#ifdef SAFETY_CHECKS -# define ASSERT_RATIONAL(x) ASSERT((x).type == VALUE_TYPE_RATIONAL) -#else -# define ASSERT_RATIONAL(x) -#endif +static inline Cmp bigCmp(Value left, Value right) { + ASSERT_BIGINT(left); + ASSERT_BIGINT(right); + return cmpBigInt(left.val.bigint, right.val.bigint); +} + +//////////////////////// +// stdint operations +//////////////////////// + +static inline Cmp stdCmp(Value left, Value right) { + ASSERT_STDINT(left); + ASSERT_STDINT(right); + return left.val.stdint < right.val.stdint ? CMP_LT : + left.val.stdint == right.val.stdint ? CMP_EQ : CMP_GT; + +} + +//////////////////////// +// rational operations +//////////////////////// -static Cmp _rat_cmp(Value left, Value right) { - ENTER(_rat_cmp); +static Cmp ratCmp(Value left, Value right) { + ENTER(ratCmp); ASSERT_RATIONAL(left); ASSERT_RATIONAL(right); - Value ad = int_mul(left.val.vec->values[NUMERATOR], + Value ad = intMul(left.val.vec->values[NUMERATOR], right.val.vec->values[DENOMINATOR]); int save = protectValue(ad); - Value bc = int_mul(left.val.vec->values[DENOMINATOR], + Value bc = intMul(left.val.vec->values[DENOMINATOR], right.val.vec->values[NUMERATOR]); protectValue(bc); - Cmp res = int_cmp(ad, bc); - LEAVE(_rat_cmp); - UNPROTECT(save); - return res; -} - -static Value makeRational(Value numerator, Value denominator) { - Vec *vec = newVec(2); - vec->values[NUMERATOR] = numerator; - vec->values[DENOMINATOR] = denominator; - Value res = { - .type = VALUE_TYPE_RATIONAL, - .val = VALUE_VAL_RATIONAL(vec) - }; - return res; -} - -Cmp ncmp(Value left, Value right) { - ENTER(ncmp); - Cmp res; - int save = PROTECT(NULL); - if (left.type == VALUE_TYPE_RATIONAL) { - if (right.type == VALUE_TYPE_RATIONAL) { - res = _rat_cmp(left, right); - } else { - right = makeRational(right, One); - protectValue(right); - res = _rat_cmp(left, right); - } - } else { - if (right.type == VALUE_TYPE_RATIONAL) { - left = makeRational(left, One); - protectValue(left); - res = _rat_cmp(left, right); - } else { - res = int_cmp(left, right); - } - } - LEAVE(ncmp); + Cmp res = numCmp(ad, bc); + LEAVE(ratCmp); UNPROTECT(save); return res; } @@ -507,26 +688,27 @@ static Value ratOp(Value left, Value right, ParameterizedBinOp op, IntegerBinOp protectValue(res); } else { // only left rational - right = makeRational(right, One); + right = ratValue(right, One); protectValue(right); res = ratOp(left, right, op, intOp, false); protectValue(res); } } else if (right.type == VALUE_TYPE_RATIONAL) { // only right rational - left = makeRational(left, One); + left = ratValue(left, One); protectValue(left); res = ratOp(left, right, op, intOp, false); protectValue(res); } else { // neither rational + eprintf("simplify\n"); if (simplify) { res = intOp(left, right); protectValue(res); } else { - left = makeRational(left, One); + left = ratValue(left, One); protectValue(left); - right = makeRational(right, One); + right = ratValue(right, One); protectValue(right); res = ratOp(left, right, op, intOp, false); protectValue(res); @@ -542,23 +724,23 @@ static Value ratSimplify(Value numerator, Value denominator) { ENTER(ratSimplify); IFDEBUG(ppNumber(numerator)); IFDEBUG(ppNumber(denominator)); - Value gcd = int_gcd(numerator, denominator); + Value gcd = intGcd(numerator, denominator); int save = protectValue(gcd); Value res; - if (int_cmp(gcd, One) != CMP_EQ) { - numerator = int_div(numerator, gcd); + if (numCmp(gcd, One) != CMP_EQ) { + numerator = basicIntDiv(numerator, gcd); protectValue(numerator); - denominator = int_div(denominator, gcd); + denominator = basicIntDiv(denominator, gcd); protectValue(denominator); } - if (int_isneg(denominator)) { - int_neg_in_place(&numerator); - int_neg_in_place(&denominator); + if (intIsNeg(denominator)) { + intNegInPlace(&numerator); + intNegInPlace(&denominator); } - if (int_cmp(denominator, One) == CMP_EQ) { + if (numCmp(denominator, One) == CMP_EQ) { res = numerator; } else { - res = makeRational(numerator, denominator); + res = ratValue(numerator, denominator); protectValue(res); } LEAVE(ratSimplify); @@ -567,22 +749,23 @@ static Value ratSimplify(Value numerator, Value denominator) { return res; } -static Value _rat_add_sub(IntegerBinOp base_op, Value left, Value right) { +// a/b o c/d = (ad o bc) / bd +static Value rat_ad_bc_cd(IntegerBinOp base_op, Value left, Value right) { ENTER(rat_add_sub); ASSERT_RATIONAL(left); ASSERT_RATIONAL(right); Value a1b2 = - int_mul(left.val.vec->values[NUMERATOR], + intMul(left.val.vec->values[NUMERATOR], right.val.vec->values[DENOMINATOR]); int save = protectValue(a1b2); Value a2b1 = - int_mul(left.val.vec->values[DENOMINATOR], + intMul(left.val.vec->values[DENOMINATOR], right.val.vec->values[NUMERATOR]); protectValue(a2b1); Value numerator = base_op(a1b2, a2b1); protectValue(numerator); Value denominator = - int_mul(left.val.vec->values[DENOMINATOR], + intMul(left.val.vec->values[DENOMINATOR], right.val.vec->values[DENOMINATOR]); protectValue(denominator); Value res = ratSimplify(numerator, denominator); @@ -591,24 +774,9 @@ static Value _rat_add_sub(IntegerBinOp base_op, Value left, Value right) { return res; } -Value nadd(Value left, Value right) { - ENTER(nadd); - IFDEBUG(ppNumber(left)); - IFDEBUG(ppNumber(right)); - Value res = ratOp(left, right, _rat_add_sub, int_add, true); - LEAVE(nadd); - return res; -} - -Value nsub(Value left, Value right) { - ENTER(nsub); - Value res = ratOp(left, right, _rat_add_sub, int_sub, true); - LEAVE(nsub); - return res; -} - -static Value _rat_mul(IntegerBinOp base_op, Value left, Value right) { - ENTER(_rat_mul); +// a/b o c/d = ac o bd +static Value rat_ac_bd(IntegerBinOp base_op, Value left, Value right) { + ENTER(rat_ac_bd); ASSERT_RATIONAL(left); ASSERT_RATIONAL(right); IFDEBUG(ppNumber(left)); @@ -623,35 +791,194 @@ static Value _rat_mul(IntegerBinOp base_op, Value left, Value right) { protectValue(denominator); Value res = ratSimplify(numerator, denominator); protectValue(res); - LEAVE(_rat_mul); + LEAVE(rat_ac_bd); IFDEBUG(ppNumber(res)); UNPROTECT(save); return res; } -Value nmul(Value left, Value right) { - ENTER(nmul); +static Value ratDiv3(IntegerBinOp base_op, Value left, Value right) { + ENTER(ratDiv3); + ASSERT_RATIONAL(left); + ASSERT_RATIONAL(right); IFDEBUG(ppNumber(left)); IFDEBUG(ppNumber(right)); - Value res = ratOp(left, right, _rat_mul, int_mul, true); - int save = protectValue(res); - LEAVE(nmul); + Value newRight = ratValue(right.val.vec->values[DENOMINATOR], right.val.vec->values[NUMERATOR]); + int save = protectValue(newRight); + Value res = rat_ac_bd(base_op, left, newRight); + protectValue(res); + LEAVE(ratDiv3); + IFDEBUG(ppNumber(res)); + UNPROTECT(save); + return res; +} + +static Value ratDiv(Value left, Value right) { + return ratDiv3(intMul, left, right); +} + +static Value ratPow(Value left, Value right) { + ENTER(ratPow); + ASSERT_RATIONAL(left); + ASSERT_INT(right); + Value numerator = left.val.vec->values[NUMERATOR]; + Value denominator = left.val.vec->values[DENOMINATOR]; + numerator = intPow(numerator, right); + int save = protectValue(numerator); + denominator = intPow(denominator, right); + protectValue(denominator); + Value res = ratSimplify(numerator, denominator); + protectValue(res); + LEAVE(ratPow); IFDEBUG(ppNumber(res)); UNPROTECT(save); return res; } -static Value _rat_div(IntegerBinOp base_op, Value left, Value right) { - ENTER(_rat_div); +static Value ratMod(Value left, Value right) { + ENTER(ratMod); ASSERT_RATIONAL(left); ASSERT_RATIONAL(right); + Value res = ratOp(left, right, rat_ad_bc_cd, intMod, true); + LEAVE(ratMod); + return res; +} + +static Value ratMul(Value left, Value right) { + return ratOp(left, right, rat_ac_bd, intMul, true); +} + +static Value intDiv(Value left, Value right) { + // N.B. intMul not basicIntDiv + return ratOp(left, right, ratDiv3, intMul, false); +} + +static Value ratSub(Value left, Value right) { + return ratOp(left, right, rat_ad_bc_cd, intSub, true); +} + +static Value ratAdd(Value left, Value right) { + return ratOp(left, right, rat_ad_bc_cd, intAdd, true); +} + +////////////////////////// +// irrational operations +////////////////////////// + +static inline Cmp irrCmp(Value left, Value right) { + ASSERT_IRRATIONAL(left); + ASSERT_IRRATIONAL(right); + return left.val.irrational < right.val.irrational ? CMP_LT : + left.val.irrational == right.val.irrational ? CMP_EQ : CMP_GT; +} + +static Value irrMod(Value left, Value right) { + ASSERT_IRRATIONAL(left); + ASSERT_IRRATIONAL(right); + return irrationalValue(fmod(left.val.irrational, right.val.irrational)); +} + +static Value irrMul(Value left, Value right) { + ASSERT_IRRATIONAL(left); + ASSERT_IRRATIONAL(right); + return irrationalValue(left.val.irrational * right.val.irrational); +} + +static Value irrDiv(Value left, Value right) { + ASSERT_IRRATIONAL(left); + ASSERT_IRRATIONAL(right); + return irrationalValue(left.val.irrational / right.val.irrational); +} + +static Value irrSub(Value left, Value right) { + ASSERT_IRRATIONAL(left); + ASSERT_IRRATIONAL(right); + return irrationalValue(left.val.irrational - right.val.irrational); +} + +static Value irrAdd(Value left, Value right) { + ASSERT_IRRATIONAL(left); + ASSERT_IRRATIONAL(right); + return irrationalValue(left.val.irrational * right.val.irrational); +} + +//////////////////////// +// generic operations +//////////////////////// + +#ifdef SAFETY_CHECKS +# define CHECK_INITIALIZED() do { \ + if (!arithmetic_initialized) { \ + cant_happen("arithmetic not initialized yet"); \ + } \ +} while(0) +#else +# define CHECK_INITIALIZED() +#endif + +typedef Value (*ValOp)(Value, Value); + +static Value dispatch(Value left, Value right, ValOp intOp, ValOp bigOp, ValOp ratOp, ValOp irrOp) { + ENTER(dispatch); + int save = PROTECT(NULL); + Value res; + switch (coerce(&left, &right)) { + case VALUE_TYPE_RATIONAL: + protectValue(left); + res = ratOp(left, right); + break; + case VALUE_TYPE_RATIONAL + RIGHT_INDICATOR: + protectValue(right); + res = ratOp(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = irrOp(left, right); + break; + case VALUE_TYPE_STDINT: + res = intOp(left, right); + break; + case VALUE_TYPE_BIGINT: + protectValue(left); + res = bigOp(left, right); + break; + case VALUE_TYPE_BIGINT + RIGHT_INDICATOR: + protectValue(left); + res = bigOp(left, right); + break; + default: + cant_happen("unexpected result from coerce"); + } + LEAVE(dispatch); + UNPROTECT(save); + return res; +} + +Value nadd(Value left, Value right) { + ENTER(nadd); + CHECK_INITIALIZED(); IFDEBUG(ppNumber(left)); IFDEBUG(ppNumber(right)); - Value newRight = makeRational(right.val.vec->values[DENOMINATOR], right.val.vec->values[NUMERATOR]); - int save = protectValue(newRight); - Value res = _rat_mul(base_op, left, newRight); - protectValue(res); - LEAVE(_rat_div); + Value res = dispatch(left, right, intAdd, intAdd, ratAdd, irrAdd); + LEAVE(nadd); + return res; +} + +Value nsub(Value left, Value right) { + ENTER(nsub); + CHECK_INITIALIZED(); + Value res = dispatch(left, right, intSub, intSub, ratSub, irrSub); + LEAVE(nsub); + return res; +} + +Value nmul(Value left, Value right) { + ENTER(nmul); + CHECK_INITIALIZED(); + IFDEBUG(ppNumber(left)); + IFDEBUG(ppNumber(right)); + Value res = dispatch(left, right, intMul, intMul, ratMul, irrMul); + int save = protectValue(res); + LEAVE(nmul); IFDEBUG(ppNumber(res)); UNPROTECT(save); return res; @@ -659,60 +986,106 @@ static Value _rat_div(IntegerBinOp base_op, Value left, Value right) { Value ndiv(Value left, Value right) { ENTER(ndiv); - // N.B. int_mul not int_div - Value res = ratOp(left, right, _rat_div, int_mul, false); - int save = protectValue(res); + CHECK_INITIALIZED(); + Value res = dispatch(left, right, intDiv, intDiv, ratDiv, irrDiv); LEAVE(ndiv); IFDEBUG(ppNumber(res)); - UNPROTECT(save); return res; } Value nmod(Value left, Value right) { ENTER(nmod); - Value res = ratOp(left, right, _rat_add_sub, int_mod, true); + CHECK_INITIALIZED(); + Value res = dispatch(left, right, intMod, intMod, ratMod, irrMod); LEAVE(nmod); return res; } -static Value _ratPower(Value left, Value right) { - ENTER(_ratPower); - ASSERT_RATIONAL(left); - Value numerator = left.val.vec->values[NUMERATOR]; - Value denominator = left.val.vec->values[DENOMINATOR]; - numerator = int_pow(numerator, right); - int save = protectValue(numerator); - denominator = int_pow(denominator, right); - protectValue(denominator); - Value res = ratSimplify(numerator, denominator); - protectValue(res); - LEAVE(_ratPower); - IFDEBUG(ppNumber(res)); - UNPROTECT(save); - return res; -} - Value npow(Value left, Value right) { ENTER(npow); + CHECK_INITIALIZED(); IFDEBUG(ppNumber(left)); IFDEBUG(ppNumber(right)); Value res; - int save = protectValue(left); - protectValue(right); - if (left.type == VALUE_TYPE_RATIONAL) { - if (right.type == VALUE_TYPE_RATIONAL) { - cant_happen("raising numbers to a rational power not supported yet"); - } else { - // only left rational - res = _ratPower(left, right); - protectValue(res); - } - } else if (right.type == VALUE_TYPE_RATIONAL) { - cant_happen("raising numbers to a rational power not supported yet"); - } else { - // neither rational - res = int_pow(left, right); - protectValue(res); + int save = PROTECT(NULL); + switch(left.type) { + case VALUE_TYPE_RATIONAL: + switch(right.type) { + case VALUE_TYPE_RATIONAL: + left = rational_to_irrational(&left); + right = rational_to_irrational(&right); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_IRRATIONAL: + left = rational_to_irrational(&left); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + res = ratPow(left, right); + break; + default: + cant_happen("unrecognised right number type %d", right.type); + } + break; + case VALUE_TYPE_IRRATIONAL: + switch(right.type) { + case VALUE_TYPE_RATIONAL: + right = rational_to_irrational(&right); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_IRRATIONAL: + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + right = int_to_irrational(&right); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + default: + cant_happen("unrecognised right number type %d", right.type); + } + break; + case VALUE_TYPE_BIGINT: + switch(right.type) { + case VALUE_TYPE_RATIONAL: + left = int_to_irrational(&left); + right = rational_to_irrational(&right); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_IRRATIONAL: + left = int_to_irrational(&left); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + res = intPow(left, right); + break; + default: + cant_happen("unrecognised right number type %d", right.type); + } + break; + case VALUE_TYPE_STDINT: + switch(right.type) { + case VALUE_TYPE_RATIONAL: + left = int_to_irrational(&left); + right = rational_to_irrational(&right); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_IRRATIONAL: + left = int_to_irrational(&left); + res = irrationalValue(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + res = intPow(left, right); + break; + default: + cant_happen("unrecognised right number type %d", right.type); + } + break; + default: + cant_happen("unrecognised left number type %d", left.type); } LEAVE(npow); IFDEBUG(ppNumber(res)); @@ -720,16 +1093,53 @@ Value npow(Value left, Value right) { return res; } +Cmp ncmp(Value left, Value right) { + ENTER(ncmp); + CHECK_INITIALIZED(); + Cmp res; + int save = PROTECT(NULL); + switch (coerce(&left, &right)) { + case VALUE_TYPE_RATIONAL: + protectValue(left); + res = ratCmp(left, right); + break; + case VALUE_TYPE_RATIONAL + RIGHT_INDICATOR: + protectValue(right); + res = ratCmp(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = irrCmp(left, right); + break; + case VALUE_TYPE_STDINT: + res = stdCmp(left, right); + break; + case VALUE_TYPE_BIGINT: + protectValue(left); + res = bigCmp(left, right); + break; + case VALUE_TYPE_BIGINT + RIGHT_INDICATOR: + protectValue(left); + res = bigCmp(left, right); + break; + default: + cant_happen("unexpected result from coerce"); + } + LEAVE(ncmp); + UNPROTECT(save); + return res; +} + Value nneg(Value v) { ENTER(nneg); + CHECK_INITIALIZED(); Value res; if (v.type == VALUE_TYPE_RATIONAL) { - Value numerator = int_neg(v.val.vec->values[NUMERATOR]); + Value numerator = intNeg(v.val.vec->values[NUMERATOR]); int save = protectValue(numerator); - res = makeRational(numerator, v.val.vec->values[DENOMINATOR]); + res = ratValue(numerator, v.val.vec->values[DENOMINATOR]); UNPROTECT(save); } else { - res = int_neg(v); + res = numNeg(v); } LEAVE(nneg); return res; @@ -742,6 +1152,7 @@ void init_arithmetic() { BigInt *one = bigIntFromInt(1); One.type = VALUE_TYPE_BIGINT; One.val = VALUE_VAL_BIGINT(one); + arithmetic_initialized = true; } void markArithmetic() { diff --git a/src/bigint.c b/src/bigint.c index 1c172de..b53b4ab 100644 --- a/src/bigint.c +++ b/src/bigint.c @@ -1270,27 +1270,41 @@ double bigint_double(const bigint * src) { // additional CEKF code MaybeBigInt *newMaybeBigInt(bigint bi) { + ENTER(newMaybeBigInt); MaybeBigInt *x = NEW(MaybeBigInt, OBJTYPE_MAYBEBIGINT); DEBUG("newMaybeBigInt %p", x); - x->little = 0; - x->fake = false; - x->bi = bi; + x->type = BI_BIG; + x->big = bi; + LEAVE(newMaybeBigInt); + return x; +} + +MaybeBigInt *irrationalBigInt(double f) { + ENTER(irrationalBigInt); + MaybeBigInt *x = NEW(MaybeBigInt, OBJTYPE_MAYBEBIGINT); + DEBUG("newMaybeBigInt %p", x); + x->type = BI_IRRATIONAL; + x->irrational = f; + LEAVE(irrationalBigInt); return x; } BigInt *newBigInt(bigint bi) { + ENTER(newBigInt); BigInt *x = NEW(BigInt, OBJTYPE_BIGINT); DEBUG("newBigInt %p", x); x->bi = bi; + LEAVE(newBigInt); return x; } MaybeBigInt *fakeBigInt(int little) { - MaybeBigInt *x = NEW(MaybeBigInt, OBJTYPE_BIGINT); + ENTER(fakeBigInt); + MaybeBigInt *x = NEW(MaybeBigInt, OBJTYPE_MAYBEBIGINT); DEBUG("fakeBigInt %p", x); - x->little = little; - x->fake = true; - bzero(&x->bi, sizeof(bigint)); + x->small = little; + x->type = BI_SMALL; + LEAVE(fakeBigInt); return x; } @@ -1355,15 +1369,19 @@ void markMaybeBigInt(MaybeBigInt *x) { } void freeBigInt(BigInt *x) { + ENTER(freeBigInt); FREE_ARRAY(bigint_word, x->bi.words, x->bi.capacity); FREE(x, BigInt); + LEAVE(freeBigInt); } void freeMaybeBigInt(MaybeBigInt *x) { - if (!x->fake) { - FREE_ARRAY(bigint_word, x->bi.words, x->bi.capacity); + ENTER(freeMaybeBigInt); + if (x->type == BI_BIG) { + FREE_ARRAY(bigint_word, x->big.words, x->big.capacity); } FREE(x, MaybeBigInt); + LEAVE(freeMaybeBigInt); } void printMaybeBigInt(MaybeBigInt *x, int depth) { @@ -1398,10 +1416,18 @@ void fprintMaybeBigInt(FILE *f, MaybeBigInt *x) { fprintf(f, ""); return; } - if (x->fake) { - fprintf(f, "%d", x->little); - } else { - bigint_fprint(f, &x->bi); + switch (x->type) { + case BI_SMALL: + fprintf(f, "%d", x->small); + break; + case BI_BIG: + bigint_fprint(f, &x->big); + break; + case BI_IRRATIONAL: + fprintf(f, "%f", x->irrational); + break; + default: + cant_happen("unrecognized type of MaybeBigInt: %d", x->type); } } @@ -1418,33 +1444,76 @@ Cmp cmpBigIntInt(BigInt *a, int b) { return res; } +static int bigint_cmp_double(bigint *b, double d) { + double bi = bigint_double(b); + return bi < d ? CMP_LT : bi == d ? CMP_EQ : CMP_GT; +} + +static int bigint_cmp_int(bigint *b, int i) { + bigint bi; + bigint_init(&bi); + bigint_from_int(&bi, i); + Cmp res = (Cmp) bigint_cmp(b, &bi); + bigint_free(&bi); + return res; +} + +Cmp cmpBigIntDouble(BigInt *a, double b) { + return bigint_cmp_double(&a->bi, b); +} + Cmp cmpMaybeBigInt(MaybeBigInt *x, MaybeBigInt *y) { - if (x->fake) { - if (y->fake) { - return x->little < y->little ? - -1 : - x->little == y->little ? - 0 : - 1; - } else { - bigint bx; - bigint_init(&bx); - bigint_from_int(&bx, x->little); - Cmp res = (Cmp) bigint_cmp(&bx, &y->bi); - bigint_free(&bx); - return res; - } - } else { - if (y->fake) { - bigint by; - bigint_init(&by); - bigint_from_int(&by, y->little); - Cmp res = (Cmp) bigint_cmp(&x->bi, &by); - bigint_free(&by); - return res; - } else { - return (Cmp) bigint_cmp(&x->bi, &y->bi); - } + switch (x->type) { + case BI_SMALL: + switch (y->type) { + case BI_SMALL: + return x->small < y->small ? CMP_LT : + x->small == y->small ? CMP_EQ : CMP_GT; + case BI_BIG: + return (Cmp)(bigint_cmp_int(&y->big, x->small) * -1); + case BI_IRRATIONAL: + return x->small < y->irrational ? CMP_LT : + x->small == y->irrational ? CMP_EQ : CMP_GT; + default: + cant_happen("unrecognized type of MaybeBigInt: %d", x->type); + } + break; + case BI_BIG: + switch (y->type) { + case BI_SMALL: + return (Cmp)(bigint_cmp_int(&x->big, y->small)); + bigint by; + bigint_init(&by); + bigint_from_int(&by, y->small); + Cmp res = (Cmp) bigint_cmp(&x->big, &by); + bigint_free(&by); + return res; + case BI_BIG: + return (Cmp) bigint_cmp(&x->big, &y->big); + case BI_IRRATIONAL: + return bigint_cmp_double(&x->big, y->irrational); + break; + default: + cant_happen("unrecognized type of MaybeBigInt: %d", x->type); + } + break; + case BI_IRRATIONAL: + switch (y->type) { + case BI_SMALL: + return x->irrational < y->small ? CMP_LT : + x->irrational == y->small ? CMP_EQ : CMP_GT; + case BI_BIG: + return (Cmp)(bigint_cmp_double(&x->big, x->irrational) * -1); + cant_happen("attempt to compare bigint and rational"); + case BI_IRRATIONAL: + return x->irrational < y->irrational ? CMP_LT : + x->irrational == y->irrational ? CMP_EQ : CMP_GT; + default: + cant_happen("unrecognized type of MaybeBigInt: %d", x->type); + } + break; + default: + cant_happen("unrecognized type of MaybeBigInt: %d", x->type); } } @@ -1595,3 +1664,7 @@ void negateBigInt(BigInt *b) { bool isNegBigInt(BigInt *b) { return b->bi.neg != 0; } + +double bigIntToDouble(BigInt *bi) { + return bigint_double(&bi->bi); +} diff --git a/src/bigint.h b/src/bigint.h index 0d35b5a..53f5d4e 100644 --- a/src/bigint.h +++ b/src/bigint.h @@ -42,11 +42,20 @@ extern "C" { // CEKF wrapper for memory management // compile-time bigint + typedef enum MaybeBigIntType { + BI_BIG, + BI_SMALL, + BI_IRRATIONAL + } MaybeBigIntType; + typedef struct MaybeBigInt { Header header; - bigint bi; - bool fake; - int little; + MaybeBigIntType type; + union { + bigint big; + int small; + double irrational; + }; } MaybeBigInt; // run-time bigint @@ -55,9 +64,11 @@ extern "C" { bigint bi; } BigInt; - BigInt *newBigInt(bigint bi); MaybeBigInt *newMaybeBigInt(bigint bi); MaybeBigInt *fakeBigInt(int little); + MaybeBigInt *irrationalBigInt(double f); + + BigInt *newBigInt(bigint bi); BigInt *bigIntFromInt(int c); BigInt *bigIntFromAddition(int a, int b); BigInt *bigIntFromMultiplication(int a, int b); @@ -73,7 +84,9 @@ extern "C" { void fprintMaybeBigInt(FILE *f, MaybeBigInt *x); Cmp cmpBigInt(BigInt *a, BigInt *b); Cmp cmpBigIntInt(BigInt *a, int b); + Cmp cmpBigIntDouble(BigInt *a, double b); static inline Cmp cmpIntBigInt(int a, BigInt *b) { return (Cmp)(cmpBigIntInt(b, a) * -1); } + static inline Cmp cmpDoubleBigInt(double a, BigInt *b) { return (Cmp)(cmpBigIntDouble(b, a) * -1); } int cmpMaybeBigInt(MaybeBigInt *a, MaybeBigInt *b); typedef bigint *(*bigint_binop)(bigint * dst, const bigint * a, const bigint * b); @@ -96,6 +109,7 @@ extern "C" { BigInt *gcdBigInt(BigInt *a, BigInt *b); BigInt *gcdBigIntInt(BigInt *a, int b); BigInt *gcdIntBigInt(int a, BigInt *b); + double bigIntToDouble(BigInt *b); void bigint_fprint(FILE *f, bigint * bi); void negateBigInt(BigInt *b); bool isNegBigInt(BigInt *b); diff --git a/src/bytecode.c b/src/bytecode.c index f7f4fe3..212cf6a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -84,6 +84,11 @@ static void writeIntAt(int loc, ByteCodeArray *b, int word) { memcpy(&b->entries[loc], &word, sizeof(int)); } +static void writeDoubleAt(int loc, ByteCodeArray *b, double f) { + DEBUG("%04x writeDouble %f", loc, f); + memcpy(&b->entries[loc], &f, sizeof(double)); +} + static void writeCurrentAddressAt(int patch, ByteCodeArray *b) { word offset = b->count - patch; writeWordAt(patch, b, offset); @@ -107,6 +112,12 @@ static void addInt(ByteCodeArray *b, int word) { b->count += sizeof(int); } +static void addIrrational(ByteCodeArray *b, double f) { + reserve(b, sizeof(double)); + writeDoubleAt(b->count, b, f); + b->count += sizeof(double); +} + static int reserveInt(ByteCodeArray *b) { int address = b->count; addInt(b, 0); @@ -379,12 +390,21 @@ void writeCexpIntCond(CexpIntCondCases *x, ByteCodeArray *b) { for (CexpIntCondCases *xx = x; xx != NULL; xx = xx->next) { if (xx->next == NULL) break; // default case doesn't get a test - if (xx->option->fake) { - addByte(b, BYTECODE_STDINT); - addInt(b, xx->option->little); - } else { - addByte(b, BYTECODE_BIGINT); - addBig(b, xx->option->bi); + switch (xx->option->type) { + case BI_SMALL: + addByte(b, BYTECODE_STDINT); + addInt(b, xx->option->small); + break; + case BI_BIG: + addByte(b, BYTECODE_BIGINT); + addBig(b, xx->option->big); + break; + case BI_IRRATIONAL: + addByte(b, BYTECODE_IRRATIONAL); + addIrrational(b, xx->option->irrational); + break; + default: + cant_happen("unsupported MaybeBigIntType %d", xx->option->type); } dispatches[i++] = reserveWord(b); } @@ -560,12 +580,21 @@ void writeAexp(Aexp *x, ByteCodeArray *b) { } break; case AEXP_TYPE_BIGINTEGER:{ - if (x->val.biginteger->fake) { - addByte(b, BYTECODE_STDINT); - addInt(b, x->val.biginteger->little); - } else { - addByte(b, BYTECODE_BIGINT); - addBig(b, x->val.biginteger->bi); + switch (x->val.biginteger->type) { + case BI_SMALL: + addByte(b, BYTECODE_STDINT); + addInt(b, x->val.biginteger->small); + break; + case BI_BIG: + addByte(b, BYTECODE_BIGINT); + addBig(b, x->val.biginteger->big); + break; + case BI_IRRATIONAL: + addByte(b, BYTECODE_IRRATIONAL); + addIrrational(b, x->val.biginteger->irrational); + break; + default: + cant_happen("unsupported MaybeBigInt type %d", x->val.biginteger->type); } } break; diff --git a/src/bytecode.h b/src/bytecode.h index b1793f5..edfa190 100644 --- a/src/bytecode.h +++ b/src/bytecode.h @@ -68,6 +68,7 @@ typedef enum ByteCodes { BYTECODE_STDINT, BYTECODE_BIGINT, + BYTECODE_IRRATIONAL, BYTECODE_CHAR, BYTECODE_RETURN, BYTECODE_JMP, @@ -134,12 +135,23 @@ static inline void _readInt(ByteCodeArray *b, size_t *i, int *a) { (*i) += sizeof(int); } +static inline void _readDouble(ByteCodeArray *b, size_t *i, double *a) { + memcpy(a, &b->entries[*i], sizeof(double)); + (*i) += sizeof(double); +} + static inline int readInt(ByteCodeArray *b, size_t *i) { int a; _readInt(b, i, &a); return a; } +static inline double readDouble(ByteCodeArray *b, size_t *i) { + double a; + _readDouble(b, i, &a); + return a; +} + static inline int readOffset(ByteCodeArray *b, size_t *i) { int ii = *i; int offset = readWord(b, i); diff --git a/src/cekf.c b/src/cekf.c index 551fe38..f4a278e 100644 --- a/src/cekf.c +++ b/src/cekf.c @@ -123,6 +123,7 @@ void markValue(Value x) { switch (x.type) { case VALUE_TYPE_VOID: case VALUE_TYPE_STDINT: + case VALUE_TYPE_IRRATIONAL: case VALUE_TYPE_CHARACTER: break; case VALUE_TYPE_PCLO: diff --git a/src/common.h b/src/common.h index f81a1a2..98b274d 100644 --- a/src/common.h +++ b/src/common.h @@ -25,6 +25,7 @@ # define DEBUG_ANY # ifdef DEBUG_ANY +// # define DEBUG_BIGINT // # define DEBUG_STACK // # define DEBUG_STEP // if DEBUG_STEP is defined, this sleeps for 1 second between each machine step diff --git a/src/lexer.l b/src/lexer.l index c5e25df..05f3f69 100644 --- a/src/lexer.l +++ b/src/lexer.l @@ -24,7 +24,8 @@ struct PmModule *mod = yyextra; [\n] { incLineNo(mod); } \/\/.* { } -[0-9]+ { yylval->s = yytext; return NUMBER; } +[0-9]*\.[0-9]+ { yylval->s = yytext; return IRRATIONAL; } +[0-9]+ { yylval->s = yytext; return NUMBER; } "and" { return AND; } "as" { return AS; } diff --git a/src/parser.y b/src/parser.y index 545b365..6cec0ad 100644 --- a/src/parser.y +++ b/src/parser.y @@ -104,6 +104,11 @@ static void bigint_add_n(bigint *b, int n) { bigint_free(&old); } +static MaybeBigInt *makeIrrational(char *str) { + double f = atof(str); + return irrationalBigInt(f); +} + static MaybeBigInt *makeMaybeBigInt(char *digits) { bool overflowed = false; int a = 0; @@ -265,6 +270,7 @@ static AstCompositeFunction *makeAstCompositeFunction(AstAltFunction *functions, %token STRING %token TYPE_VAR %token VAR +%token IRRATIONAL %right ARROW %right THEN @@ -410,7 +416,8 @@ consfargs : farg { $$ = newAstUnpack(consSymbol(), newAstArgList( | farg ',' consfargs { $$ = newAstUnpack(consSymbol(), newAstArgList($1, newAstArgList(newAstArg(AST_ARG_TYPE_UNPACK, AST_ARG_VAL_UNPACK($3)), NULL))); } ; -number : NUMBER { $$ = makeMaybeBigInt($1); } +number : NUMBER { $$ = makeMaybeBigInt($1); } + | IRRATIONAL { $$ = makeIrrational($1); } ; farg : symbol { $$ = newAstArg(AST_ARG_TYPE_SYMBOL, AST_ARG_VAL_SYMBOL($1)); } diff --git a/src/step.c b/src/step.c index 793dcf3..c01d76a 100644 --- a/src/step.c +++ b/src/step.c @@ -23,6 +23,7 @@ #include #include #include +#include #include "common.h" #include "debug.h" @@ -115,6 +116,10 @@ static inline int readCurrentInt(void) { return readInt(&state.B, &state.C); } +static inline double readCurrentIrrational(void) { + return readDouble(&state.B, &state.C); +} + static inline BigInt *readCurrentBigInt(void) { bigint bi = readBigint(&state.B, &state.C); return newBigInt(bi); @@ -425,9 +430,7 @@ static void step() { Clo *clo = newClo(nargs, state.C, state.E); int save = PROTECT(clo); snapshotClo(&state.S, clo, letRecOffset); - Value v; - v.type = VALUE_TYPE_CLO; - v.val = VALUE_VAL_CLO(clo); + Value v = cloValue(clo); push(v); UNPROTECT(save); state.C = end; @@ -479,6 +482,12 @@ static void step() { case VALUE_TYPE_STDINT: printf("%d", b.val.stdint); break; + case VALUE_TYPE_IRRATIONAL: + if( fmod(b.val.irrational, 1) == 0) + printf("%.1f", b.val.irrational); + else + printf("%g", b.val.irrational); + break; case VALUE_TYPE_RATIONAL: putValue(b.val.vec->values[0]); printf("/"); @@ -684,9 +693,7 @@ static void step() { int save = PROTECT(v); copyToVec(v); popn(size); - Value val; - val.type = VALUE_TYPE_VEC; - val.val = VALUE_VAL_VEC(v); + Value val = vecValue(v); push(val); UNPROTECT(save); } @@ -768,9 +775,7 @@ static void step() { case BYTECODE_BIGINT: { BigInt *bigInt = readCurrentBigInt(); PROTECT(bigInt); - Value u; - u.type = VALUE_TYPE_BIGINT; - u.val = VALUE_VAL_BIGINT(bigInt); + Value u = bigintValue(bigInt); protectValue(u); int offset = readCurrentOffset(); if (ncmp(u, v) == CMP_EQ) { @@ -781,10 +786,17 @@ static void step() { break; case BYTECODE_STDINT: { int option = readCurrentInt(); - Value u; - u.type = VALUE_TYPE_STDINT; - u.val = VALUE_VAL_STDINT(option); - protectValue(u); + Value u = stdintValue(option); + int offset = readCurrentOffset(); + if (ncmp(u, v) == CMP_EQ) { + state.C = offset; + goto FINISHED_INTCOND; + } + } + break; + case BYTECODE_IRRATIONAL: { + double option = readCurrentIrrational(); + Value u = irrationalValue(option); int offset = readCurrentOffset(); if (ncmp(u, v) == CMP_EQ) { state.C = offset; @@ -932,13 +944,19 @@ static void step() { push(vVoid); } break; + case BYTECODE_IRRATIONAL:{ + // push literal double + double f = readCurrentIrrational(); + DEBUGPRINTF("IRRATIONAL [%f]\n", f); + Value v = irrationalValue(f); + push(v); + } + break; case BYTECODE_STDINT:{ // push literal int int val = readCurrentInt(); DEBUGPRINTF("STDINT [%d]\n", val); - Value v; - v.type = VALUE_TYPE_STDINT; - v.val = VALUE_VAL_STDINT(val); + Value v = stdintValue(val); push(v); } break; @@ -946,9 +964,7 @@ static void step() { // push literal char char c = readCurrentByte(); DEBUGPRINTF("CHAR [%c]\n", c); - Value v; - v.type = VALUE_TYPE_CHARACTER; - v.val = VALUE_VAL_CHARACTER(c); + Value v = characterValue(c); push(v); } break; @@ -960,9 +976,7 @@ static void step() { fprintBigInt(stdout, bigInt); printf("]\n"); #endif - Value v; - v.type = VALUE_TYPE_BIGINT; - v.val = VALUE_VAL_BIGINT(bigInt); + Value v = bigintValue(bigInt); push(v); UNPROTECT(save); } @@ -970,9 +984,7 @@ static void step() { case BYTECODE_RETURN:{ // push the current continuation and apply DEBUGPRINTF("RETURN\n"); - Value kont; - kont.type = VALUE_TYPE_CONT; - kont.val = VALUE_VAL_CONT(state.K); + Value kont = kontValue(state.K); push(kont); applyProc(1); } diff --git a/src/value.h b/src/value.h index 83adb4c..995d066 100644 --- a/src/value.h +++ b/src/value.h @@ -25,6 +25,7 @@ typedef enum { VALUE_TYPE_STDINT, VALUE_TYPE_BIGINT, VALUE_TYPE_RATIONAL, + VALUE_TYPE_IRRATIONAL, VALUE_TYPE_CHARACTER, VALUE_TYPE_CLO, VALUE_TYPE_PCLO, @@ -36,6 +37,7 @@ typedef union { void *none; int stdint; BigInt *bigint; + double irrational; char character; struct Clo *clo; struct Kont *kont; @@ -47,17 +49,18 @@ typedef struct Value { ValueVal val; } Value; -# define VALUE_VAL_STDINT(x) ((ValueVal){.stdint = (x)}) -# define VALUE_VAL_BIGINT(x) ((ValueVal){.bigint = (x)}) -# define VALUE_VAL_CHARACTER(x) ((ValueVal){.character = (x)}) +# define VALUE_VAL_STDINT(x) ((ValueVal){.stdint = (x)}) +# define VALUE_VAL_BIGINT(x) ((ValueVal){.bigint = (x)}) +# define VALUE_VAL_CHARACTER(x) ((ValueVal){.character = (x)}) +# define VALUE_VAL_IRRATIONAL(x) ((ValueVal){.irrational = (x)}) // CLO and PCLO share the same Clo struct -# define VALUE_VAL_CLO(x) ((ValueVal){.clo = (x)}) -# define VALUE_VAL_PCLO(x) ((ValueVal){.clo = (x)}) -# define VALUE_VAL_CONT(x) ((ValueVal){.kont = (x)}) +# define VALUE_VAL_CLO(x) ((ValueVal){.clo = (x)}) +# define VALUE_VAL_PCLO(x) ((ValueVal){.clo = (x)}) +# define VALUE_VAL_CONT(x) ((ValueVal){.kont = (x)}) // RATIONAL and VEC share the same Vec struct -# define VALUE_VAL_VEC(x) ((ValueVal){.vec = (x)}) -# define VALUE_VAL_RATIONAL(x) ((ValueVal){.vec = (x)}) -# define VALUE_VAL_NONE() ((ValueVal){.none = NULL}) +# define VALUE_VAL_VEC(x) ((ValueVal){.vec = (x)}) +# define VALUE_VAL_RATIONAL(x) ((ValueVal){.vec = (x)}) +# define VALUE_VAL_NONE() ((ValueVal){.none = NULL}) // constants extern Value vTrue; @@ -67,4 +70,75 @@ extern Value vLt; extern Value vEq; extern Value vGt; +static inline Value voidValue() { + Value v; + v.type = VALUE_TYPE_VOID; + v.val = VALUE_VAL_NONE(); + return v; +} + +static inline Value stdintValue(int x) { + Value v; + v.type = VALUE_TYPE_STDINT; + v.val = VALUE_VAL_STDINT(x); + return v; +} +static inline Value bigintValue(BigInt * x) { + Value v; + v.type = VALUE_TYPE_BIGINT; + v.val = VALUE_VAL_BIGINT(x); + return v; +} + +static inline Value irrationalValue(double x) { + Value v; + v.type = VALUE_TYPE_IRRATIONAL; + v.val = VALUE_VAL_IRRATIONAL(x); + return v; +} + +static inline Value characterValue(char x) { + Value v; + v.type = VALUE_TYPE_CHARACTER; + v.val = VALUE_VAL_CHARACTER(x); + return v; +} + +static inline Value cloValue(struct Clo * x) { + Value v; + v.type = VALUE_TYPE_CLO; + v.val = VALUE_VAL_CLO(x); + return v; +} + +static inline Value pcloValue(struct Clo * x) { + Value v; + v.type = VALUE_TYPE_PCLO; + v.val = VALUE_VAL_PCLO(x); + return v; +} + +static inline Value kontValue(struct Kont * x) { + Value v; + v.type = VALUE_TYPE_CONT; + v.val = VALUE_VAL_CONT(x); + return v; +} + +static inline Value rationalValue(struct Vec * x) { + Value v; + v.type = VALUE_TYPE_RATIONAL; + v.val = VALUE_VAL_RATIONAL(x); + return v; +} + +static inline Value vecValue(struct Vec * x) { + Value v; + v.type = VALUE_TYPE_VEC; + v.val = VALUE_VAL_VEC(x); + return v; +} + + + #endif diff --git a/utils.sh b/utils.sh index 9e74edd..aa76fa6 100644 --- a/utils.sh +++ b/utils.sh @@ -1,3 +1,3 @@ fnd () { - grep -rwn $1 src generated + grep -Irwn $1 src generated }