simon/post-scarcity
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Still broken, but I believe we're moving in the right direction.

Browse source
This commit is contained in:
Simon Brooke 2019-01-24 10:12:08 +00:00
parent bf72ae379d
commit f8c20ab3b1
5 changed files with 124 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/arith/integer.c
View file

@ -137,6 +137,23 @@ __int128_t int128_to_integer( __int128_t val,
return carry;
}
struct cons_pointer make_integer_128(__int128_t val,
struct cons_pointer less_significant) {
struct cons_pointer result = NIL;
do {
if ( MAX_INTEGER >= val ) {
result = make_integer( (long int) val, less_significant);
} else {
less_significant = make_integer( (long int)val & MAX_INTEGER, less_significant);
val = val >> 60;
}
} while (nilp(result));
return result;
}
/**
* Return a pointer to an integer representing the sum of the integers
* pointed to by `a` and `b`. If either isn't an integer, will return nil.
@ -221,7 +238,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
struct cons_pointer result = NIL;
bool neg = is_negative(a) != is_negative(b);
bool is_first_b = true;
int oom = 0;
int oom = -1;
debug_print( L"multiply_integers: a = ", DEBUG_ARITH );
debug_print_object(a, DEBUG_ARITH);
@ -233,14 +250,14 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
while ( !nilp( b ) ) {
bool is_first_d = true;
struct cons_pointer d = a;
struct cons_pointer partial = base_partial(oom++);
struct cons_pointer partial = base_partial(++oom);
__int128_t carry = 0;
while ( !nilp(d) || carry != 0) {
partial = make_integer(0, partial);
struct cons_pointer new = make_integer( 0, NIL);
__int128_t dv = cell_value( d, '*', is_first_d );
__int128_t bv = cell_value( b, '*', is_first_b );
struct cons_pointer new = NIL;
__int128_t dv = cell_value( d, '+', is_first_d );
__int128_t bv = cell_value( b, '+', is_first_b );
__int128_t rv = (dv * bv) + carry;
@ -260,17 +277,12 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
debug_print_object( partial, DEBUG_ARITH);
debug_print( L"\n", DEBUG_ARITH );
inc_ref(new);
carry = int128_to_integer(rv, NIL, new);
new = make_integer_128(rv, base_partial(oom));
if (nilp(d) && carry != 0) debug_print(L"THIS SHOULD NEVER HAPPEN!\n", DEBUG_ARITH);
if (nilp(partial) || zerop(partial)) {
if ( zerop(partial)) {
partial = new;
} else {
partial = add_integers(partial, new);
inc_ref(partial);
//dec_ref(new);
}
d = integerp(d) ? pointer2cell( d ).payload.integer.more : NIL;

32
src/arith/peano.c
View file

@ -43,9 +43,14 @@ bool zerop( struct cons_pointer arg ) {
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
result = cell.payload.integer.value == 0 &&
nilp( cell.payload.integer.more );
case INTEGERTV: {
do {
debug_print(L"zerop: ", DEBUG_ARITH);
debug_dump_object(arg, DEBUG_ARITH);
result = (pointer2cell( arg ).payload.integer.value == 0);
arg = pointer2cell(arg).payload.integer.more;
} while (result && integerp(arg));
}
break;
case RATIOTV:
result = zerop( cell.payload.ratio.dividend );
@ -115,16 +120,25 @@ struct cons_pointer absolute( struct cons_pointer frame_pointer, struct cons_poi
* not a number is passed in.
*/
long double to_long_double( struct cons_pointer arg ) {
long double result = 0; /* not a number, as a long double */
long double result = 0;
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
result = 1.0;
while ( cell.tag.value == INTEGERTV ) {
result = ( result * (MAX_INTEGER + 1) * cell.payload.integer.value );
cell = pointer2cell( cell.payload.integer.more );
}
// obviously, this doesn't work for bignums
result = (long double)cell.payload.integer.value;
// sadly, this doesn't work at all.
// result += 1.0;
// for (bool is_first = false; integerp(arg); is_first = true) {
// debug_printf(DEBUG_ARITH, L"to_long_double: accumulator = %lf, arg = ", result);
// debug_dump_object(arg, DEBUG_ARITH);
// if (!is_first) {
// result *= (long double)(MAX_INTEGER + 1);
// }
// result *= (long double)(cell.payload.integer.value);
// arg = cell.payload.integer.more;
// cell = pointer2cell( arg );
// }
break;
case RATIOTV:
result = to_long_double(cell.payload.ratio.dividend) /