From cec32eff54310f52660d2b6a3b3e5152e589cf22 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Thu, 13 Dec 2018 23:20:34 +0000
Subject: [PATCH] Progress, but there's something wrong with nlambdas

---
 lisp/defun.lisp         |  15 ++--
 lisp/fact.lisp          |   4 ++
 src/init.c              |   3 +-
 src/lispops.c           | 111 ++++++++++++++++-------------
 src/peano.c             | 150 ++++++++++++++++++++++------------------
 src/print.c             |  15 ++--
 src/read.c              | 130 ++++++++++++++++++----------------
 src/repl.c              |  23 ++++--
 src/stack.c             |   8 +--
 unit-tests/many-args.sh |  13 ++++
 unit-tests/progn.sh     |   4 +-
 unit-tests/varargs.sh   |  16 +++++
 12 files changed, 288 insertions(+), 204 deletions(-)
 create mode 100644 lisp/fact.lisp
 create mode 100644 unit-tests/many-args.sh
 create mode 100644 unit-tests/varargs.sh

diff --git a/lisp/defun.lisp b/lisp/defun.lisp
index 4aaeb6d..83f65c2 100644
--- a/lisp/defun.lisp
+++ b/lisp/defun.lisp
@@ -2,17 +2,18 @@
 ;; to defun as a list of sexprs.
 (set! defun!
       (nlambda
-       (name args body)
-       (cond (symbolp name)
-         (set! name (apply lambda (cons args body))))))
+       form
+       (cond ((symbolp (car form))
+         (set! (car form) (apply lambda (cdr form)))))
+       (t nil)))
 
-(defun! square (x) ((* x x)))
+(defun! square (x) (* x x))
 
 (set! defsp!
       (nlambda
-       (name args body)
-       (cond (symbolp name)
-         (set! name (nlambda args body)))))
+       form
+       (cond (symbolp (car form))
+         (set! (car form) (apply nlambda (cdr form))))))
 
 (defsp! cube (x) ((* x x x)))
 
diff --git a/lisp/fact.lisp b/lisp/fact.lisp
new file mode 100644
index 0000000..b204299
--- /dev/null
+++ b/lisp/fact.lisp
@@ -0,0 +1,4 @@
+(set! fact
+      (lambda (n)
+      (cond ((= n 1) 1)
+        (true (* n (fact (- n 1)))))))
diff --git a/src/init.c b/src/init.c
index a0b8559..b69177d 100644
--- a/src/init.c
+++ b/src/init.c
@@ -46,7 +46,7 @@ int main( int argc, char *argv[] ) {
     bool dump_at_end = false;
     bool show_prompt = false;
 
-    while ( ( option = getopt( argc, argv, "pd" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "pdc" ) ) != -1 ) {
         switch ( option ) {
             case 'c':
                 print_use_colours = true;
@@ -108,6 +108,7 @@ int main( int argc, char *argv[] ) {
     bind_special( "cond", &lisp_cond );
     bind_special( "lambda", &lisp_lambda );
     bind_special( "nlambda", &lisp_nlambda );
+    bind_special( "progn", &lisp_progn );
     bind_special( "quote", &lisp_quote );
     bind_special( "set!", &lisp_set_shriek );
 
diff --git a/src/lispops.c b/src/lispops.c
index 9a62e06..fe71c60 100644
--- a/src/lispops.c
+++ b/src/lispops.c
@@ -92,12 +92,12 @@ struct cons_pointer eval_form( struct stack_frame *parent,
     inc_ref( next->arg[0] );
     result = lisp_eval( next, env );
 
-  if (!exceptionp( result)) {
-    /* if we're returning an exception, we should NOT free the
-     * stack frame. Corollary is, when we free an exception, we
-     * should free all the frames it's holding on to. */
-    free_stack_frame( next );
-  }
+    if ( !exceptionp( result ) ) {
+        /* if we're returning an exception, we should NOT free the
+         * stack frame. Corollary is, when we free an exception, we
+         * should free all the frames it's holding on to. */
+        free_stack_frame( next );
+    }
 
     return result;
 }
@@ -111,8 +111,8 @@ struct cons_pointer eval_forms( struct stack_frame *frame,
                                 struct cons_pointer list,
                                 struct cons_pointer env ) {
     return consp( list ) ?
-      make_cons( eval_form( frame, c_car( list ), env ), eval_forms( frame, c_cdr( list), env)) :
-      NIL;
+        make_cons( eval_form( frame, c_car( list ), env ),
+                   eval_forms( frame, c_cdr( list ), env ) ) : NIL;
 }
 
 
@@ -231,12 +231,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
     inc_ref( fn_frame->arg[0] );
     struct cons_pointer fn_pointer = lisp_eval( fn_frame, env );
 
-  if (!exceptionp( result)) {
-    /* if we're returning an exception, we should NOT free the
-     * stack frame. Corollary is, when we free an exception, we
-     * should free all the frames it's holding on to. */
-    free_stack_frame( fn_frame );
-  }
+    if ( !exceptionp( result ) ) {
+        /* if we're returning an exception, we should NOT free the
+         * stack frame. Corollary is, when we free an exception, we
+         * should free all the frames it's holding on to. */
+        free_stack_frame( fn_frame );
+    }
 
     struct cons_space_object fn_cell = pointer2cell( fn_pointer );
     struct cons_pointer args = c_cdr( frame->arg[0] );
@@ -251,12 +251,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 struct stack_frame *next =
                     make_stack_frame( frame, args, env );
                 result = ( *fn_cell.payload.special.executable ) ( next, env );
-  if (!exceptionp( result)) {
-    /* if we're returning an exception, we should NOT free the
-     * stack frame. Corollary is, when we free an exception, we
-     * should free all the frames it's holding on to. */
-    free_stack_frame( next );
-  }
+                if ( !exceptionp( result ) ) {
+                    /* if we're returning an exception, we should NOT free the
+                     * stack frame. Corollary is, when we free an exception, we
+                     * should free all the frames it's holding on to. */
+                    free_stack_frame( next );
+                }
             }
             break;
         case LAMBDATV:
@@ -266,12 +266,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 fputws( L"Stack frame for lambda\n", stderr );
                 dump_frame( stderr, next );
                 result = eval_lambda( fn_cell, next, env );
-  if (!exceptionp( result)) {
-    /* if we're returning an exception, we should NOT free the
-     * stack frame. Corollary is, when we free an exception, we
-     * should free all the frames it's holding on to. */
-    free_stack_frame( next );
-  }
+                if ( !exceptionp( result ) ) {
+                    /* if we're returning an exception, we should NOT free the
+                     * stack frame. Corollary is, when we free an exception, we
+                     * should free all the frames it's holding on to. */
+                    free_stack_frame( next );
+                }
             }
             break;
         case NLAMBDATV:
@@ -279,12 +279,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 struct stack_frame *next =
                     make_special_frame( frame, args, env );
                 result = ( *fn_cell.payload.special.executable ) ( next, env );
-  if (!exceptionp( result)) {
-    /* if we're returning an exception, we should NOT free the
-     * stack frame. Corollary is, when we free an exception, we
-     * should free all the frames it's holding on to. */
-    free_stack_frame( next );
-  }
+                if ( !exceptionp( result ) ) {
+                    /* if we're returning an exception, we should NOT free the
+                     * stack frame. Corollary is, when we free an exception, we
+                     * should free all the frames it's holding on to. */
+                    free_stack_frame( next );
+                }
             }
             break;
         case SPECIALTV:
@@ -292,12 +292,12 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 struct stack_frame *next =
                     make_special_frame( frame, args, env );
                 result = ( *fn_cell.payload.special.executable ) ( next, env );
-  if (!exceptionp( result)) {
-    /* if we're returning an exception, we should NOT free the
-     * stack frame. Corollary is, when we free an exception, we
-     * should free all the frames it's holding on to. */
-    free_stack_frame( next );
-  }
+                if ( !exceptionp( result ) ) {
+                    /* if we're returning an exception, we should NOT free the
+                     * stack frame. Corollary is, when we free an exception, we
+                     * should free all the frames it's holding on to. */
+                    free_stack_frame( next );
+                }
             }
             break;
         default:
