diff --git a/src/consspaceobject.c b/src/consspaceobject.c index 68b32b9..d4e9d50 100644 --- a/src/consspaceobject.c +++ b/src/consspaceobject.c @@ -101,14 +101,33 @@ void dump_object( FILE* output, struct cons_pointer pointer) { * Construct a cons cell from this pair of pointers. */ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr) { - struct cons_pointer pointer = allocate_cell( CONSTAG); + struct cons_pointer pointer = NIL; - struct cons_space_object* cell = &conspages[pointer.page]->cell[pointer.offset]; + if ( ! ( nilp( car) && nilp( cdr))) { + pointer = allocate_cell( CONSTAG); - inc_ref(car); - inc_ref(cdr); - cell->payload.cons.car = car; - cell->payload.cons.cdr = cdr; + struct cons_space_object* cell = &conspages[pointer.page]->cell[pointer.offset]; + + inc_ref(car); + inc_ref(cdr); + cell->payload.cons.car = car; + cell->payload.cons.cdr = cdr; + } + + return pointer; +} + +/** + * Construct a cell which points to an executable Lisp special form. + */ +struct cons_pointer make_function( struct cons_pointer src, + struct cons_pointer (*executable) + (struct stack_frame*, struct cons_pointer)) { + struct cons_pointer pointer = allocate_cell( FUNCTIONTAG); + struct cons_space_object* cell = &pointer2cell(pointer); + + cell->payload.function.source = src; + cell->payload.function.executable = executable; return pointer; } @@ -137,6 +156,23 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail) { return pointer; } +/** + * Construct a cell which points to an executable Lisp special form. + */ +struct cons_pointer make_special( struct cons_pointer src, + struct cons_pointer (*executable) + (struct cons_pointer s_expr, + struct cons_pointer env, + struct stack_frame* frame)) { + struct cons_pointer pointer = allocate_cell( SPECIALTAG); + struct cons_space_object* cell = &pointer2cell(pointer); + + cell->payload.special.source = src; + cell->payload.special.executable = executable; + + return pointer; +} + /** * Return a lisp string representation of this old skool ASCII string. */ diff --git a/src/consspaceobject.h b/src/consspaceobject.h index fe055c2..628474c 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -350,6 +350,13 @@ void dump_object( FILE* output, struct cons_pointer pointer); struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr); +/** + * Construct a cell which points to an executable Lisp special form. + */ +struct cons_pointer make_function( struct cons_pointer src, + struct cons_pointer (*executable) + (struct stack_frame*, struct cons_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 @@ -358,6 +365,15 @@ struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr) */ struct cons_pointer make_string( wint_t c, struct cons_pointer tail); +/** + * Construct a cell which points to an executable Lisp special form. + */ +struct cons_pointer make_special( struct cons_pointer src, + struct cons_pointer (*executable) + (struct cons_pointer s_expr, + struct cons_pointer env, + struct stack_frame* frame)); + /** * Return a lisp string representation of this old skool ASCII string. */ diff --git a/src/init.c b/src/init.c index 33c9836..a5c3c40 100644 --- a/src/init.c +++ b/src/init.c @@ -14,14 +14,40 @@ #include "version.h" #include "conspage.h" #include "consspaceobject.h" +#include "intern.h" +#include "lispops.h" #include "print.h" #include "read.h" -#include "lispops.h" + +void bind_function( char* name, struct cons_pointer (*executable) + (struct stack_frame*, struct cons_pointer)) { + deep_bind( intern( c_string_to_lisp_string( name), oblist ), + make_function( NIL, executable)); +} + +void bind_special( char* name, struct cons_pointer (*executable) + (struct cons_pointer s_expr, struct cons_pointer env, + struct stack_frame* frame)) { + deep_bind( intern( c_string_to_lisp_string( name), oblist ), + make_special( NIL, executable)); +} int main (int argc, char *argv[]) { fprintf( stderr, "Post scarcity software environment version %s\n", VERSION); initialise_cons_pages(); + bind_function( "assoc", &lisp_assoc); + bind_function( "car", &lisp_car); + bind_function( "cdr", &lisp_cdr); + bind_function( "cons", &lisp_cons); + bind_function( "eq", &lisp_eq); + bind_function( "equal", &lisp_equal); + bind_function( "read", &lisp_read); + bind_function( "print", &lisp_print); + + bind_special( "apply", &lisp_apply); + bind_special( "eval", &lisp_eval); + fprintf( stderr, "\n:: "); struct cons_pointer input = read( stdin); fprintf( stderr, "\n{%d,%d}=> ", input.page, input.offset); diff --git a/src/intern.c b/src/intern.c index 862c43a..3cc9379 100644 --- a/src/intern.c +++ b/src/intern.c @@ -23,6 +23,17 @@ #include "conspage.h" #include "consspaceobject.h" +/** + * The object list. What is added to this during system setup is 'global', that is, + * visible to all sessions/threads. What is added during a session/thread is local to + * that session/thread (because shallow binding). There must be some way for a user to + * make the contents of their own environment persistent between threads but I don't + * know what it is yet. At some stage there must be a way to rebind deep values so + * they're visible to all users/threads, but again I don't yet have any idea how + * that will work. + */ +struct cons_pointer oblist = NIL; + /** * Implementation of interned? in C. The final implementation if interned? will * deal with stores which can be association lists or hashtables or hybrids of @@ -75,17 +86,6 @@ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer store) return result; } -/** - * The object list. What is added to this during system setup is 'global', that is, - * visible to all sessions/threads. What is added during a session/thread is local to - * that session/thread (because shallow binding). There must be some way for a user to - * make the contents of their own environment persistent between threads but I don't - * know what it is yet. At some stage there must be a way to rebind deep values so - * they're visible to all users/threads, but again I don't yet have any idea how - * that will work. - */ -struct cons_pointer oblist = NIL; - /** * Return a new key/value store containing all the key/value pairs in this store diff --git a/src/lispops.c b/src/lispops.c index f91ba02..6dd4d88 100644 --- a/src/lispops.c +++ b/src/lispops.c @@ -28,15 +28,11 @@ #include "equal.h" #include "integer.h" #include "intern.h" +#include "lispops.h" #include "print.h" #include "read.h" #include "stack.h" -/* special forms */ -struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); -struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer env, - struct stack_frame* frame); /* * also to create in this section: * struct cons_pointer lisp_cond( struct cons_pointer args, struct cons_pointer env, @@ -49,19 +45,6 @@ struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer en * and others I haven't thought of yet. */ -/* functions */ -struct cons_pointer lisp_cons( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_car( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_cdr( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_assoc( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_eq( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env); -struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env); - -/* neither, at this stage, really */ -struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame); - /** * Implementation of car in C. If arg is not a cons, does not error but returns nil. */ diff --git a/src/lispops.h b/src/lispops.h index c9da923..1268b7e 100644 --- a/src/lispops.h +++ b/src/lispops.h @@ -19,5 +19,21 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env); +/* special forms */ +struct cons_pointer lisp_eval( struct cons_pointer args, struct cons_pointer env, + struct stack_frame* frame); +struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer env, + struct stack_frame* frame); +/* functions */ +struct cons_pointer lisp_cons( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_car( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_cdr( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_assoc( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_eq( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env); +struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env); + +/* neither, at this stage, really */ +struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame); diff --git a/src/stack.c b/src/stack.c index 148ef41..2f8b926 100644 --- a/src/stack.c +++ b/src/stack.c @@ -59,7 +59,7 @@ struct stack_frame* make_stack_frame( struct stack_frame* previous, /* TODO: if we were running on real massively parallel hardware, each * arg except the first should be handed off to another processor to * be evaled in parallel */ - result->arg[i] = lisp_eval( cell.payload.cons.car, env); + result->arg[i] = lisp_eval( cell.payload.cons.car, env, result); /* TODO: later, going to have to mess with reference counts */ args = cell.payload.cons.cdr; } else {