diff --git a/Makefile b/Makefile index b300b3c..bf818ac 100644 --- a/Makefile +++ b/Makefile @@ -38,7 +38,7 @@ test: $(OBJS) $(TESTS) Makefile .PHONY: clean clean: - $(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ + $(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ *~ repl: $(TARGET) -p 2> psse.log diff --git a/src/init.c b/src/init.c index 616261c..3f85b51 100644 --- a/src/init.c +++ b/src/init.c @@ -73,7 +73,6 @@ int main( int argc, char *argv[] ) { */ deep_bind( c_string_to_lisp_symbol( "nil" ), NIL ); deep_bind( c_string_to_lisp_symbol( "t" ), TRUE ); - /* deep_bind( c_string_to_lisp_symbol( L"λ"), LAMBDA ); */ deep_bind( c_string_to_lisp_symbol( "lambda" ), LAMBDA ); /* @@ -85,6 +84,7 @@ int main( int argc, char *argv[] ) { bind_function( "car", &lisp_car ); bind_function( "cdr", &lisp_cdr ); bind_function( "cons", &lisp_cons ); + bind_function( "divide", &lisp_divide ); bind_function( "eq", &lisp_eq ); bind_function( "equal", &lisp_equal ); bind_function( "eval", &lisp_eval ); @@ -98,6 +98,7 @@ int main( int argc, char *argv[] ) { bind_function( "+", &lisp_add ); bind_function( "*", &lisp_multiply ); bind_function( "-", &lisp_subtract ); + bind_function( "/", &lisp_divide ); /* * primitive special forms diff --git a/src/integer.c b/src/integer.c index 6352b34..999c803 100644 --- a/src/integer.c +++ b/src/integer.c @@ -21,7 +21,7 @@ * but only integers and reals are so far implemented. */ long double numeric_value( struct cons_pointer pointer ) { - double result = NAN; + long double result = NAN; struct cons_space_object *cell = &pointer2cell( pointer ); if ( integerp( pointer ) ) { diff --git a/src/peano.c b/src/peano.c index aec3104..2402440 100644 --- a/src/peano.c +++ b/src/peano.c @@ -170,13 +170,16 @@ lisp_divide( struct stack_frame *frame, struct cons_pointer env ) { if ( numberp( frame->arg[1] ) && numeric_value( frame->arg[1] ) == 0 ) { lisp_throw( c_string_to_lisp_string ( "Cannot divide: divisor is zero" ), frame ); - } else if ( integerp( frame->arg[0] ) && integerp( frame->arg[1] ) ) { - result = make_integer( arg0.payload.integer.value / - arg1.payload.integer.value ); } else if ( numberp( frame->arg[0] ) && numberp( frame->arg[1] ) ) { - result = - make_real( numeric_value( frame->arg[0] ) / - numeric_value( frame->arg[1] ) ); + long int i = ( long int ) numeric_value( frame->arg[0] ) / + numeric_value( frame->arg[1] ); + long double r = ( long double ) numeric_value( frame->arg[0] ) / + numeric_value( frame->arg[1] ); + if ( fabsl( ( long double ) i - r ) < 0.0000000001 ) { + result = make_integer( i ); + } else { + result = make_real( r ); + } } else { lisp_throw( c_string_to_lisp_string ( "Cannot divide: not a number" ), frame ); diff --git a/src/peano.h b/src/peano.h index 4650fe0..79735c0 100644 --- a/src/peano.h +++ b/src/peano.h @@ -43,6 +43,15 @@ extern "C" { struct cons_pointer lisp_subtract( struct stack_frame *frame, 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 env ); + #ifdef __cplusplus } #endif diff --git a/src/print.c b/src/print.c index 1fdcafd..1988563 100644 --- a/src/print.c +++ b/src/print.c @@ -9,6 +9,7 @@ #include #include +#include #include /* * wide characters @@ -72,6 +73,7 @@ void print_list( FILE * output, struct cons_pointer pointer ) { void print( FILE * output, struct cons_pointer pointer ) { struct cons_space_object cell = pointer2cell( pointer ); + char *buffer; /* * Because tags have values as well as bytes, this if ... else if @@ -95,7 +97,20 @@ void print( FILE * output, struct cons_pointer pointer ) { fwprintf( output, L"nil" ); break; case REALTV: - fwprintf( output, L"%Lf", cell.payload.real.value ); + /* TODO: using the C heap is a bad plan because it will fragment. + * As soon as I have working vector space I'll use a special purpose + * vector space object */ + buffer = ( char * ) malloc( 24 ); + memset( buffer, 0, 24 ); + /* format it really long, then clear the trailing zeros */ + sprintf( buffer, "%-.23Lg", cell.payload.real.value ); + if ( strchr( buffer, '.' ) != NULL ) { + for ( int i = strlen( buffer ) - 1; buffer[i] == '0'; i-- ) { + buffer[i] = '\0'; + } + } + fwprintf( output, L"%s", buffer ); + free( buffer ); break; case STRINGTV: print_string( output, pointer ); diff --git a/unit-tests/add.sh b/unit-tests/add.sh index ba8e635..7bb29c7 100644 --- a/unit-tests/add.sh +++ b/unit-tests/add.sh @@ -11,7 +11,7 @@ else exit 1 fi -expected='5.500000' +expected='5.5' actual=`echo "(add 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1` if [ "${expected}" = "${actual}" ] diff --git a/unit-tests/multiply.sh b/unit-tests/multiply.sh index b9fd5b1..0675a6f 100644 --- a/unit-tests/multiply.sh +++ b/unit-tests/multiply.sh @@ -11,7 +11,7 @@ else exit 1 fi -expected='7.500000' +expected='7.5' actual=`echo "(multiply 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1` if [ "${expected}" = "${actual}" ] diff --git a/unit-tests/string-allocation.sh b/unit-tests/string-allocation.sh index e377c42..7fe78c4 100644 --- a/unit-tests/string-allocation.sh +++ b/unit-tests/string-allocation.sh @@ -1,14 +1,17 @@ #!/bin/bash +log=log.$$ value='"Fred"' expected="String cell: character 'F' (70)" -echo ${value} | target/psse -d 2>/dev/null | grep "${expected}" > /dev/null +echo ${value} | target/psse -d > ${log} 2>/dev/null +grep "${expected}" ${log} > /dev/null if [ $? -eq 0 ] then echo "OK" + rm ${log} exit 0 else - echo "Expected '${expected}', not found" + echo "Expected '${expected}', not found in ${log}" exit 1 fi