Interpreter working!
This commit is contained in:
parent
7189c0172c
commit
676b231743
7 changed files with 108 additions and 91 deletions
|
|
@ -54,7 +54,7 @@ void make_cons_page( ) {
|
|||
for ( int i = 0; i < CONSPAGESIZE; i++ ) {
|
||||
struct cons_space_object *cell =
|
||||
&conspages[initialised_cons_pages]->cell[i];
|
||||
if ( initialised_cons_pages == 0 && i < 3 ) {
|
||||
if ( initialised_cons_pages == 0 && i < 2 ) {
|
||||
switch ( i ) {
|
||||
case 0:
|
||||
/*
|
||||
|
|
@ -78,16 +78,6 @@ void make_cons_page( ) {
|
|||
0, 1};
|
||||
fwprintf( stderr, L"Allocated special cell T\n" );
|
||||
break;
|
||||
case 2:
|
||||
/*
|
||||
* initialise cell as λ
|
||||
*/
|
||||
strncpy( &cell->tag.bytes[0], LAMBDATAG, TAGLENGTH );
|
||||
cell->count = MAXREFERENCE;
|
||||
cell->payload.string.character = ( wint_t ) L'λ';
|
||||
cell->payload.free.cdr = NIL;
|
||||
fwprintf( stderr, L"Allocated special cell LAMBDA\n" );
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -128,6 +128,12 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
|
|||
L"\t\tInteger cell: value %ld, count %u\n",
|
||||
cell.payload.integer.value, cell.count );
|
||||
break;
|
||||
case LAMBDATV:
|
||||
fwprintf( output, L"Lambda cell; args: " );
|
||||
print( output, cell.payload.lambda.args );
|
||||
fwprintf( output, L";\n\t\t\tbody: " );
|
||||
print( output, cell.payload.lambda.args );
|
||||
break;
|
||||
case READTV:
|
||||
fwprintf( output, L"\t\tInput stream\n" );
|
||||
case REALTV:
|
||||
|
|
@ -152,8 +158,7 @@ struct cons_pointer make_cons( struct cons_pointer car,
|
|||
|
||||
pointer = allocate_cell( CONSTAG );
|
||||
|
||||
struct cons_space_object *cell =
|
||||
&conspages[pointer.page]->cell[pointer.offset];
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
inc_ref( car );
|
||||
inc_ref( cdr );
|
||||
|
|
@ -195,6 +200,21 @@ make_function( struct cons_pointer src, struct cons_pointer ( *executable )
|
|||
return pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a lambda (interpretable source) cell
|
||||
*/
|
||||
struct cons_pointer make_lambda( struct cons_pointer args,
|
||||
struct cons_pointer body ) {
|
||||
struct cons_pointer pointer = allocate_cell( LAMBDATAG );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
inc_ref( args );
|
||||
inc_ref( body );
|
||||
cell->payload.lambda.args = args;
|
||||
cell->payload.lambda.body = body;
|
||||
|
||||
return pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a string from this character (which later will be UTF) and
|
||||
* this tail. A string is implemented as a flat list of cells each of which
|
||||
|
|
|
|||
|
|
@ -61,8 +61,7 @@
|
|||
#define INTEGERTV 1381256777
|
||||
|
||||
/**
|
||||
* Lambda is very special, and, like NIL and TRUE, we need to identify it
|
||||
* quickly and cheaply. So we will give it, too, a special cons cell at {0,2}
|
||||
* A lambda cell.
|
||||
*/
|
||||
#define LAMBDATAG "LMDA"
|
||||
#define LAMBDATV 1094995276
|
||||
|
|
@ -134,11 +133,6 @@
|
|||
*/
|
||||
#define TRUE (struct cons_pointer){ 0, 1}
|
||||
|
||||
/**
|
||||
* a cons pointer which points to the special λ cell
|
||||
*/
|
||||
#define LAMBDA (struct cons_pointer){ 0,2}
|
||||
|
||||
/**
|
||||
* the maximum possible value of a reference count
|
||||
*/
|
||||
|
|
@ -173,7 +167,7 @@
|
|||
#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG))
|
||||
|
||||
/**
|
||||
* true if conspointer points to the special Lambda cell, else false
|
||||
* true if conspointer points to a special Lambda cell, else false
|
||||
*/
|
||||
#define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG))
|
||||
|
||||
|
|
@ -309,11 +303,15 @@ struct integer_payload {
|
|||
long int value;
|
||||
};
|
||||
|
||||
struct lambda_payload {
|
||||
struct cons_pointer args;
|
||||
struct cons_pointer body;
|
||||
};
|
||||
|
||||
/**
|
||||
* payload for a real number cell. Internals of this liable to change to give 128 bits
|
||||
* precision, but I'm not sure of the detail.
|
||||
*/
|
||||
struct real_payload {
|
||||
*/ struct real_payload {
|
||||
long double value;
|
||||
};
|
||||
|
||||
|
|
@ -403,6 +401,10 @@ struct cons_space_object {
|
|||
* if tag == INTEGERTAG
|
||||
*/
|
||||
struct integer_payload integer;
|
||||
/*
|
||||
* if tag == LAMBDATAG
|
||||
*/
|
||||
struct lambda_payload lambda;
|
||||
/*
|
||||
* if tag == NILTAG; we'll treat the special cell NIL as just a cons
|
||||
*/
|
||||
|
|
@ -472,6 +474,12 @@ struct cons_pointer make_function( struct cons_pointer src,
|
|||
( struct stack_frame *,
|
||||
struct cons_pointer ) );
|
||||
|
||||
/**
|
||||
* Construct a lambda (interpretable source) cell
|
||||
*/
|
||||
struct cons_pointer make_lambda( struct cons_pointer args,
|
||||
struct cons_pointer body );
|
||||
|
||||
/**
|
||||
* Construct a cell which points to an executable Lisp special form.
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -74,8 +74,6 @@ int main( int argc, char *argv[] ) {
|
|||
*/
|
||||
deep_bind( c_string_to_lisp_symbol( "nil" ), NIL );
|
||||
deep_bind( c_string_to_lisp_symbol( "t" ), TRUE );
|
||||
/* lambda is even more privileged than a special form */
|
||||
deep_bind( c_string_to_lisp_symbol( "lambda" ), LAMBDA );
|
||||
|
||||
/*
|
||||
* primitive function operations
|
||||
|
|
@ -106,6 +104,7 @@ int main( int argc, char *argv[] ) {
|
|||
* primitive special forms
|
||||
*/
|
||||
bind_special( "cond", &lisp_cond );
|
||||
bind_special( "lambda", &lisp_lambda );
|
||||
bind_special( "quote", &lisp_quote );
|
||||
|
||||
|
||||
|
|
|
|||
100
src/lispops.c
100
src/lispops.c
|
|
@ -100,58 +100,58 @@ struct cons_pointer eval_form( struct stack_frame *parent,
|
|||
* The Lisp interpreter.
|
||||
*
|
||||
* @param frame the stack frame in which the expression is to be interpreted;
|
||||
* @param lexpr the lambda expression to be interpreted;
|
||||
* @param env the environment in which it is to be intepreted.
|
||||
*/
|
||||
struct cons_pointer
|
||||
lisp_lambda( struct stack_frame *frame, struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer lexpr = frame->arg[0];
|
||||
struct cons_pointer should_be_lambda =
|
||||
eval_form( frame, c_car( lexpr ), env );
|
||||
|
||||
dump_frame( stderr, frame );
|
||||
struct cons_pointer body =
|
||||
!nilp( frame->arg[args_in_frame - 1] ) ? frame->more : NIL;
|
||||
|
||||
for ( int i = args_in_frame - 1; i >= 0; i-- ) {
|
||||
if ( !nilp( frame->arg[i] ) ) {
|
||||
body = make_cons( frame->arg[i], body );
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
return make_lambda( frame->arg[0], body );
|
||||
}
|
||||
|
||||
|
||||
struct cons_pointer
|
||||
eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
|
||||
struct cons_pointer env ) {
|
||||
struct cons_pointer result = NIL;
|
||||
fwprintf( stderr, L"eval_lambda called" );
|
||||
|
||||
if ( lambdap( should_be_lambda ) ) {
|
||||
struct cons_pointer new_env = env;
|
||||
struct cons_pointer args = c_car( c_cdr( lexpr ) );
|
||||
struct cons_pointer body = c_cdr( c_cdr( lexpr ) );
|
||||
struct cons_pointer args = cell.payload.lambda.args;
|
||||
struct cons_pointer body = cell.payload.lambda.body;
|
||||
struct cons_pointer vals = frame->arg[0];
|
||||
|
||||
for ( int i = 1; i < args_in_frame && consp( args ); i++ ) {
|
||||
args = c_cdr( args );
|
||||
while ( consp( args ) && consp( vals ) ) {
|
||||
struct cons_pointer arg = c_car( args );
|
||||
struct cons_pointer val = c_car( vals );
|
||||
print( stderr, c_string_to_lisp_string( "\n\tBinding " ) );
|
||||
print( stderr, arg );
|
||||
print( stderr, c_string_to_lisp_string( " to " ) );
|
||||
print( stderr, frame->arg[i] );
|
||||
print( stderr, val );
|
||||
fputws( L"\"\n", stderr );
|
||||
|
||||
new_env = make_cons( make_cons( arg, val ), new_env );
|
||||
args = c_cdr( args );
|
||||
vals = c_cdr( vals );
|
||||
|
||||
new_env = make_cons( make_cons( arg, frame->arg[i] ), new_env );
|
||||
}
|
||||
|
||||
while ( !nilp( body ) ) {
|
||||
struct cons_pointer sexpr = c_car( body );
|
||||
body = c_cdr( body );
|
||||
|
||||
fputws( L"In lambda: ", stderr );
|
||||
result = eval_form( frame, sexpr, new_env );
|
||||
}
|
||||
} else {
|
||||
if ( exceptionp( should_be_lambda ) ) {
|
||||
result = should_be_lambda;
|
||||
} else {
|
||||
char *buffer = malloc( 1024 );
|
||||
struct cons_space_object not_lambda =
|
||||
pointer2cell( should_be_lambda );
|
||||
memset( buffer, '\0', 1024 );
|
||||
sprintf( buffer,
|
||||
"Expected lambda, but found cell with tag %d (%c%c%c%c)",
|
||||
not_lambda.tag.value, not_lambda.tag.bytes[0],
|
||||
not_lambda.tag.bytes[1], not_lambda.tag.bytes[2],
|
||||
not_lambda.tag.bytes[3] );
|
||||
struct cons_pointer message = c_string_to_lisp_string( buffer );
|
||||
free( buffer );
|
||||
result = lisp_throw( message, frame );
|
||||
}
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -178,13 +178,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
|
|||
struct cons_pointer args = c_cdr( frame->arg[0] );
|
||||
|
||||
switch ( fn_cell.tag.value ) {
|
||||
case SPECIALTV:
|
||||
{
|
||||
struct stack_frame *next =
|
||||
make_special_frame( frame, args, env );
|
||||
result = ( *fn_cell.payload.special.executable ) ( next, env );
|
||||
free_stack_frame( next );
|
||||
}
|
||||
case EXCEPTIONTV:
|
||||
/* just pass exceptions straight back */
|
||||
result = fn_pointer;
|
||||
break;
|
||||
case FUNCTIONTV:
|
||||
{
|
||||
|
|
@ -194,16 +190,21 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
|
|||
free_stack_frame( next );
|
||||
}
|
||||
break;
|
||||
case CONSTV:
|
||||
case LAMBDATV:
|
||||
{
|
||||
fwprintf( stdout,
|
||||
L"Treating cons as lambda expression (apply)\n" );
|
||||
result = lisp_lambda( frame, env );
|
||||
struct stack_frame *next =
|
||||
make_stack_frame( frame, args, env );
|
||||
result = eval_lambda( fn_cell, next, env );
|
||||
free_stack_frame( next );
|
||||
}
|
||||
break;
|
||||
case EXCEPTIONTV:
|
||||
/* just pass exceptions straight back */
|
||||
result = fn_pointer;
|
||||
case SPECIALTV:
|
||||
{
|
||||
struct stack_frame *next =
|
||||
make_special_frame( frame, args, env );
|
||||
result = ( *fn_cell.payload.special.executable ) ( next, env );
|
||||
free_stack_frame( next );
|
||||
}
|
||||
break;
|
||||
default:
|
||||
{
|
||||
|
|
@ -266,12 +267,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
|
|||
|
||||
switch ( cell.tag.value ) {
|
||||
case CONSTV:
|
||||
print( stderr, frame->arg[0] );
|
||||
if ( lambdap( c_car( frame->arg[0] ) ) ) {
|
||||
fwprintf( stdout,
|
||||
L"Treating cons as lambda expression (eval)\n" );
|
||||
result = lisp_lambda( frame, env );
|
||||
} else {
|
||||
{
|
||||
result = c_apply( frame, env );
|
||||
}
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -131,7 +131,11 @@ void print( FILE * output, struct cons_pointer pointer ) {
|
|||
}
|
||||
break;
|
||||
case LAMBDATV:
|
||||
fwprintf( output, L"lambda" /* "λ" */ );
|
||||
fputws( L"(lambda ", output );
|
||||
print( output, cell.payload.lambda.args );
|
||||
fputws( L" ", output );
|
||||
print( output, cell.payload.lambda.body );
|
||||
fputws( L")", output );
|
||||
break;
|
||||
case NILTV:
|
||||
fwprintf( output, L"nil" );
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue