Complete reworking of the REPL
which is good in itself, but not what I was meant to be working on.
This commit is contained in:
parent
47f4b4c7f7
commit
02fe5669d8
43 changed files with 415 additions and 281 deletions
|
|
@ -68,7 +68,7 @@ long double numeric_value( struct cons_pointer pointer ) {
|
|||
*/
|
||||
struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
||||
struct cons_pointer result = NIL;
|
||||
debug_print(L"Entering make_integer\n", DEBUG_ARITH);
|
||||
debug_print( L"Entering make_integer\n", DEBUG_ARITH );
|
||||
|
||||
if ( integerp( more ) || nilp( more ) ) {
|
||||
result = allocate_cell( INTEGERTAG );
|
||||
|
|
@ -78,7 +78,7 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
|||
|
||||
}
|
||||
|
||||
debug_print(L"make_integer: returning\n", DEBUG_ARITH);
|
||||
debug_print( L"make_integer: returning\n", DEBUG_ARITH );
|
||||
debug_dump_object( result, DEBUG_ARITH );
|
||||
return result;
|
||||
}
|
||||
|
|
@ -89,18 +89,18 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
|||
*/
|
||||
struct cons_pointer add_integers( struct cons_pointer a,
|
||||
struct cons_pointer b ) {
|
||||
debug_print(L"Entering add_integers\n", DEBUG_ARITH);
|
||||
debug_print( L"Entering add_integers\n", DEBUG_ARITH );
|
||||
|
||||
struct cons_pointer result = NIL;
|
||||
int64_t carry = 0;
|
||||
|
||||
if ( integerp( a ) && integerp( b ) ) {
|
||||
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
|
||||
debug_print(L"add_integers: ", DEBUG_ARITH);
|
||||
debug_print_object(a, DEBUG_ARITH);
|
||||
debug_print(L" x ", DEBUG_ARITH);
|
||||
debug_print_object(b, DEBUG_ARITH);
|
||||
debug_printf(DEBUG_ARITH, L"; carry = %ld\n", carry);
|
||||
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
|
||||
debug_print( L"add_integers: ", DEBUG_ARITH );
|
||||
debug_print_object( a, DEBUG_ARITH );
|
||||
debug_print( L" x ", DEBUG_ARITH );
|
||||
debug_print_object( b, DEBUG_ARITH );
|
||||
debug_printf( DEBUG_ARITH, L"; carry = %ld\n", carry );
|
||||
|
||||
int64_t av =
|
||||
integerp( a ) ? pointer2cell( a ).payload.integer.value : 0;
|
||||
|
|
@ -110,7 +110,9 @@ struct cons_pointer add_integers( struct cons_pointer a,
|
|||
__int128_t rv = av + bv + carry;
|
||||
|
||||
if ( rv > LONG_MAX || rv < LONG_MIN ) {
|
||||
debug_printf( DEBUG_ARITH, L"add_integers: 64 bit overflow; setting carry to %ld\n", carry);
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"add_integers: 64 bit overflow; setting carry to %ld\n",
|
||||
carry );
|
||||
carry = llabs( rv / LONG_MAX );
|
||||
rv = rv % LONG_MAX;
|
||||
} else {
|
||||
|
|
@ -122,9 +124,9 @@ struct cons_pointer add_integers( struct cons_pointer a,
|
|||
b = pointer2cell( b ).payload.integer.more;
|
||||
}
|
||||
}
|
||||
debug_print(L"add_integers returning: ", DEBUG_ARITH);
|
||||
debug_print_object(result, DEBUG_ARITH);
|
||||
debug_println(DEBUG_ARITH);
|
||||
debug_print( L"add_integers returning: ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -139,11 +141,11 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
|
|||
int64_t carry = 0;
|
||||
|
||||
if ( integerp( a ) && integerp( b ) ) {
|
||||
debug_print(L"multiply_integers: ", DEBUG_ARITH);
|
||||
debug_print_object(a, DEBUG_ARITH);
|
||||
debug_print(L" x ", DEBUG_ARITH);
|
||||
debug_print_object(b, DEBUG_ARITH);
|
||||
debug_println(DEBUG_ARITH);
|
||||
debug_print( L"multiply_integers: ", DEBUG_ARITH );
|
||||
debug_print_object( a, DEBUG_ARITH );
|
||||
debug_print( L" x ", DEBUG_ARITH );
|
||||
debug_print_object( b, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
|
||||
int64_t av =
|
||||
|
|
@ -154,7 +156,9 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
|
|||
__int128_t rv = ( av * bv ) + carry;
|
||||
|
||||
if ( rv > LONG_MAX || rv < LONG_MIN ) {
|
||||
debug_printf( DEBUG_ARITH, L"multiply_integers: 64 bit overflow; setting carry to %ld\n", carry);
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"multiply_integers: 64 bit overflow; setting carry to %ld\n",
|
||||
carry );
|
||||
carry = llabs( rv / LONG_MAX );
|
||||
rv = rv % LONG_MAX;
|
||||
} else {
|
||||
|
|
@ -166,9 +170,9 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
|
|||
b = pointer2cell( b ).payload.integer.more;
|
||||
}
|
||||
}
|
||||
debug_print(L"multiply_integers returning: ", DEBUG_ARITH);
|
||||
debug_print_object(result, DEBUG_ARITH);
|
||||
debug_println(DEBUG_ARITH);
|
||||
debug_print( L"multiply_integers returning: ", DEBUG_ARITH );
|
||||
debug_print_object( result, DEBUG_ARITH );
|
||||
debug_println( DEBUG_ARITH );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -192,36 +196,43 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
|
|||
bool is_negative = accumulator < 0;
|
||||
accumulator = llabs( accumulator );
|
||||
|
||||
if (accumulator == 0) {
|
||||
result = c_string_to_lisp_string( L"0");
|
||||
} else {
|
||||
while ( accumulator > 0 ) {
|
||||
debug_printf(DEBUG_ARITH, L"integer_to_string: accumulator is %ld\n:",
|
||||
accumulator);
|
||||
do {
|
||||
debug_printf(DEBUG_ARITH, L"integer_to_string: digit is %ld, hexadecimal is %lc\n:",
|
||||
accumulator % base, hex_digits[accumulator % base]);
|
||||
wint_t digit = (wint_t)hex_digits[accumulator % base];
|
||||
if ( accumulator == 0 ) {
|
||||
result = c_string_to_lisp_string( L"0" );
|
||||
} else {
|
||||
while ( accumulator > 0 ) {
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"integer_to_string: accumulator is %ld\n:",
|
||||
accumulator );
|
||||
do {
|
||||
debug_printf( DEBUG_ARITH,
|
||||
L"integer_to_string: digit is %ld, hexadecimal is %lc\n:",
|
||||
accumulator % base,
|
||||
hex_digits[accumulator % base] );
|
||||
wint_t digit = ( wint_t ) hex_digits[accumulator % base];
|
||||
|
||||
result = make_string( (wint_t)hex_digits[accumulator % base], result );
|
||||
accumulator = accumulator / base;
|
||||
} while ( accumulator > base );
|
||||
result =
|
||||
make_string( ( wint_t ) hex_digits[accumulator % base],
|
||||
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;
|
||||
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 = make_string( (wint_t)hex_digits[accumulator % base], result );
|
||||
accumulator += ( base * ( i / base ) );
|
||||
/* TODO: I don't believe it's as simple as this! */
|
||||
accumulator += ( base * ( i % base ) );
|
||||
result =
|
||||
make_string( ( wint_t ) hex_digits[accumulator % base],
|
||||
result );
|
||||
accumulator += ( base * ( i / base ) );
|
||||
}
|
||||
}
|
||||
|
||||
if ( is_negative ) {
|
||||
result = make_string( L'-', result );
|
||||
}
|
||||
}
|
||||
|
||||
if ( is_negative ) {
|
||||
result = make_string( L'-', result );
|
||||
}
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -284,7 +284,9 @@ 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 =
|
||||
make_integer( cell1.payload.integer.value *
|
||||
cell2.payload.integer.value, NIL );
|
||||
//result = multiply_integers( arg1, arg2 );
|
||||
break;
|
||||
case RATIOTV:
|
||||
|
|
@ -412,8 +414,9 @@ struct cons_pointer inverse( struct cons_pointer frame,
|
|||
case RATIOTV:
|
||||
result = make_ratio( frame,
|
||||
make_integer( 0 -
|
||||
to_long_int( cell.payload.ratio.
|
||||
dividend ), NIL ),
|
||||
to_long_int( cell.payload.
|
||||
ratio.dividend ),
|
||||
NIL ),
|
||||
cell.payload.ratio.divisor );
|
||||
break;
|
||||
case REALTV:
|
||||
|
|
@ -453,7 +456,8 @@ struct cons_pointer lisp_subtract( struct
|
|||
break;
|
||||
case INTEGERTV:
|
||||
result = make_integer( cell0.payload.integer.value
|
||||
- cell1.payload.integer.value, NIL );
|
||||
- cell1.payload.integer.value,
|
||||
NIL );
|
||||
break;
|
||||
case RATIOTV:{
|
||||
struct cons_pointer tmp =
|
||||
|
|
|
|||
|
|
@ -61,10 +61,10 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer,
|
|||
|
||||
if ( ratiop( arg ) ) {
|
||||
int64_t ddrv =
|
||||
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
|
||||
payload.integer.value, drrv =
|
||||
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
|
||||
payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
|
||||
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload.
|
||||
integer.value, drrv =
|
||||
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload.
|
||||
integer.value, gcd = greatest_common_divisor( ddrv, drrv );
|
||||
|
||||
if ( gcd > 1 ) {
|
||||
if ( drrv / gcd == 1 ) {
|
||||
|
|
@ -203,10 +203,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer,
|
|||
struct cons_pointer arg1,
|
||||
struct cons_pointer arg2 ) {
|
||||
struct cons_pointer i = make_ratio( frame_pointer,
|
||||
pointer2cell( arg2 ).payload.
|
||||
ratio.divisor,
|
||||
pointer2cell( arg2 ).payload.
|
||||
ratio.dividend ), result =
|
||||
pointer2cell( arg2 ).payload.ratio.
|
||||
divisor,
|
||||
pointer2cell( arg2 ).payload.ratio.
|
||||
dividend ), result =
|
||||
multiply_ratio_ratio( frame_pointer, arg1, i );
|
||||
|
||||
dec_ref( i );
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue