From 02fe5669d8ccaa1907e48acce8d8506c10e49d08 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 30 Dec 2018 17:56:15 +0000 Subject: [PATCH] Complete reworking of the REPL which is good in itself, but not what I was meant to be working on. --- Makefile | 4 +- lisp/expt.lisp | 6 + lisp/types.lisp | 24 +++ src/arith/integer.c | 105 ++++++------ src/arith/peano.c | 12 +- src/arith/ratio.c | 16 +- src/init.c | 29 +++- src/memory/dump.c | 14 +- src/ops/equal.c | 4 +- src/ops/lispops.c | 268 +++++++++++++++++++++++++------ src/ops/lispops.h | 4 + src/ops/print.c | 4 + src/ops/print.h | 1 + src/repl.c | 108 ++----------- src/repl.h | 7 +- unit-tests/add.sh | 10 +- unit-tests/apply.sh | 2 +- unit-tests/complex-list.sh | 2 +- unit-tests/cond.sh | 4 +- unit-tests/empty-list.sh | 4 +- unit-tests/empty-string.sh | 2 +- unit-tests/eval-integer.sh | 2 +- unit-tests/eval-quote-sexpr.sh | 2 +- unit-tests/eval-quote-symbol.sh | 2 +- unit-tests/eval-real.sh | 3 +- unit-tests/eval-string.sh | 2 +- unit-tests/fred.sh | 2 +- unit-tests/integer.sh | 4 +- unit-tests/intepreter.sh | 2 +- unit-tests/lambda.sh | 5 +- unit-tests/many-args.sh | 2 +- unit-tests/multiply.sh | 4 +- unit-tests/nil.sh | 2 +- unit-tests/nlambda.sh | 2 +- unit-tests/progn.sh | 4 +- unit-tests/quote.sh | 2 +- unit-tests/quoted-list.sh | 2 +- unit-tests/ratio-addition.sh | 2 +- unit-tests/recursion.sh | 5 +- unit-tests/reverse.sh | 6 +- unit-tests/simple-list.sh | 2 +- unit-tests/string-with-spaces.sh | 2 +- unit-tests/varargs.sh | 7 +- 43 files changed, 415 insertions(+), 281 deletions(-) create mode 100644 lisp/expt.lisp create mode 100644 lisp/types.lisp diff --git a/Makefile b/Makefile index c368d50..4fe322f 100644 --- a/Makefile +++ b/Makefile @@ -15,13 +15,11 @@ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \ -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \ -npsl -nsc -nsob -nss -nut -prs -l79 -ts2 -VERSION := "0.0.2" - CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g -DDEBUG LDFLAGS := -lm $(TARGET): $(OBJS) Makefile - $(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) + $(CC) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS) doc: $(SRCS) Makefile Doxyfile doxygen diff --git a/lisp/expt.lisp b/lisp/expt.lisp new file mode 100644 index 0000000..db6a7b3 --- /dev/null +++ b/lisp/expt.lisp @@ -0,0 +1,6 @@ +(set! expt (lambda + (n x) + "Return the value of `n` raised to the `x`th power." + (cond + ((= x 1) n) + (t (* n (expt n (- x 1))))))) diff --git a/lisp/types.lisp b/lisp/types.lisp new file mode 100644 index 0000000..cba1ef6 --- /dev/null +++ b/lisp/types.lisp @@ -0,0 +1,24 @@ +(set! cons? (lambda (o) "True if o is a cons cell." (= (type o) "CONS") ) ) +(set! exception? (lambda (o) "True if o is an exception." (= (type o) "EXEP"))) +(set! free? (lambda (o) "Trus if o is a free cell - this should be impossible!" (= (type o) "FREE"))) +(set! function? (lambda (o) "True if o is a compiled function." (= (type o) "EXEP"))) +(set! integer? (lambda (o) "True if o is an integer." (= (type o) "INTR"))) +(set! lambda? (lambda (o) "True if o is an interpreted (source) function." (= (type o) "LMDA"))) +(set! nil? (lambda (o) "True if o is the canonical nil value." (= (type o) "NIL "))) +(set! nlambda? (lambda (o) "True if o is an interpreted (source) special form." (= (type o) "NLMD"))) +(set! rational? (lambda (o) "True if o is an rational number." (= (type o) "RTIO"))) +(set! read? (lambda (o) "True if o is a read stream." (= (type o) "READ") ) ) +(set! real? (lambda (o) "True if o is an real number." (= (type o) "REAL"))) +(set! special? (lambda (o) "True if o is a compiled special form." (= (type o) "SPFM") ) ) +(set! string? (lambda (o) "True if o is a string." (= (type o) "STRG") ) ) +(set! symbol? (lambda (o) "True if o is a symbol." (= (type o) "SYMB") ) ) +(set! true? (lambda (o) "True if o is the canonical true value." (= (type o) "TRUE") ) ) +(set! write? (lambda (o) "True if o is a write stream." (= (type o) "WRIT") ) ) + +(set! or (lambda values + "True if any of `values` are non-nil." + (cond ((car values) t) (t (apply 'or (cdr values)))))) + +(set! number? + (lambda (o) + "I don't yet have an `or` operator diff --git a/src/arith/integer.c b/src/arith/integer.c index 176b09e..0e74f7b 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -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; } diff --git a/src/arith/peano.c b/src/arith/peano.c index 2a9fb7f..3a24ed1 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -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 = diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 95c9a8f..fd6a770 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -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 ); diff --git a/src/init.c b/src/init.c index 773afb5..15fd8e4 100644 --- a/src/init.c +++ b/src/init.c @@ -62,12 +62,6 @@ void bind_value( wchar_t *name, struct cons_pointer value ) { } int main( int argc, char *argv[] ) { - /* - * attempt to set wide character acceptance on all streams - */ - fwide( stdin, 1 ); - fwide( stdout, 1 ); - fwide( stderr, 1 ); int option; bool dump_at_end = false; bool show_prompt = false; @@ -110,6 +104,26 @@ int main( int argc, char *argv[] ) { bind_value( L"nil", NIL ); bind_value( L"t", TRUE ); + /* + * standard input, output, error and sink streams + * attempt to set wide character acceptance on all streams + */ + FILE *sink = fopen( "/dev/null", "w" ); + fwide( stdin, 1 ); + fwide( stdout, 1 ); + fwide( stderr, 1 ); + fwide( sink, 1 ); + bind_value( L"*in*", make_read_stream( stdin ) ); + bind_value( L"*out*", make_write_stream( stdout ) ); + bind_value( L"*log*", make_write_stream( stderr ) ); + bind_value( L"*sink*", make_write_stream( sink ) ); + + /* + * the default prompt + */ + bind_value( L"*prompt*", + show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL ); + /* * primitive function operations */ @@ -126,6 +140,7 @@ int main( int argc, char *argv[] ) { bind_function( L"exception", &lisp_exception ); bind_function( L"multiply", &lisp_multiply ); bind_function( L"read", &lisp_read ); + bind_function( L"repl", &lisp_repl ); bind_function( L"oblist", &lisp_oblist ); bind_function( L"print", &lisp_print ); bind_function( L"progn", &lisp_progn ); @@ -156,7 +171,7 @@ int main( int argc, char *argv[] ) { debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); - repl( stdin, stdout, stderr, show_prompt ); + repl( show_prompt ); debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP ); dec_ref( oblist ); diff --git a/src/memory/dump.c b/src/memory/dump.c index 24fd955..bd6587f 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -83,9 +83,9 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n", cell.payload.integer.value, cell.count ); - if (!nilp(cell.payload.integer.more)) { - fputws( L"\t\tBIGNUM! More at\n:", output); - dump_object(output, cell.payload.integer.more); + if ( !nilp( cell.payload.integer.more ) ) { + fputws( L"\t\tBIGNUM! More at\n:", output ); + dump_object( output, cell.payload.integer.more ); } break; case LAMBDATV: @@ -107,10 +107,10 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { case RATIOTV: fwprintf( output, L"\t\tRational cell: value %ld/%ld, count %u\n", - pointer2cell( cell.payload.ratio.dividend ). - payload.integer.value, - pointer2cell( cell.payload.ratio.divisor ). - payload.integer.value, cell.count ); + pointer2cell( cell.payload.ratio.dividend ).payload. + integer.value, + pointer2cell( cell.payload.ratio.divisor ).payload. + integer.value, cell.count ); break; case READTV: fwprintf( output, L"\t\tInput stream\n" ); diff --git a/src/ops/equal.c b/src/ops/equal.c index bade594..9eedd53 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -80,8 +80,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { && ( equal( cell_a->payload.string.cdr, cell_b->payload.string.cdr ) || ( end_of_string( cell_a->payload.string.cdr ) - && end_of_string( cell_b->payload. - string.cdr ) ) ); + && end_of_string( cell_b->payload.string. + cdr ) ) ); break; case INTEGERTV: result = diff --git a/src/ops/lispops.c b/src/ops/lispops.c index c83287d..1913406 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -117,11 +117,16 @@ struct cons_pointer eval_forms( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer list, struct cons_pointer env ) { - /* TODO: refactor. This runs up the C stack. */ - return consp( list ) ? - make_cons( eval_form( frame, frame_pointer, c_car( list ), env ), - eval_forms( frame, frame_pointer, c_cdr( list ), - env ) ) : NIL; + struct cons_pointer result = NIL; + + while ( consp( list ) ) { + result = + make_cons( eval_form( frame, frame_pointer, c_car( list ), env ), + result ); + list = c_cdr( list ); + } + + return result; } /** @@ -220,7 +225,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, /* if `names` is a symbol, rather than a list of symbols, * then bind a list of the values of args to that symbol. */ /* TODO: eval all the things in frame->more */ - struct cons_pointer vals = frame->more; + struct cons_pointer vals = + eval_forms( frame, frame_pointer, frame->more, env ); for ( int i = args_in_frame - 1; i >= 0; i-- ) { struct cons_pointer val = @@ -353,10 +359,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload. - special.executable ) ( get_stack_frame - ( next_pointer ), - next_pointer, env ); + ( *fn_cell.payload.special. + executable ) ( get_stack_frame( next_pointer ), + next_pointer, env ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); @@ -480,10 +485,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { -#ifdef DEBUG debug_print( L"Apply: ", DEBUG_EVAL ); - dump_frame( stderr, frame_pointer ); -#endif + debug_dump_object( frame_pointer, DEBUG_EVAL ); + set_reg( frame, 0, make_cons( frame->arg[0], frame->arg[1] ) ); set_reg( frame, 1, NIL ); @@ -612,17 +616,24 @@ struct cons_pointer lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; + struct cons_space_object cell = pointer2cell( frame->arg[0] ); - if ( consp( frame->arg[0] ) ) { - struct cons_space_object cell = pointer2cell( frame->arg[0] ); - result = cell.payload.cons.car; - } else if ( stringp( frame->arg[0] ) ) { - struct cons_space_object cell = pointer2cell( frame->arg[0] ); - result = make_string( cell.payload.string.character, NIL ); - } else { - struct cons_pointer message = - c_string_to_lisp_string( L"Attempt to take CAR of non sequence" ); - result = throw_exception( message, frame_pointer ); + switch ( cell.tag.value ) { + case CONSTV: + result = cell.payload.cons.car; + break; + case READTV: + result = make_string( fgetwc( cell.payload.stream.stream ), NIL ); + case STRINGTV: + result = make_string( cell.payload.string.character, NIL ); + break; + case NILTV: + break; + default: + result = + throw_exception( c_string_to_lisp_string + ( L"Attempt to take CAR of non sequence" ), + frame_pointer ); } return result; @@ -632,22 +643,33 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, * (cdr s_expr) * Returns the remainder of a sequence when the head is removed. Valid for cons cells, * strings, and TODO read streams and other things which can be considered as sequences. + * NOTE that if the argument is an input stream, the first character is removed AND + * DISCARDED. */ struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; + struct cons_space_object cell = pointer2cell( frame->arg[0] ); - if ( consp( frame->arg[0] ) ) { - struct cons_space_object cell = pointer2cell( frame->arg[0] ); - result = cell.payload.cons.cdr; - } else if ( stringp( frame->arg[0] ) ) { - struct cons_space_object cell = pointer2cell( frame->arg[0] ); - result = cell.payload.string.cdr; - } else { - struct cons_pointer message = - c_string_to_lisp_string( L"Attempt to take CDR of non sequence" ); - result = throw_exception( message, frame_pointer ); + switch ( cell.tag.value ) { + case CONSTV: + result = cell.payload.cons.cdr; + break; + case READTV: + fgetwc( cell.payload.stream.stream ); + result = frame->arg[0]; + break; + case STRINGTV: + result = cell.payload.string.cdr; + break; + case NILTV: + break; + default: + result = + throw_exception( c_string_to_lisp_string + ( L"Attempt to take CDR of non sequence" ), + frame_pointer ); } return result; @@ -683,6 +705,26 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer, return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; } + +/** + * Resutn the current default input, or of `inputp` is false, output stream from + * this `env`ironment. + */ +struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) { + struct cons_pointer result = NIL; + struct cons_pointer stream_name = + c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" ); + + inc_ref( stream_name ); + + result = c_assoc( stream_name, env ); + + dec_ref( stream_name ); + + return result; +} + + /** * (read) * (read read-stream) @@ -696,15 +738,24 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, debug_print( L"entering lisp_read\n", DEBUG_IO ); #endif FILE *input = stdin; + struct cons_pointer in_stream = readp( frame->arg[0] ) ? + frame->arg[0] : get_default_stream( true, env ); - if ( readp( frame->arg[0] ) ) { - input = pointer2cell( frame->arg[0] ).payload.stream.stream; + if ( readp( in_stream ) ) { + debug_print( L"lisp_print: setting input stream\n", DEBUG_IO ); + debug_dump_object( in_stream, DEBUG_IO ); + input = pointer2cell( in_stream ).payload.stream.stream; + inc_ref( in_stream ); } struct cons_pointer result = read( frame, frame_pointer, input ); debug_print( L"lisp_read returning\n", DEBUG_IO ); debug_dump_object( result, DEBUG_IO ); + if ( readp( in_stream ) ) { + dec_ref( in_stream ); + } + return result; } @@ -757,12 +808,16 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, debug_print( L"Entering print\n", DEBUG_IO ); struct cons_pointer result = NIL; FILE *output = stdout; + struct cons_pointer out_stream = writep( frame->arg[1] ) ? + frame->arg[1] : get_default_stream( false, env ); - if ( writep( frame->arg[1] ) ) { + if ( writep( out_stream ) ) { debug_print( L"lisp_print: setting output stream\n", DEBUG_IO ); - debug_dump_object( frame->arg[1], DEBUG_IO ); - output = pointer2cell( frame->arg[1] ).payload.stream.stream; + debug_dump_object( out_stream, DEBUG_IO ); + output = pointer2cell( out_stream ).payload.stream.stream; + inc_ref( out_stream ); } + debug_print( L"lisp_print: about to print\n", DEBUG_IO ); debug_dump_object( frame->arg[0], DEBUG_IO ); @@ -771,6 +826,10 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, debug_print( L"lisp_print returning\n", DEBUG_IO ); debug_dump_object( result, DEBUG_IO ); + if ( writep( out_stream ) ) { + dec_ref( out_stream ); + } + return result; } @@ -787,6 +846,27 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, return c_type( frame->arg[0] ); } +/** + * Evaluate each of these forms in this `env`ironment over this `frame`, + * returning only the value of the last. + */ +struct cons_pointer +c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer forms, struct cons_pointer env ) { + struct cons_pointer result = NIL; + + while ( consp( forms ) ) { + struct cons_pointer r = result; + inc_ref( r ); + result = eval_form( frame, frame_pointer, c_car( forms ), env ); + dec_ref( r ); + + forms = c_cdr( forms ); + } + + return result; +} + /** * (progn forms...) @@ -803,17 +883,19 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer remaining = frame->more; struct cons_pointer result = NIL; for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) { + struct cons_pointer r = result; + inc_ref( r ); + result = eval_form( frame, frame_pointer, frame->arg[i], env ); + + dec_ref( r ); } - while ( consp( remaining ) ) { - result = eval_form( frame, frame_pointer, c_car( remaining ), env ); - - remaining = c_cdr( remaining ); + if ( consp( frame->more ) ) { + result = c_progn( frame, frame_pointer, frame->more, env ); } return result; @@ -846,15 +928,9 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, env ); if ( !nilp( result ) ) { - struct cons_pointer vals = - eval_forms( frame, frame_pointer, c_cdr( clause_pointer ), - env ); - - while ( consp( vals ) ) { - result = c_car( vals ); - vals = c_cdr( vals ); - } - + result = + c_progn( frame, frame_pointer, c_cdr( clause_pointer ), + env ); done = true; } } else if ( nilp( clause_pointer ) ) { @@ -915,3 +991,91 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, return exceptionp( message ) ? message : make_exception( message, frame->previous ); } + +/** + * (repl) + * (repl prompt) + * (repl prompt input_stream output_stream) + * + * Function: the read/eval/print loop. Returns the value of the last expression + * entered. + */ +struct cons_pointer lisp_repl( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer expr = NIL; + + /* TODO: bind *prompt*, *input*, *output* in the environment to the values + * of arguments 0, 1, and 2 respectively, but in each case only if the + * argument is not nil */ + + struct cons_pointer input = get_default_stream( true, env ); + struct cons_pointer output = get_default_stream( false, env ); + FILE *os = pointer2cell( output ).payload.stream.stream; + struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" ); + struct cons_pointer old_oblist = oblist; + struct cons_pointer new_env = env; + + inc_ref( input ); + inc_ref( output ); + inc_ref( prompt_name ); + inc_ref( new_env ); + + /* TODO: this is subtly wrong. If we were evaluating + * (print (eval (read))) + * then the stack frame for read would have the stack frame for + * eval as parent, and it in turn would have the stack frame for + * print as parent. + */ + while ( readp( input ) && writep( output ) + && !feof( pointer2cell( input ).payload.stream.stream ) ) { + /* OK, here's a really subtle problem: because lists are immutable, anything + * bound in the oblist subsequent to this function being invoked isn't in the + * environment. So, for example, changes to *prompt* or *log* made in the oblist + * are not visible. So copy changes made in the oblist into the enviroment. + * TODO: the whole process of resolving symbol values needs to be revisited + * when we get onto namespaces. */ + struct cons_pointer cursor = oblist; + while ( !nilp( cursor ) && !eq( cursor, old_oblist ) ) { + debug_print + ( L"lisp_repl: copying new oblist binding into REPL environment:\n", + DEBUG_REPL ); + debug_print_object( c_car( cursor ), DEBUG_REPL ); + debug_println( DEBUG_REPL ); + + new_env = make_cons( c_car( cursor ), new_env ); + cursor = c_cdr( cursor ); + } + old_oblist = oblist; + + println( os ); + + struct cons_pointer prompt = c_assoc( prompt_name, new_env ); + if ( !nilp( prompt ) ) { + print( os, prompt ); + } + + expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer, + new_env ); + inc_ref( expr ); + + if ( exceptionp( expr ) + && feof( pointer2cell( input ).payload.stream.stream ) ) { + /* suppress printing end of stream exception */ + break; + } + + println( os ); + + print( os, eval_form( frame, frame_pointer, expr, new_env ) ); + + dec_ref( expr ); + } + + dec_ref( input ); + dec_ref( output ); + dec_ref( prompt_name ); + dec_ref( new_env ); + + return expr; +} diff --git a/src/ops/lispops.h b/src/ops/lispops.h index a1dee81..f9cd8ba 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -140,9 +140,13 @@ struct cons_pointer lisp_print( struct stack_frame *frame, struct cons_pointer lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); +struct cons_pointer lisp_repl( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); + /** * Function: Get the Lisp type of the single argument. * @param frame My stack frame. diff --git a/src/ops/print.c b/src/ops/print.c index 9138077..3feeb21 100644 --- a/src/ops/print.c +++ b/src/ops/print.c @@ -224,3 +224,7 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { return pointer; } + +void println( FILE * output ) { + fputws( L"\n", output ); +} diff --git a/src/ops/print.h b/src/ops/print.h index 1399db4..2751032 100644 --- a/src/ops/print.h +++ b/src/ops/print.h @@ -15,6 +15,7 @@ #define __print_h struct cons_pointer print( FILE * output, struct cons_pointer pointer ); +void println( FILE * output ); extern int print_use_colours; #endif diff --git a/src/repl.c b/src/repl.c index 99f41f8..0ea104d 100644 --- a/src/repl.c +++ b/src/repl.c @@ -11,118 +11,28 @@ #include #include -#include "conspage.h" #include "consspaceobject.h" #include "debug.h" #include "intern.h" #include "lispops.h" -#include "read.h" -#include "print.h" #include "stack.h" -/* TODO: this is subtly wrong. If we were evaluating - * (print (eval (read))) - * then the stack frame for read would have the stack frame for - * eval as parent, and it in turn would have the stack frame for - * print as parent. - */ - /** - * Dummy up a Lisp read call with its own stack frame. + * The read/eval/print loop. */ -struct cons_pointer repl_read( struct cons_pointer stream_pointer ) { - struct cons_pointer result = NIL; - debug_print( L"Entered repl_read\n", DEBUG_REPL ); - struct cons_pointer frame_pointer = - make_stack_frame( NIL, make_cons( stream_pointer, NIL ), oblist ); - debug_print( L"repl_read: got stack_frame pointer\n", DEBUG_REPL ); - debug_dump_object( frame_pointer, DEBUG_REPL ); +void repl( ) { + debug_print( L"Entered repl\n", DEBUG_REPL ); + + struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, oblist ); + if ( !nilp( frame_pointer ) ) { inc_ref( frame_pointer ); - result = - lisp_read( get_stack_frame( frame_pointer ), frame_pointer, - oblist ); + + lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, oblist ); + dec_ref( frame_pointer ); } - debug_print( L"repl_read: returning\n", DEBUG_REPL ); - debug_dump_object( result, DEBUG_REPL ); - - return result; -} - -/** - * Dummy up a Lisp eval call with its own stack frame. - */ -struct cons_pointer repl_eval( struct cons_pointer input ) { - debug_print( L"Entered repl_eval\n", DEBUG_REPL ); - struct cons_pointer result = NIL; - - result = eval_form( NULL, NIL, input, oblist ); - - debug_print( L"repl_eval: returning\n", DEBUG_REPL ); - debug_dump_object( result, DEBUG_REPL ); - - return result; -} - -/** - * Dummy up a Lisp print call with its own stack frame. - */ -struct cons_pointer repl_print( struct cons_pointer stream_pointer, - struct cons_pointer value ) { - debug_print( L"Entered repl_print\n", DEBUG_REPL ); - debug_dump_object( value, DEBUG_REPL ); - struct cons_pointer result = - print( pointer2cell( stream_pointer ).payload.stream.stream, value ); - debug_print( L"repl_print: returning\n", DEBUG_REPL ); - debug_dump_object( result, DEBUG_REPL ); - - return result; -} - -/** - * The read/eval/print loop - * @param in_stream the stream to read from; - * @param out_stream the stream to write to; - * @param err_stream the stream to send errors to; - * @param show_prompt true if prompts should be shown. - */ -void -repl( FILE * in_stream, FILE * out_stream, FILE * error_stream, - bool show_prompt ) { - debug_print( L"Entered repl\n", DEBUG_REPL ); - struct cons_pointer input_stream = make_read_stream( in_stream ); - inc_ref( input_stream ); - - struct cons_pointer output_stream = make_write_stream( out_stream ); - inc_ref( output_stream ); - while ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) { - if ( show_prompt ) { - fwprintf( out_stream, L"\n:: " ); - } - - struct cons_pointer input = repl_read( input_stream ); - inc_ref( input ); - - if ( exceptionp( input ) ) { - /* suppress the end-of-stream exception */ - if ( !feof( pointer2cell( input_stream ).payload.stream.stream ) ) { - repl_print( output_stream, input ); - } - break; - } else { - struct cons_pointer val = repl_eval( input ); - inc_ref( val ); - repl_print( output_stream, val ); - dec_ref( val ); - } - - dec_ref( input ); - } - - dec_ref( input_stream ); - dec_ref( output_stream ); debug_print( L"Leaving repl\n", DEBUG_REPL ); } diff --git a/src/repl.h b/src/repl.h index 1a7b0e9..8ff8b19 100644 --- a/src/repl.h +++ b/src/repl.h @@ -20,13 +20,8 @@ extern "C" { /** * The read/eval/print loop - * @param in_stream the stream to read from; - * @param out_stream the stream to write to; - * @param err_stream the stream to send errors to; - * @param show_prompt true if prompts should be shown. */ - void repl( FILE * in_stream, FILE * out_stream, - FILE * error_stream, bool show_prompt ); + void repl( ); #ifdef __cplusplus } diff --git a/unit-tests/add.sh b/unit-tests/add.sh index 4516808..2802c3a 100644 --- a/unit-tests/add.sh +++ b/unit-tests/add.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='5' -actual=`echo "(add 2 3)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(add 2 3)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -12,7 +12,7 @@ else fi expected='5.5' -actual=`echo "(add 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(add 2.5 3)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -24,7 +24,7 @@ else fi expected='1/4' -actual=`echo "(+ 3/14 1/28)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -36,7 +36,7 @@ fi # (+ integer ratio) should be ratio expected='25/4' -actual=`echo "(+ 6 1/4)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(+ 6 1/4)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -48,7 +48,7 @@ fi # (+ ratio integer) should be ratio expected='25/4' -actual=`echo "(+ 1/4 6)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(+ 1/4 6)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/apply.sh b/unit-tests/apply.sh index 3483fb0..811fdae 100644 --- a/unit-tests/apply.sh +++ b/unit-tests/apply.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='1' -actual=`echo "(apply 'add '(1))"| target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(apply 'add '(1))"| target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/complex-list.sh b/unit-tests/complex-list.sh index d3728d8..5bb5e9c 100644 --- a/unit-tests/complex-list.sh +++ b/unit-tests/complex-list.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='(1 2 3 ("Fred") nil 77354)' -actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/cond.sh b/unit-tests/cond.sh index 227f9b3..ab2e2f0 100644 --- a/unit-tests/cond.sh +++ b/unit-tests/cond.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='5' -actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -12,7 +12,7 @@ else fi expected='"should"' -actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/empty-list.sh b/unit-tests/empty-list.sh index 1e24452..8f0f702 100644 --- a/unit-tests/empty-list.sh +++ b/unit-tests/empty-list.sh @@ -1,5 +1,5 @@ #!/bin/bash -# +# # File: empty-list.sh.bash # Author: simon # @@ -7,7 +7,7 @@ # expected=nil -actual=`echo "'()" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "'()" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/empty-string.sh b/unit-tests/empty-string.sh index 340fd1b..a1e5baa 100644 --- a/unit-tests/empty-string.sh +++ b/unit-tests/empty-string.sh @@ -1,7 +1,7 @@ #!/bin/bash expected="\"\"" -actual=`echo '""' | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo '""' | target/psse | tail -1` if [ "$expected" = "$actual" ] then diff --git a/unit-tests/eval-integer.sh b/unit-tests/eval-integer.sh index addc133..1aadb39 100644 --- a/unit-tests/eval-integer.sh +++ b/unit-tests/eval-integer.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='5' -actual=`echo "(eval 5)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(eval 5)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/eval-quote-sexpr.sh b/unit-tests/eval-quote-sexpr.sh index eea16ec..d83bbe8 100644 --- a/unit-tests/eval-quote-sexpr.sh +++ b/unit-tests/eval-quote-sexpr.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='5' -actual=`echo "(eval '(add 2 3))" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(eval '(add 2 3))" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/eval-quote-symbol.sh b/unit-tests/eval-quote-symbol.sh index 5eca83d..253ce32 100644 --- a/unit-tests/eval-quote-symbol.sh +++ b/unit-tests/eval-quote-symbol.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='(Special form)' -actual=`echo "(eval 'cond)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(eval 'cond)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/eval-real.sh b/unit-tests/eval-real.sh index 8832719..3aa16d7 100644 --- a/unit-tests/eval-real.sh +++ b/unit-tests/eval-real.sh @@ -5,12 +5,11 @@ expected='5.05' actual=`echo "(eval 5.05)" |\ target/psse 2> /dev/null |\ sed 's/0*$//' |\ - head -2 |\ tail -1` +# one part in a million is close enough... outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc` - if [ "${outcome}" = "1" ] then echo "OK" diff --git a/unit-tests/eval-string.sh b/unit-tests/eval-string.sh index 4b8dc8e..90f6f2c 100644 --- a/unit-tests/eval-string.sh +++ b/unit-tests/eval-string.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='"5"' -actual=`echo '(eval "5")' | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo '(eval "5")' | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/fred.sh b/unit-tests/fred.sh index 427c60d..8e3d513 100644 --- a/unit-tests/fred.sh +++ b/unit-tests/fred.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='"Fred"' -actual=`echo ${expected} | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo ${expected} | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/integer.sh b/unit-tests/integer.sh index 41b2da3..18ae66e 100644 --- a/unit-tests/integer.sh +++ b/unit-tests/integer.sh @@ -1,7 +1,7 @@ #!/bin/bash -expected="354" -actual=`echo ${expected} | target/psse 2> /dev/null | head -2 | tail -1` +expected='354' +actual=`echo ${expected} | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/intepreter.sh b/unit-tests/intepreter.sh index 9eb2a06..6f23fc9 100644 --- a/unit-tests/intepreter.sh +++ b/unit-tests/intepreter.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='6' -actual=`echo "(apply '(lambda (x y z) (/ (* y z) x)) '(2 3 4))" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(apply '(lambda (x y z) (/ (* y z) x)) '(2 3 4))" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/lambda.sh b/unit-tests/lambda.sh index c1197e0..b7f1707 100644 --- a/unit-tests/lambda.sh +++ b/unit-tests/lambda.sh @@ -1,10 +1,11 @@ #!/bin/bash -expected='(lambda (l) l)(1 2 3 4 5 6 7 8 9 10)' -actual=`target/psse 2>/dev/null </dev/null < /dev/null | head -2 | tail -1` +actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/multiply.sh b/unit-tests/multiply.sh index 0675a6f..94b19f6 100644 --- a/unit-tests/multiply.sh +++ b/unit-tests/multiply.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='6' -actual=`echo "(multiply 2 3)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(multiply 2 3)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -12,7 +12,7 @@ else fi expected='7.5' -actual=`echo "(multiply 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(multiply 2.5 3)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/nil.sh b/unit-tests/nil.sh index de4ef57..fcbf530 100644 --- a/unit-tests/nil.sh +++ b/unit-tests/nil.sh @@ -1,7 +1,7 @@ #!/bin/bash expected=nil -actual=`echo 'nil' | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo 'nil' | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/nlambda.sh b/unit-tests/nlambda.sh index f267527..68f0447 100644 --- a/unit-tests/nlambda.sh +++ b/unit-tests/nlambda.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='a' -actual=`echo "((nlambda (x) x) a)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "((nlambda (x) x) a)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh index 017646b..352c87a 100644 --- a/unit-tests/progn.sh +++ b/unit-tests/progn.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='5' -actual=`echo "(progn (add 2 3))" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(progn (add 2 3))" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -12,7 +12,7 @@ else fi expected='"foo"' -actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/quote.sh b/unit-tests/quote.sh index bded011..78d4ce5 100644 --- a/unit-tests/quote.sh +++ b/unit-tests/quote.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='Fred' -actual=`echo "'Fred" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "'Fred" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/quoted-list.sh b/unit-tests/quoted-list.sh index 24480c6..f69cd75 100644 --- a/unit-tests/quoted-list.sh +++ b/unit-tests/quoted-list.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='(123 (4 (5 nil)) Fred)' -actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/ratio-addition.sh b/unit-tests/ratio-addition.sh index f57d0b0..ba93c5d 100644 --- a/unit-tests/ratio-addition.sh +++ b/unit-tests/ratio-addition.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='1/4' -actual=`echo "(+ 3/14 1/28)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/recursion.sh b/unit-tests/recursion.sh index a49154b..407265e 100644 --- a/unit-tests/recursion.sh +++ b/unit-tests/recursion.sh @@ -1,7 +1,7 @@ #!/bin/bash -expected='nil3628800' -actual=`target/psse 2>/dev/null </dev/null </dev/null < /dev/null | head -2 | tail -1` +actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -12,7 +12,7 @@ else 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` +actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then @@ -23,7 +23,7 @@ else fi expected='esrever' -actual=`echo "(reverse 'reverse)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "(reverse 'reverse)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/simple-list.sh b/unit-tests/simple-list.sh index 60492b9..daf3db2 100644 --- a/unit-tests/simple-list.sh +++ b/unit-tests/simple-list.sh @@ -1,7 +1,7 @@ #!/bin/bash expected="(1 2 3)" -actual=`echo "'(1 2 3)" | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo "'(1 2 3)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/string-with-spaces.sh b/unit-tests/string-with-spaces.sh index 384cc9f..0f0f6d0 100644 --- a/unit-tests/string-with-spaces.sh +++ b/unit-tests/string-with-spaces.sh @@ -1,7 +1,7 @@ #!/bin/bash expected='"Strings should be able to include spaces (and other stuff)!"' -actual=`echo ${expected} | target/psse 2> /dev/null | head -2 | tail -1` +actual=`echo ${expected} | target/psse | tail -1` if [ "${expected}" = "${actual}" ] then diff --git a/unit-tests/varargs.sh b/unit-tests/varargs.sh index 6c31163..27bac3e 100644 --- a/unit-tests/varargs.sh +++ b/unit-tests/varargs.sh @@ -1,10 +1,7 @@ #!/bin/bash -expected='(lambda l l)(1 2 3 4 5 6 7 8 9 10)' -actual=`target/psse 2>/dev/null <