And now the interpreter works (I think) correctly!
This commit is contained in:
parent
676b231743
commit
434c17eb0e
|
@ -73,9 +73,11 @@ void make_cons_page( ) {
|
|||
strncpy( &cell->tag.bytes[0], TRUETAG, TAGLENGTH );
|
||||
cell->count = MAXREFERENCE;
|
||||
cell->payload.free.car = ( struct cons_pointer ) {
|
||||
0, 1};
|
||||
0, 1
|
||||
};
|
||||
cell->payload.free.cdr = ( struct cons_pointer ) {
|
||||
0, 1};
|
||||
0, 1
|
||||
};
|
||||
fwprintf( stderr, L"Allocated special cell T\n" );
|
||||
break;
|
||||
}
|
||||
|
@ -110,7 +112,8 @@ void dump_pages( FILE * output ) {
|
|||
|
||||
for ( int j = 0; j < CONSPAGESIZE; j++ ) {
|
||||
dump_object( output, ( struct cons_pointer ) {
|
||||
i, j} );
|
||||
i, j
|
||||
} );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
@ -63,7 +63,7 @@ void dec_ref( struct cons_pointer pointer ) {
|
|||
}
|
||||
}
|
||||
|
||||
void dump_string_cell( FILE * output, wchar_t * prefix,
|
||||
void dump_string_cell( FILE * output, wchar_t *prefix,
|
||||
struct cons_pointer pointer ) {
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
if ( cell.payload.string.character == 0 ) {
|
||||
|
|
|
@ -78,8 +78,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.string.
|
||||
cdr ) ) );
|
||||
&& end_of_string( cell_b->payload.
|
||||
string.cdr ) ) );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
case REALTV:
|
||||
|
|
|
@ -128,11 +128,10 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
|
|||
struct cons_pointer new_env = env;
|
||||
struct cons_pointer args = cell.payload.lambda.args;
|
||||
struct cons_pointer body = cell.payload.lambda.body;
|
||||
struct cons_pointer vals = frame->arg[0];
|
||||
|
||||
while ( consp( args ) && consp( vals ) ) {
|
||||
for ( int i = 0; i < args_in_frame && consp( args ); i++ ) {
|
||||
struct cons_pointer arg = c_car( args );
|
||||
struct cons_pointer val = c_car( vals );
|
||||
struct cons_pointer val = frame->arg[i];
|
||||
print( stderr, c_string_to_lisp_string( "\n\tBinding " ) );
|
||||
print( stderr, arg );
|
||||
print( stderr, c_string_to_lisp_string( " to " ) );
|
||||
|
@ -141,8 +140,6 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
|
|||
|
||||
new_env = make_cons( make_cons( arg, val ), new_env );
|
||||
args = c_cdr( args );
|
||||
vals = c_cdr( vals );
|
||||
|
||||
}
|
||||
|
||||
while ( !nilp( body ) ) {
|
||||
|
@ -194,6 +191,8 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
|
|||
{
|
||||
struct stack_frame *next =
|
||||
make_stack_frame( frame, args, env );
|
||||
fputws( L"Stack frame for lambda\n", stderr );
|
||||
dump_frame( stderr, next );
|
||||
result = eval_lambda( fn_cell, next, env );
|
||||
free_stack_frame( next );
|
||||
}
|
||||
|
|
12
unit-tests/intepreter.sh
Normal file
12
unit-tests/intepreter.sh
Normal file
|
@ -0,0 +1,12 @@
|
|||
#!/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`
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
else
|
||||
echo "Fail: expected '${expected}', got '${actual}'"
|
||||
exit 1
|
||||
fi
|
Loading…
Reference in a new issue