Now successfully reading/printing 2 cell bignums
Something is wrong with n-cell bignums, but let's make haste slowly.
This commit is contained in:
parent
d9d789fdd0
commit
67802a07b8
|
|
@ -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 ) {
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
#include "integer.h"
|
||||
#include "intern.h"
|
||||
#include "lispops.h"
|
||||
#include "peano.h"
|
||||
#include "print.h"
|
||||
#include "ratio.h"
|
||||
#include "read.h"
|
||||
|
|
@ -152,25 +153,25 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
|
|||
|
||||
/**
|
||||
* read a number from this input stream, given this initial character.
|
||||
* TODO: to be able to read bignums, we need to read the number from the
|
||||
* input stream into a Lisp string, and then convert it to a number.
|
||||
* TODO: Need to do a lot of inc_ref and dec_ref, to make sure the
|
||||
* garbage is collected.
|
||||
*/
|
||||
struct cons_pointer read_number( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
FILE * input,
|
||||
wint_t initial, bool seen_period ) {
|
||||
debug_print( L"entering read_number\n", DEBUG_IO );
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
/* TODO: accumulator and dividend cannot be `int64_t`s, otherwise we cannot
|
||||
* read bignums. They will have to be Lisp integers. */
|
||||
int64_t accumulator = 0;
|
||||
int64_t dividend = 0;
|
||||
struct cons_pointer result = make_integer( 0, NIL );
|
||||
/* TODO: we really need to be getting `base` from a privileged Lisp name -
|
||||
* and it should be the same privileged name we use when writing numbers */
|
||||
struct cons_pointer base = make_integer( 10, NIL );
|
||||
struct cons_pointer dividend = NIL;
|
||||
int places_of_decimals = 0;
|
||||
wint_t c;
|
||||
bool negative = initial == btowc( '-' );
|
||||
bool neg = initial == btowc( '-' );
|
||||
|
||||
if ( negative ) {
|
||||
if ( neg ) {
|
||||
initial = fgetwc( input );
|
||||
}
|
||||
|
||||
|
|
@ -180,7 +181,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
for ( c = initial; iswdigit( c )
|
||||
|| c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) {
|
||||
if ( c == btowc( '.' ) ) {
|
||||
if ( seen_period || dividend != 0 ) {
|
||||
if ( seen_period || !nilp( dividend ) ) {
|
||||
return throw_exception( c_string_to_lisp_string
|
||||
( L"Malformed number: too many periods" ),
|
||||
frame_pointer );
|
||||
|
|
@ -188,23 +189,24 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
seen_period = true;
|
||||
}
|
||||
} else if ( c == btowc( '/' ) ) {
|
||||
if ( seen_period || dividend > 0 ) {
|
||||
if ( seen_period || !nilp( dividend ) ) {
|
||||
return throw_exception( c_string_to_lisp_string
|
||||
( L"Malformed number: dividend of rational must be integer" ),
|
||||
frame_pointer );
|
||||
} else {
|
||||
dividend = negative ? 0 - accumulator : accumulator;
|
||||
dividend = result;
|
||||
|
||||
accumulator = 0;
|
||||
result = make_integer( 0, NIL );
|
||||
}
|
||||
} else if ( c == L',' ) {
|
||||
// silently ignore it.
|
||||
} else {
|
||||
accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
|
||||
result = add_integers( multiply_integers( result, base ),
|
||||
make_integer( ( int ) c - ( int ) '0',
|
||||
NIL ) );
|
||||
|
||||
debug_printf( DEBUG_IO,
|
||||
L"Added character %c, accumulator now %ld\n",
|
||||
c, accumulator );
|
||||
L"Added character %c, result now %ld\n", c, result );
|
||||
|
||||
if ( seen_period ) {
|
||||
places_of_decimals++;
|
||||
|
|
@ -217,21 +219,23 @@ struct cons_pointer read_number( struct stack_frame *frame,
|
|||
*/
|
||||
ungetwc( c, input );
|
||||
if ( seen_period ) {
|
||||
long double rv = ( long double )
|
||||
( accumulator / pow( 10, places_of_decimals ) );
|
||||
if ( negative ) {
|
||||
rv = 0 - rv;
|
||||
}
|
||||
result = make_real( rv );
|
||||
} else if ( dividend != 0 ) {
|
||||
result =
|
||||
make_ratio( frame_pointer, make_integer( dividend, NIL ),
|
||||
make_integer( accumulator, NIL ) );
|
||||
} else {
|
||||
if ( negative ) {
|
||||
accumulator = 0 - accumulator;
|
||||
}
|
||||
result = make_integer( accumulator, NIL );
|
||||
struct cons_pointer div = make_ratio( frame_pointer, result,
|
||||
make_integer( powl
|
||||
( to_long_double
|
||||
( base ),
|
||||
places_of_decimals ),
|
||||
NIL ) );
|
||||
inc_ref( div );
|
||||
|
||||
result = make_real( to_long_double( div ) );
|
||||
|
||||
dec_ref( div );
|
||||
} else if ( integerp( dividend ) ) {
|
||||
result = make_ratio( frame_pointer, dividend, result );
|
||||
}
|
||||
|
||||
if ( neg ) {
|
||||
result = negative( frame_pointer, result );
|
||||
}
|
||||
|
||||
debug_print( L"read_number returning\n", DEBUG_IO );
|
||||
|
|
|
|||
Loading…
Reference in a new issue