From 8231c74baea4ce656730ff7a40e39636b009af02 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 28 Dec 2018 22:41:00 +0000 Subject: [PATCH] Various fixes while trying to make `defun!` work It still doesn't, but I think it's VERY close! --- README.md | 6 +++++ src/debug.h | 1 + src/memory/dump.c | 10 +++++++- src/ops/intern.c | 39 ++++++++++++++----------------- src/ops/lispops.c | 2 +- utils_src/debugflags/debugflags.c | 4 +++- 6 files changed, 37 insertions(+), 25 deletions(-) diff --git a/README.md b/README.md index caa6375..953a83c 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,12 @@ Very Nearly a Big Lisp Environment tl,dr: look at the [[wiki]]. +## State of play + +### Version 0.0.4 + +Has working rational number arithmetic, as well as integer and real number arithmetic. The stack is now in vector space, but vector space is not yet properly garbage collected. `defun` does not yet work, so although Lisp functions can be defined the syntax is pretty clunky. So you *can* start to do things with this, but you should probably wait for at least a 0.1.0 release! + ## Introduction Long ago when the world was young, I worked on Xerox Dandelion and Daybreak machines which ran Interlisp-D, and Acorn Cambridge Workstation and Archimedes machines which ran Cambridge Lisp (derived from Portable Standard Lisp). At the same time, Lisp Machines Inc, Symbolics, Thinking Machines, Texas Instruments and probably various other companies I've either forgotten or didn't know about built other varieties of dedicated Lisp machines which ran Lisp right down to the metal, with no operating system under them. Those machines were not only far superior to any other contemporary machines; they were also far superior to any machines we've built since. But they were expensive, and UNIX machines with the same raw compute power became very much cheaper; and so they died. diff --git a/src/debug.h b/src/debug.h index 22f5591..acd67fe 100644 --- a/src/debug.h +++ b/src/debug.h @@ -21,6 +21,7 @@ #define DEBUG_BOOTSTRAP 32 #define DEBUG_IO 64 #define DEBUG_REPL 128 +#define DEBUG_BIND 256 extern int verbosity; diff --git a/src/memory/dump.c b/src/memory/dump.c index e88332a..cf26bb5 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -85,13 +85,21 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { cell.payload.integer.value, cell.count ); break; case LAMBDATV: - fwprintf( output, L"\t\tLambda cell; args: " ); + fwprintf( output, L"\t\tLambda cell;\n\t\t args: " ); print( output, cell.payload.lambda.args ); fwprintf( output, L";\n\t\t\tbody: " ); print( output, cell.payload.lambda.body ); + fputws( L"\n", output); break; case NILTV: break; + case NLAMBDATV: + fwprintf( output, L"\t\tNlambda cell; \n\t\targs: " ); + print( output, cell.payload.lambda.args ); + fwprintf( output, L";\n\t\t\tbody: " ); + print( output, cell.payload.lambda.body ); + fputws( L"\n", output); + break; case RATIOTV: fwprintf( output, L"\t\tRational cell: value %ld/%ld, count %u\n", diff --git a/src/ops/intern.c b/src/ops/intern.c index 27c745d..03da271 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -57,22 +57,22 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { struct cons_space_object entry = pointer2cell( pointer2cell( next ).payload.cons.car ); - debug_print( L"Internedp: checking whether `", DEBUG_ALLOC ); - debug_print_object( key, DEBUG_ALLOC ); - debug_print( L"` equals `", DEBUG_ALLOC ); - debug_print_object( entry.payload.cons.car, DEBUG_ALLOC ); - debug_print( L"`\n", DEBUG_ALLOC ); + debug_print( L"Internedp: checking whether `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"` equals `", DEBUG_BIND ); + debug_print_object( entry.payload.cons.car, DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); if ( equal( key, entry.payload.cons.car ) ) { result = entry.payload.cons.car; } } } else { - debug_print( L"`", DEBUG_ALLOC ); - debug_print_object( key, DEBUG_ALLOC ); - debug_print( L"` is a ", DEBUG_ALLOC ); - debug_print_object( c_type( key ), DEBUG_ALLOC ); - debug_print( L", not a SYMB", DEBUG_ALLOC ); + debug_print( L"`", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"` is a ", DEBUG_BIND ); + debug_print_object( c_type( key ), DEBUG_BIND ); + debug_print( L", not a SYMB", DEBUG_BIND ); } return result; @@ -111,11 +111,11 @@ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer bind( struct cons_pointer key, struct cons_pointer value, struct cons_pointer store ) { - debug_print(L"Binding ", DEBUG_ALLOC); - debug_print_object(key, DEBUG_ALLOC); - debug_print(L" to ", DEBUG_ALLOC); - debug_print_object(value, DEBUG_ALLOC); - debug_println(DEBUG_ALLOC); + debug_print(L"Binding ", DEBUG_BIND); + debug_print_object(key, DEBUG_BIND); + debug_print(L" to ", DEBUG_BIND); + debug_print_object(value, DEBUG_BIND); + debug_println( DEBUG_BIND); return make_cons( make_cons( key, value ), store ); } @@ -127,16 +127,11 @@ bind( struct cons_pointer key, struct cons_pointer value, */ struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value ) { - debug_print( L"Entering deep_bind\n", DEBUG_ALLOC ); - debug_print( L"\tSetting ", DEBUG_ALLOC ); - debug_print_object( key, DEBUG_ALLOC ); - debug_print( L" to ", DEBUG_ALLOC ); - debug_print_object( value, DEBUG_ALLOC ); - debug_print( L"\n", DEBUG_ALLOC ); + debug_print( L"Entering deep_bind\n", DEBUG_BIND ); oblist = bind( key, value, oblist ); - debug_print( L"Leaving deep_bind\n", DEBUG_ALLOC ); + debug_print( L"Leaving deep_bind\n", DEBUG_BIND ); return oblist; } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 82746e0..2be19b6 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -375,7 +375,7 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { struct cons_pointer result = NIL; struct cons_space_object cell = pointer2cell( pointer ); - for (int i = TAGLENGTH; i >= 0; i--) + for (int i = TAGLENGTH -1; i >= 0; i--) { result = make_string((wchar_t)cell.tag.bytes[i], result); } diff --git a/utils_src/debugflags/debugflags.c b/utils_src/debugflags/debugflags.c index a9850d1..2ad04ce 100644 --- a/utils_src/debugflags/debugflags.c +++ b/utils_src/debugflags/debugflags.c @@ -13,6 +13,7 @@ #define DEBUG_BOOTSTRAP 32 #define DEBUG_IO 64 #define DEBUG_REPL 128 +#define DEBUG_BIND 256 int check_level( int v, int level, char * name) { int result = 0; @@ -37,7 +38,8 @@ int main( int argc, char *argv[] ) { check_level(v, DEBUG_LAMBDA, "DEBUG_LAMBDA") + check_level(v, DEBUG_BOOTSTRAP, "DEBUG_BOOTSTRAP") + check_level(v, DEBUG_IO, "DEBUG_IO") + - check_level(v, DEBUG_REPL, "DEBUG_REPL"); + check_level(v, DEBUG_REPL, "DEBUG_REPL") + + check_level(v, DEBUG_BIND, "DEBUG_BIND"); printf("\t%d matches\n", matches); } }