simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Printing of bignums basically done, not tested.

Browse source
This commit is contained in:
Simon Brooke 2018-12-29 23:44:28 +00:00
parent 342f0308d3
commit 489f008044
14 changed files with 244 additions and 164 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

198
src/arith/integer.c
View file

@ -12,116 +12,182 @@
#include <math.h> #include <math.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
/*
* wide characters
*/
#include <wchar.h>
#include <wctype.h>
#include "conspage.h" #include "conspage.h"
#include "consspaceobject.h" #include "consspaceobject.h"
#include "debug.h" #include "debug.h"
/**
* hexadecimal digits for printing numbers.
*/
const wchar_t *hex_digits = L"0123456789ABCDEF";
/*
* Doctrine from here on in is that ALL integers are bignums, it's just
* that integers less than 65 bits are bignums of one cell only.
*
* TODO: I have no idea at all how I'm going to print bignums!
*/
/** /**
* return the numeric value of this cell, as a C primitive double, not * return the numeric value of this cell, as a C primitive double, not
* as a cons-space object. Cell may in principle be any kind of number. * as a cons-space object. Cell may in principle be any kind of number.
*/ */
long double numeric_value( struct cons_pointer pointer ) { long double numeric_value( struct cons_pointer pointer ) {
long double result = NAN; long double result = NAN;
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
switch (cell->tag.value) { switch ( cell->tag.value ) {
case INTEGERTV: case INTEGERTV:
result = 1.0; result = 1.0;
while (cell->tag.value == INTEGERTV) { while ( cell->tag.value == INTEGERTV ) {
result = (result * LONG_MAX * cell->payload.integer.value); result = ( result * LONG_MAX * cell->payload.integer.value );
cell = &pointer2cell(cell->payload.integer.more); cell = &pointer2cell( cell->payload.integer.more );
}
break;
case RATIOTV:
result = numeric_value( cell->payload.ratio.dividend ) /
numeric_value( cell->payload.ratio.divisor );
break;
case REALTV:
result = cell->payload.real.value;
break;
// default is NAN
} }
break;
case RATIOTV:
result = numeric_value(cell->payload.ratio.dividend) /
numeric_value(cell->payload.ratio.divisor);
break;
case REALTV:
result = cell->payload.real.value;
break;
// default is NAN
}
return result; return result;
} }
/** /**
* Allocate an integer cell representing this value and return a cons pointer to it. * Allocate an integer cell representing this value and return a cons pointer to it.
*/ */
struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) { struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
if (integerp(more) || nilp(more)) { if ( integerp( more ) || nilp( more ) ) {
result = allocate_cell( INTEGERTAG ); result = allocate_cell( INTEGERTAG );
struct cons_space_object *cell = &pointer2cell( result ); struct cons_space_object *cell = &pointer2cell( result );
cell->payload.integer.value = value; cell->payload.integer.value = value;
cell->payload.integer.more = more; cell->payload.integer.more = more;
debug_dump_object( result, DEBUG_ARITH ); debug_dump_object( result, DEBUG_ARITH );
} }
return result; return result;
} }
/** /**
* Return the sum of the integers pointed to by `a` and `b`. If either isn't * Return the sum of the integers pointed to by `a` and `b`. If either isn't
* an integer, will return nil. * an integer, will return nil.
*/ */
struct cons_pointer add_integers( struct cons_pointer a, struct cons_pointer b) { struct cons_pointer add_integers( struct cons_pointer a,
struct cons_pointer result = NIL; struct cons_pointer b ) {
int64_t carry = 0; struct cons_pointer result = NIL;
int64_t carry = 0;
if (integerp(a) && integerp(b)) { if ( integerp( a ) && integerp( b ) ) {
while (!nilp(a) || !nilp(b) || carry != 0) { while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
int64_t av = integerp(a) ? pointer2cell(a).payload.integer.value : 0; int64_t av =
int64_t bv = integerp(b) ? pointer2cell(b).payload.integer.value : 0; integerp( a ) ? pointer2cell( a ).payload.integer.value : 0;
int64_t bv =
integerp( b ) ? pointer2cell( b ).payload.integer.value : 0;
__int128_t rv = av + bv + carry; __int128_t rv = av + bv + carry;
if (rv > LONG_MAX || rv < LONG_MIN) { if ( rv > LONG_MAX || rv < LONG_MIN ) {
carry = llabs(rv / LONG_MAX); carry = llabs( rv / LONG_MAX );
rv = rv % LONG_MAX; rv = rv % LONG_MAX;
} else { } else {
carry = 0; carry = 0;
} }
result = make_integer( rv, result); result = make_integer( rv, result );
a = pointer2cell(a).payload.integer.more; a = pointer2cell( a ).payload.integer.more;
b = pointer2cell(b).payload.integer.more; b = pointer2cell( b ).payload.integer.more;
}
} }
}
return result; return result;
} }
/** /**
* Return the product of the integers pointed to by `a` and `b`. If either isn't * Return the product of the integers pointed to by `a` and `b`. If either isn't
* an integer, will return nil. * an integer, will return nil.
*/ */
struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer b) { struct cons_pointer multiply_integers( struct cons_pointer a,
struct cons_pointer result = NIL; struct cons_pointer b ) {
int64_t carry = 0; struct cons_pointer result = NIL;
int64_t carry = 0;
if (integerp(a) && integerp(b)) { if ( integerp( a ) && integerp( b ) ) {
while (!nilp(a) || ! nilp(b) || carry != 0) { while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
int64_t av = integerp(a) ? pointer2cell(a).payload.integer.value : 1; int64_t av =
int64_t bv = integerp(b) ? pointer2cell(b).payload.integer.value : 1; integerp( a ) ? pointer2cell( a ).payload.integer.value : 1;
int64_t bv =
integerp( b ) ? pointer2cell( b ).payload.integer.value : 1;
__int128_t rv = (av * bv) + carry; __int128_t rv = ( av * bv ) + carry;
if (rv > LONG_MAX || rv < LONG_MIN) { if ( rv > LONG_MAX || rv < LONG_MIN ) {
carry = llabs(rv / LONG_MAX); carry = llabs( rv / LONG_MAX );
rv = rv % LONG_MAX; rv = rv % LONG_MAX;
} else { } else {
carry = 0; carry = 0;
} }
result = make_integer( rv, result); result = make_integer( rv, result );
a = pointer2cell(a).payload.integer.more; a = pointer2cell( a ).payload.integer.more;
b = pointer2cell(b).payload.integer.more; b = pointer2cell( b ).payload.integer.more;
}
} }
}
return result; return result;
}
/**
* The general principle of printing a bignum is that you print the least
* significant digit in whatever base you're dealing with, divide through
* by the base, print the next, and carry on until you've none left.
* Obviously, that means you print from right to left. Given that we build
* strings from right to left, 'printing' an integer to a lisp string
* would seem reasonably easy. The problem is when you jump from one integer
* object to the next. 64 bit integers don't align with decimal numbers, so
* when we get to the last digit from one integer cell, we have potentially
* to be looking to the next. H'mmmm.
*/
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 );
while ( accumulator > 0 ) {
while ( accumulator > base ) {
result = make_string( hex_digits[accumulator % base], result );
accumulator = 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 = make_string( hex_digits[accumulator % base], result );
accumulator += ( base * ( i / base ) );
}
}
if ( is_negative ) {
result = make_string( L'-', result );
}
return result;
} }

