/* $Header$ */
/*
* Copyright © 1988-2004 Keith Packard and Bart Massey.
* All Rights Reserved. See the file COPYING in this directory
* for licensing information.
*/
/*
* integer.c
*
* operations on integers
*/
#include "nickle.h"
#define IMag(i) ((Natural *) ((long) ((i)->magn) & ~1))
#define ISign(i) ((Sign) ((long) ((i)->magn) & 1))
int
IntegerToInt (Integer *i)
{
int result;
result = NaturalToInt (IMag(i));
if (ISign(i) == Negative)
result = -result;
return result;
}
static Value
IntegerPlus (Value av, Value bv, int expandOk)
{
ENTER ();
Integer *a = &av->integer, *b = &bv->integer;
Value ret;
switch (catagorize_signs(ISign(a), ISign(b))) {
case BothPositive:
default:
ret = NewInteger (Positive, NaturalPlus (IMag(a), IMag(b)));
break;
case FirstPositive:
if (NaturalLess (IMag(a), IMag(b)))
ret = NewInteger (Negative, NaturalMinus (IMag(b), IMag(a)));
else
ret = NewInteger (Positive, NaturalMinus (IMag(a), IMag(b)));
break;
case SecondPositive:
if (NaturalLess (IMag(a), IMag(b)))
ret = NewInteger (Positive, NaturalMinus (IMag(b), IMag(a)));
else
ret = NewInteger (Negative, NaturalMinus (IMag(a), IMag(b)));
break;
case BothNegative:
ret = NewInteger (Negative, NaturalPlus (IMag(a), IMag(b)));
break;
}
RETURN (ret);
}
static Value
IntegerMinus (Value av, Value bv, int expandOk)
{
ENTER ();
Integer *a = &av->integer, *b = &bv->integer;
Value ret;
switch (catagorize_signs(ISign(a), ISign(b))) {
case BothPositive:
default:
if (NaturalLess (IMag(a), IMag(b)))
ret = NewInteger (Negative, NaturalMinus (IMag(b), IMag(a)));
else
ret = NewInteger (Positive, NaturalMinus (IMag(a), IMag(b)));
break;
case FirstPositive:
ret = NewInteger (Positive, NaturalPlus (IMag(a), IMag(b)));
break;
case SecondPositive:
ret = NewInteger (Negative, NaturalPlus (IMag(a), IMag(b)));
break;
case BothNegative:
if (NaturalLess (IMag(a), IMag(b)))
ret = NewInteger (Positive, NaturalMinus (IMag(b), IMag(a)));
else
ret = NewInteger (Negative, NaturalMinus (IMag(a), IMag(b)));
break;
}
RETURN (ret);
}
static Value
IntegerTimes (Value av, Value bv, int expandOk)
{
ENTER ();
Integer *a = &av->integer, *b = &bv->integer;
Sign sign;
sign = Positive;
if (ISign(a) != ISign(b))
sign = Negative;
RETURN (NewInteger (sign, NaturalTimes (IMag(a), IMag(b))));
}
static Value
IntegerDivide (Value av, Value bv, int expandOk)
{
ENTER ();
Integer *a = &av->integer, *b = &bv->integer;
Natural *rem;
Sign sign;
if (NaturalZero (IMag(b)))
{
RaiseStandardException (exception_divide_by_zero,
"integer divide by zero",
2, av, bv);
RETURN (Void);
}
sign = Positive;
if (ISign(a) != ISign(b))
sign = Negative;
if (expandOk)
RETURN (NewRational (sign, IMag(a), IMag(b)));
else
RETURN (NewInteger (sign, NaturalDivide (IMag(a), IMag(b), &rem)));
}
static Value
IntegerDiv (Value av, Value bv, int expandOk)
{
ENTER ();
Integer *a = &av->integer, *b = &bv->integer;
Sign sign;
Natural *quo, *rem;
if (NaturalZero (IMag(b)))
{
RaiseStandardException (exception_divide_by_zero,
"integer div by zero",
2, av, bv);
RETURN (Void);
}
quo = NaturalDivide (IMag(a), IMag(b), &rem);
sign = Positive;
if ((ISign(a) == Positive) != (ISign(b) == Positive))
sign = Negative;
if (sign == Negative && !NaturalZero (rem))
quo = NaturalPlus (quo, one_natural);
RETURN (NewInteger (sign, quo));
}
static Value
IntegerMod (Value av, Value bv, int expandOk)
{
ENTER ();
Integer *a = &av->integer, *b = &bv->integer;
Natural *quo, *rem;
if (NaturalZero (IMag(b)))
{
RaiseStandardException (exception_divide_by_zero,
"integer modulus by zero",
2, av, bv);
RETURN (Void);
}
quo = NaturalDivide (IMag(a), IMag(b), &rem);
if (ISign(a) == Negative && !NaturalZero (rem))
rem = NaturalMinus (IMag(b), rem);
RETURN (NewInteger (Positive, rem));
}
static Value
IntegerLess (Value av, Value bv, int expandOk)
{
Integer *a = &av->integer, *b = &bv->integer;
Value ret;
ret = FalseVal;
switch (catagorize_signs (ISign(a), ISign(b))) {
case BothPositive:
if (NaturalLess (IMag(a), IMag(b)))
ret = TrueVal;
break;
case FirstPositive:
break;
case SecondPositive:
ret = TrueVal;
break;
case BothNegative:
if (NaturalLess (IMag(b), IMag(a)))
ret = TrueVal;
break;
}
return ret;
}
static Value
IntegerEqual (Value av, Value bv, int expandOk)
{
Integer *a = &av->integer, *b = &bv->integer;
if (ISign(a) == ISign(b) && NaturalEqual (IMag(a), IMag(b)))
return TrueVal;
return FalseVal;
}
#if 0
#define DebugN(s,n) FilePrintf (FileStdout, "%s %N\n", s, n)
#else
#define DebugN(s,n)
#endif
static Value
IntegerLand (Value av, Value bv, int expandOk)
{
ENTER ();
Value ret;
Integer *a = &av->integer, *b = &bv->integer;
Natural *am = IMag(a), *bm = IMag(b), *m;
DebugN("a", am);
if (ISign(a) == Negative)
{
am = NaturalNegate (am, NaturalLength (bm));
DebugN ("-a", am);
}
DebugN("b", bm);
if (ISign(b) == Negative)
{
bm = NaturalNegate (bm, NaturalLength (am));
DebugN("-b", bm);
}
m = NaturalLand (am, bm);
DebugN("m", m);
if (ISign(a) == Negative && ISign(b) == Negative)
{
m = NaturalNegate (m, 0);
DebugN("-m", m);
ret = NewInteger (Negative, m);
}
else
ret = NewInteger (Positive, m);
RETURN (ret);
}
static Value
IntegerLor (Value av, Value bv, int expandOk)
{
ENTER ();
Value ret;
Integer *a = &av->integer, *b = &bv->integer;
Natural *am = IMag(a), *bm = IMag(b), *m;
DebugN("a", am);
if (ISign(a) == Negative)
{
am = NaturalNegate (am, NaturalLength (bm));
DebugN ("-a", am);
}
DebugN("b", bm);
if (ISign(b) == Negative)
{
bm = NaturalNegate (bm, NaturalLength (am));
DebugN("-b", bm);
}
m = NaturalLor (am, bm);
DebugN("m", m);
if (ISign(a) == Negative || ISign(b) == Negative)
{
m = NaturalNegate (m, 0);
DebugN("-m", m);
ret = NewInteger (Negative, m);
}
else
ret = NewInteger (Positive, m);
RETURN (ret);
}
static Value
IntegerNegate (Value av, int expandOk)
{
Integer *a = &av->integer;
return NewInteger (SignNegate (ISign(a)), IMag(a));
}
static Value
IntegerFloor (Value av, int expandOk)
{
return av;
}
static Value
IntegerCeil (Value av, int expandOk)
{
return av;
}
static Value
IntegerPromote (Value av, Value bv)
{
if (ValueIsInt(av))
av = NewIntInteger (ValueInt(av));
return av;
}
static Value
IntegerReduce (Value av)
{
Integer *a = &av->integer;
if (NaturalLess (IMag(a), max_int_natural))
av = NewInt (IntegerToInt (a));
return av;
}
static Bool
IntegerPrint (Value f, Value iv, char format, int base, int width, int prec, int fill)
{
ENTER ();
Integer *i = &iv->integer;
char *result;
int print_width;
int fraction_width;
if (base == 0)
base = 10;
result = NaturalSprint (0, IMag(i), base, &print_width);
if (result)
{
if (ISign(i) == Negative)
print_width++;
fraction_width = 0;
if (prec >= 0)
{
int avail_width;
if (width > 0)
avail_width = width;
else
avail_width = -width;
fraction_width = prec + 1;
if (avail_width > 0)
{
if (print_width + fraction_width > avail_width)
{
fraction_width = avail_width - print_width;
if (fraction_width < 0)
fraction_width = 0;
}
}
}
print_width += fraction_width;
while (width > print_width)
{
FileOutchar (f, fill);
width--;
}
if (ISign(i) == Negative)
FileOutput (f, '-');
FilePuts (f, result);
if (fraction_width)
{
FileOutput (f, '.');
--fraction_width;
while (fraction_width)
{
FileOutput (f, '0');
--fraction_width;
}
}
while (-width > print_width)
{
FileOutchar (f, fill);
width++;
}
}
EXIT ();
return result != 0;
}
static HashValue
IntegerHash (Value iv)
{
return NaturalHash (IntegerMag(iv)) ^ IntegerSign(iv);
}
static void
IntegerMark (void *object)
{
Integer *integer = object;
MemReference (IMag(integer));
}
ValueRep IntegerRep = {
{ IntegerMark, 0, "IntegerRep" }, /* base */
rep_integer, /* tag */
{ /* binary */
IntegerPlus,
IntegerMinus,
IntegerTimes,
IntegerDivide,
IntegerDiv,
IntegerMod,
IntegerLess,
IntegerEqual,
IntegerLand,
IntegerLor,
},
{ /* unary */
IntegerNegate,
IntegerFloor,
IntegerCeil,
},
IntegerPromote,
IntegerReduce,
IntegerPrint,
0,
IntegerHash,
};
#define INTEGER_CACHE_SIZE 8191
DataCachePtr integerCache;
Value
NewInteger (Sign sign, Natural *mag)
{
ENTER ();
unsigned c = (PtrToUInt(mag) ^ (unsigned) sign) % INTEGER_CACHE_SIZE;
Value *re = (Value *) DataCacheValues(integerCache) + c;
Value ret = *re;
if (ret && IntegerSign(ret) == sign && NaturalEqual (mag, IntegerMag(ret)))
{
RETURN (ret);
}
ret = ALLOCATE (&IntegerRep.data, sizeof (Integer));
ret->integer.magn = (Natural *) (((long) mag) | (long) sign);
*re = ret;
RETURN (ret);
}
Value
NewIntInteger (int i)
{
ENTER ();
Sign sign = Positive;
unsigned long mag;
if (i < 0)
{
sign = Negative;
mag = -i;
}
else
mag = i;
RETURN (NewInteger (sign, NewNatural (mag)));
}
Value
NewSignedDigitInteger (signed_digit d)
{
ENTER ();
Sign sign = Positive;
double_digit dd;
if (d < 0)
{
sign = Negative;
dd = -d;
}
else
dd = d;
RETURN (NewInteger (sign, NewDoubleDigitNatural (dd)));
}
int
IntegerInit (void)
{
ENTER ();
integerCache = NewDataCache (INTEGER_CACHE_SIZE);
EXIT ();
return 1;
}
syntax highlighted by Code2HTML, v. 0.9.1