diff --git a/lisp/defun.lisp b/lisp/defun.lisp new file mode 100644 index 0000000..4aaeb6d --- /dev/null +++ b/lisp/defun.lisp @@ -0,0 +1,27 @@ +;; Because I don't (yet) have syntax for varargs, the body must be passed +;; to defun as a list of sexprs. +(set! defun! + (nlambda + (name args body) + (cond (symbolp name) + (set! name (apply lambda (cons args body)))))) + +(defun! square (x) ((* x x))) + +(set! defsp! + (nlambda + (name args body) + (cond (symbolp name) + (set! name (nlambda args body))))) + +(defsp! cube (x) ((* x x x))) + +(set! p 5) + +(square 5) ;; should work + +(square p) ;; should work + +(cube 5) ;; should work + +(cube p) ;; should fail: unbound symbol diff --git a/src/consspaceobject.c b/src/consspaceobject.c index 30bfa83..6d6a805 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -215,6 +215,22 @@ struct cons_pointer make_lambda( struct cons_pointer args, return pointer; } +/** + * Construct an nlambda (interpretable source) cell; to a + * lambda as a special form is to a function. + */ +struct cons_pointer make_nlambda( struct cons_pointer args, + struct cons_pointer body ) { + struct cons_pointer pointer = allocate_cell( NLAMBDATAG ); + 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 diff --git a/src/consspaceobject.h b/src/consspaceobject.h index 22b7c18..e6f6f83 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -73,6 +73,12 @@ #define NILTAG "NIL " #define NILTV 541870414 +/** + * An nlambda cell. + */ +#define NLAMBDATAG "NLMD" +#define NLAMBDATV 1145916494 + /** * An open read stream. */ @@ -303,6 +309,9 @@ struct integer_payload { long int value; }; +/** + * payload for lambda and nlambda cells + */ struct lambda_payload { struct cons_pointer args; struct cons_pointer body; @@ -402,7 +411,7 @@ struct cons_space_object { */ struct integer_payload integer; /* - * if tag == LAMBDATAG + * if tag == LAMBDATAG or NLAMBDATAG */ struct lambda_payload lambda; /* @@ -481,6 +490,13 @@ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ); /** + * Construct an nlambda (interpretable source) cell; to a + * lambda as a special form is to a function. + */ +struct cons_pointer make_nlambda( struct cons_pointer args, + struct cons_pointer body ); + + /** * Construct a cell which points to an executable Lisp special form. */ struct cons_pointer make_special( struct cons_pointer src, diff --git a/src/init.c b/src/init.c index 9c217c8..a0b8559 100644 --- a/src/init.c +++ b/src/init.c @@ -107,6 +107,7 @@ int main( int argc, char *argv[] ) { */ bind_special( "cond", &lisp_cond ); bind_special( "lambda", &lisp_lambda ); + bind_special( "nlambda", &lisp_nlambda ); bind_special( "quote", &lisp_quote ); bind_special( "set!", &lisp_set_shriek ); diff --git a/src/lispops.c b/src/lispops.c index 945c412..09704aa 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -96,15 +96,7 @@ struct cons_pointer eval_form( struct stack_frame *parent, return result; } -/** - * The Lisp interpreter. - * - * @param frame the stack frame in which the expression is 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 ) { - dump_frame( stderr, frame ); +struct cons_pointer compose_body( struct stack_frame *frame ) { struct cons_pointer body = !nilp( frame->arg[args_in_frame - 1] ) ? frame->more : NIL; @@ -112,10 +104,31 @@ lisp_lambda( struct stack_frame *frame, struct cons_pointer env ) { if ( !nilp( frame->arg[i] ) ) { body = make_cons( frame->arg[i], body ); } - } - return make_lambda( frame->arg[0], body ); + return body; +} + +/** + * Construct an interpretable function. + * + * @param frame the stack frame in which the expression is 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 ) { + return make_lambda( frame->arg[0], compose_body( frame ) ); +} + +/** + * Construct an interpretable special form. + * + * @param frame the stack frame in which the expression is to be interpreted; + * @param env the environment in which it is to be intepreted. + */ +struct cons_pointer +lisp_nlambda( struct stack_frame *frame, struct cons_pointer env ) { + return make_nlambda( frame->arg[0], compose_body( frame ) ); } @@ -153,7 +166,6 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, } - /** * Internal guts of apply. * @param frame the stack frame, expected to have only one argument, a list @@ -197,6 +209,14 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) { free_stack_frame( next ); } break; + case NLAMBDATV: + { + struct stack_frame *next = + make_special_frame( frame, args, env ); + result = ( *fn_cell.payload.special.executable ) ( next, env ); + free_stack_frame( next ); + } + break; case SPECIALTV: { struct stack_frame *next = diff --git a/src/lispops.h b/src/lispops.h index dbbf55a..6d49b9b 100644 --- a/src/lispops.h +++ b/src/lispops.h @@ -42,7 +42,7 @@ struct cons_pointer lisp_set_shriek( struct stack_frame *frame, struct cons_pointer env ); /** - * The Lisp interpreter. + * Construct an interpretable function. * * @param frame the stack frame in which the expression is to be interpreted; * @param lexpr the lambda expression to be interpreted; @@ -51,6 +51,15 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer env ); struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer env ); +/** + * Construct an interpretable special form. + * + * @param frame the stack frame in which the expression is to be interpreted; + * @param env the environment in which it is to be intepreted. + */ +struct cons_pointer +lisp_nlambda( struct stack_frame *frame, struct cons_pointer env ); + struct cons_pointer lisp_quote( struct stack_frame *frame, struct cons_pointer env ); diff --git a/src/print.c b/src/print.c index d6b966a..7957e5e 100644 --- a/src/print.c +++ b/src/print.c @@ -29,7 +29,7 @@ int print_use_colours = 0; /** - * print all the characters in the symbol or string indicated by `pointer` + * 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. */ @@ -58,7 +58,7 @@ void print_string( FILE * output, struct cons_pointer pointer ) { /** * Print a single list cell (cons cell) indicated by `pointer` to the - * stream indicated by `output`. if `initial_space` is `true`, prepend + * stream indicated by `output`. if `initial_space` is `true`, prepend * a space character. */ void @@ -100,7 +100,7 @@ void print_list( FILE * output, struct cons_pointer pointer ) { } /** - * Print the cons-space object indicated by `pointer` to the stream indicated + * Print the cons-space object indicated by `pointer` to the stream indicated * by `output`. */ void print( FILE * output, struct cons_pointer pointer ) { @@ -131,15 +131,18 @@ void print( FILE * output, struct cons_pointer pointer ) { } break; case LAMBDATV: - fputws( L"(lambda ", output ); - print( output, cell.payload.lambda.args ); - fputws( L" ", output ); - print( output, cell.payload.lambda.body ); - fputws( L")", output ); + print( output, make_cons( c_string_to_lisp_symbol("lambda"), + make_cons( cell.payload.lambda.args, + cell.payload.lambda.body ) ) ); break; case NILTV: fwprintf( output, L"nil" ); break; + case NLAMBDATV: + print( output, make_cons( c_string_to_lisp_symbol("nlambda"), + make_cons( cell.payload.lambda.args, + cell.payload.lambda.body ) ) ); + break; case REALTV: /* TODO: using the C heap is a bad plan because it will fragment. * As soon as I have working vector space I'll use a special purpose diff --git a/src/read.c b/src/read.c index ff0b51f..ef094d5 100644 --- a/src/read.c +++ b/src/read.c @@ -60,6 +60,10 @@ struct cons_pointer read_continuation( struct stack_frame *frame, FILE * input, c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) ); switch ( c ) { + case ';': + for ( c= fgetwc( input ); c != '\n'; c= fgetwc( input )); + /* skip all characters from semi-colon to the end of the line */ + break; case EOF: result = lisp_throw( c_string_to_lisp_string ( "End of input while reading" ), frame );