9
src/arith/integer.h
View file

@ -18,8 +18,13 @@ long double numeric_value( struct cons_pointer pointer );
*/ */
struct cons_pointer make_integer( int64_t value, struct cons_pointer more ); 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); struct cons_pointer add_integers( struct cons_pointer a,
struct cons_pointer b );
struct cons_pointer multiply_integers( struct cons_pointer a, struct cons_pointer b); struct cons_pointer multiply_integers( struct cons_pointer a,
struct cons_pointer b );
struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
int base );
#endif #endif

8
src/arith/peano.c
View file

@ -411,8 +411,9 @@ struct cons_pointer inverse( struct cons_pointer frame,
case RATIOTV: case RATIOTV:
result = make_ratio( frame, result = make_ratio( frame,
make_integer( 0 - make_integer( 0 -
to_long_int( cell.payload.ratio. to_long_int( cell.payload.
dividend ), NIL ), ratio.dividend ),
NIL ),
cell.payload.ratio.divisor ); cell.payload.ratio.divisor );
break; break;
case REALTV: case REALTV:
@ -452,7 +453,8 @@ struct cons_pointer lisp_subtract( struct
break; break;
case INTEGERTV: case INTEGERTV:
result = make_integer( cell0.payload.integer.value result = make_integer( cell0.payload.integer.value
- cell1.payload.integer.value, NIL ); - cell1.payload.integer.value,
NIL );
break; break;
case RATIOTV:{ case RATIOTV:{
struct cons_pointer tmp = struct cons_pointer tmp =

28
src/arith/ratio.c
View file

@ -61,18 +61,18 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer,
if ( ratiop( arg ) ) { if ( ratiop( arg ) ) {
int64_t ddrv = int64_t ddrv =
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload. pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
integer.value, drrv = payload.integer.value, drrv =
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload. pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
integer.value, gcd = greatest_common_divisor( ddrv, drrv ); payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
if ( gcd > 1 ) { if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) { if ( drrv / gcd == 1 ) {
result = make_integer( ddrv / gcd , NIL); result = make_integer( ddrv / gcd, NIL );
} else { } else {
result = result =
make_ratio( frame_pointer, make_integer( ddrv / gcd , NIL), make_ratio( frame_pointer, make_integer( ddrv / gcd, NIL ),
make_integer( drrv / gcd , NIL) ); make_integer( drrv / gcd, NIL ) );
} }
} }
} else { } else {
@ -106,7 +106,7 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer frame_pointer,
if ( ratiop( arg1 ) && ratiop( arg2 ) ) { if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
struct cons_space_object cell1 = pointer2cell( arg1 ); struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 ); struct cons_space_object cell2 = pointer2cell( arg2 );
// TODO: to be entirely reworked for bignums. All vars must be lisp integers. // TODO: to be entirely reworked for bignums. All vars must be lisp integers.
int64_t dd1v = int64_t dd1v =
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value, pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
dd2v = dd2v =
@ -203,10 +203,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer,
struct cons_pointer arg1, struct cons_pointer arg1,
struct cons_pointer arg2 ) { struct cons_pointer arg2 ) {
struct cons_pointer i = make_ratio( frame_pointer, struct cons_pointer i = make_ratio( frame_pointer,
pointer2cell( arg2 ).payload.ratio. pointer2cell( arg2 ).payload.
divisor, ratio.divisor,
pointer2cell( arg2 ).payload.ratio. pointer2cell( arg2 ).payload.
dividend ), result = ratio.dividend ), result =
multiply_ratio_ratio( frame_pointer, arg1, i ); multiply_ratio_ratio( frame_pointer, arg1, i );
dec_ref( i ); dec_ref( i );
@ -245,7 +245,7 @@ struct cons_pointer multiply_ratio_ratio( struct cons_pointer frame_pointer, str
struct cons_pointer unsimplified = struct cons_pointer unsimplified =
make_ratio( frame_pointer, make_integer( ddrv, NIL ), make_ratio( frame_pointer, make_integer( ddrv, NIL ),
make_integer( drrv , NIL) ); make_integer( drrv, NIL ) );
result = simplify_ratio( frame_pointer, unsimplified ); result = simplify_ratio( frame_pointer, unsimplified );
if ( !eq( unsimplified, result ) ) { if ( !eq( unsimplified, result ) ) {
@ -272,7 +272,7 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer frame_pointer,
struct cons_pointer result; struct cons_pointer result;
if ( integerp( intarg ) && ratiop( ratarg ) ) { if ( integerp( intarg ) && ratiop( ratarg ) ) {
struct cons_pointer one = make_integer( 1, NIL), struct cons_pointer one = make_integer( 1, NIL ),
ratio = make_ratio( frame_pointer, intarg, one ); ratio = make_ratio( frame_pointer, intarg, one );
result = multiply_ratio_ratio( frame_pointer, ratio, ratarg ); result = multiply_ratio_ratio( frame_pointer, ratio, ratarg );

44
src/init.c
View file

@ -30,35 +30,35 @@
void bind_function( wchar_t *name, struct cons_pointer ( *executable ) void bind_function( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
inc_ref(n); inc_ref( n );
/* TODO: where a function is not compiled from source, we could cache /* TODO: where a function is not compiled from source, we could cache
* the name on the source pointer. Would make stack frames potentially * the name on the source pointer. Would make stack frames potentially
* more readable and aid debugging generally. */ * more readable and aid debugging generally. */
deep_bind( n, make_function( NIL, executable ) ); deep_bind( n, make_function( NIL, executable ) );
dec_ref(n); dec_ref( n );
} }
void bind_special( wchar_t *name, struct cons_pointer ( *executable ) void bind_special( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
inc_ref(n); inc_ref( n );
deep_bind( n, make_special( NIL, executable ) ); deep_bind( n, make_special( NIL, executable ) );
dec_ref(n); dec_ref( n );
} }
void bind_value( wchar_t *name, struct cons_pointer value) { void bind_value( wchar_t *name, struct cons_pointer value ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
inc_ref(n); inc_ref( n );
deep_bind( n, value ); deep_bind( n, value );
dec_ref(n); dec_ref( n );
} }
int main( int argc, char *argv[] ) { int main( int argc, char *argv[] ) {
@ -107,8 +107,8 @@ int main( int argc, char *argv[] ) {
/* /*
* privileged variables (keywords) * privileged variables (keywords)
*/ */
bind_value( L"nil" , NIL ); bind_value( L"nil", NIL );
bind_value( L"t" , TRUE ); bind_value( L"t", TRUE );
/* /*
* primitive function operations * primitive function operations
@ -153,14 +153,14 @@ int main( int argc, char *argv[] ) {
bind_special( L"quote", &lisp_quote ); bind_special( L"quote", &lisp_quote );
bind_special( L"set!", &lisp_set_shriek ); bind_special( L"set!", &lisp_set_shriek );
debug_print(L"Initialised oblist\n", DEBUG_BOOTSTRAP); debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP );
debug_dump_object(oblist, DEBUG_BOOTSTRAP); debug_dump_object( oblist, DEBUG_BOOTSTRAP );
repl( stdin, stdout, stderr, show_prompt ); repl( stdin, stdout, stderr, show_prompt );
debug_print(L"Freeing oblist\n", DEBUG_BOOTSTRAP); debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref(oblist); dec_ref( oblist );
debug_dump_object(oblist, DEBUG_BOOTSTRAP); debug_dump_object( oblist, DEBUG_BOOTSTRAP );
if ( dump_at_end ) { if ( dump_at_end ) {

6
src/memory/conspage.c
View file

@ -151,7 +151,7 @@ void free_cell( struct cons_pointer pointer ) {
dec_ref( cell->payload.function.source ); dec_ref( cell->payload.function.source );
break; break;
case INTEGERTV: case INTEGERTV:
dec_ref( cell->payload.integer.more); dec_ref( cell->payload.integer.more );
break; break;
case LAMBDATV: case LAMBDATV:
case NLAMBDATV: case NLAMBDATV:
@ -179,8 +179,8 @@ void free_cell( struct cons_pointer pointer ) {
switch ( vso->header.tag.value ) { switch ( vso->header.tag.value ) {
case STACKFRAMETV: case STACKFRAMETV:
free_stack_frame(get_stack_frame(pointer)); free_stack_frame( get_stack_frame( pointer ) );
break; break;
} }
free( ( void * ) cell->payload.vectorp.address ); free( ( void * ) cell->payload.vectorp.address );

8
src/memory/dump.c
View file

@ -103,10 +103,10 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
case RATIOTV: case RATIOTV:
fwprintf( output, fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n", L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).payload. pointer2cell( cell.payload.ratio.dividend ).
integer.value, payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload. pointer2cell( cell.payload.ratio.divisor ).
integer.value, cell.count ); payload.integer.value, cell.count );
break; break;
case READTV: case READTV:
fwprintf( output, L"\t\tInput stream\n" ); fwprintf( output, L"\t\tInput stream\n" );

4
src/memory/stack.c
View file

@ -222,14 +222,14 @@ void free_stack_frame( struct stack_frame *frame ) {
/* /*
* TODO: later, push it back on the stack-frame freelist * TODO: later, push it back on the stack-frame freelist
*/ */
debug_print(L"Entering free_stack_frame\n", DEBUG_ALLOC); debug_print( L"Entering free_stack_frame\n", DEBUG_ALLOC );
for ( int i = 0; i < args_in_frame; i++ ) { for ( int i = 0; i < args_in_frame; i++ ) {
dec_ref( frame->arg[i] ); dec_ref( frame->arg[i] );
} }
if ( !nilp( frame->more ) ) { if ( !nilp( frame->more ) ) {
dec_ref( frame->more ); dec_ref( frame->more );
} }
debug_print(L"Leaving free_stack_frame\n", DEBUG_ALLOC); debug_print( L"Leaving free_stack_frame\n", DEBUG_ALLOC );
} }

2
src/memory/vectorspace.c
View file

@ -67,7 +67,7 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
struct vector_space_object *vso = malloc( padded ); struct vector_space_object *vso = malloc( padded );
if ( vso != NULL ) { if ( vso != NULL ) {
memset(vso, 0, padded); memset( vso, 0, padded );
debug_printf( DEBUG_ALLOC, debug_printf( DEBUG_ALLOC,
L"make_vso: about to write tag '%s' into vso at %p\n", L"make_vso: about to write tag '%s' into vso at %p\n",
tag, vso ); tag, vso );

11
src/ops/equal.c
View file

@ -80,14 +80,15 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
&& ( equal( cell_a->payload.string.cdr, && ( equal( cell_a->payload.string.cdr,
cell_b->payload.string.cdr ) cell_b->payload.string.cdr )
|| ( end_of_string( cell_a->payload.string.cdr ) || ( end_of_string( cell_a->payload.string.cdr )
&& end_of_string( cell_b->payload.string. && end_of_string( cell_b->payload.
cdr ) ) ); string.cdr ) ) );
break; break;
case INTEGERTV: case INTEGERTV:
result = result =
(cell_a->payload.integer.value == ( cell_a->payload.integer.value ==
cell_b->payload.integer.value) && cell_b->payload.integer.value ) &&
equal(cell_a->payload.integer.more, cell_b->payload.integer.more); equal( cell_a->payload.integer.more,
cell_b->payload.integer.more );
break; break;
case REALTV: case REALTV:
{ {

4
src/ops/intern.c
View file

@ -131,8 +131,8 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) {
struct cons_pointer old = oblist; struct cons_pointer old = oblist;
oblist = bind( key, value, oblist ); oblist = bind( key, value, oblist );
inc_ref(oblist); inc_ref( oblist );
dec_ref(old); dec_ref( old );
debug_print( L"Leaving deep_bind\n", DEBUG_BIND ); debug_print( L"Leaving deep_bind\n", DEBUG_BIND );

30
src/ops/lispops.c
View file

@ -195,7 +195,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer frame_pointer, struct cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
debug_print( L"eval_lambda called\n", DEBUG_LAMBDA ); debug_print( L"eval_lambda called\n", DEBUG_LAMBDA );
debug_println(DEBUG_LAMBDA); debug_println( DEBUG_LAMBDA );
struct cons_pointer new_env = env; struct cons_pointer new_env = env;
struct cons_pointer names = cell.payload.lambda.args; struct cons_pointer names = cell.payload.lambda.args;
@ -213,7 +213,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
names = c_cdr( names ); names = c_cdr( names );
} }
inc_ref(new_env); inc_ref( new_env );
/* TODO: if there's more than `args_in_frame` arguments, bind those too. */ /* TODO: if there's more than `args_in_frame` arguments, bind those too. */
} else if ( symbolp( names ) ) { } else if ( symbolp( names ) ) {
@ -233,7 +233,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
} }
new_env = bind( names, vals, new_env ); new_env = bind( names, vals, new_env );
inc_ref(new_env); inc_ref( new_env );
} }
while ( !nilp( body ) ) { while ( !nilp( body ) ) {
@ -241,21 +241,22 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
body = c_cdr( body ); body = c_cdr( body );
debug_print( L"In lambda: evaluating ", DEBUG_LAMBDA ); debug_print( L"In lambda: evaluating ", DEBUG_LAMBDA );
debug_print_object(sexpr, DEBUG_LAMBDA); debug_print_object( sexpr, DEBUG_LAMBDA );
debug_println( DEBUG_LAMBDA); debug_println( DEBUG_LAMBDA );
/* if a result is not the terminal result in the lambda, it's a /* if a result is not the terminal result in the lambda, it's a
* side effect, and needs to be GCed */ * side effect, and needs to be GCed */
if (!nilp(result)) dec_ref(result); if ( !nilp( result ) )
dec_ref( result );
result = eval_form( frame, frame_pointer, sexpr, new_env ); result = eval_form( frame, frame_pointer, sexpr, new_env );
} }
dec_ref(new_env); dec_ref( new_env );
debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA ); debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA );
debug_print_object( result, DEBUG_LAMBDA); debug_print_object( result, DEBUG_LAMBDA );
debug_println(DEBUG_LAMBDA); debug_println( DEBUG_LAMBDA );
return result; return result;
} }
@ -352,9 +353,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer; result = next_pointer;
} else { } else {
result = result =
( *fn_cell.payload.special. ( *fn_cell.payload.
executable ) ( get_stack_frame( next_pointer ), special.executable ) ( get_stack_frame
next_pointer, env ); ( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );

48
src/ops/print.c
View file

@ -124,38 +124,42 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
case FUNCTIONTV: case FUNCTIONTV:
fwprintf( output, L"(Function)" ); fwprintf( output, L"(Function)" );
break; break;
case INTEGERTV: case INTEGERTV:{
if ( print_use_colours ) { struct cons_pointer s = integer_to_string( pointer, 10 );
fputws( L"\x1B[34m", output ); inc_ref( s );
if ( print_use_colours ) {
fputws( L"\x1B[34m", output );
}
print_string_contents( output, s );
dec_ref( s );
} }
fwprintf( output, L"%ld%", cell.payload.integer.value );
break; break;
case LAMBDATV: { case LAMBDATV:{
struct cons_pointer to_print = make_cons( c_string_to_lisp_symbol( L"lambda" ), struct cons_pointer to_print =
make_cons( cell.payload.lambda.args, make_cons( c_string_to_lisp_symbol( L"lambda" ),
cell.payload. make_cons( cell.payload.lambda.args,
lambda.body )); cell.payload.lambda.body ) );
inc_ref(to_print); inc_ref( to_print );
print( output, to_print ); print( output, to_print );
dec_ref(to_print); dec_ref( to_print );
} }
break; break;
case NILTV: case NILTV:
fwprintf( output, L"nil" ); fwprintf( output, L"nil" );
break; break;
case NLAMBDATV: { case NLAMBDATV:{
struct cons_pointer to_print = make_cons( c_string_to_lisp_symbol( L"nlambda" ), struct cons_pointer to_print =
make_cons( cell.payload.lambda.args, make_cons( c_string_to_lisp_symbol( L"nlambda" ),
cell.payload. make_cons( cell.payload.lambda.args,
lambda.body )); cell.payload.lambda.body ) );
inc_ref(to_print); inc_ref( to_print );
print( output, to_print ); print( output, to_print );
dec_ref(to_print); dec_ref( to_print );
} }
break; break;
case RATIOTV: case RATIOTV:
print( output, cell.payload.ratio.dividend ); print( output, cell.payload.ratio.dividend );

8
src/repl.c
View file

@ -113,16 +113,16 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
break; break;
} else { } else {
struct cons_pointer val = repl_eval( input ); struct cons_pointer val = repl_eval( input );
inc_ref(val); inc_ref( val );
repl_print( output_stream, val ); repl_print( output_stream, val );
dec_ref(val); dec_ref( val );
} }
dec_ref( input ); dec_ref( input );
} }
dec_ref(input_stream); dec_ref( input_stream );
dec_ref(output_stream); dec_ref( output_stream );
debug_print( L"Leaving repl\n", DEBUG_REPL ); debug_print( L"Leaving repl\n", DEBUG_REPL );
} }