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

Various fixes while trying to make defun! work

Browse source 
It still doesn't, but I think it's VERY close!
This commit is contained in:
Simon Brooke 2018-12-28 22:41:00 +00:00
parent a2afbe030f
commit 8231c74bae
6 changed files with 37 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
README.md
View file

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

1
src/debug.h
View file

@ -21,6 +21,7 @@
#define DEBUG_BOOTSTRAP 32
#define DEBUG_IO 64
#define DEBUG_REPL 128
#define DEBUG_BIND 256
extern int verbosity;

10
src/memory/dump.c
View file

@ -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",

39
src/ops/intern.c
View file

@ -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;
}

2
src/ops/lispops.c
View file

@ -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);
}

4
utils_src/debugflags/debugflags.c
View file

@ -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);
}
}