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

51
src/arith/integer.c
View file

@ -115,9 +115,11 @@ struct cons_pointer add_integers( struct cons_pointer a,
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) { while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
__int128_t av = __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 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; __int128_t rv = av + bv + carry;
@ -179,9 +181,11 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) { while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
__int128_t av = __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 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 /* 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 * `LONG_MAX * LONG_MAX` =~ the maximum value for `__int128_t`. So if the carry
@ -200,7 +204,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
debug_printf( DEBUG_ARITH, debug_printf( DEBUG_ARITH,
L"multiply_integers: 64 bit overflow; setting carry to %ld\n", L"multiply_integers: 64 bit overflow; setting carry to %ld\n",
( int64_t ) carry ); ( int64_t ) carry );
rv &= MAX_INTEGER; // <<< PROBLEM IS HERE! rv &= MAX_INTEGER;
} }
struct cons_pointer tail = make_integer( ( int64_t ) rv, NIL ); struct cons_pointer tail = make_integer( ( int64_t ) rv, NIL );
@ -259,25 +263,27 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
int base ) { int base ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object integer = pointer2cell( int_pointer ); struct cons_space_object integer = pointer2cell( int_pointer );
int64_t accumulator = integer.payload.integer.value; __int128_t accumulator = llabs( integer.payload.integer.value );
bool is_negative = accumulator < 0; bool is_negative = integer.payload.integer.value < 0;
accumulator = llabs( accumulator );
int digits = 0; int digits = 0;
if ( accumulator == 0 && !nilp(integer.payload.integer.more) ) { if ( accumulator == 0 && nilp( integer.payload.integer.more ) ) {
accumulator = MAX_INTEGER;
}
if ( accumulator == 0) {
result = c_string_to_lisp_string( L"0" ); result = c_string_to_lisp_string( L"0" );
} else { } 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, debug_printf( DEBUG_IO,
L"integer_to_string: accumulator is %ld\n:", L"integer_to_string: accumulator is %ld\n:",
accumulator ); accumulator );
do { do {
debug_printf( DEBUG_IO, 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, accumulator % base,
hex_digits[accumulator % base] ); hex_digits[accumulator % base] );
@ -286,21 +292,10 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
result ); result );
accumulator = accumulator / base; accumulator = accumulator / base;
} while ( 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 ( stringp( result )
&& pointer2cell( result ).payload.string.character == L',' ) {
/* if the number of digits in the string is divisible by 3, there will be /* if the number of digits in the string is divisible by 3, there will be
* an unwanted comma on the front. */ * an unwanted comma on the front. */
struct cons_pointer tmp = result; struct cons_pointer tmp = result;

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

38
src/arith/peano.h
View file

@ -12,9 +12,17 @@
#ifndef PEANO_H #ifndef PEANO_H
#define PEANO_H #define PEANO_H
#ifdef __cplusplus bool zerop( struct cons_pointer arg );
extern "C" {
#endif 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 * Add an indefinite number of numbers together
@ -34,8 +42,24 @@ extern "C" {
*/ */
struct cons_pointer struct cons_pointer
lisp_multiply( struct stack_frame *frame, 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 frame_pointer,
struct cons_pointer env ); struct cons_pointer arg1,
struct cons_pointer arg2 );
/** /**
* Subtract one number from another. * Subtract one number from another.
@ -45,8 +69,7 @@ extern "C" {
*/ */
struct cons_pointer struct cons_pointer
lisp_subtract( struct stack_frame *frame, lisp_subtract( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer, struct cons_pointer env );
struct cons_pointer env );
/** /**
* Divide one number by another. * Divide one number by another.
@ -58,7 +81,4 @@ extern "C" {
lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_divide( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ); 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 "equal.h"
#include "integer.h" #include "integer.h"
#include "lispops.h" #include "lispops.h"
#include "peano.h"
#include "print.h" #include "print.h"
#include "ratio.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`, * 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 subtract_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1, struct cons_pointer arg1,
struct cons_pointer arg2 ) { 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 ); result = add_ratio_ratio( frame_pointer, arg1, i );
dec_ref( i ); dec_ref( i );