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 );
diff --git a/src/ops/read.c b/src/ops/read.c
index cc035a1..9074652 100644
--- a/src/ops/read.c
+++ b/src/ops/read.c
@@ -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 );