simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Fixed the eval-real test

Browse source 
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
This commit is contained in:
Simon Brooke 2018-12-21 21:35:57 +00:00
parent 7cd2cbf785
commit 5a84f5e305
6 changed files with 52 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/fact.lisp
View file

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

22
src/lispops.c
View file

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

5
src/stack.c
View file

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

3
src/stack.h
View file

@ -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 );
/**

7
unit-tests/eval-real.sh
View file

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

21
unit-tests/recursion.sh Normal file
View file

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