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

Much work on the interpreter, but it is getting messy

Browse source 
Going to try something radically different
This commit is contained in:
Simon Brooke 2018-12-12 16:20:16 +00:00
parent 7d0b6bec97
commit 7189c0172c
6 changed files with 99 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/consspaceobject.h
View file

@ -34,6 +34,13 @@
#define CONSTAG "CONS"
#define CONSTV 1397641027
/**
* An exception.
*/
#define EXCEPTIONTAG "EXEP"
/* TODO: this is wrong */
#define EXCEPTIONTV 1346721861
/**
* An unallocated cell on the free list - should never be encountered by a Lisp
* function. 1162170950
@ -117,13 +124,6 @@
/* TODO: this is wrong */
#define WRITETV 1414091351
/**
* An exception.
*/
#define EXCEPTIONTAG "EXEP"
/* TODO: this is wrong */
#define EXCEPTIONTV 1346721861
/**
* a cons pointer which points to the special NIL cell
*/

4
src/equal.c
View file

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

3
src/init.c
View file

@ -53,7 +53,7 @@ int main( int argc, char *argv[] ) {
break;
case 'p':
show_prompt = true;
print_use_colours = true;
print_use_colours = true;
break;
default:
fwprintf( stderr, L"Unexpected option %c\n", option );
@ -74,6 +74,7 @@ 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 );
/*

72
src/lispops.c
View file

@ -104,26 +104,53 @@ struct cons_pointer eval_form( struct stack_frame *parent,
* @param env the environment in which it is to be intepreted.
*/
struct cons_pointer
lisp_lambda( struct stack_frame *frame, struct cons_pointer lexpr,
struct cons_pointer env ) {
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 );
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 ) );
for ( int i = 1; i < args_in_frame && consp( args ); i++ ) {
args = c_cdr( args );
struct cons_pointer arg = c_car( args );
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] );
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 );
result = eval_form( frame, sexpr, new_env );
}
} 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 );
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;
}
@ -159,7 +186,6 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
free_stack_frame( next );
}
break;
case FUNCTIONTV:
{
struct stack_frame *next =
@ -168,12 +194,17 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
free_stack_frame( next );
}
break;
case CONSTV:
{
result = lisp_lambda( frame, fn_pointer, env );
fwprintf( stdout,
L"Treating cons as lambda expression (apply)\n" );
result = lisp_lambda( frame, env );
}
break;
case EXCEPTIONTV:
/* just pass exceptions straight back */
result = fn_pointer;
break;
default:
{
char *buffer = malloc( 1024 );
@ -235,7 +266,14 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
switch ( cell.tag.value ) {
case CONSTV:
result = c_apply( frame, env );
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;
case SYMBOLTV:

10
src/lispops.h
View file

@ -37,6 +37,16 @@ struct cons_pointer lisp_eval( struct stack_frame *frame,
struct cons_pointer env );
struct cons_pointer lisp_apply( struct stack_frame *frame,
struct cons_pointer env );
/**
* 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 lisp_quote( struct stack_frame *frame,
struct cons_pointer env );

26
src/print.c
View file

@ -22,20 +22,34 @@
#include "integer.h"
#include "print.h"
/**
* Whether or not we colorise output.
* TODO: this should be a Lisp symbol binding, not a C variable.
*/
int print_use_colours = 0;
/**
* print all the characters in the symbol or string indicated by `pointer`
* onto this `output`; if `pointer` does not indicate a string or symbol,
* don't print anything but just return.
*/
void print_string_contents( FILE * output, struct cons_pointer pointer ) {
if ( stringp( pointer ) || symbolp( pointer ) ) {
while ( stringp( pointer ) || symbolp( pointer ) ) {
struct cons_space_object *cell = &pointer2cell( pointer );
wint_t c = cell->payload.string.character;
if ( c != '\0' ) {
fputwc( c, output );
}
print_string_contents( output, cell->payload.string.cdr );
pointer = cell->payload.string.cdr;
}
}
/**
* print all the characters in the string indicated by `pointer` onto
* the stream at this `output`, prepending and appending double quote
* characters.
*/
void print_string( FILE * output, struct cons_pointer pointer ) {
fputwc( btowc( '"' ), output );
print_string_contents( output, pointer );
@ -43,7 +57,9 @@ void print_string( FILE * output, struct cons_pointer pointer ) {
}
/**
* Print a single list cell (cons cell).
* Print a single list cell (cons cell) indicated by `pointer` to the
* stream indicated by `output`. if `initial_space` is `true`, prepend
* a space character.
*/
void
print_list_contents( FILE * output, struct cons_pointer pointer,
@ -83,6 +99,10 @@ void print_list( FILE * output, struct cons_pointer pointer ) {
}
/**
* Print the cons-space object indicated by `pointer` to the stream indicated
* by `output`.
*/
void print( FILE * output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
char *buffer;