From 9b6a37ebb5ae6e2a3411fed9552d8b525c7afb78 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 4 Jan 2019 10:39:48 +0000 Subject: [PATCH] Now successfully reading/printing 2 cell bignums Something is wrong with n-cell bignums, but let's make haste slowly. --- src/arith/integer.c | 117 +++++++++++++++++++++----------------------- src/arith/peano.c | 111 +++++++++++++++++++++-------------------- src/arith/peano.h | 62 +++++++++++++++-------- src/arith/ratio.c | 10 +--- 4 files changed, 157 insertions(+), 143 deletions(-) diff --git a/src/arith/integer.c b/src/arith/integer.c index 957b6bb..d6162ea 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -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 ) { diff --git a/src/arith/peano.c b/src/arith/peano.c index f34d632..481f33e 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -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; diff --git a/src/arith/peano.h b/src/arith/peano.h index f1c21b4..0bd09d5 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -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 */ diff --git a/src/arith/ratio.c b/src/arith/ratio.c index fd6a770..f9dd0f4 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -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 );