2004-08-04 22:43:58 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
2004-09-18 22:29:29 -04:00
|
|
|
/* Does not reduce to lowest terms, so should only be used by math
|
|
|
|
library implementation, to avoid breaking invariants. */
|
|
|
|
void primitive_from_fraction(void)
|
|
|
|
{
|
|
|
|
CELL denominator = dpop();
|
|
|
|
CELL numerator = dpop();
|
|
|
|
if(zerop(denominator))
|
|
|
|
raise(SIGFPE);
|
|
|
|
if(onep(denominator))
|
|
|
|
dpush(numerator);
|
2004-09-19 00:33:40 -04:00
|
|
|
else
|
2004-09-19 00:57:33 -04:00
|
|
|
{
|
|
|
|
RATIO* ratio = allot(sizeof(RATIO));
|
|
|
|
ratio->numerator = numerator;
|
|
|
|
ratio->denominator = denominator;
|
|
|
|
dpush(tag_ratio(ratio));
|
|
|
|
}
|
2004-08-25 00:26:49 -04:00
|
|
|
}
|
|
|
|
|
2004-09-18 22:29:29 -04:00
|
|
|
void primitive_to_fraction(void)
|
2004-08-04 22:43:58 -04:00
|
|
|
{
|
2004-09-18 22:29:29 -04:00
|
|
|
RATIO* r;
|
|
|
|
|
|
|
|
switch(type_of(dpeek()))
|
|
|
|
{
|
|
|
|
case FIXNUM_TYPE:
|
|
|
|
case BIGNUM_TYPE:
|
|
|
|
dpush(tag_fixnum(1));
|
|
|
|
break;
|
|
|
|
case RATIO_TYPE:
|
|
|
|
r = untag_ratio(dpeek());
|
|
|
|
drepl(r->numerator);
|
|
|
|
dpush(r->denominator);
|
|
|
|
break;
|
|
|
|
default:
|
|
|
|
type_error(RATIONAL_TYPE,dpeek());
|
|
|
|
break;
|
|
|
|
}
|
2004-08-04 22:43:58 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_numerator(void)
|
|
|
|
{
|
2004-08-12 17:36:36 -04:00
|
|
|
switch(type_of(dpeek()))
|
2004-08-04 22:43:58 -04:00
|
|
|
{
|
|
|
|
case FIXNUM_TYPE:
|
|
|
|
case BIGNUM_TYPE:
|
|
|
|
/* No op */
|
|
|
|
break;
|
|
|
|
case RATIO_TYPE:
|
2004-08-12 17:36:36 -04:00
|
|
|
drepl(untag_ratio(dpeek())->numerator);
|
2004-08-04 22:43:58 -04:00
|
|
|
break;
|
|
|
|
default:
|
2004-08-12 17:36:36 -04:00
|
|
|
type_error(RATIONAL_TYPE,dpeek());
|
2004-08-04 22:43:58 -04:00
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_denominator(void)
|
|
|
|
{
|
2004-08-12 17:36:36 -04:00
|
|
|
switch(type_of(dpeek()))
|
2004-08-04 22:43:58 -04:00
|
|
|
{
|
|
|
|
case FIXNUM_TYPE:
|
|
|
|
case BIGNUM_TYPE:
|
2004-08-12 17:36:36 -04:00
|
|
|
drepl(tag_fixnum(1));
|
2004-08-04 22:43:58 -04:00
|
|
|
break;
|
|
|
|
case RATIO_TYPE:
|
2004-08-12 17:36:36 -04:00
|
|
|
drepl(untag_ratio(dpeek())->denominator);
|
2004-08-04 22:43:58 -04:00
|
|
|
break;
|
|
|
|
default:
|
2004-08-12 17:36:36 -04:00
|
|
|
type_error(RATIONAL_TYPE,dpeek());
|
2004-08-04 22:43:58 -04:00
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|