Fixed the eval-real test

So that it passes provided the answer is right to within one part in a million. Also worked on a solution to returning exceptions from make_stack_frame

lisp/fact.lisp

@@ -1,4 +1,4 @@
 (set! fact
       (lambda (n)
       (cond ((= n 1) 1)
-        (true (* n (fact (- n 1)))))))
+        (t (* n (fact (- n 1)))))))

src/lispops.c

@@ -241,7 +241,6 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 struct cons_pointer
 c_apply( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-
     struct stack_frame *fn_frame = make_empty_frame( frame, env );
     fn_frame->arg[0] = c_car( frame->arg[0] );
     inc_ref( fn_frame->arg[0] );
@@ -264,28 +263,34 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
             break;
         case FUNCTIONTV:
             {
+                struct cons_pointer exep = NIL;
                 struct stack_frame *next =
-                    make_stack_frame( frame, args, env );
+                    make_stack_frame( frame, args, env, &exep );
                 result = ( *fn_cell.payload.special.executable ) ( next, env );
-                if ( !exceptionp( result ) ) {
+                if ( exceptionp( exep ) ) {
                     /* 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. */
+                    result = exep;
+                } else {
                     free_stack_frame( next );
                 }
             }
             break;
         case LAMBDATV:
             {
+                struct cons_pointer exep = NIL;
                 struct stack_frame *next =
-                    make_stack_frame( frame, args, env );
+                    make_stack_frame( frame, args, env, &exep );
                 fputws( L"Stack frame for lambda\n", stderr );
                 dump_frame( stderr, next );
                 result = eval_lambda( fn_cell, next, env );
-                if ( !exceptionp( result ) ) {
+                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. */
+                    result = exep;
+                } else {
                     free_stack_frame( next );
                 }
             }
@@ -390,10 +395,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
                     internedp( frame->arg[0], env );
                 if ( nilp( canonical ) ) {
                     struct cons_pointer message =
-                      c_cons(
+                        make_cons( c_string_to_lisp_string
-                        c_string_to_lisp_string
+                                   ( "Attempt to take value of unbound symbol." ),
-                        ( "Attempt to take value of unbound symbol." ),
+                                   frame->arg[0] );
-                      frame->arg[0]);
                     result = lisp_throw( message, frame );
                 } else {
                     result = c_assoc( canonical, env );

src/stack.c

@@ -66,7 +66,8 @@ struct stack_frame *make_empty_frame( struct stack_frame *previous,
  */
 struct stack_frame *make_stack_frame( struct stack_frame *previous,
                                       struct cons_pointer args,
-                                      struct cons_pointer env ) {
+                                      struct cons_pointer env,
+                                      struct cons_pointer *exception ) {
     struct stack_frame *result = make_empty_frame( previous, env );
 
     for ( int i = 0; i < args_in_frame && consp( args ); i++ ) {
@@ -87,7 +88,7 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
 
         struct cons_pointer val = lisp_eval( arg_frame, env );
         if ( exceptionp( val ) ) {
-            result->arg[0] = val;
+            exception = &val;
             break;
         } else {
             result->arg[i] = val;

src/stack.h

@@ -4,13 +4,13 @@
  * The Lisp evaluation stack.
  *
  * Stack frames could be implemented in cons space; indeed, the stack
- * could simply be an assoc list consed onto the front of the environment. 
+ * could simply be an assoc list consed onto the front of the environment.
- * But such a stack would be costly to search. The design sketched here, 
+ * But such a stack would be costly to search. The design sketched here,
- * with stack frames as special objects, SHOULD be substantially more 
+ * with stack frames as special objects, SHOULD be substantially more
  * efficient, but does imply we need to generalise the idea of cons pages
  * with freelists to a more general 'equal sized object pages', so that
  * allocating/freeing stack frames can be more efficient.
- * 
+ *
  * Stack frames are not yet a first class object; they have no VECP pointer
  * in cons space.
  *
@@ -35,7 +35,8 @@ struct stack_frame *make_empty_frame( struct stack_frame *previous,
 
 struct stack_frame *make_stack_frame( struct stack_frame *previous,
                                       struct cons_pointer args,
-                                      struct cons_pointer env );
+                                      struct cons_pointer env,
+                                      struct cons_pointer *exception );
 void free_stack_frame( struct stack_frame *frame );
 
 /**
@@ -48,7 +49,7 @@ void dump_frame( FILE * output, struct stack_frame *frame );
 struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n );
 
 /**
- * A 'special' frame is exactly like a normal stack frame except that the 
+ * A 'special' frame is exactly like a normal stack frame except that the
  * arguments are unevaluated.
  * @param previous the previous stack frame;
  * @param args a list of the arguments to be stored in this stack frame;
@@ -61,7 +62,7 @@ struct stack_frame *make_special_frame( struct stack_frame *previous,
 
 /*
  * struct stack_frame is defined in consspaceobject.h to break circularity
- * TODO: refactor. 
+ * TODO: refactor.
  */
 
 #endif

unit-tests/eval-real.sh

@@ -8,10 +8,15 @@ actual=`echo "(eval 5.05)" |\
   head -2 |\
   tail -1`
 
-if [ "${expected}" = "${actual}" ]
+outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
+
+
+if [ "${outcome}" = "1" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
     exit 1
 fi
+
+

unit-tests/recursion.sh

@@ -0,0 +1,21 @@
+#!/bin/bash
+
+expected='nil3628800'
+actual=`target/psse 2>/dev/null <<EOF
+(progn
+  (set! fact
+    (lambda (n)
+    (cond ((= n 1) 1)
+      (t (* n (fact (- n 1)))))))
+  nil)
+(fact 10)
+EOF`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi