Major progress, multiply now almost works
There's a premature free() somewhere, and I'm not sure why. Print depends on divide, which is easy, but also on mod and floor (of rationals) which isn't.
This commit is contained in:
parent
64fc43e9fc
commit
3fd322af6f
|
|
@ -5,4 +5,5 @@
|
|||
((= x 1) n)
|
||||
(t (* n (expt n (- x 1)))))))
|
||||
|
||||
(expt 2 60)
|
||||
(inspect expt)
|
||||
(expt 2 59)
|
||||
|
|
|
|||
|
|
@ -27,7 +27,9 @@
|
|||
#include "conspage.h"
|
||||
#include "consspaceobject.h"
|
||||
#include "debug.h"
|
||||
#include "equal.h"
|
||||
#include "lispops.h"
|
||||
#include "peano.h"
|
||||
|
||||
/*
|
||||
* The maximum value we will allow in an integer cell.
|
||||
|
|
@ -100,11 +102,11 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
|||
/**
|
||||
* Internal to `operate_on_integers`, do not use.
|
||||
* @param c a pointer to a cell, assumed to be an integer cell;
|
||||
* @param op a character representing the operation: expectedto be either
|
||||
* '+' or '*'; behaviour with other values is undefined.
|
||||
* @param is_first_cell true if this is the first cell in a bignum
|
||||
* chain, else false.
|
||||
* \see operate_on_integers
|
||||
*/
|
||||
__int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
|
||||
__int128_t cell_value( struct cons_pointer c, bool is_first_cell ) {
|
||||
long int val = nilp( c ) ?
|
||||
0 :
|
||||
pointer2cell( c ).payload.integer.value;
|
||||
|
|
@ -117,8 +119,8 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
|
|||
val :
|
||||
0;
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"cell_value: raw value is %ld, op = '%c', is_first_cell = %s; %4.4s; returning ",
|
||||
val, op, is_first_cell ? "true" : "false", pointer2cell(c).tag.bytes);
|
||||
L"cell_value: raw value is %ld, is_first_cell = %s; %4.4s; returning ",
|
||||
val, is_first_cell ? "true" : "false", pointer2cell(c).tag.bytes);
|
||||
debug_print_128bit( result, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
|
|
@ -126,60 +128,77 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
|
|||
}
|
||||
|
||||
/**
|
||||
* internal workings of both `add_integers` and `multiply_integers` (and
|
||||
* possibly, later, other operations. Apply the operator `op` to the
|
||||
* integer arguments `a` and `b`, and return a pointer to the result. If
|
||||
* either `a` or `b` is not an integer, returns `NIL`.
|
||||
* Overwrite the value field of the integer indicated by `new` with
|
||||
* the least significant 60 bits of `val`, and return the more significant
|
||||
* bits (if any) right-shifted by 60 places. Destructive, primitive, do not
|
||||
* use in any context except primitive operations on integers.
|
||||
*
|
||||
* @param a a pointer to a cell, assumed to be an integer cell;
|
||||
* @param b a pointer to a cell, assumed to be an integer cell;
|
||||
* @param op a character representing the operation: expected to be either
|
||||
* '+' or '*'; behaviour with other values is undefined.
|
||||
* \see add_integers
|
||||
* \see multiply_integers
|
||||
* @param val the value to represent;
|
||||
* @param less_significant the less significant words of this bignum, if any,
|
||||
* else NIL;
|
||||
* @param new a newly created integer, which will be destructively changed.
|
||||
* @return carry, if any, else 0.
|
||||
*/
|
||||
/* \todo there is a significant bug here, which manifests in multiply but
|
||||
* may not manifest in add. The value in the least significant cell ends
|
||||
* up significantly WRONG, but the value in the more significant cell
|
||||
* ends up correct. */
|
||||
struct cons_pointer operate_on_integers( struct cons_pointer a,
|
||||
struct cons_pointer b, char op ) {
|
||||
__int128_t int128_to_integer( __int128_t val,
|
||||
struct cons_pointer less_significant,
|
||||
struct cons_pointer new)
|
||||
{
|
||||
struct cons_pointer cursor = NIL;
|
||||
__int128_t carry = 0;
|
||||
|
||||
if ( MAX_INTEGER >= val ) {
|
||||
carry = 0;
|
||||
} else {
|
||||
carry = val >> 60;
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"int128_to_integer: 64 bit overflow; setting carry to %ld\n",
|
||||
( int64_t ) carry );
|
||||
val &= MAX_INTEGER;
|
||||
}
|
||||
|
||||
struct cons_space_object * newc = &pointer2cell( new);
|
||||
newc->payload.integer.value = val;
|
||||
|
||||
if ( integerp( less_significant ) ) {
|
||||
struct cons_space_object *lsc = &pointer2cell( less_significant );
|
||||
inc_ref( new );
|
||||
lsc->payload.integer.more = new;
|
||||
}
|
||||
|
||||
return carry;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return a pointer to an integer representing the sum of the integers
|
||||
* pointed to by `a` and `b`. If either isn't an integer, will return nil.
|
||||
*/
|
||||
struct cons_pointer add_integers( struct cons_pointer a,
|
||||
struct cons_pointer b ) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer cursor = NIL;
|
||||
|
||||
debug_print( L"add_integers: a = ", DEBUG_ARITH );
|
||||
debug_print_object(a, DEBUG_ARITH);
|
||||
debug_print( L"; b = ", DEBUG_ARITH );
|
||||
debug_print_object(b, DEBUG_ARITH);
|
||||
debug_println(DEBUG_ARITH);
|
||||
|
||||
__int128_t carry = 0;
|
||||
bool is_first_cell = true;
|
||||
|
||||
if ( integerp( a ) && integerp( b ) ) {
|
||||
debug_print( L"operate_on_integers: \n", DEBUG_ARITH );
|
||||
debug_print( L"add_integers: \n", DEBUG_ARITH );
|
||||
debug_dump_object( a, DEBUG_ARITH );
|
||||
debug_printf( DEBUG_ARITH, L" %c \n", op );
|
||||
debug_print( L" plus \n", DEBUG_ARITH );
|
||||
debug_dump_object( b, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
|
||||
__int128_t av = cell_value( a, op, is_first_cell );
|
||||
__int128_t bv = cell_value( b, op, is_first_cell );
|
||||
__int128_t av = cell_value( a, is_first_cell );
|
||||
__int128_t bv = cell_value( b, is_first_cell );
|
||||
__int128_t rv = av + bv + carry;
|
||||
|
||||
/* 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
|
||||
* is very large (which I'm not certain whether it can be and am not
|
||||
* intellectually up to proving it this morning) adding the carry might
|
||||
* overflow `__int128_t`. Edge-case testing required.
|
||||
*/
|
||||
__int128_t rv = NAN;
|
||||
|
||||
switch ( op ) {
|
||||
case '*':
|
||||
rv = (av * bv) + carry;
|
||||
break;
|
||||
case '+':
|
||||
rv = av + bv + carry;
|
||||
break;
|
||||
}
|
||||
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"operate_on_integers: op = '%c'; av = ", op );
|
||||
debug_print( L"add_integers: av = ", DEBUG_ARITH );
|
||||
debug_print_128bit( av, DEBUG_ARITH );
|
||||
debug_print( L"; bv = ", DEBUG_ARITH );
|
||||
debug_print_128bit( bv, DEBUG_ARITH );
|
||||
|
|
@ -189,31 +208,9 @@ struct cons_pointer operate_on_integers( struct cons_pointer a,
|
|||
debug_print_128bit( rv, DEBUG_ARITH );
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
|
||||
if ( MAX_INTEGER >= rv ) {
|
||||
carry = 0;
|
||||
} else {
|
||||
// \todo we're correctly detecting overflow, but not yet correctly
|
||||
// handling it.
|
||||
carry = rv >> 60;
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"operate_on_integers: 64 bit overflow; setting carry to %ld\n",
|
||||
( int64_t ) carry );
|
||||
rv &= MAX_INTEGER;
|
||||
}
|
||||
|
||||
struct cons_pointer tail = make_integer( ( int64_t ) rv, NIL );
|
||||
|
||||
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;
|
||||
cursor = tail;
|
||||
}
|
||||
struct cons_pointer new = make_integer( 0, NIL);
|
||||
carry = int128_to_integer(rv, cursor, new);
|
||||
cursor = new;
|
||||
|
||||
if ( nilp( result ) ) {
|
||||
result = cursor;
|
||||
|
|
@ -225,30 +222,111 @@ struct cons_pointer operate_on_integers( struct cons_pointer a,
|
|||
}
|
||||
}
|
||||
|
||||
debug_print( L"operate_on_integers returning:\n", DEBUG_ARITH );
|
||||
debug_dump_object( result, DEBUG_ARITH );
|
||||
debug_print( L"add_integers returning: ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return a pointer to an integer representing the sum of the integers
|
||||
* pointed to by `a` and `b`. If either isn't an integer, will return nil.
|
||||
*/
|
||||
struct cons_pointer add_integers( struct cons_pointer a,
|
||||
struct cons_pointer b ) {
|
||||
struct cons_pointer base_partial(int depth) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
return operate_on_integers( a, b, '+' );
|
||||
for (int i = 0; i < depth; i++) {
|
||||
result = make_integer(0, result);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return a pointer to an integer representing the product of the integers
|
||||
* pointed to by `a` and `b`. If either isn't an integer, will return nil.
|
||||
* \todo it is MUCH more complicated than this!
|
||||
*
|
||||
* @param a an integer;
|
||||
* @param b an integer.
|
||||
*/
|
||||
struct cons_pointer multiply_integers( struct cons_pointer a,
|
||||
struct cons_pointer b ) {
|
||||
return operate_on_integers( a, b, '*' );
|
||||
struct cons_pointer result = NIL;
|
||||
bool neg = is_negative(a) != is_negative(b);
|
||||
bool is_first_b = true;
|
||||
int oom = 0;
|
||||
|
||||
debug_print( L"multiply_integers: a = ", DEBUG_ARITH );
|
||||
debug_print_object(a, DEBUG_ARITH);
|
||||
debug_print( L"; b = ", DEBUG_ARITH );
|
||||
debug_print_object(b, DEBUG_ARITH);
|
||||
debug_println(DEBUG_ARITH);
|
||||
|
||||
if ( integerp( a ) && integerp( b ) ) {
|
||||
while ( !nilp( b ) ) {
|
||||
bool is_first_d = true;
|
||||
struct cons_pointer d = a;
|
||||
struct cons_pointer partial = base_partial(oom++);
|
||||
__int128_t carry = 0;
|
||||
|
||||
while ( !nilp(d) || carry != 0) {
|
||||
struct cons_pointer old_partial = partial;
|
||||
struct cons_pointer new = make_integer( 0, NIL);
|
||||
__int128_t dv = cell_value( d, is_first_d );
|
||||
__int128_t bv = cell_value( b, is_first_b );
|
||||
|
||||
__int128_t rv = (dv * bv) + carry;
|
||||
|
||||
debug_print( L"multiply_integers: d = ", DEBUG_ARITH);
|
||||
debug_print_object( d, DEBUG_ARITH);
|
||||
debug_print( L"; dv = ", DEBUG_ARITH );
|
||||
debug_print_128bit( dv, DEBUG_ARITH );
|
||||
debug_print( L"; bv = ", DEBUG_ARITH );
|
||||
debug_print_128bit( bv, DEBUG_ARITH );
|
||||
debug_print( L"; carry = ", DEBUG_ARITH );
|
||||
debug_print_128bit( carry, DEBUG_ARITH );
|
||||
debug_print( L"; rv = ", DEBUG_ARITH );
|
||||
debug_print_128bit( rv, DEBUG_ARITH );
|
||||
debug_print( L"; acc = ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH);
|
||||
debug_print( L"; partial = ", DEBUG_ARITH );
|
||||
debug_print_object( partial, DEBUG_ARITH);
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
inc_ref(new);
|
||||
carry = int128_to_integer(rv, NIL, new);
|
||||
|
||||
if (nilp(d) && carry != 0) debug_print(L"THIS SHOULD NEVER HAPPEN!\n", DEBUG_ARITH);
|
||||
|
||||
if (nilp(partial) || zerop(partial)) {
|
||||
partial = new;
|
||||
} else {
|
||||
partial = add_integers(partial, new);
|
||||
inc_ref(partial);
|
||||
//dec_ref(new);
|
||||
}
|
||||
|
||||
//dec_ref(old_partial);
|
||||
d = integerp(d) ? pointer2cell( d ).payload.integer.more : NIL;
|
||||
is_first_d = false;
|
||||
}
|
||||
|
||||
if (nilp(result) || zerop(result)) {
|
||||
result = partial;
|
||||
} else {
|
||||
struct cons_pointer old = result;
|
||||
result = add_integers(partial, result);
|
||||
//if (!eq(result, old)) dec_ref(old);
|
||||
//if (!eq(result, partial)) dec_ref(partial);
|
||||
}
|
||||
b = pointer2cell( b ).payload.integer.more;
|
||||
is_first_b = false;
|
||||
}
|
||||
}
|
||||
|
||||
debug_print( L"multiply_integers returning: ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -325,7 +403,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
|
|||
* an unwanted comma on the front. */
|
||||
struct cons_pointer tmp = result;
|
||||
result = pointer2cell( result ).payload.string.cdr;
|
||||
dec_ref( tmp );
|
||||
//dec_ref( tmp );
|
||||
}
|
||||
|
||||
if ( is_negative ) {
|
||||
|
|
|
|||
|
|
@ -57,6 +57,51 @@ bool zerop( struct cons_pointer arg ) {
|
|||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* does this `arg` point to a negative number?
|
||||
*/
|
||||
bool is_negative( struct cons_pointer arg) {
|
||||
bool result = false;
|
||||
struct cons_space_object cell = pointer2cell( arg );
|
||||
|
||||
switch ( cell.tag.value ) {
|
||||
case INTEGERTV:
|
||||
result = cell.payload.integer.value < 0;
|
||||
break;
|
||||
case RATIOTV:
|
||||
result = is_negative( cell.payload.ratio.dividend );
|
||||
break;
|
||||
case REALTV:
|
||||
result = ( cell.payload.real.value < 0 );
|
||||
break;
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
struct cons_pointer absolute( struct cons_pointer frame_pointer, struct cons_pointer arg) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_space_object cell = pointer2cell( arg );
|
||||
|
||||
if ( is_negative( arg)) {
|
||||
switch ( cell.tag.value ) {
|
||||
case INTEGERTV:
|
||||
result = make_integer(llabs(cell.payload.integer.value), cell.payload.integer.more);
|
||||
break;
|
||||
case RATIOTV:
|
||||
result = make_ratio(frame_pointer,
|
||||
absolute(frame_pointer, cell.payload.ratio.dividend),
|
||||
cell.payload.ratio.divisor);
|
||||
break;
|
||||
case REALTV:
|
||||
result = make_real( 0 - cell.payload.real.value );
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return the closest possible `binary64` representation to the value of
|
||||
* this `arg`, expected to be an integer, ratio or real, or `NAN` if `arg`
|
||||
|
|
@ -136,6 +181,22 @@ int64_t to_long_int( struct cons_pointer arg ) {
|
|||
}
|
||||
|
||||
|
||||
/**
|
||||
* Function: calculate the absolute value of a number.
|
||||
*
|
||||
* (absolute arg)
|
||||
*
|
||||
* @param env the evaluation environment - ignored;
|
||||
* @param frame the stack frame.
|
||||
* @return the absolute value of the number represented by the first
|
||||
* argument, or NIL if it was not a number.
|
||||
*/
|
||||
struct cons_pointer lisp_absolute( struct stack_frame
|
||||
*frame, struct cons_pointer frame_pointer, struct
|
||||
cons_pointer env ) {
|
||||
return absolute( frame_pointer, frame->arg[0]);
|
||||
}
|
||||
|
||||
/**
|
||||
* return a cons_pointer indicating a number which is the sum of
|
||||
* the numbers indicated by `arg1` and `arg2`.
|
||||
|
|
@ -286,7 +347,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
|
|||
debug_print_object( arg1, DEBUG_ARITH );
|
||||
debug_print( L"; arg2 = ", DEBUG_ARITH );
|
||||
debug_print_object( arg2, DEBUG_ARITH );
|
||||
debug_print( L")", DEBUG_ARITH );
|
||||
debug_print( L")\n", DEBUG_ARITH );
|
||||
|
||||
if ( zerop( arg1 ) ) {
|
||||
result = arg2;
|
||||
|
|
@ -316,9 +377,10 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
|
|||
to_long_double( arg2 ) );
|
||||
break;
|
||||
default:
|
||||
result = throw_exception( c_string_to_lisp_string
|
||||
( L"Cannot multiply: argument 2 is not a number" ),
|
||||
frame_pointer );
|
||||
result = throw_exception( make_cons(
|
||||
c_string_to_lisp_string( L"Cannot multiply: argument 2 is not a number: " ),
|
||||
c_type(arg2)),
|
||||
frame_pointer );
|
||||
break;
|
||||
}
|
||||
break;
|
||||
|
|
@ -342,8 +404,10 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
|
|||
to_long_double( arg2 ) );
|
||||
break;
|
||||
default:
|
||||
result = throw_exception( c_string_to_lisp_string
|
||||
( L"Cannot multiply: argument 1 is not a number" ),
|
||||
result = throw_exception(
|
||||
make_cons(c_string_to_lisp_string
|
||||
( L"Cannot multiply: argument 2 is not a number" ),
|
||||
c_type(arg2)),
|
||||
frame_pointer );
|
||||
}
|
||||
break;
|
||||
|
|
@ -353,20 +417,24 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
|
|||
to_long_double( arg2 ) );
|
||||
break;
|
||||
default:
|
||||
result = throw_exception( c_string_to_lisp_string
|
||||
( L"Cannot multiply: not a number" ),
|
||||
frame_pointer );
|
||||
result = throw_exception(
|
||||
make_cons(c_string_to_lisp_string
|
||||
( L"Cannot multiply: argument 1 is not a number" ),
|
||||
c_type(arg1)),
|
||||
frame_pointer );
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
debug_print( L" => ", DEBUG_ARITH );
|
||||
debug_print_object( arg2, DEBUG_ARITH );
|
||||
debug_print( L"multiply_2 returning: ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_print( L"\n", DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
#define multiply_one_arg(arg) {if (exceptionp(arg)){result=arg;}else{tmp = result; result = multiply_2( frame, frame_pointer, result, arg ); if ( !eq( tmp, result ) ) dec_ref( tmp );}}
|
||||
|
||||
/**
|
||||
* Multiply an indefinite number of numbers together
|
||||
* @param env the evaluation environment - ignored;
|
||||
|
|
@ -381,29 +449,31 @@ struct cons_pointer lisp_multiply( struct
|
|||
struct cons_pointer result = make_integer( 1, NIL );
|
||||
struct cons_pointer tmp;
|
||||
|
||||
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] )
|
||||
&& !exceptionp( result ); i++ ) {
|
||||
tmp = result;
|
||||
result = multiply_2( frame, frame_pointer, result, frame->arg[i] );
|
||||
for ( int i = 0;
|
||||
i < args_in_frame
|
||||
&& !nilp( frame->arg[i] )
|
||||
&& !exceptionp( result );
|
||||
i++ ) {
|
||||
debug_print( L"lisp_multiply: accumulator = ",DEBUG_ARITH);
|
||||
debug_print_object(result, DEBUG_ARITH);
|
||||
debug_print( L"; arg = ", DEBUG_ARITH);
|
||||
debug_print_object(frame->arg[i], DEBUG_ARITH);
|
||||
debug_println( DEBUG_ARITH);
|
||||
|
||||
if ( !eq( tmp, result ) ) {
|
||||
dec_ref( tmp );
|
||||
}
|
||||
multiply_one_arg(frame->arg[i]);
|
||||
}
|
||||
|
||||
struct cons_pointer more = frame->more;
|
||||
while ( consp( more )
|
||||
&& !exceptionp( result ) ) {
|
||||
tmp = result;
|
||||
result = multiply_2( frame, frame_pointer, result, c_car( more ) );
|
||||
|
||||
if ( !eq( tmp, result ) ) {
|
||||
dec_ref( tmp );
|
||||
}
|
||||
|
||||
multiply_one_arg(c_car( more ));
|
||||
more = c_cdr( more );
|
||||
}
|
||||
|
||||
debug_print( L"lisp_multiply returning: ",DEBUG_ARITH);
|
||||
debug_print_object(result, DEBUG_ARITH);
|
||||
debug_println(DEBUG_ARITH);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -445,6 +515,24 @@ struct cons_pointer negative( struct cons_pointer frame,
|
|||
return result;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* Function: is this number negative?
|
||||
*
|
||||
* * (negative? arg)
|
||||
*
|
||||
* @param env the evaluation environment - ignored;
|
||||
* @param frame the stack frame.
|
||||
* @return T if the first argument was a negative number, or NIL if it
|
||||
* was not.
|
||||
*/
|
||||
struct cons_pointer lisp_is_negative( struct stack_frame
|
||||
*frame, struct cons_pointer frame_pointer, struct
|
||||
cons_pointer env ) {
|
||||
return is_negative(frame->arg[0]) ? TRUE : NIL;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* return a cons_pointer indicating a number which is the result of
|
||||
* subtracting the number indicated by `arg2` from that indicated by `arg1`,
|
||||
|
|
|
|||
|
|
@ -17,66 +17,40 @@ 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.
|
||||
*/
|
||||
bool is_negative( struct cons_pointer arg);
|
||||
|
||||
struct cons_pointer absolute( struct cons_pointer frame_pointer, struct cons_pointer arg);
|
||||
|
||||
long double to_long_double( struct cons_pointer arg );
|
||||
|
||||
/**
|
||||
* Add an indefinite number of numbers together
|
||||
* @param env the evaluation environment - ignored;
|
||||
* @param frame the stack frame.
|
||||
* @return a pointer to an integer or real.
|
||||
*/
|
||||
struct cons_pointer lisp_absolute( 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.
|
||||
* @param env the evaluation environment - ignored;
|
||||
* @param frame the stack frame.
|
||||
* @return a pointer to an integer or real.
|
||||
*/
|
||||
struct cons_pointer lisp_is_negative( 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.
|
||||
* @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 );
|
||||
|
||||
/**
|
||||
* Divide one number by another.
|
||||
* @param env the evaluation environment - ignored;
|
||||
* @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 );
|
||||
|
|
|
|||
|
|
@ -142,6 +142,7 @@ int main( int argc, char *argv[] ) {
|
|||
/*
|
||||
* primitive function operations
|
||||
*/
|
||||
bind_function( L"absolute", &lisp_absolute );
|
||||
bind_function( L"add", &lisp_add );
|
||||
bind_function( L"apply", &lisp_apply );
|
||||
bind_function( L"assoc", &lisp_assoc );
|
||||
|
|
@ -155,6 +156,7 @@ int main( int argc, char *argv[] ) {
|
|||
bind_function( L"exception", &lisp_exception );
|
||||
bind_function( L"inspect", &lisp_inspect );
|
||||
bind_function( L"multiply", &lisp_multiply );
|
||||
bind_function( L"negative?", &lisp_is_negative);
|
||||
bind_function( L"read", &lisp_read );
|
||||
bind_function( L"repl", &lisp_repl );
|
||||
bind_function( L"oblist", &lisp_oblist );
|
||||
|
|
|
|||
Loading…
Reference in a new issue