From 5a84f5e305edf358bf82f8b1920b489604b3358b Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 21 Dec 2018 21:35:57 +0000 Subject: [PATCH] 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 | 2 +- src/lispops.c | 22 +++++++++++++--------- src/stack.c | 5 +++-- src/stack.h | 15 ++++++++------- unit-tests/eval-real.sh | 7 ++++++- unit-tests/recursion.sh | 21 +++++++++++++++++++++ 6 files changed, 52 insertions(+), 20 deletions(-) create mode 100644 unit-tests/recursion.sh diff --git a/lisp/fact.lisp b/lisp/fact.lisp index b204299..2f578a6 100644 --- a/lisp/fact.lisp +++ b/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))))))) diff --git a/src/lispops.c b/src/lispops.c index 46ebed3..62338b1 100644 --- a/src/lispops.c +++ b/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( - c_string_to_lisp_string - ( "Attempt to take value of unbound symbol." ), - frame->arg[0]); + make_cons( c_string_to_lisp_string + ( "Attempt to take value of unbound symbol." ), + frame->arg[0] ); result = lisp_throw( message, frame ); } else { result = c_assoc( canonical, env ); diff --git a/src/stack.c b/src/stack.c index cf75df8..3554f22 100644 --- a/src/stack.c +++ b/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; diff --git a/src/stack.h b/src/stack.h index 3a7f0ad..ebb1aa1 100644 --- a/src/stack.h +++ b/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. - * But such a stack would be costly to search. The design sketched here, - * with stack frames as special objects, SHOULD be substantially more + * 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, + * 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 diff --git a/unit-tests/eval-real.sh b/unit-tests/eval-real.sh index 39de72f..8832719 100644 --- a/unit-tests/eval-real.sh +++ b/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 + + diff --git a/unit-tests/recursion.sh b/unit-tests/recursion.sh new file mode 100644 index 0000000..a49154b --- /dev/null +++ b/unit-tests/recursion.sh @@ -0,0 +1,21 @@ +#!/bin/bash + +expected='nil3628800' +actual=`target/psse 2>/dev/null <