Woohoo! Huge decrease in cells not cleaned up, with fixing one stupid bug.
This commit is contained in:
parent
004ff6737c
commit
f6d7fcea1e
12 changed files with 93 additions and 293 deletions
|
|
@ -1,157 +0,0 @@
|
||||||
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
|
|
||||||
<CodeBlocks_project_file>
|
|
||||||
<FileVersion major="1" minor="6" />
|
|
||||||
<Project>
|
|
||||||
<Option title="post-scarcity" />
|
|
||||||
<Option makefile_is_custom="1" />
|
|
||||||
<Option pch_mode="2" />
|
|
||||||
<Option compiler="gcc" />
|
|
||||||
<Build>
|
|
||||||
<Target title="Debug">
|
|
||||||
<Option output="bin/Debug/post-scarcity" prefix_auto="1" extension_auto="1" />
|
|
||||||
<Option object_output="obj/Debug/" />
|
|
||||||
<Option type="1" />
|
|
||||||
<Option compiler="gcc" />
|
|
||||||
<Compiler>
|
|
||||||
<Add option="-g" />
|
|
||||||
</Compiler>
|
|
||||||
</Target>
|
|
||||||
<Target title="Release">
|
|
||||||
<Option output="bin/Release/post-scarcity" prefix_auto="1" extension_auto="1" />
|
|
||||||
<Option object_output="obj/Release/" />
|
|
||||||
<Option type="1" />
|
|
||||||
<Option compiler="gcc" />
|
|
||||||
<Compiler>
|
|
||||||
<Add option="-O2" />
|
|
||||||
</Compiler>
|
|
||||||
<Linker>
|
|
||||||
<Add option="-s" />
|
|
||||||
</Linker>
|
|
||||||
</Target>
|
|
||||||
</Build>
|
|
||||||
<Compiler>
|
|
||||||
<Add option="-Wall" />
|
|
||||||
</Compiler>
|
|
||||||
<Unit filename="Makefile" />
|
|
||||||
<Unit filename="src/arith/integer.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/arith/integer.h" />
|
|
||||||
<Unit filename="src/arith/peano.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/arith/peano.h" />
|
|
||||||
<Unit filename="src/arith/ratio.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/arith/ratio.h" />
|
|
||||||
<Unit filename="src/arith/real.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/arith/real.h" />
|
|
||||||
<Unit filename="src/authorise.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/authorise.h" />
|
|
||||||
<Unit filename="src/debug.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/debug.h" />
|
|
||||||
<Unit filename="src/init.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/io/fopen.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/io/fopen.h" />
|
|
||||||
<Unit filename="src/io/io.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/io/io.h" />
|
|
||||||
<Unit filename="src/io/print.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/io/print.h" />
|
|
||||||
<Unit filename="src/io/read.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/io/read.h" />
|
|
||||||
<Unit filename="src/memory/conspage.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/conspage.h" />
|
|
||||||
<Unit filename="src/memory/consspaceobject.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/consspaceobject.h" />
|
|
||||||
<Unit filename="src/memory/cursor.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/cursor.h" />
|
|
||||||
<Unit filename="src/memory/dump.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/dump.h" />
|
|
||||||
<Unit filename="src/memory/hashmap.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/hashmap.h" />
|
|
||||||
<Unit filename="src/memory/lookup3.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/lookup3.h" />
|
|
||||||
<Unit filename="src/memory/stack.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/stack.h" />
|
|
||||||
<Unit filename="src/memory/vectorspace.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/memory/vectorspace.h" />
|
|
||||||
<Unit filename="src/ops/equal.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/ops/equal.h" />
|
|
||||||
<Unit filename="src/ops/intern.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/ops/intern.h" />
|
|
||||||
<Unit filename="src/ops/lispops.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/ops/lispops.h" />
|
|
||||||
<Unit filename="src/ops/loop.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/ops/loop.h" />
|
|
||||||
<Unit filename="src/ops/meta.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/ops/meta.h" />
|
|
||||||
<Unit filename="src/repl.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/repl.h" />
|
|
||||||
<Unit filename="src/time/psse_time.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/time/psse_time.h" />
|
|
||||||
<Unit filename="src/utils.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="src/utils.h" />
|
|
||||||
<Unit filename="src/version.h" />
|
|
||||||
<Unit filename="utils_src/debugflags/debugflags.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="utils_src/readprintwc/readprintwc.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Unit filename="utils_src/tagvalcalc/tagvalcalc.c">
|
|
||||||
<Option compilerVar="CC" />
|
|
||||||
</Unit>
|
|
||||||
<Extensions>
|
|
||||||
<lib_finder disable_auto="1" />
|
|
||||||
</Extensions>
|
|
||||||
</Project>
|
|
||||||
</CodeBlocks_project_file>
|
|
||||||
|
|
@ -1,58 +0,0 @@
|
||||||
"/home/simon/workspace/post-scarcity/utils_src/readprintwc/readprintwc.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/vectorspace.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/peano.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/init.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/utils.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/intern.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/ratio.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/io.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/conspage.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/time/psse_time.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/cursor.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/dump.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/intern.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/lookup3.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/fopen.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/version.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/meta.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/real.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/loop.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/integer.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/time/psse_time.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/vectorspace.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/hashmap.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/read.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/lispops.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/loop.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/stack.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/utils_src/tagvalcalc/tagvalcalc.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/debug.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/read.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/meta.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/dump.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/repl.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/print.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/hashmap.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/utils.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/io.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/stack.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/utils_src/debugflags/debugflags.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/conspage.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/cursor.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/ratio.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/Makefile"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/peano.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/memory/lookup3.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/real.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/equal.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/lispops.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/authorise.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/print.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/authorise.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/debug.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/arith/integer.c"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/ops/equal.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/repl.h"
|
|
||||||
"/home/simon/workspace/post-scarcity/src/io/fopen.c"
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
|
|
||||||
<CodeBlocks_layout_file>
|
|
||||||
<FileVersion major="1" minor="0" />
|
|
||||||
<ActiveTarget name="Debug" />
|
|
||||||
<File name="Makefile" open="1" top="0" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
|
|
||||||
<Cursor>
|
|
||||||
<Cursor1 position="642" topLine="5" />
|
|
||||||
</Cursor>
|
|
||||||
</File>
|
|
||||||
<File name="src/arith/integer.c" open="1" top="1" tabpos="2" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
|
|
||||||
<Cursor>
|
|
||||||
<Cursor1 position="3454" topLine="156" />
|
|
||||||
</Cursor>
|
|
||||||
</File>
|
|
||||||
</CodeBlocks_layout_file>
|
|
||||||
|
|
@ -272,9 +272,12 @@ struct cons_pointer add_integers( struct cons_pointer a,
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// TODO: I have really no idea what I was trying to do here, or why it could possibly be a good idea.
|
||||||
struct cons_pointer base_partial( int depth ) {
|
struct cons_pointer base_partial( int depth ) {
|
||||||
struct cons_pointer result = NIL;
|
struct cons_pointer result = NIL;
|
||||||
|
|
||||||
|
debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth);
|
||||||
|
|
||||||
for ( int i = 0; i < depth; i++ ) {
|
for ( int i = 0; i < depth; i++ ) {
|
||||||
result = acquire_integer( 0, result );
|
result = acquire_integer( 0, result );
|
||||||
}
|
}
|
||||||
|
|
|
||||||
40
src/init.c
40
src/init.c
|
|
@ -37,6 +37,34 @@
|
||||||
#include "io/fopen.h"
|
#include "io/fopen.h"
|
||||||
#include "time/psse_time.h"
|
#include "time/psse_time.h"
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief If `pointer` is an exception, display that exception to stderr,
|
||||||
|
* decrement that exception, and return NIL; else return the pointer.
|
||||||
|
*
|
||||||
|
* @param pointer a cons pointer.
|
||||||
|
* @param location_descriptor a description of where the pointer was caught.
|
||||||
|
* @return struct cons_pointer
|
||||||
|
*/
|
||||||
|
struct cons_pointer check_exception( struct cons_pointer pointer, char * location_descriptor) {
|
||||||
|
struct cons_pointer result = NIL;
|
||||||
|
|
||||||
|
struct cons_space_object * object = &pointer2cell( pointer);
|
||||||
|
|
||||||
|
if ( exceptionp( pointer)) {
|
||||||
|
fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor);
|
||||||
|
URL_FILE *ustderr = file_to_url_file( stderr );
|
||||||
|
fwide( stderr, 1 );
|
||||||
|
print( ustderr, object->payload.exception.payload );
|
||||||
|
free( ustderr );
|
||||||
|
|
||||||
|
dec_ref( pointer);
|
||||||
|
} else {
|
||||||
|
result = pointer;
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Bind this compiled `executable` function, as a Lisp function, to
|
* Bind this compiled `executable` function, as a Lisp function, to
|
||||||
|
|
@ -55,7 +83,8 @@ void bind_function( wchar_t *name, struct cons_pointer ( *executable )
|
||||||
n ),
|
n ),
|
||||||
NIL ) );
|
NIL ) );
|
||||||
|
|
||||||
deep_bind( n, make_function( meta, executable ) );
|
check_exception( deep_bind( n, make_function( meta, executable ) ),
|
||||||
|
"bind_function");
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
@ -72,14 +101,17 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable )
|
||||||
n ),
|
n ),
|
||||||
NIL ) );
|
NIL ) );
|
||||||
|
|
||||||
deep_bind( n, make_special( meta, executable ) );
|
check_exception(deep_bind( n, make_special( meta, executable ) ),
|
||||||
|
"bind_special");
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Bind this `value` to this `name` in the `oblist`.
|
* Bind this `value` to this `name` in the `oblist`.
|
||||||
*/
|
*/
|
||||||
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) {
|
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) {
|
||||||
return deep_bind( c_string_to_lisp_symbol( name ), value );
|
return check_exception(
|
||||||
|
deep_bind( c_string_to_lisp_symbol( name ), value ),
|
||||||
|
"bind_value");
|
||||||
}
|
}
|
||||||
|
|
||||||
void print_banner( ) {
|
void print_banner( ) {
|
||||||
|
|
@ -227,7 +259,7 @@ int main( int argc, char *argv[] ) {
|
||||||
/*
|
/*
|
||||||
* the default prompt
|
* the default prompt
|
||||||
*/
|
*/
|
||||||
bind_value( L"*prompt*",
|
prompt_name = bind_value( L"*prompt*",
|
||||||
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
|
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
|
||||||
/*
|
/*
|
||||||
* primitive function operations
|
* primitive function operations
|
||||||
|
|
|
||||||
|
|
@ -169,9 +169,11 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
|
||||||
print( output, cell.payload.function.meta );
|
print( output, cell.payload.function.meta );
|
||||||
url_fputwc( L'>', output );
|
url_fputwc( L'>', output );
|
||||||
break;
|
break;
|
||||||
case INTEGERTV:{
|
case INTEGERTV:
|
||||||
|
if ( nilp( cell.payload.integer.more)) {
|
||||||
|
url_fwprintf( output, L"%ld", cell.payload.integer.value);
|
||||||
|
} else {
|
||||||
struct cons_pointer s = integer_to_string( pointer, 10 );
|
struct cons_pointer s = integer_to_string( pointer, 10 );
|
||||||
inc_ref( s );
|
|
||||||
print_string_contents( output, s );
|
print_string_contents( output, s );
|
||||||
dec_ref( s );
|
dec_ref( s );
|
||||||
}
|
}
|
||||||
|
|
@ -186,7 +188,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
|
||||||
make_cons( c_string_to_lisp_symbol( L"\u03bb" ),
|
make_cons( c_string_to_lisp_symbol( L"\u03bb" ),
|
||||||
make_cons( cell.payload.lambda.args,
|
make_cons( cell.payload.lambda.args,
|
||||||
cell.payload.lambda.body ) );
|
cell.payload.lambda.body ) );
|
||||||
inc_ref( to_print );
|
|
||||||
|
|
||||||
print( output, to_print );
|
print( output, to_print );
|
||||||
|
|
||||||
|
|
@ -203,7 +204,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
|
||||||
make_cons( c_string_to_lisp_symbol( L"n\u03bb" ),
|
make_cons( c_string_to_lisp_symbol( L"n\u03bb" ),
|
||||||
make_cons( cell.payload.lambda.args,
|
make_cons( cell.payload.lambda.args,
|
||||||
cell.payload.lambda.body ) );
|
cell.payload.lambda.body ) );
|
||||||
inc_ref( to_print );
|
|
||||||
|
|
||||||
print( output, to_print );
|
print( output, to_print );
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -201,7 +201,6 @@ struct cons_pointer make_exception( struct cons_pointer message,
|
||||||
struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
|
struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
|
||||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||||
|
|
||||||
inc_ref( message );
|
|
||||||
inc_ref( frame_pointer );
|
inc_ref( frame_pointer );
|
||||||
cell->payload.exception.payload = message;
|
cell->payload.exception.payload = message;
|
||||||
cell->payload.exception.frame = frame_pointer;
|
cell->payload.exception.frame = frame_pointer;
|
||||||
|
|
@ -237,9 +236,6 @@ struct cons_pointer make_lambda( struct cons_pointer args,
|
||||||
struct cons_pointer pointer = allocate_cell( LAMBDATV );
|
struct cons_pointer pointer = allocate_cell( LAMBDATV );
|
||||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||||
|
|
||||||
inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do
|
|
||||||
this, but if I don't the cell gets freed */
|
|
||||||
|
|
||||||
inc_ref( args );
|
inc_ref( args );
|
||||||
inc_ref( body );
|
inc_ref( body );
|
||||||
cell->payload.lambda.args = args;
|
cell->payload.lambda.args = args;
|
||||||
|
|
@ -256,9 +252,6 @@ struct cons_pointer make_nlambda( struct cons_pointer args,
|
||||||
struct cons_pointer body ) {
|
struct cons_pointer body ) {
|
||||||
struct cons_pointer pointer = allocate_cell( NLAMBDATV );
|
struct cons_pointer pointer = allocate_cell( NLAMBDATV );
|
||||||
|
|
||||||
inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do
|
|
||||||
this, but if I don't the cell gets freed */
|
|
||||||
|
|
||||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||||
inc_ref( args );
|
inc_ref( args );
|
||||||
inc_ref( body );
|
inc_ref( body );
|
||||||
|
|
@ -312,7 +305,6 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
|
||||||
pointer = allocate_cell( tag );
|
pointer = allocate_cell( tag );
|
||||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||||
|
|
||||||
inc_ref( tail );
|
|
||||||
cell->payload.string.character = c;
|
cell->payload.string.character = c;
|
||||||
cell->payload.string.cdr.page = tail.page;
|
cell->payload.string.cdr.page = tail.page;
|
||||||
/* \todo There's a problem here. Sometimes the offsets on
|
/* \todo There's a problem here. Sometimes the offsets on
|
||||||
|
|
|
||||||
|
|
@ -87,9 +87,9 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
|
||||||
&( map->payload ) )->n_buckets;
|
&( map->payload ) )->n_buckets;
|
||||||
|
|
||||||
map->payload.hashmap.buckets[bucket_no] =
|
map->payload.hashmap.buckets[bucket_no] =
|
||||||
inc_ref( make_cons( make_cons( key, val ),
|
make_cons( make_cons( key, val ),
|
||||||
map->payload.hashmap.
|
map->payload.hashmap.
|
||||||
buckets[bucket_no] ) );
|
buckets[bucket_no] );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -292,7 +292,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
|
||||||
// if ( equal( key, entry.payload.cons.car ) ) {
|
// if ( equal( key, entry.payload.cons.car ) ) {
|
||||||
// result = entry.payload.cons.car;
|
// result = entry.payload.cons.car;
|
||||||
// }
|
// }
|
||||||
if (!nilp( c_assoc( store, key))) {
|
if (!nilp( c_assoc( key, store))) {
|
||||||
result = key;
|
result = key;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -340,18 +340,23 @@ struct cons_pointer c_assoc( struct cons_pointer key,
|
||||||
result = hashmap_get( entry_ptr, key );
|
result = hashmap_get( entry_ptr, key );
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
throw_exception( c_string_to_lisp_string
|
throw_exception( c_append(
|
||||||
( L"Store entry is of unknown type" ),
|
c_string_to_lisp_string( L"Store entry is of unknown type: " ),
|
||||||
NIL );
|
c_type( entry_ptr)), NIL);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else if ( hashmapp( store ) ) {
|
} else if ( hashmapp( store ) ) {
|
||||||
result = hashmap_get( store, key );
|
result = hashmap_get( store, key );
|
||||||
} else if ( !nilp( store ) ) {
|
} else if ( !nilp( store ) ) {
|
||||||
|
debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
|
||||||
|
debug_print_object( c_type( store), DEBUG_BIND );
|
||||||
|
debug_print( L"`\n", DEBUG_BIND );
|
||||||
result =
|
result =
|
||||||
throw_exception( c_string_to_lisp_string
|
throw_exception(
|
||||||
( L"Store is of unknown type" ), NIL );
|
c_append(
|
||||||
|
c_string_to_lisp_string( L"Store is of unknown type: " ),
|
||||||
|
c_type( store)), NIL );
|
||||||
}
|
}
|
||||||
|
|
||||||
debug_print( L"c_assoc returning ", DEBUG_BIND );
|
debug_print( L"c_assoc returning ", DEBUG_BIND );
|
||||||
|
|
|
||||||
|
|
@ -38,6 +38,13 @@
|
||||||
#include "memory/stack.h"
|
#include "memory/stack.h"
|
||||||
#include "memory/vectorspace.h"
|
#include "memory/vectorspace.h"
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief the name of the symbol to which the prompt is bound;
|
||||||
|
*
|
||||||
|
* Set in init to `*prompt*`
|
||||||
|
*/
|
||||||
|
struct cons_pointer prompt_name;
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* also to create in this section:
|
* also to create in this section:
|
||||||
* struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
|
* struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
|
||||||
|
|
@ -46,7 +53,6 @@
|
||||||
* and others I haven't thought of yet.
|
* and others I haven't thought of yet.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Useful building block; evaluate this single form in the context of this
|
* Useful building block; evaluate this single form in the context of this
|
||||||
* parent stack frame and this environment.
|
* parent stack frame and this environment.
|
||||||
|
|
@ -1263,7 +1269,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
|
||||||
|
|
||||||
struct cons_pointer input = get_default_stream( true, env );
|
struct cons_pointer input = get_default_stream( true, env );
|
||||||
struct cons_pointer output = get_default_stream( false, env );
|
struct cons_pointer output = get_default_stream( false, env );
|
||||||
struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
|
// struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
|
||||||
struct cons_pointer old_oblist = oblist;
|
struct cons_pointer old_oblist = oblist;
|
||||||
struct cons_pointer new_env = env;
|
struct cons_pointer new_env = env;
|
||||||
|
|
||||||
|
|
@ -1558,43 +1564,35 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// /**
|
// struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) {
|
||||||
// * Function; print the internal representation of the object indicated by `frame->arg[0]` to the
|
// struct cons_pointer result = b;
|
||||||
// * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
|
|
||||||
// *
|
|
||||||
// * * (inspect expression)
|
|
||||||
// * * (inspect expression <write-stream>)
|
|
||||||
// *
|
|
||||||
// * @param frame my stack frame.
|
|
||||||
// * @param frame_pointer a pointer to my stack_frame.
|
|
||||||
// * @param env the environment.
|
|
||||||
// * @return the value of the first argument - `expression`.
|
|
||||||
// */
|
|
||||||
// struct cons_pointer lisp_inspect( struct stack_frame *frame,
|
|
||||||
// struct cons_pointer frame_pointer,
|
|
||||||
// struct cons_pointer env ) {
|
|
||||||
// debug_print( L"Entering print\n", DEBUG_IO );
|
|
||||||
// URL_FILE *output;
|
|
||||||
// struct cons_pointer out_stream = writep( frame->arg[1] ) ?
|
|
||||||
// frame->arg[1] : get_default_stream( false, env );
|
|
||||||
|
|
||||||
// if ( writep( out_stream ) ) {
|
// if ( nilp( b.tag.value)) {
|
||||||
// debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
|
// result = make_cons( a, b);
|
||||||
// debug_dump_object( out_stream, DEBUG_IO );
|
|
||||||
// output = pointer2cell( out_stream ).payload.stream.stream;
|
|
||||||
// inc_ref( out_stream );
|
|
||||||
// } else {
|
// } else {
|
||||||
// output = file_to_url_file( stdout );
|
// if ( ! nilp( a)) {
|
||||||
|
// if (a.tag.value == b.tag.value) {
|
||||||
|
|
||||||
|
// struct cons_pointer tail = c_concat( c_cdr( a), b);
|
||||||
|
|
||||||
|
// switch ( a.tag.value) {
|
||||||
|
// case CONSTV:
|
||||||
|
// result = make_cons( c_car( a), tail);
|
||||||
|
// break;
|
||||||
|
// case KEYTV:
|
||||||
|
// case STRINGTV:
|
||||||
|
// case SYMBOLTV:
|
||||||
|
// result = make_string_like_thing()
|
||||||
|
|
||||||
|
// }
|
||||||
|
|
||||||
|
// } else {
|
||||||
|
// // throw an exception
|
||||||
|
// }
|
||||||
|
// }
|
||||||
// }
|
// }
|
||||||
|
|
||||||
|
|
||||||
// dump_object( output, frame->arg[0] );
|
|
||||||
// url_fputws( L"\n", output );
|
|
||||||
|
|
||||||
// if ( writep( out_stream ) ) {
|
// return result;
|
||||||
// dec_ref( out_stream );
|
// }
|
||||||
// } else {
|
|
||||||
// free( output );
|
|
||||||
// }
|
|
||||||
|
|
||||||
// return frame->arg[0];
|
|
||||||
// }
|
|
||||||
|
|
@ -22,6 +22,8 @@
|
||||||
#ifndef __psse_lispops_h
|
#ifndef __psse_lispops_h
|
||||||
#define __psse_lispops_h
|
#define __psse_lispops_h
|
||||||
|
|
||||||
|
extern struct cons_pointer prompt_name;
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* utilities
|
* utilities
|
||||||
*/
|
*/
|
||||||
|
|
|
||||||
|
|
@ -41,8 +41,6 @@ void repl( ) {
|
||||||
struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env );
|
struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env );
|
||||||
|
|
||||||
if ( !nilp( frame_pointer ) ) {
|
if ( !nilp( frame_pointer ) ) {
|
||||||
inc_ref( frame_pointer );
|
|
||||||
|
|
||||||
lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
|
lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
|
||||||
|
|
||||||
dec_ref( frame_pointer );
|
dec_ref( frame_pointer );
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue