Complete reworking of the REPL

which is good in itself, but not what I was meant to be working on.

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

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)))))))

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

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 ) {
+        while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
-            debug_print(L"add_integers: ", DEBUG_ARITH);
+            debug_print( L"add_integers: ", DEBUG_ARITH );
-            debug_print_object(a, DEBUG_ARITH);
+            debug_print_object( a, DEBUG_ARITH );
-            debug_print(L" x ", DEBUG_ARITH);
+            debug_print( L" x ", DEBUG_ARITH );
-            debug_print_object(b, DEBUG_ARITH);
+            debug_print_object( b, DEBUG_ARITH );
-            debug_printf(DEBUG_ARITH, L"; carry = %ld\n", carry);
+            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( L"add_integers returning: ", DEBUG_ARITH );
-    debug_print_object(result, DEBUG_ARITH);
+    debug_print_object( result, DEBUG_ARITH );
-    debug_println(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( L"multiply_integers: ", DEBUG_ARITH );
-        debug_print_object(a, DEBUG_ARITH);
+        debug_print_object( a, DEBUG_ARITH );
-        debug_print(L" x ", DEBUG_ARITH);
+        debug_print( L" x ", DEBUG_ARITH );
-        debug_print_object(b, DEBUG_ARITH);
+        debug_print_object( b, DEBUG_ARITH );
-        debug_println(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( L"multiply_integers returning: ", DEBUG_ARITH );
-    debug_print_object(result, DEBUG_ARITH);
+    debug_print_object( result, DEBUG_ARITH );
-    debug_println(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) {
+    if ( accumulator == 0 ) {
-    result = c_string_to_lisp_string( L"0");
+        result = c_string_to_lisp_string( L"0" );
-  } else {
+    } else {
-    while ( accumulator > 0 ) {
+        while ( accumulator > 0 ) {
-        debug_printf(DEBUG_ARITH, L"integer_to_string: accumulator is %ld\n:",
+            debug_printf( DEBUG_ARITH,
-                     accumulator);
+                          L"integer_to_string: accumulator is %ld\n:",
-        do {
+                          accumulator );
-            debug_printf(DEBUG_ARITH, L"integer_to_string: digit is %ld, hexadecimal is %lc\n:",
+            do {
-                         accumulator % base, hex_digits[accumulator % base]);
+                debug_printf( DEBUG_ARITH,
-            wint_t digit = (wint_t)hex_digits[accumulator % base];
+                              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 );
+                result =
-            accumulator = accumulator / base;
+                    make_string( ( wint_t ) hex_digits[accumulator % base],
-        } while ( accumulator > base );
+                                 result );
+                accumulator = accumulator / base;
+            } while ( accumulator > base );
 
-        if ( integerp( integer.payload.integer.more ) ) {
+            if ( integerp( integer.payload.integer.more ) ) {
-            integer = pointer2cell( integer.payload.integer.more );
+                integer = pointer2cell( integer.payload.integer.more );
-            int64_t i = integer.payload.integer.value;
+                int64_t i = integer.payload.integer.value;
 
-            /* TODO: I don't believe it's as simple as this! */
+                /* TODO: I don't believe it's as simple as this! */
-            accumulator += ( base * ( i % base ) );
+                accumulator += ( base * ( i % base ) );
-            result = make_string( (wint_t)hex_digits[accumulator % base], result );
+                result =
-            accumulator += ( base * ( i / base ) );
+                    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;
 }

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.
+                                               to_long_int( cell.payload.
-                                                            dividend ), NIL ),
+                                                            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 =

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 ).
+            pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload.
-            payload.integer.value, drrv =
+            integer.value, drrv =
-            pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
+            pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload.
-            payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
+            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.
+                                        pointer2cell( arg2 ).payload.ratio.
-                                        ratio.divisor,
+                                        divisor,
-                                        pointer2cell( arg2 ).payload.
+                                        pointer2cell( arg2 ).payload.ratio.
-                                        ratio.dividend ), result =
+                                        dividend ), result =
         multiply_ratio_ratio( frame_pointer, arg1, i );
 
     dec_ref( i );

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 );

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)) {
+            if ( !nilp( cell.payload.integer.more ) ) {
-                fputws( L"\t\tBIGNUM! More at\n:", output);
+                fputws( L"\t\tBIGNUM! More at\n:", output );
-                dump_object(output, cell.payload.integer.more);
+                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 ).
+                      pointer2cell( cell.payload.ratio.dividend ).payload.
-                      payload.integer.value,
+                      integer.value,
-                      pointer2cell( cell.payload.ratio.divisor ).
+                      pointer2cell( cell.payload.ratio.divisor ).payload.
-                      payload.integer.value, cell.count );
+                      integer.value, cell.count );
             break;
         case READTV:
             fwprintf( output, L"\t\tInput stream\n" );

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.
+                              && end_of_string( cell_b->payload.string.
-                                                string.cdr ) ) );
+                                                cdr ) ) );
                 break;
             case INTEGERTV:
                 result =

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. */
+    struct cons_pointer result = NIL;
-    return consp( list ) ?
+
-        make_cons( eval_form( frame, frame_pointer, c_car( list ), env ),
+    while ( consp( list ) ) {
-                   eval_forms( frame, frame_pointer, c_cdr( list ),
+        result =
-                               env ) ) : NIL;
+            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.
+                            ( *fn_cell.payload.special.
-                              special.executable ) ( get_stack_frame
+                              executable ) ( get_stack_frame( next_pointer ),
-                                                     ( next_pointer ),
+                                             next_pointer, env );
-                                                     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 );
+    debug_dump_object( frame_pointer, DEBUG_EVAL );
-#endif
+
     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] ) ) {
+    switch ( cell.tag.value ) {
-        struct cons_space_object cell = pointer2cell( frame->arg[0] );
+        case CONSTV:
-        result = cell.payload.cons.car;
+            result = cell.payload.cons.car;
-    } else if ( stringp( frame->arg[0] ) ) {
+            break;
-        struct cons_space_object cell = pointer2cell( frame->arg[0] );
+        case READTV:
-        result = make_string( cell.payload.string.character, NIL );
+            result = make_string( fgetwc( cell.payload.stream.stream ), NIL );
-    } else {
+        case STRINGTV:
-        struct cons_pointer message =
+            result = make_string( cell.payload.string.character, NIL );
-            c_string_to_lisp_string( L"Attempt to take CAR of non sequence" );
+            break;
-        result = throw_exception( message, frame_pointer );
+        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] ) ) {
+    switch ( cell.tag.value ) {
-        struct cons_space_object cell = pointer2cell( frame->arg[0] );
+        case CONSTV:
-        result = cell.payload.cons.cdr;
+            result = cell.payload.cons.cdr;
-    } else if ( stringp( frame->arg[0] ) ) {
+            break;
-        struct cons_space_object cell = pointer2cell( frame->arg[0] );
+        case READTV:
-        result = cell.payload.string.cdr;
+            fgetwc( cell.payload.stream.stream );
-    } else {
+            result = frame->arg[0];
-        struct cons_pointer message =
+            break;
-            c_string_to_lisp_string( L"Attempt to take CDR of non sequence" );
+        case STRINGTV:
-        result = throw_exception( message, frame_pointer );
+            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] ) ) {
+    if ( readp( in_stream ) ) {
-        input = pointer2cell( frame->arg[0] ).payload.stream.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 );
+        debug_dump_object( out_stream, DEBUG_IO );
-        output = pointer2cell( frame->arg[1] ).payload.stream.stream;
+        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 ) ) {
+    if ( consp( frame->more ) ) {
-        result = eval_form( frame, frame_pointer, c_car( remaining ), env );
+        result = c_progn( frame, frame_pointer, frame->more, env );
-
-        remaining = c_cdr( remaining );
     }
 
     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 =
+                result =
-                    eval_forms( frame, frame_pointer, c_cdr( clause_pointer ),
+                    c_progn( frame, frame_pointer, c_cdr( clause_pointer ),
-                                env );
+                             env );
-
-                while ( consp( vals ) ) {
-                    result = c_car( vals );
-                    vals = c_cdr( vals );
-                }
-
                 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;
+}

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.

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 );
+}

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

src/repl.c

@@ -11,118 +11,28 @@
 #include <stdio.h>
 #include <wchar.h>
 
-#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 ) {
+void repl(  ) {
-    struct cons_pointer result = NIL;
+    debug_print( L"Entered repl\n", DEBUG_REPL );
-    debug_print( L"Entered repl_read\n", DEBUG_REPL );
+
-    struct cons_pointer frame_pointer =
+    struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, oblist );
-        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 );
     if ( !nilp( frame_pointer ) ) {
         inc_ref( frame_pointer );
-        result =
+
-            lisp_read( get_stack_frame( frame_pointer ), frame_pointer,
+        lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, oblist );
-                       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 );
 }

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,
+    void repl(  );
-               FILE * error_stream, bool show_prompt );
 
 #ifdef __cplusplus
 }

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

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

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

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

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

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

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

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

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

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"

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

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

unit-tests/integer.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
-expected="354"
+expected='354'
-actual=`echo ${expected} | target/psse 2> /dev/null | head -2 | tail -1`
+actual=`echo ${expected} | target/psse | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

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

unit-tests/lambda.sh

@@ -1,10 +1,11 @@
 #!/bin/bash
 
-expected='(lambda (l) l)(1 2 3 4 5 6 7 8 9 10)'
+expected='(lambda (l) l) (1 2 3 4 5 6 7 8 9 10)'
-actual=`target/psse 2>/dev/null <<EOF
+output=`target/psse 2>/dev/null <<EOF
 (set! list (lambda (l) l))
 (list '(1 2 3 4 5 6 7 8 9 10))
 EOF`
+actual=`echo $output | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/many-args.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected="120"
-actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2> /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

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

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

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

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

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

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

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

unit-tests/recursion.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
-expected='nil3628800'
+expected='nil 3628800'
-actual=`target/psse 2>/dev/null <<EOF
+output=`target/psse 2>/dev/null <<EOF
 (progn
   (set! fact
     (lambda (n)
@@ -10,6 +10,7 @@ actual=`target/psse 2>/dev/null <<EOF
   nil)
 (fact 10)
 EOF`
+actual=`echo $output | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/reverse.sh

@@ -1,7 +1,7 @@
 #!/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`
+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

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

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

unit-tests/varargs.sh

@@ -1,10 +1,7 @@
 #!/bin/bash
 
-expected='(lambda l l)(1 2 3 4 5 6 7 8 9 10)'
+expected='(1 2 3 4 5 6 7 8 9 10)'
-actual=`target/psse 2>/dev/null <<EOF
+actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" |target/psse | tail -1`
-(set! list (lambda l l))
-(list 1 2 3 4 5 6 7 8 9 10)
-EOF`
 
 if [ "${expected}" = "${actual}" ]
 then