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

Now successfully reading/printing 2 cell bignums

Browse source 
Something is wrong with n-cell bignums, but let's make haste slowly.
This commit is contained in:
Simon Brooke 2019-01-04 10:39:48 +00:00
parent d9d789fdd0
commit 9b6a37ebb5
4 changed files with 157 additions and 143 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

117
src/arith/integer.c
View file

@ -111,13 +111,15 @@ struct cons_pointer add_integers( struct cons_pointer a,
debug_print_object( a, DEBUG_ARITH );
debug_print( L" + ", DEBUG_ARITH );
debug_print_object( b, DEBUG_ARITH );
debug_println( DEBUG_ARITH);
debug_println( DEBUG_ARITH );
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
__int128_t av =
(__int128_t)integerp( a ) ? pointer2cell( a ).payload.integer.value : 0;
( __int128_t ) integerp( a ) ? pointer2cell( a ).
payload.integer.value : 0;
__int128_t bv =
(__int128_t)integerp( b ) ? pointer2cell( b ).payload.integer.value : 0;
( __int128_t ) integerp( b ) ? pointer2cell( b ).
payload.integer.value : 0;
__int128_t rv = av + bv + carry;
@ -126,27 +128,27 @@ struct cons_pointer add_integers( struct cons_pointer a,
} else {
// TODO: we're correctly detecting overflow, but not yet correctly
// handling it.
carry = rv >> 60;
carry = rv >> 60;
debug_printf( DEBUG_ARITH,
L"add_integers: 64 bit overflow; setting carry to %ld\n",
(int64_t)carry );
( int64_t ) carry );
rv = rv & MAX_INTEGER;
}
struct cons_pointer tail = make_integer( (int64_t)rv, NIL);
struct cons_pointer tail = make_integer( ( int64_t ) rv, NIL );
if (nilp(cursor)) {
cursor = tail;
if ( nilp( cursor ) ) {
cursor = tail;
} else {
inc_ref(tail);
/* yes, this is a destructive change - but the integer has not yet been released
* into the wild */
struct cons_space_object * c = &pointer2cell(cursor);
c->payload.integer.more = tail;
inc_ref( tail );
/* yes, this is a destructive change - but the integer has not yet been released
* into the wild */
struct cons_space_object *c = &pointer2cell( cursor );
c->payload.integer.more = tail;
}
if ( nilp(result) ) {
result = cursor;
if ( nilp( result ) ) {
result = cursor;
}
a = pointer2cell( a ).payload.integer.more;
@ -179,9 +181,11 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
__int128_t av =
(__int128_t)integerp( a ) ? pointer2cell( a ).payload.integer.value : 0;
( __int128_t ) integerp( a ) ? pointer2cell( a ).
payload.integer.value : 1;
__int128_t bv =
(__int128_t)integerp( b ) ? pointer2cell( b ).payload.integer.value : 0;
( __int128_t ) integerp( b ) ? pointer2cell( b ).
payload.integer.value : 1;
/* slightly dodgy. `MAX_INTEGER` is substantially smaller than `LONG_MAX`, and
* `LONG_MAX * LONG_MAX` =~ the maximum value for `__int128_t`. So if the carry
@ -189,34 +193,34 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
* intellectually up to proving it this morning) adding the carry might
* overflow `__int128_t`. Edge-case testing required.
*/
__int128_t rv = (av * bv) + carry;
__int128_t rv = ( av * bv ) + carry;
if ( MAX_INTEGER >= rv ) {
if ( MAX_INTEGER >= rv ) {
carry = 0;
} else {
// TODO: we're correctly detecting overflow, but not yet correctly
// handling it.
carry = rv >> 60;
carry = rv >> 60;
debug_printf( DEBUG_ARITH,
L"multiply_integers: 64 bit overflow; setting carry to %ld\n",
(int64_t)carry );
rv &= MAX_INTEGER; // <<< PROBLEM IS HERE!
( int64_t ) carry );
rv &= MAX_INTEGER;
}
struct cons_pointer tail = make_integer( (int64_t)rv, NIL);
struct cons_pointer tail = make_integer( ( int64_t ) rv, NIL );
if (nilp(cursor)) {
cursor = tail;
if ( nilp( cursor ) ) {
cursor = tail;
} else {
inc_ref(tail);
/* yes, this is a destructive change - but the integer has not yet been released
* into the wild */
struct cons_space_object * c = &pointer2cell(cursor);
c->payload.integer.more = tail;
}
inc_ref( tail );
/* yes, this is a destructive change - but the integer has not yet been released
* into the wild */
struct cons_space_object *c = &pointer2cell( cursor );
c->payload.integer.more = tail;
}
if ( nilp(result) ) {
result = cursor;
if ( nilp( result ) ) {
result = cursor;
}
a = pointer2cell( a ).payload.integer.more;
@ -259,25 +263,27 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
int base ) {
struct cons_pointer result = NIL;
struct cons_space_object integer = pointer2cell( int_pointer );
int64_t accumulator = integer.payload.integer.value;
bool is_negative = accumulator < 0;
accumulator = llabs( accumulator );
__int128_t accumulator = llabs( integer.payload.integer.value );
bool is_negative = integer.payload.integer.value < 0;
int digits = 0;
if ( accumulator == 0 && !nilp(integer.payload.integer.more) ) {
accumulator = MAX_INTEGER;
}
if ( accumulator == 0) {
if ( accumulator == 0 && nilp( integer.payload.integer.more ) ) {
result = c_string_to_lisp_string( L"0" );
} else {
while ( accumulator > 0 ) {
while ( accumulator > 0 || !nilp( integer.payload.integer.more ) ) {
if ( !nilp( integer.payload.integer.more ) ) {
integer = pointer2cell( integer.payload.integer.more );
accumulator +=
( llabs( integer.payload.integer.value ) *
( MAX_INTEGER + 1 ) );
}
debug_printf( DEBUG_IO,
L"integer_to_string: accumulator is %ld\n:",
accumulator );
do {
debug_printf( DEBUG_IO,
L"integer_to_string: digit is %ld, hexadecimal is %lc\n:",
L"integer_to_string: digit is %ld, hexadecimal is %c\n:",
accumulator % base,
hex_digits[accumulator % base] );
@ -286,26 +292,15 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
result );
accumulator = accumulator / base;
} while ( accumulator > base );
if ( integerp( integer.payload.integer.more ) ) {
integer = pointer2cell( integer.payload.integer.more );
int64_t i = integer.payload.integer.value;
/* TODO: I don't believe it's as simple as this! */
accumulator += ( base * ( i % base ) );
result =
integer_to_string_add_digit( accumulator % base, digits++,
result );
accumulator += ( base * ( i / base ) );
}
}
if (stringp(result) && pointer2cell(result).payload.string.character == L',') {
/* if the number of digits in the string is divisible by 3, there will be
* an unwanted comma on the front. */
struct cons_pointer tmp = result;
result = pointer2cell(result).payload.string.cdr;
dec_ref(tmp);
if ( stringp( result )
&& pointer2cell( result ).payload.string.character == L',' ) {
/* if the number of digits in the string is divisible by 3, there will be
* an unwanted comma on the front. */
struct cons_pointer tmp = result;
result = pointer2cell( result ).payload.string.cdr;
dec_ref( tmp );
}
if ( is_negative ) {

111
src/arith/peano.c
View file

@ -105,6 +105,9 @@ int64_t to_long_int( struct cons_pointer arg ) {
struct cons_space_object cell = pointer2cell( arg );
switch ( cell.tag.value ) {
case INTEGERTV:
/* TODO: if (integerp(cell.payload.integer.more)) {
* throw an exception!
* } */
result = cell.payload.integer.value;
break;
case RATIOTV:
@ -252,9 +255,9 @@ struct cons_pointer lisp_add( struct stack_frame
/**
* return a cons_pointer indicating a number which is the product of
* the numbers indicated by `arg1` and `arg2`.
*/
* return a cons_pointer indicating a number which is the product of
* the numbers indicated by `arg1` and `arg2`.
*/
struct cons_pointer multiply_2( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer arg1,
@ -284,9 +287,6 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
result = arg2;
break;
case INTEGERTV:
// result =
// make_integer( cell1.payload.integer.value *
// cell2.payload.integer.value, NIL );
result = multiply_integers( arg1, arg2 );
break;
case RATIOTV:
@ -351,7 +351,6 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
return result;
}
/**
* Multiply an indefinite number of numbers together
* @param env the evaluation environment - ignored;
@ -393,10 +392,10 @@ struct cons_pointer lisp_multiply( struct
/**
* return a cons_pointer indicating a number which is the
* inverse of the number indicated by `arg`.
* 0 - the number indicated by `arg`.
*/
struct cons_pointer inverse( struct cons_pointer frame,
struct cons_pointer arg ) {
struct cons_pointer negative( struct cons_pointer frame,
struct cons_pointer arg ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( arg );
@ -405,18 +404,17 @@ struct cons_pointer inverse( struct cons_pointer frame,
result = arg;
break;
case INTEGERTV:
// TODO: bignums
result = make_integer( 0 - to_long_int( arg ), NIL );
result =
make_integer( 0 - cell.payload.integer.value,
cell.payload.integer.more );
break;
case NILTV:
result = TRUE;
break;
case RATIOTV:
result = make_ratio( frame,
make_integer( 0 -
to_long_int( cell.payload.
ratio.dividend ),
NIL ),
negative( frame,
cell.payload.ratio.dividend ),
cell.payload.ratio.divisor );
break;
case REALTV:
@ -430,50 +428,48 @@ struct cons_pointer inverse( struct cons_pointer frame,
return result;
}
/**
* Subtract one number from another.
* @param env the evaluation environment - ignored;
* @param frame the stack frame.
* @return a pointer to an integer or real.
* return a cons_pointer indicating a number which is the result of
* subtracting the numbers indicated by `arg2` from that indicated by `arg1`,
* in the context of this `frame`.
*/
struct cons_pointer lisp_subtract( struct
stack_frame
*frame, struct cons_pointer frame_pointer, struct
cons_pointer env ) {
struct cons_pointer subtract_2( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer result = NIL;
struct cons_space_object cell0 = pointer2cell( frame->arg[0] );
struct cons_space_object cell1 = pointer2cell( frame->arg[1] );
switch ( cell0.tag.value ) {
switch ( pointer2cell( arg1 ).tag.value ) {
case EXCEPTIONTV:
result = frame->arg[0];
result = arg1;
break;
case INTEGERTV:
switch ( cell1.tag.value ) {
switch ( pointer2cell( arg2 ).tag.value ) {
case EXCEPTIONTV:
result = frame->arg[1];
result = arg2;
break;
case INTEGERTV:
result = make_integer( cell0.payload.integer.value
- cell1.payload.integer.value,
NIL );
case INTEGERTV:{
struct cons_pointer i =
negative( frame_pointer, arg2 );
inc_ref( i );
result = add_integers( arg1, i );
dec_ref( i );
}
break;
case RATIOTV:{
struct cons_pointer tmp =
make_ratio( frame_pointer, frame->arg[0],
make_ratio( frame_pointer, arg1,
make_integer( 1, NIL ) );
inc_ref( tmp );
result =
subtract_ratio_ratio( frame_pointer, tmp,
frame->arg[1] );
subtract_ratio_ratio( frame_pointer, tmp, arg2 );
dec_ref( tmp );
}
break;
case REALTV:
result =
make_real( to_long_double( frame->arg[0] ) -
to_long_double( frame->arg[1] ) );
make_real( to_long_double( arg1 ) -
to_long_double( arg2 ) );
break;
default:
result = throw_exception( c_string_to_lisp_string
@ -483,30 +479,27 @@ struct cons_pointer lisp_subtract( struct
}
break;
case RATIOTV:
switch ( cell1.tag.value ) {
switch ( pointer2cell( arg2 ).tag.value ) {
case EXCEPTIONTV:
result = frame->arg[1];
result = arg2;
break;
case INTEGERTV:{
struct cons_pointer tmp =
make_ratio( frame_pointer, frame->arg[1],
make_ratio( frame_pointer, arg2,
make_integer( 1, NIL ) );
inc_ref( tmp );
result =
subtract_ratio_ratio( frame_pointer, frame->arg[0],
tmp );
subtract_ratio_ratio( frame_pointer, arg1, tmp );
dec_ref( tmp );
}
break;
case RATIOTV:
result =
subtract_ratio_ratio( frame_pointer, frame->arg[0],
frame->arg[1] );
result = subtract_ratio_ratio( frame_pointer, arg1, arg2 );
break;
case REALTV:
result =
make_real( to_long_double( frame->arg[0] ) -
to_long_double( frame->arg[1] ) );
make_real( to_long_double( arg1 ) -
to_long_double( arg2 ) );
break;
default:
result = throw_exception( c_string_to_lisp_string
@ -516,9 +509,8 @@ struct cons_pointer lisp_subtract( struct
}
break;
case REALTV:
result = exceptionp( frame->arg[1] ) ? frame->arg[1] :
make_real( to_long_double( frame->arg[0] ) -
to_long_double( frame->arg[1] ) );
result = exceptionp( arg2 ) ? arg2 :
make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
break;
default:
result = throw_exception( c_string_to_lisp_string
@ -532,6 +524,19 @@ struct cons_pointer lisp_subtract( struct
return result;
}
/**
* Subtract one number from another.
* @param env the evaluation environment - ignored;
* @param frame the stack frame.
* @return a pointer to an integer or real.
*/
struct cons_pointer lisp_subtract( struct
stack_frame
*frame, struct cons_pointer frame_pointer, struct
cons_pointer env ) {
return subtract_2( frame, frame_pointer, frame->arg[0], frame->arg[1] );
}
/**
* Divide one number by another.
* @param env the evaluation environment - ignored;

62
src/arith/peano.h
View file

@ -12,9 +12,17 @@
#ifndef PEANO_H
#define PEANO_H
#ifdef __cplusplus
extern "C" {
#endif
bool zerop( struct cons_pointer arg );
struct cons_pointer negative( struct cons_pointer frame,
struct cons_pointer arg );
/**
* TODO: cannot throw an exception out of here, which is a problem
* if a ratio may legally have zero as a divisor, or something which is
* not a number is passed in.
*/
long double to_long_double( struct cons_pointer arg );
/**
* Add an indefinite number of numbers together
@ -22,9 +30,9 @@ extern "C" {
* @param frame the stack frame.
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
struct cons_pointer
lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
/**
* Multiply an indefinite number of numbers together
@ -32,10 +40,26 @@ extern "C" {
* @param frame the stack frame.
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_multiply( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
struct cons_pointer
lisp_multiply( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer env );
/**
* return a cons_pointer indicating a number which is the
* 0 - the number indicated by `arg`.
*/
struct cons_pointer negative( struct cons_pointer frame,
struct cons_pointer arg );
/**
* return a cons_pointer indicating a number which is the result of
* subtracting the numbers indicated by `arg2` from that indicated by `arg1`,
* in the context of this `frame`.
*/
struct cons_pointer subtract_2( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 );
/**
* Subtract one number from another.
@ -43,10 +67,9 @@ extern "C" {
* @param frame the stack frame.
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_subtract( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
struct cons_pointer
lisp_subtract( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer env );
/**
* Divide one number by another.
@ -54,11 +77,8 @@ extern "C" {
* @param frame the stack frame.
* @return a pointer to an integer or real.
*/
struct cons_pointer
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
struct cons_pointer
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env );
#ifdef __cplusplus
}
#endif
#endif /* PEANO_H */
#endif /* PEANO_H */

10
src/arith/ratio.c
View file

@ -17,17 +17,11 @@
#include "equal.h"
#include "integer.h"
#include "lispops.h"
#include "peano.h"
#include "print.h"
#include "ratio.h"
/*
* declared in peano.c, can't include piano.h here because
* circularity. TODO: refactor.
*/
struct cons_pointer inverse( struct cons_pointer frame_pointer,
struct cons_pointer arg );
/**
* return, as a int64_t, the greatest common divisor of `m` and `n`,
*/
@ -297,7 +291,7 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer subtract_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer i = inverse( frame_pointer, arg2 ),
struct cons_pointer i = negative( frame_pointer, arg2 ),
result = add_ratio_ratio( frame_pointer, arg1, i );
dec_ref( i );