@@ -382,12 +382,16 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
             }
             break;
             /*
+             * TODO:
              * the Clojure practice of having a map serve in the function place of
              * an s-expression is a good one and I should adopt it; also if the
              * object is a consp it could be interpretable source code but in the
              * long run I don't want an interpreter, and if I can get away without
              * so much the better.
              */
+        default:
+            result = frame->arg[0];
+            break;
     }
 
     fputws( L"Eval returning ", stderr );
@@ -616,7 +620,9 @@ lisp_type( struct stack_frame *frame, struct cons_pointer env ) {
 
 
 /**
- * Function; evaluate the forms which are listed in my single argument
+ * (progn forms...)
+ *
+ * Special form; evaluate the forms which are listed in my arguments
  * sequentially and return the value of the last. This function is called 'do'
  * in some dialects of Lisp.
  *
@@ -627,14 +633,17 @@ lisp_type( struct stack_frame *frame, struct cons_pointer env ) {
  */
 struct cons_pointer
 lisp_progn( struct stack_frame *frame, struct cons_pointer env ) {
-    struct cons_pointer remaining = frame->arg[0];
+    struct cons_pointer remaining = frame->more;
     struct cons_pointer result = NIL;
 
-    while ( consp( remaining ) ) {
-        struct cons_space_object cell = pointer2cell( remaining );
-        result = eval_form( frame, cell.payload.cons.car, env );
+    for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
+        result = eval_form( frame, frame->arg[i], env );
+    }
 
-        remaining = cell.payload.cons.cdr;
+    while ( consp( remaining ) ) {
+        result = eval_form( frame, c_car( remaining ), env );
+
+        remaining = c_cdr( remaining );
     }
 
     return result;
@@ -661,12 +670,16 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer env ) {
 
         if ( consp( clause_pointer ) ) {
             struct cons_space_object cell = pointer2cell( clause_pointer );
+          result = eval_form( frame, c_car( clause_pointer ), env);
+
+            if ( !nilp( result ) ) {
+                struct cons_pointer vals = eval_forms( frame, c_cdr( clause_pointer ), env );
+
+              while (consp( vals)) {
+                result = c_car(vals);
+                vals = c_cdr(vals);
+              }
 
-            if ( !nilp( eval_form( frame, cell.payload.cons.car, env ) ) ) {
-                struct stack_frame *next = make_empty_frame( frame, env );
-                next->arg[0] = cell.payload.cons.cdr;
-                inc_ref( next->arg[0] );
-                result = lisp_progn( next, env );
                 done = true;
             }
         } else if ( nilp( clause_pointer ) ) {
diff --git a/src/peano.c b/src/peano.c
index eed1b05..691c95f 100644
--- a/src/peano.c
+++ b/src/peano.c
@@ -25,6 +25,36 @@
 #include "real.h"
 #include "stack.h"
 
+/**
+ * Internal guts of add. Dark and mysterious.
+ */
+struct cons_pointer add_accumulate( struct cons_pointer arg,
+                                    struct stack_frame *frame,
+                                    long int *i_accumulator,
+                                    long double *d_accumulator, int *is_int ) {
+    struct cons_pointer result = NIL;
+    struct cons_space_object cell = pointer2cell( arg );
+
+    switch ( cell.tag.value ) {
+        case INTEGERTV:
+            ( *i_accumulator ) += cell.payload.integer.value;
+            ( *d_accumulator ) += numeric_value( arg );
+            break;
+        case REALTV:
+            ( *d_accumulator ) += cell.payload.real.value;
+            ( *is_int ) &= false;
+            break;
+        case EXCEPTIONTV:
+            result = arg;
+            break;
+        default:
+            result = lisp_throw( c_string_to_lisp_string
+                                 ( "Cannot multiply: not a number" ), frame );
+    }
+    return result;
+}
+
+
 /**
  * Add an indefinite number of numbers together
  * @param env the evaluation environment - ignored;
@@ -36,46 +66,21 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
     long int i_accumulator = 0;
     long double d_accumulator = 0;
-    bool is_int = true;
+    int is_int = true;
 
     for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
-        struct cons_space_object current = pointer2cell( frame->arg[i] );
-
-        switch ( current.tag.value ) {
-            case INTEGERTV:
-                i_accumulator += current.payload.integer.value;
-                d_accumulator += numeric_value( frame->arg[i] );
-                break;
-            case REALTV:
-                d_accumulator += current.payload.real.value;
-                is_int = false;
-                break;
-            default:
-                lisp_throw( c_string_to_lisp_string
-                            ( "Cannot add: not a number" ), frame );
-        }
+        result =
+            add_accumulate( frame->arg[i], frame, &i_accumulator,
+                            &d_accumulator, &is_int );
     }
 
     struct cons_pointer more = frame->more;
 
     while ( consp( more ) ) {
-        struct cons_pointer pointer = c_car( more );
-        more = c_cdr( more);
-        struct cons_space_object current = pointer2cell( pointer );
-
-        switch ( current.tag.value ) {
-            case INTEGERTV:
-                i_accumulator += current.payload.integer.value;
-                d_accumulator += numeric_value( pointer );
-                break;
-            case REALTV:
-                d_accumulator += current.payload.real.value;
-                is_int = false;
-                break;
-            default:
-                lisp_throw( c_string_to_lisp_string
-                            ( "Cannot add: not a number" ), frame );
-        }
+        result =
+            add_accumulate( c_car( more ), frame, &i_accumulator,
+                            &d_accumulator, &is_int );
+        more = c_cdr( more );
     }
 
     if ( is_int ) {
@@ -87,6 +92,36 @@ lisp_add( struct stack_frame *frame, struct cons_pointer env ) {
     return result;
 }
 
+/**
+ * Internal guts of multiply. Dark and mysterious.
+ */
+struct cons_pointer multiply_accumulate( struct cons_pointer arg,
+                                         struct stack_frame *frame,
+                                         long int *i_accumulator,
+                                         long double *d_accumulator,
+                                         int *is_int ) {
+    struct cons_pointer result = NIL;
+    struct cons_space_object cell = pointer2cell( arg );
+
+    switch ( cell.tag.value ) {
+        case INTEGERTV:
+            ( *i_accumulator ) *= cell.payload.integer.value;
+            ( *d_accumulator ) *= numeric_value( arg );
+            break;
+        case REALTV:
+            ( *d_accumulator ) *= cell.payload.real.value;
+            ( *is_int ) &= false;
+            break;
+        case EXCEPTIONTV:
+            result = arg;
+            break;
+        default:
+            result = lisp_throw( c_string_to_lisp_string
+                                 ( "Cannot multiply: not a number" ), frame );
+    }
+    return result;
+}
+
 /**
  * Multiply an indefinite number of numbers together
  * @param env the evaluation environment - ignored;
@@ -98,53 +133,32 @@ lisp_multiply( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
     long int i_accumulator = 1;
     long double d_accumulator = 1;
-    bool is_int = true;
+    int is_int = true;
 
-    for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
-        struct cons_space_object arg = pointer2cell( frame->arg[i] );
-
-        switch ( arg.tag.value ) {
-            case INTEGERTV:
-                i_accumulator *= arg.payload.integer.value;
-                d_accumulator *= numeric_value( frame->arg[i] );
-                break;
-            case REALTV:
-                d_accumulator *= arg.payload.real.value;
-                is_int = false;
-                break;
-            default:
-                lisp_throw( c_string_to_lisp_string
-                            ( "Cannot multiply: not a number" ), frame );
-        }
+    for ( int i = 0;
+          i < args_in_frame && !nilp( frame->arg[i] ) && !exceptionp( result );
+          i++ ) {
+        result =
+            multiply_accumulate( frame->arg[i], frame, &i_accumulator,
+                                 &d_accumulator, &is_int );
     }
 
     struct cons_pointer more = frame->more;
 
-    while ( consp( more ) ) {
-        struct cons_pointer pointer = c_car( more );
-        more = c_cdr( more);
-        struct cons_space_object current = pointer2cell( pointer );
-
-        switch ( current.tag.value ) {
-            case INTEGERTV:
-                i_accumulator *= current.payload.integer.value;
-                d_accumulator *= numeric_value( pointer );
-                break;
-            case REALTV:
-                d_accumulator *= current.payload.real.value;
-                is_int = false;
-                break;
-            default:
-                lisp_throw( c_string_to_lisp_string
-                            ( "Cannot add: not a number" ), frame );
-        }
+    while ( consp( more ) && !exceptionp( result ) ) {
+        result =
+            multiply_accumulate( c_car( more ), frame, &i_accumulator,
+                                 &d_accumulator, &is_int );
+        more = c_cdr( more );
     }
 
+    if ( !exceptionp( result ) ) {
         if ( is_int ) {
             result = make_integer( i_accumulator );
         } else {
             result = make_real( d_accumulator );
         }
+    }
 
     return result;
 }
diff --git a/src/print.c b/src/print.c
index b6973b1..e3002f8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -120,6 +120,9 @@ void print( FILE * output, struct cons_pointer pointer ) {
                       print_use_colours ? "\x1B[31m" : "" );
             print_string_contents( output, cell.payload.exception.message );
             break;
+        case FUNCTIONTV:
+            fwprintf( output, L"(Function)" );
+            break;
         case INTEGERTV:
             if ( print_use_colours ) {
                 fputws( L"\x1B[34m", output );
@@ -141,6 +144,9 @@ void print( FILE * output, struct cons_pointer pointer ) {
                                                  cell.payload.lambda.
                                                  body ) ) );
             break;
+        case READTV:
+            fwprintf( output, L"(Input stream)" );
+            break;
         case REALTV:
             /* TODO: using the C heap is a bad plan because it will fragment.
              * As soon as I have working vector space I'll use a special purpose
@@ -171,15 +177,12 @@ void print( FILE * output, struct cons_pointer pointer ) {
                 fputws( L"\x1B[1;33m", output );
             print_string_contents( output, pointer );
             break;
-        case TRUETV:
-            fwprintf( output, L"t" );
-            break;
-        case FUNCTIONTV:
-            fwprintf( output, L"(Function)" );
-            break;
         case SPECIALTV:
             fwprintf( output, L"(Special form)" );
             break;
+        case TRUETV:
+            fwprintf( output, L"t" );
+            break;
         default:
             fwprintf( stderr,
                       L"%sError: Unrecognised tag value %d (%c%c%c%c)%s\n",
diff --git a/src/read.c b/src/read.c
index 5d8b78b..3bee19f 100644
--- a/src/read.c
+++ b/src/read.c
@@ -59,47 +59,59 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input,
     for ( c = initial;
           c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) );
 
-    switch ( c ) {
-        case ';':
-            for ( c = fgetwc( input ); c != '\n'; c = fgetwc( input ) );
-            /* skip all characters from semi-colon to the end of the line */
-            break;
-        case EOF:
-            result = lisp_throw( c_string_to_lisp_string
-                                 ( "End of input while reading" ), frame );
-            break;
-        case '\'':
-            result =
-                c_quote( read_continuation( frame, input, fgetwc( input ) ) );
-            break;
-        case '(':
-            result = read_list( frame, input, fgetwc( input ) );
-            break;
-        case '"':
-            result = read_string( input, fgetwc( input ) );
-            break;
-        default:
-            if ( c == '.' ) {
-                wint_t next = fgetwc( input );
-                if ( iswdigit( next ) ) {
-                    ungetwc( next, input );
-                    result = read_number( input, c );
-                } else if ( iswblank( next ) ) {
-                    /* dotted pair. TODO: this isn't right, we
-                     * really need to backtrack up a level. */
-                    result =
-                        read_continuation( frame, input, fgetwc( input ) );
-                } else {
-                    read_symbol( input, c );
+    if ( feof( input ) ) {
+        result =
+            make_exception( c_string_to_lisp_string
+                            ( "End of file while reading" ), frame );
+    } else {
+        switch ( c ) {
+            case ';':
+                for ( c = fgetwc( input ); c != '\n'; c = fgetwc( input ) );
+                /* skip all characters from semi-colon to the end of the line */
+                break;
+            case EOF:
+                result = lisp_throw( c_string_to_lisp_string
+                                     ( "End of input while reading" ), frame );
+                break;
+            case '\'':
+                result =
+                    c_quote( read_continuation
+                             ( frame, input, fgetwc( input ) ) );
+                break;
+            case '(':
+                result = read_list( frame, input, fgetwc( input ) );
+                break;
+            case '"':
+                result = read_string( input, fgetwc( input ) );
+                break;
+            case '.':
+                {
+                    wint_t next = fgetwc( input );
+                    if ( iswdigit( next ) ) {
+                        ungetwc( next, input );
+                        result = read_number( input, c );
+                    } else if ( iswblank( next ) ) {
+                        /* dotted pair. TODO: this isn't right, we
+                         * really need to backtrack up a level. */
+                        result =
+                            read_continuation( frame, input, fgetwc( input ) );
+                    } else {
+                        read_symbol( input, c );
+                    }
                 }
-            } else if ( iswdigit( c ) ) {
-                result = read_number( input, c );
-            } else if ( iswprint( c ) ) {
-                result = read_symbol( input, c );
-            } else {
-                fwprintf( stderr,
-                          L"Unrecognised start of input character %c\n", c );
-            }
+                break;
+            default:
+                if ( iswdigit( c ) ) {
+                    result = read_number( input, c );
+                } else if ( iswprint( c ) ) {
+                    result = read_symbol( input, c );
+                } else {
+                    result =
+                        make_exception( c_string_to_lisp_string
+                                        ( "Unrecognised start of input character" ),
+                                        frame );
+                }
+        }
     }
 
     return result;
@@ -114,19 +126,16 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
     int places_of_decimals = 0;
     bool seen_period = false;
     wint_t c;
-
     fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
-
-    for ( c = initial; iswdigit( c ) || c == btowc( '.' );
-          c = fgetwc( input ) ) {
+    for ( c = initial; iswdigit( c )
+          || c == btowc( '.' ); c = fgetwc( input ) ) {
         if ( c == btowc( '.' ) ) {
             seen_period = true;
         } else {
             accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );
-
-            fwprintf( stderr, L"Added character %c, accumulator now %ld\n", c,
-                      accumulator );
-
+            fwprintf( stderr,
+                      L"Added character %c, accumulator now %ld\n",
+                      c, accumulator );
             if ( seen_period ) {
                 places_of_decimals++;
             }
@@ -137,11 +146,9 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
      * push back the character read which was not a digit
      */
     ungetwc( c, input );
-
     if ( seen_period ) {
         long double rv = ( long double )
             ( accumulator / pow( 10, places_of_decimals ) );
-
         fwprintf( stderr, L"read_numer returning %Lf\n", rv );
         result = make_real( rv );
     } else {
@@ -155,14 +162,15 @@ struct cons_pointer read_number( FILE * input, wint_t initial ) {
  * Read a list from this input stream, which no longer contains the opening
  * left parenthesis.
  */
-struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
-                               wint_t initial ) {
+struct cons_pointer read_list( struct
+                               stack_frame
+                               *frame, FILE * input, wint_t initial ) {
     struct cons_pointer result = NIL;
-
     if ( initial != ')' ) {
-        fwprintf( stderr, L"read_list starting '%C' (%d)\n", initial,
-                  initial );
-        struct cons_pointer car = read_continuation( frame, input, initial );
+        fwprintf( stderr,
+                  L"read_list starting '%C' (%d)\n", initial, initial );
+        struct cons_pointer car = read_continuation( frame, input,
+                                                     initial );
         result = make_cons( car, read_list( frame, input, fgetwc( input ) ) );
     } else {
         fwprintf( stderr, L"End of list detected\n" );
@@ -181,7 +189,6 @@ struct cons_pointer read_list( struct stack_frame *frame, FILE * input,
 struct cons_pointer read_string( FILE * input, wint_t initial ) {
     struct cons_pointer cdr = NIL;
     struct cons_pointer result;
-
     switch ( initial ) {
         case '\0':
             result = make_string( initial, NIL );
@@ -201,7 +208,6 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) {
 struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
     struct cons_pointer cdr = NIL;
     struct cons_pointer result;
-
     switch ( initial ) {
         case '\0':
             result = make_symbol( initial, NIL );
@@ -224,7 +230,8 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
             ungetwc( initial, input );
             break;
         default:
-            if ( iswprint( initial ) && !iswblank( initial ) ) {
+            if ( iswprint( initial )
+                 && !iswblank( initial ) ) {
                 result =
                     make_symbol( initial,
                                  read_symbol( input, fgetwc( input ) ) );
@@ -241,13 +248,14 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
     fputws( L"Read symbol '", stderr );
     print( stderr, result );
     fputws( L"'\n", stderr );
-
     return result;
 }
 
 /**
  * Read the next object on this input stream and return a cons_pointer to it.
  */
-struct cons_pointer read( struct stack_frame *frame, FILE * input ) {
+struct cons_pointer read( struct
+                          stack_frame
+                          *frame, FILE * input ) {
     return read_continuation( frame, input, fgetwc( input ) );
 }
diff --git a/src/repl.c b/src/repl.c
index a11e511..596cb61 100644
--- a/src/repl.c
+++ b/src/repl.c
@@ -48,7 +48,10 @@ struct cons_pointer repl_eval( struct cons_pointer input ) {
 
     frame->arg[0] = input;
     struct cons_pointer result = lisp_eval( frame, oblist );
-    free_stack_frame( frame );
+
+    if ( !exceptionp( result ) ) {
+        free_stack_frame( frame );
+    }
 
     return result;
 }
@@ -86,12 +89,20 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream,
             fwprintf( out_stream, L"\n:: " );
         }
 
-        struct cons_pointer val = repl_eval( repl_read( input_stream ) );
+        struct cons_pointer input = repl_read( input_stream );
 
-        /* suppress the 'end of stream' exception */
-        if ( !exceptionp( val ) &&
-             !feof( pointer2cell( input_stream ).payload.stream.stream ) ) {
-            repl_print( output_stream, val );
+        if ( exceptionp( input ) ) {
+            break;
+        } else {
+
+            struct cons_pointer val = repl_eval( input );
+
+            /* suppress the 'end of stream' exception */
+            if ( !exceptionp( val ) &&
+                 !feof( pointer2cell( input_stream ).payload.stream.
+                        stream ) ) {
+                repl_print( output_stream, val );
+            }
         }
     }
 }
diff --git a/src/stack.c b/src/stack.c
index 74df15f..ea1f911 100644
--- a/src/stack.c
+++ b/src/stack.c
@@ -105,7 +105,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
         inc_ref( more );
     }
 
-  dump_frame( stderr, result );
+    dump_frame( stderr, result );
     return result;
 }
 
@@ -176,9 +176,9 @@ void dump_frame( FILE * output, struct stack_frame *frame ) {
         print( output, frame->arg[arg] );
         fputws( L"\n", output );
     }
-    fputws( L"More: \t", output);
-    print( output, frame->more);
-        fputws( L"\n", output );
+    fputws( L"More: \t", output );
+    print( output, frame->more );
+    fputws( L"\n", output );
 }
 
 
diff --git a/unit-tests/many-args.sh b/unit-tests/many-args.sh
new file mode 100644
index 0000000..2db2318
--- /dev/null
+++ b/unit-tests/many-args.sh
@@ -0,0 +1,13 @@
+#!/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`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi
diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh
index 94c7f40..017646b 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 2> /dev/null | head -2 | 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 2> /dev/null | head -2 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
diff --git a/unit-tests/varargs.sh b/unit-tests/varargs.sh
new file mode 100644
index 0000000..6c31163
--- /dev/null
+++ b/unit-tests/varargs.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+
+expected='(lambda l l)(1 2 3 4 5 6 7 8 9 10)'
+actual=`target/psse 2>/dev/null <<EOF
+(set! list (lambda l l))
+(list 1 2 3 4 5 6 7 8 9 10)
+EOF`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi