diff --git a/post-scarcity.cbp b/post-scarcity.cbp
deleted file mode 100644
index a1f42e0..0000000
--- a/post-scarcity.cbp
+++ /dev/null
@@ -1,157 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/post-scarcity.cscope_file_list b/post-scarcity.cscope_file_list
deleted file mode 100644
index 6fbf5ec..0000000
--- a/post-scarcity.cscope_file_list
+++ /dev/null
@@ -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"
diff --git a/post-scarcity.layout b/post-scarcity.layout
deleted file mode 100644
index 98bd2b3..0000000
--- a/post-scarcity.layout
+++ /dev/null
@@ -1,15 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/src/arith/integer.c b/src/arith/integer.c
index e9d9b79..821b476 100644
--- a/src/arith/integer.c
+++ b/src/arith/integer.c
@@ -272,9 +272,12 @@ struct cons_pointer add_integers( struct cons_pointer a,
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 result = NIL;
+ debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth);
+
for ( int i = 0; i < depth; i++ ) {
result = acquire_integer( 0, result );
}
diff --git a/src/init.c b/src/init.c
index 45b534f..17f8d36 100644
--- a/src/init.c
+++ b/src/init.c
@@ -37,6 +37,34 @@
#include "io/fopen.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
@@ -55,7 +83,8 @@ void bind_function( wchar_t *name, struct cons_pointer ( *executable )
n ),
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 ),
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`.
*/
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( ) {
@@ -227,7 +259,7 @@ int main( int argc, char *argv[] ) {
/*
* the default prompt
*/
- bind_value( L"*prompt*",
+ prompt_name = bind_value( L"*prompt*",
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
/*
* primitive function operations
diff --git a/src/io/print.c b/src/io/print.c
index 8f4b88e..f4aab9f 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -169,9 +169,11 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
print( output, cell.payload.function.meta );
url_fputwc( L'>', output );
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 );
- inc_ref( s );
print_string_contents( output, 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( cell.payload.lambda.args,
cell.payload.lambda.body ) );
- inc_ref( 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( cell.payload.lambda.args,
cell.payload.lambda.body ) );
- inc_ref( to_print );
print( output, to_print );
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 8f9e2a8..81836f8 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -201,7 +201,6 @@ struct cons_pointer make_exception( struct cons_pointer message,
struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
struct cons_space_object *cell = &pointer2cell( pointer );
- inc_ref( message );
inc_ref( frame_pointer );
cell->payload.exception.payload = message;
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_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( body );
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 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 );
inc_ref( args );
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 );
struct cons_space_object *cell = &pointer2cell( pointer );
- inc_ref( tail );
cell->payload.string.character = c;
cell->payload.string.cdr.page = tail.page;
/* \todo There's a problem here. Sometimes the offsets on
diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c
index f2911e5..15b5550 100644
--- a/src/memory/hashmap.c
+++ b/src/memory/hashmap.c
@@ -87,9 +87,9 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
&( map->payload ) )->n_buckets;
map->payload.hashmap.buckets[bucket_no] =
- inc_ref( make_cons( make_cons( key, val ),
+ make_cons( make_cons( key, val ),
map->payload.hashmap.
- buckets[bucket_no] ) );
+ buckets[bucket_no] );
}
}
}
diff --git a/src/ops/intern.c b/src/ops/intern.c
index cafc294..3fb38d3 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -292,7 +292,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
// if ( equal( key, entry.payload.cons.car ) ) {
// result = entry.payload.cons.car;
// }
- if (!nilp( c_assoc( store, key))) {
+ if (!nilp( c_assoc( key, store))) {
result = key;
}
} else {
@@ -340,18 +340,23 @@ struct cons_pointer c_assoc( struct cons_pointer key,
result = hashmap_get( entry_ptr, key );
break;
default:
- throw_exception( c_string_to_lisp_string
- ( L"Store entry is of unknown type" ),
- NIL );
+ throw_exception( c_append(
+ c_string_to_lisp_string( L"Store entry is of unknown type: " ),
+ c_type( entry_ptr)), NIL);
}
}
}
} else if ( hashmapp( store ) ) {
result = hashmap_get( store, key );
} 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 =
- throw_exception( c_string_to_lisp_string
- ( L"Store is of unknown type" ), NIL );
+ throw_exception(
+ 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 );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 236a290..2f549e4 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -38,6 +38,13 @@
#include "memory/stack.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:
* 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.
*/
-
/**
* Useful building block; evaluate this single form in the context of this
* 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 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 new_env = env;
@@ -1558,43 +1564,35 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
}
-// /**
-// * Function; print the internal representation of the object indicated by `frame->arg[0]` to the
-// * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
-// *
-// * * (inspect expression)
-// * * (inspect expression )
-// *
-// * @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 );
+// struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) {
+// struct cons_pointer result = b;
-// if ( writep( out_stream ) ) {
-// debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
-// debug_dump_object( out_stream, DEBUG_IO );
-// output = pointer2cell( out_stream ).payload.stream.stream;
-// inc_ref( out_stream );
+// if ( nilp( b.tag.value)) {
+// result = make_cons( a, b);
// } 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 ) ) {
-// dec_ref( out_stream );
-// } else {
-// free( output );
-// }
-
-// return frame->arg[0];
-// }
+// return result;
+// }
\ No newline at end of file
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index da1f27e..ec84d61 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -22,6 +22,8 @@
#ifndef __psse_lispops_h
#define __psse_lispops_h
+extern struct cons_pointer prompt_name;
+
/*
* utilities
*/
diff --git a/src/repl.c b/src/repl.c
index b68fa1c..5295465 100644
--- a/src/repl.c
+++ b/src/repl.c
@@ -41,8 +41,6 @@ void repl( ) {
struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env );
if ( !nilp( frame_pointer ) ) {
- inc_ref( frame_pointer );
-
lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
dec_ref( frame_pointer );