diff --git a/src/init.c b/src/init.c index 876bdad..a7e835a 100644 --- a/src/init.c +++ b/src/init.c @@ -95,6 +95,7 @@ int main( int argc, char *argv[] ) { bind_function( "oblist", &lisp_oblist ); bind_function( "print", &lisp_print ); bind_function( "progn", &lisp_progn ); + bind_function( "reverse", &lisp_reverse ); bind_function( "set", &lisp_set ); bind_function( "subtract", &lisp_subtract ); bind_function( "type", &lisp_type ); diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 555614a..43bdfe0 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -234,6 +234,8 @@ */ #define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)||check_tag(conspoint,BIGNUMTAG)) +#define sequencep(conspoint) (check_tag(conspoint,CONSTAG)||check_tag(conspoint,STRINGTAG)||check_tag(conspoint,SYMBOLTAG)) + /** * true if thr conspointer points to a vector pointer. */ diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 5dae587..a0417b7 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -169,11 +169,13 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer env ) { } void log_binding( struct cons_pointer name, struct cons_pointer val ) { - print( stderr, c_string_to_lisp_string( "\n\tBinding " ) ); +#ifdef DEBUG + fputws( L"\n\tBinding ", stderr ); print( stderr, name ); - print( stderr, c_string_to_lisp_string( " to " ) ); + fputws( L" to ", stderr); print( stderr, val ); fputws( L"\"\n", stderr ); +#endif } /** @@ -279,8 +281,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer exep = NIL; struct stack_frame *next = make_stack_frame( frame, args, env, &exep ); +#ifdef DEBUG fputws( L"Stack frame for lambda\n", stderr ); dump_frame( stderr, next ); +#endif result = eval_lambda( fn_cell, next, env ); if ( exceptionp( result ) ) { /* if we're returning an exception, we should NOT free the @@ -296,8 +300,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) { { struct stack_frame *next = make_special_frame( frame, args, env ); +#ifdef DEBUG fputws( L"Stack frame for nlambda\n", stderr ); dump_frame( stderr, next ); +#endif result = eval_lambda( fn_cell, next, env ); if ( !exceptionp( result ) ) { /* if we're returning an exception, we should NOT free the @@ -376,8 +382,10 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) { struct cons_pointer result = frame->arg[0]; struct cons_space_object cell = pointer2cell( frame->arg[0] ); +#ifdef DEBUG fputws( L"Eval: ", stderr ); dump_frame( stderr, frame ); +#endif switch ( cell.tag.value ) { case CONSTV: @@ -415,9 +423,11 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) { break; } +#ifdef DEBUG fputws( L"Eval returning ", stderr ); print( stderr, result ); fputws( L"\n", stderr ); +#endif return result; } @@ -432,17 +442,20 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) { */ struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer env ) { +#ifdef DEBUG fputws( L"Apply: ", stderr ); dump_frame( stderr, frame ); - +#endif set_reg( frame, 0, make_cons( frame->arg[0], frame->arg[1] ) ); set_reg( frame, 1, NIL ); struct cons_pointer result = c_apply( frame, env ); +#ifdef DEBUG fputws( L"Apply returning ", stderr ); print( stderr, result ); fputws( L"\n", stderr ); +#endif return result; } @@ -641,6 +654,40 @@ lisp_read( struct stack_frame *frame, struct cons_pointer env ) { } +/** + * reverse a sequence. + */ +struct cons_pointer c_reverse( struct cons_pointer arg) { + struct cons_pointer result = NIL; + + for (struct cons_pointer p = arg; sequencep(p); p = c_cdr(p)) { + struct cons_space_object o = pointer2cell(p); + switch (o.tag.value) { + case CONSTV: + result = make_cons(o.payload.cons.car, result); + break; + case STRINGTV: + result = make_string(o.payload.string.character, result); + break; + case SYMBOLTV: + result = make_symbol(o.payload.string.character, result); + break; + } + } + + return result; +} + + +/** + * (reverse sequence) + * Return a sequence like this sequence but with the members in the reverse order. + */ +struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer env ) { + return c_reverse( frame->arg[0]); +} + + /** * (print expr) * (print expr write-stream) diff --git a/src/ops/lispops.h b/src/ops/lispops.h index 122e149..3ac53c7 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -40,6 +40,7 @@ struct cons_pointer c_car( struct cons_pointer arg ); */ struct cons_pointer c_cdr( struct cons_pointer arg ); +struct cons_pointer c_reverse( struct cons_pointer arg); /** * Useful building block; evaluate this single form in the context of this @@ -117,10 +118,12 @@ struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer env ); struct cons_pointer lisp_equal( struct stack_frame *frame, struct cons_pointer env ); -struct cons_pointer lisp_read( struct stack_frame *frame, - struct cons_pointer env ); struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer env ); +struct cons_pointer lisp_read( struct stack_frame *frame, + struct cons_pointer env ); +struct cons_pointer lisp_reverse( struct stack_frame *frame, + struct cons_pointer env ); /** * Function: Get the Lisp type of the single argument. * @param frame My stack frame. diff --git a/src/ops/read.c b/src/ops/read.c index 4ba45dc..2acb99c 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -148,6 +148,8 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input, initial = fgetwc( input ); } + + #ifdef DEBUG fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial ); #endif @@ -164,7 +166,7 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input, } else if ( c == btowc( '/' ) ) { if ( seen_period || dividend > 0 ) { return make_exception( c_string_to_lisp_string - ( "Malformed number: dividend must be integer" ), + ( "Malformed number: dividend of rational must be integer" ), frame ); } else { dividend = negative ? 0 - accumulator : accumulator; diff --git a/unit-tests/add.sh b/unit-tests/add.sh index 7bb29c7..4516808 100644 --- a/unit-tests/add.sh +++ b/unit-tests/add.sh @@ -23,3 +23,57 @@ else exit 1 fi +expected='1/4' +actual=`echo "(+ 3/14 1/28)" | target/psse 2> /dev/null | head -2 | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +# (+ integer ratio) should be ratio +expected='25/4' +actual=`echo "(+ 6 1/4)" | target/psse 2> /dev/null | head -2 | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +# (+ ratio integer) should be ratio +expected='25/4' +actual=`echo "(+ 1/4 6)" | target/psse 2> /dev/null | head -2 | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +# (+ real ratio) should be real +# for this test, trailing zeros can be ignored +expected='6.25' +actual=`echo "(+ 6.000000001 1/4)" |\ + target/psse 2> /dev/null |\ + sed 's/0*$//' |\ + head -2 |\ + tail -1` + +outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc` + +if [ "${outcome}" = "1" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + diff --git a/unit-tests/reverse.sh b/unit-tests/reverse.sh new file mode 100644 index 0000000..4e3f8f6 --- /dev/null +++ b/unit-tests/reverse.sh @@ -0,0 +1,36 @@ +#!/bin/bash + +expected='"god yzal eht revo depmuj xof nworb kciuq ehT"' +actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse 2> /dev/null | head -2 | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +expected='(1024 512 256 128 64 32 16 8 4 2)' +actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse 2> /dev/null | head -2 | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +expected='esrever' +actual=`echo "(reverse 'reverse)" | target/psse 2> /dev/null | head -2 | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" + exit 0 +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi +