From 72548097cf9362e0c1f29559e81403267940a8c0 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 11:21:11 +0000
Subject: [PATCH 1/6] Rewriting intern. This is badly broken, but I think on
 the road to better.

---
 src/init.c                   |  3 ++
 src/memory/consspaceobject.c |  2 +-
 src/ops/equal.c              |  3 +-
 src/ops/intern.c             | 97 +++++++++++++++++++++++-------------
 src/ops/intern.h             |  3 ++
 src/ops/lispops.c            | 33 ++++++++++--
 src/ops/lispops.h            |  3 ++
 7 files changed, 103 insertions(+), 41 deletions(-)

diff --git a/src/init.c b/src/init.c
index f1301ee..5febcbc 100644
--- a/src/init.c
+++ b/src/init.c
@@ -401,6 +401,9 @@ int main( int argc, char *argv[] ) {
     bind_function( L"inspect",
                    L"`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.",
                    &lisp_inspect );
+    bind_function( L"interned?",
+                   L"`(interned? key store)`: Return `t` if the symbol or keyword `key` is bound in this `store`, else `nil`.",
+                   &lisp_internedp );
     bind_function( L"keys",
                    L"`(keys store)`: Return a list of all keys in this `store`.",
                    &lisp_keys );
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 3793709..8c4c5c0 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -388,7 +388,7 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
         result = make_string_like_thing( c, tail, tag );
 
         if ( tag == KEYTV ) {
-            struct cons_pointer r = internedp( result, oblist );
+            struct cons_pointer r = interned( result, oblist );
 
             if ( nilp( r ) ) {
                 intern( result, oblist );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index b4412fb..ea813a9 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -375,8 +375,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
                     memset( a_buff, 0, sizeof( a_buff ) );
                     memset( b_buff, 0, sizeof( b_buff ) );
 
-                    for ( ;
-                          ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
+                    for ( ; ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
                           && !nilp( b ); i++ ) {
                         a_buff[i] = cell_a->payload.string.character;
                         a = c_cdr( a );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index e064ac4..39e121f 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -270,54 +270,81 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
 // (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
 
 /**
- * Implementation of interned? in C. The final implementation if interned? will
- * deal with stores which can be association lists or hashtables or hybrids of
- * the two, but that will almost certainly be implemented in lisp.
- *
  * If this key is lexically identical to a key in this store, return the key
  * from the store (so that later when we want to retrieve a value, an eq test
  * will work); otherwise return NIL.
  */
-struct cons_pointer
-internedp( struct cons_pointer key, struct cons_pointer store ) {
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        // TODO: I see what I was doing here and it would be the right thing to 
-        // do for stores which are old-fashioned assoc lists, but it will not work
-        // for my new hybrid stores.
-        // for ( struct cons_pointer next = store;
-        //       nilp( result ) && consp( next );
-        //       next = pointer2cell( next ).payload.cons.cdr ) {
-        //     struct cons_space_object entry =
-        //         pointer2cell( pointer2cell( next ).payload.cons.car );
+        struct cons_space_object *cell = &pointer2cell( store );
 
-        //     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 );
+        switch ( cell->tag.value ) {
+            case CONSTV:
+                for ( struct cons_pointer next = store;
+                      nilp( result ) && consp( next );
+                      next = c_cdr( next) ) {
+                    if ( !nilp( next ) ) {
+                        // struct cons_space_object entry =
+                        //     pointer2cell( c_car( next) );
 
-        //     if ( equal( key, entry.payload.cons.car ) ) {
-        //         result = entry.payload.cons.car;
-        //     }
-        if ( !nilp( c_assoc( key, store ) ) ) {
-            result = key;
-        } else if ( equal( key, privileged_symbol_nil ) ) {
-            result = privileged_symbol_nil;
+                        if ( equal( key, c_car(next) ) ) {
+                            result = key;
+                        }
+                    }
+                }
+                break;
+            case VECTORPOINTTV:
+                if ( hashmapp( store ) || namespacep( store ) ) {
+                    // get the right hash bucket and recursively call interned on that.
+                    struct vector_space_object *map = pointer_to_vso( store );
+                    uint32_t bucket_no =
+                        get_hash( key ) % map->payload.hashmap.n_buckets;
+
+                    result =
+                        interned( key,
+                                  map->payload.hashmap.buckets[bucket_no] );
+                } else {
+                    result =
+                        throw_exception( make_cons
+                                         ( c_string_to_lisp_string
+                                           ( L"Unexpected store type: " ),
+                                           c_type( store ) ), NIL );
+                }
+                break;
+            default:
+                result =
+                    throw_exception( make_cons
+                                     ( c_string_to_lisp_string
+                                       ( L"Unexpected store type: " ),
+                                       c_type( store ) ), NIL );
+                break;
         }
     } else {
-        debug_print( L"`", DEBUG_BIND );
-        debug_print_object( key, DEBUG_BIND );
-        debug_print( L"` is a ", DEBUG_BIND );
-        debug_printf( DEBUG_BIND, L"%4.4s",
-                      ( char * ) pointer2cell( key ).tag.bytes );
-        debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
+        result =
+            throw_exception( make_cons
+                             ( c_string_to_lisp_string
+                               ( L"Unexpected key type: " ), c_type( key ) ),
+                             NIL );
     }
 
     return result;
 }
 
+/**
+ * @brief Implementation of `interned?` in C: predicate wrapped around interned.
+ * 
+ * @param key the key to search for.
+ * @param store the store to search in.
+ * @return struct cons_pointer `t` if the key was found, else `nil`.
+ */
+struct cons_pointer internedp( struct cons_pointer key,
+                               struct cons_pointer store ) {
+    return nilp( interned( key, store ) ) ? NIL : TRUE;
+}
+
 /**
  * Implementation of assoc in C. Like interned?, the final implementation will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -370,7 +397,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 // #endif
                 }
             }
-        } else if ( hashmapp( store ) ) {
+        } else if ( hashmapp( store ) || namespacep( store ) ) {
             result = hashmap_get( store, key );
         } else if ( !nilp( store ) ) {
 // #ifdef DEBUG        
@@ -426,7 +453,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = vectorpointp( store );
+    bool deep = eq( store, oblist);
     debug_print_binding( key, value, deep, DEBUG_BIND );
 
     if ( deep ) {
@@ -480,7 +507,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
     struct cons_pointer canonical = internedp( key, environment );
     if ( nilp( canonical ) ) {
         /*
-         * not currently bound
+         * not currently bound. TODO: should this bind to NIL?
          */
         result = set( key, TRUE, environment );
     }
diff --git a/src/ops/intern.h b/src/ops/intern.h
index bc22bf7..4043e66 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -49,6 +49,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer environment );
+
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 7333c3f..be4227b 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -517,8 +517,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
         case SYMBOLTV:
             {
-                struct cons_pointer canonical =
-                    internedp( frame->arg[0], env );
+                struct cons_pointer canonical = interned( frame->arg[0], env );
                 if ( nilp( canonical ) ) {
                     struct cons_pointer message =
                         make_cons( c_string_to_lisp_string
@@ -835,7 +834,35 @@ struct cons_pointer lisp_length( struct stack_frame *frame,
 struct cons_pointer
 lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
-    return c_assoc( frame->arg[0], frame->arg[1] );
+    return c_assoc( frame->arg[0],
+                    nilp( frame->arg[1] ) ? oblist : frame->arg[1] );
+}
+
+/**
+ * @brief `(interned? key store)`: Return `t` if the symbol or keyword `key` is bound in this `store`, else `nil`.
+ * 
+ * @param frame 
+ * @param frame_pointer 
+ * @param env 
+ * @return struct cons_pointer 
+ */
+struct cons_pointer
+lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                struct cons_pointer env ) {
+    struct cons_pointer result = internedp( frame->arg[0],
+                                            nilp( frame->
+                                                  arg[1] ) ? oblist : frame->
+                                            arg[1] );
+
+    if ( exceptionp( result ) ) {
+        struct cons_pointer old = result;
+        struct cons_space_object *cell = &( pointer2cell( result ) );
+        result =
+            throw_exception( cell->payload.exception.payload, frame_pointer );
+        dec_ref( old );
+    }
+
+    return result;
 }
 
 struct cons_pointer c_keys( struct cons_pointer store ) {
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index aea8772..06407c2 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -131,6 +131,9 @@ struct cons_pointer lisp_cdr( struct stack_frame *frame,
 struct cons_pointer lisp_inspect( struct stack_frame *frame,
                                   struct cons_pointer frame_pointer,
                                   struct cons_pointer env );
+struct cons_pointer lisp_internedp( struct stack_frame *frame,
+                                    struct cons_pointer frame_pointer,
+                                    struct cons_pointer env );
 struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer frame_pointer,
                              struct cons_pointer env );

From 54f6f023c63035567ca88e89ab398d0a970f1b67 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 12:24:59 +0000
Subject: [PATCH 2/6] More debugging output. Getting desperate!

---
 src/io/io.c       |  4 ++--
 src/memory/dump.c |  8 ++++----
 src/ops/intern.c  | 39 ++++++++++++++++++++-------------------
 src/ops/lispops.c | 24 ++++++++++--------------
 4 files changed, 36 insertions(+), 39 deletions(-)

diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 39e121f..5a81fb3 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -278,19 +278,22 @@ struct cons_pointer interned( struct cons_pointer key,
                               struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
+    debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+
     if ( symbolp( key ) || keywordp( key ) ) {
         struct cons_space_object *cell = &pointer2cell( store );
 
         switch ( cell->tag.value ) {
             case CONSTV:
                 for ( struct cons_pointer next = store;
-                      nilp( result ) && consp( next );
-                      next = c_cdr( next) ) {
+                      nilp( result ) && consp( next ); next = c_cdr( next ) ) {
                     if ( !nilp( next ) ) {
                         // struct cons_space_object entry =
                         //     pointer2cell( c_car( next) );
 
-                        if ( equal( key, c_car(next) ) ) {
+                        if ( equal( key, c_car( next ) ) ) {
                             result = key;
                         }
                     }
@@ -330,6 +333,10 @@ struct cons_pointer interned( struct cons_pointer key,
                              NIL );
     }
 
+    debug_print( L"interned: returning `", DEBUG_BIND );
+    debug_print_object( result, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+
     return result;
 }
 
@@ -441,19 +448,23 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
                        map->payload.hashmap.buckets[bucket_no] );
     }
 
+    debug_print(L"hashmap_put:\n", DEBUG_BIND);
+    debug_dump_object( mapp, DEBUG_BIND);
+
     return mapp;
 }
 
-    /**
-     * Return a new key/value store containing all the key/value pairs in this
-     * store with this key/value pair added to the front.
-     */
+/**
+ * If this store is modifiable, add this key value pair to it. Otherwise,
+ * return a new key/value store containing all the key/value pairs in this
+ * store with this key/value pair added to the front.
+ */
 struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                          struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
 #ifdef DEBUG
-    bool deep = eq( store, oblist);
+    bool deep = eq( store, oblist );
     debug_print_binding( key, value, deep, DEBUG_BIND );
 
     if ( deep ) {
@@ -461,9 +472,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
                       pointer2cell( store ).payload.vectorp.tag.bytes );
     }
 #endif
-    if ( nilp( value ) ) {
-        result = store;
-    } else if ( nilp( store ) || consp( store ) ) {
+    if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
         result = hashmap_put( store, key, value );
@@ -479,16 +488,8 @@ struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
     debug_print( L"Entering deep_bind\n", DEBUG_BIND );
 
-    struct cons_pointer old = oblist;
-
     oblist = set( key, value, oblist );
 
-    // The oblist is not now an assoc list, and I don't think it will be again.
-    // if ( consp( oblist ) ) {
-    //     inc_ref( oblist );
-    //     dec_ref( old );
-    // }
-
     debug_print( L"deep_bind returning ", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
     debug_println( DEBUG_BIND );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index be4227b..4a89d98 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.
-                              special.executable ) ( get_stack_frame
-                                                     ( next_pointer ),
-                                                     next_pointer, env );
+                            ( *fn_cell.payload.special.
+                              executable ) ( get_stack_frame( next_pointer ),
+                                             next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -850,9 +849,8 @@ struct cons_pointer
 lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer result = internedp( frame->arg[0],
-                                            nilp( frame->
-                                                  arg[1] ) ? oblist : frame->
-                                            arg[1] );
+                                            nilp( frame->arg[1] ) ? oblist :
+                                            frame->arg[1] );
 
     if ( exceptionp( result ) ) {
         struct cons_pointer old = result;
@@ -1313,8 +1311,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1497,14 +1494,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From a1c377bc7c7ded8b175a346e9028212db418bc51 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 15:15:42 +0000
Subject: [PATCH 3/6] Established intern bug is in getting, not setting;
 improved exceptions.

---
 src/arith/peano.c            |  36 ++++--
 src/arith/ratio.c            |  16 ++-
 src/init.c                   |  10 +-
 src/io/read.c                |  15 ++-
 src/memory/consspaceobject.c |  14 +++
 src/memory/consspaceobject.h |  17 +++
 src/ops/intern.c             |  21 ++--
 src/ops/lispops.c            | 206 ++++++++++++++++++++++++-----------
 src/ops/lispops.h            |   3 +-
 9 files changed, 241 insertions(+), 97 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index 995ce0f..3e85412 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -296,7 +296,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_string
+                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                                   ( L"Cannot add: not a number" ),
                                                   frame_pointer );
                         break;
@@ -319,7 +320,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_string
+                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                                   ( L"Cannot add: not a number" ),
                                                   frame_pointer );
                         break;
@@ -332,7 +334,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                 break;
             default:
                 result = exceptionp( arg2 ) ? arg2 :
-                    throw_exception( c_string_to_lisp_string
+                    throw_exception( c_string_to_lisp_symbol( L"+"),
+                            c_string_to_lisp_string
                                      ( L"Cannot add: not a number" ),
                                      frame_pointer );
         }
@@ -428,7 +431,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number: " ),
                                                c_type( arg2 ) ),
@@ -454,7 +458,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number" ),
                                                c_type( arg2 ) ),
@@ -467,7 +472,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                                to_long_double( arg2 ) );
                 break;
             default:
-                result = throw_exception( make_cons( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"*"),
+                            make_cons( c_string_to_lisp_string
                                                      ( L"Cannot multiply: argument 1 is not a number" ),
                                                      c_type( arg1 ) ),
                                           frame_pointer );
@@ -620,7 +626,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -650,7 +657,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -661,7 +669,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"-"),
+                            c_string_to_lisp_string
                                       ( L"Cannot subtract: not a number" ),
                                       frame_pointer );
             break;
@@ -732,7 +741,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -762,7 +772,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -774,7 +785,8 @@ struct cons_pointer lisp_divide( struct
                            to_long_double( frame->arg[1] ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"/"),
+                            c_string_to_lisp_string
                                       ( L"Cannot divide: not a number" ),
                                       frame_pointer );
             break;
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 1c20a4f..011ef43 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -114,7 +114,9 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                              cell1->payload.ratio.divisor ) );
         r = make_ratio( dividend, divisor, true );
     } else {
-        r = throw_exception( make_cons( c_string_to_lisp_string
+        r = throw_exception( c_string_to_lisp_symbol( L"+"),
+                            make_cons( 
+                            c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -154,7 +156,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
         dec_ref( ratio );
     } else {
         result =
-            throw_exception( make_cons( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"+"),
+                            make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_integer_ratio" ),
                                         make_cons( intarg,
                                                    make_cons( ratarg,
@@ -234,7 +237,8 @@ struct cons_pointer multiply_ratio_ratio( struct
         release_integer( divisor );
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
                              NIL );
     }
@@ -269,7 +273,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
         release_integer( one );
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*"),
+                            c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
                              NIL );
     }
@@ -337,7 +342,8 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"make_ratio"),
+                            c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
diff --git a/src/init.c b/src/init.c
index 5febcbc..8c8da7c 100644
--- a/src/init.c
+++ b/src/init.c
@@ -84,12 +84,18 @@ void maybe_bind_init_symbols(  ) {
     if ( nilp( privileged_symbol_nil ) ) {
         privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
     }
+    // we can't make this string when we need it, because memory is then 
+    // exhausted!
     if ( nilp( privileged_string_memory_exhausted ) ) {
-        // we can't make this string when we need it, because memory is then 
-        // exhausted!
         privileged_string_memory_exhausted =
             c_string_to_lisp_string( L"Memory exhausted." );
     }
+    if ( nilp( privileged_keyword_location ) ) {
+        privileged_keyword_location = c_string_to_lisp_keyword( L"location" );
+    }
+    if ( nilp( privileged_keyword_payload ) ) {
+        privileged_keyword_location = c_string_to_lisp_keyword( L"payload" );
+    }
 }
 
 void free_init_symbols(  ) {
diff --git a/src/io/read.c b/src/io/read.c
index 9ca49f0..5ffb143 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -167,7 +167,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
 
     if ( url_feof( input ) ) {
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                              ( L"End of file while reading" ), frame_pointer );
     } else {
         switch ( c ) {
@@ -177,7 +178,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 /* skip all characters from semi-colon to the end of the line */
                 break;
             case EOF:
-                result = throw_exception( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                           ( L"End of input while reading" ),
                                           frame_pointer );
                 break;
@@ -266,7 +268,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                     result = read_symbol_or_key( input, SYMBOLTV, c );
                 } else {
                     result =
-                        throw_exception( make_cons( c_string_to_lisp_string
+                        throw_exception(c_string_to_lisp_symbol( L"read"),
+                             make_cons( c_string_to_lisp_string
                                                     ( L"Unrecognised start of input character" ),
                                                     make_string( c, NIL ) ),
                                          frame_pointer );
@@ -313,7 +316,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                             ( L"Malformed number: too many periods" ),
                                             frame_pointer );
                 } else {
@@ -324,7 +328,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             case LSLASH:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read"),
+                            c_string_to_lisp_string
                                             ( L"Malformed number: dividend of rational must be integer" ),
                                             frame_pointer );
                 } else {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 8c4c5c0..c461f10 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -27,6 +27,20 @@
 #include "memory/vectorspace.h"
 #include "ops/intern.h"
 
+/**
+ * Keywords used when constructing exceptions: `:location`. Instantiated in 
+ * `init.c`q.v.
+ */
+struct cons_pointer privileged_keyword_location = NIL;
+
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`, q.v.
+ */
+struct cons_pointer privileged_keyword_payload = NIL;
+
+
+
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index adde136..bddd232 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -56,6 +56,18 @@
  */
 #define EXCEPTIONTV 1346721861
 
+/**
+ * Keywords used when constructing exceptions: `:location`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_location;
+
+/**
+ * Keywords used when constructing exceptions: `:payload`. Instantiated in 
+ * `init.c`.
+ */
+extern struct cons_pointer privileged_keyword_payload;
+
 /**
  * An unallocated cell on the free list - should never be encountered by a Lisp
  * function.
@@ -296,6 +308,11 @@
  */
 #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+#define get_tag_value(conspoint) ((pointer2cell(conspoint)).tag.value)
+
 /**
  * true if `conspoint` points to the special cell NIL, else false
  * (there should only be one of these so it's slightly redundant).
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 5a81fb3..2764bae 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -311,7 +311,8 @@ struct cons_pointer interned( struct cons_pointer key,
                                   map->payload.hashmap.buckets[bucket_no] );
                 } else {
                     result =
-                        throw_exception( make_cons
+                        throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                            make_cons
                                          ( c_string_to_lisp_string
                                            ( L"Unexpected store type: " ),
                                            c_type( store ) ), NIL );
@@ -319,7 +320,8 @@ struct cons_pointer interned( struct cons_pointer key,
                 break;
             default:
                 result =
-                    throw_exception( make_cons
+                    throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                            make_cons
                                      ( c_string_to_lisp_string
                                        ( L"Unexpected store type: " ),
                                        c_type( store ) ), NIL );
@@ -327,7 +329,8 @@ struct cons_pointer interned( struct cons_pointer key,
         }
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"interned?"),
+                make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
@@ -389,7 +392,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             result = hashmap_get( entry_ptr, key );
                             break;
                         default:
-                            throw_exception( c_append
+                            throw_exception( c_string_to_lisp_symbol( L"assoc"),
+                            c_append
                                              ( c_string_to_lisp_string
                                                ( L"Store entry is of unknown type: " ),
                                                c_type( entry_ptr ) ), NIL );
@@ -413,7 +417,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 //             debug_print( L"`\n", DEBUG_BIND );
 // #endif
             result =
-                throw_exception( c_append
+                throw_exception( c_string_to_lisp_symbol(L"assoc"),
+                    c_append
                                  ( c_string_to_lisp_string
                                    ( L"Store is of unknown type: " ),
                                    c_type( store ) ), NIL );
@@ -448,8 +453,8 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
                        map->payload.hashmap.buckets[bucket_no] );
     }
 
-    debug_print(L"hashmap_put:\n", DEBUG_BIND);
-    debug_dump_object( mapp, DEBUG_BIND);
+    debug_print( L"hashmap_put:\n", DEBUG_BIND );
+    debug_dump_object( mapp, DEBUG_BIND );
 
     return mapp;
 }
@@ -508,7 +513,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
     struct cons_pointer canonical = internedp( key, environment );
     if ( nilp( canonical ) ) {
         /*
-         * not currently bound. TODO: should this bind to NIL?
+         * not currently bound. TODO: this should bind to NIL?
          */
         result = set( key, TRUE, environment );
     }
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 4a89d98..3cb0287 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -248,7 +248,7 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * Evaluate a lambda or nlambda expression.
  */
 struct cons_pointer
-eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
+eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
              struct cons_pointer frame_pointer, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
 #ifdef DEBUG
@@ -257,8 +257,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
 #endif
 
     struct cons_pointer new_env = env;
-    struct cons_pointer names = cell.payload.lambda.args;
-    struct cons_pointer body = cell.payload.lambda.body;
+    struct cons_pointer names = cell->payload.lambda.args;
+    struct cons_pointer body = cell->payload.lambda.body;
 
     if ( consp( names ) ) {
         /* if `names` is a list, bind successive items from that list
@@ -328,6 +328,57 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame,
     return result;
 }
 
+/**
+ * if `r` is an exception, and it doesn't have a location, fix up its location from
+ * the name associated with this fn_pointer, if any. 
+ */
+struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
+                                                    struct cons_pointer
+                                                    fn_pointer ) {
+    struct cons_pointer result = r;
+        
+    if ( exceptionp( result ) && (functionp( fn_pointer) || specialp(fn_pointer))) {
+        struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
+
+        struct cons_pointer payload =
+            pointer2cell( result ).payload.exception.payload;
+        /* TODO: should name_key also be a privileged keyword? */
+        struct cons_pointer name_key =
+                        c_string_to_lisp_keyword( L"name" );
+
+        switch ( get_tag_value( payload ) ) {
+            case NILTV:
+            case CONSTV:
+            case HASHTV:
+                {
+                    if ( nilp( c_assoc( privileged_keyword_location ,
+                           payload ) )) {
+                        pointer2cell( result ).payload.exception.payload =
+                            set( privileged_keyword_location,
+                                    c_assoc( name_key,
+                                             fn_cell->payload.function.meta ),
+                                    payload );
+                    }
+                }
+                break;
+            default:
+                pointer2cell( result ).payload.exception.payload =
+                    make_cons( 
+                        make_cons( privileged_keyword_location,
+                                 c_assoc( name_key,
+                                          fn_cell->payload.function.meta ) ),
+                               make_cons( 
+                                    make_cons( privileged_keyword_payload,
+                                            payload ) , 
+                                            NIL ));
+        }
+
+        dec_ref( name_key);
+    }
+
+    return result;
+}
+
 
 /**
  * Internal guts of apply.
@@ -348,10 +399,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( exceptionp( fn_pointer ) ) {
         result = fn_pointer;
     } else {
-        struct cons_space_object fn_cell = pointer2cell( fn_pointer );
+        struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
         struct cons_pointer args = c_cdr( frame->arg[0] );
 
-        switch ( fn_cell.tag.value ) {
+        switch ( get_tag_value( fn_pointer ) ) {
             case EXCEPTIONTV:
                 /* just pass exceptions straight back */
                 result = fn_pointer;
@@ -369,10 +420,15 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         struct stack_frame *next =
                             get_stack_frame( next_pointer );
 
-                        result =
-                            ( *fn_cell.payload.function.executable ) ( next,
-                                                                       next_pointer,
-                                                                       env );
+                        result = maybe_fixup_exception_location( ( *
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
+                                                                 ( next,
+                                                                   next_pointer,
+                                                                   env ),
+                                                                 fn_pointer );
                         dec_ref( next_pointer );
                     }
                 }
@@ -406,18 +462,14 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 }
                 break;
 
-            case VECTORPOINTTV:
-                switch ( pointer_to_vso( fn_pointer )->header.tag.value ) {
-                    case HASHTV:
-                        /* \todo: if arg[0] is a CONS, treat it as a path */
-                        result = c_assoc( eval_form( frame,
-                                                     frame_pointer,
-                                                     c_car( c_cdr
-                                                            ( frame->arg
-                                                              [0] ) ), env ),
-                                          fn_pointer );
-                        break;
-                }
+            case HASHTV:
+                /* \todo: if arg[0] is a CONS, treat it as a path */
+                result = c_assoc( eval_form( frame,
+                                             frame_pointer,
+                                             c_car( c_cdr
+                                                    ( frame->arg
+                                                      [0] ) ), env ),
+                                  fn_pointer );
                 break;
 
             case NLAMBDATV:
@@ -441,14 +493,16 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 {
                     struct cons_pointer next_pointer =
                         make_special_frame( frame_pointer, args, env );
-                    inc_ref( next_pointer );
+                    // inc_ref( next_pointer );
                     if ( exceptionp( next_pointer ) ) {
                         result = next_pointer;
                     } else {
-                        result =
-                            ( *fn_cell.payload.special.
-                              executable ) ( get_stack_frame( next_pointer ),
-                                             next_pointer, env );
+                        result = maybe_fixup_exception_location( ( *
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
+                                                                 ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -464,13 +518,16 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                     memset( buffer, '\0', bs );
                     swprintf( buffer, bs,
                               L"Unexpected cell with tag %d (%4.4s) in function position",
-                              fn_cell.tag.value, &fn_cell.tag.bytes[0] );
+                              fn_cell->tag.value, &( fn_cell->tag.bytes[0] ) );
                     struct cons_pointer message =
                         c_string_to_lisp_string( buffer );
                     free( buffer );
-                    result = throw_exception( message, frame_pointer );
+                    result =
+                        throw_exception( c_string_to_lisp_symbol( L"apply" ),
+                                         message, frame_pointer );
                 }
         }
+
     }
 
     debug_print( L"c_apply: returning: ", DEBUG_EVAL );
@@ -507,9 +564,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
     debug_dump_object( frame_pointer, DEBUG_EVAL );
 
     struct cons_pointer result = frame->arg[0];
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
             result = c_apply( frame, frame_pointer, env );
             break;
@@ -522,7 +579,9 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         make_cons( c_string_to_lisp_string
                                    ( L"Attempt to take value of unbound symbol." ),
                                    frame->arg[0] );
-                    result = throw_exception( message, frame_pointer );
+                    result =
+                        throw_exception( c_string_to_lisp_symbol( L"eval" ),
+                                         message, frame_pointer );
                 } else {
                     result = c_assoc( canonical, env );
                     inc_ref( result );
@@ -623,7 +682,8 @@ lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
         result = frame->arg[1];
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"set" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"The first argument to `set` is not a symbol: " ),
                                make_cons( frame->arg[0], NIL ) ),
@@ -662,7 +722,8 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
         result = val;
     } else {
         result =
-            throw_exception( make_cons
+            throw_exception( c_string_to_lisp_symbol( L"set!" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"The first argument to `set!` is not a symbol: " ),
                                make_cons( frame->arg[0], NIL ) ),
@@ -734,24 +795,25 @@ struct cons_pointer
 lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer,
           struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
-            result = cell.payload.cons.car;
+            result = cell->payload.cons.car;
             break;
         case NILTV:
             break;
         case READTV:
             result =
-                make_string( url_fgetwc( cell.payload.stream.stream ), NIL );
+                make_string( url_fgetwc( cell->payload.stream.stream ), NIL );
             break;
         case STRINGTV:
-            result = make_string( cell.payload.string.character, NIL );
+            result = make_string( cell->payload.string.character, NIL );
             break;
         default:
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"car" ),
+                                 c_string_to_lisp_string
                                  ( L"Attempt to take CAR of non sequence" ),
                                  frame_pointer );
     }
@@ -778,24 +840,25 @@ struct cons_pointer
 lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer,
           struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
 
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case CONSTV:
-            result = cell.payload.cons.cdr;
+            result = cell->payload.cons.cdr;
             break;
         case NILTV:
             break;
         case READTV:
-            url_fgetwc( cell.payload.stream.stream );
+            url_fgetwc( cell->payload.stream.stream );
             result = frame->arg[0];
             break;
         case STRINGTV:
-            result = cell.payload.string.cdr;
+            result = cell->payload.string.cdr;
             break;
         default:
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"cdr" ),
+                                 c_string_to_lisp_string
                                  ( L"Attempt to take CDR of non sequence" ),
                                  frame_pointer );
     }
@@ -856,7 +919,8 @@ lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
         struct cons_pointer old = result;
         struct cons_space_object *cell = &( pointer2cell( result ) );
         result =
-            throw_exception( cell->payload.exception.payload, frame_pointer );
+            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                             cell->payload.exception.payload, frame_pointer );
         dec_ref( old );
     }
 
@@ -1213,7 +1277,8 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
 #endif
         }
     } else {
-        result = throw_exception( c_string_to_lisp_string
+        result = throw_exception( c_string_to_lisp_symbol( L"cond" ),
+                                  c_string_to_lisp_string
                                   ( L"Arguments to `cond` must be lists" ),
                                   frame_pointer );
     }
@@ -1271,18 +1336,25 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * pointer to the frame in which the exception occurred.
  */
 struct cons_pointer
-throw_exception( struct cons_pointer message,
+throw_exception( struct cons_pointer location,
+                 struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
     debug_print( L"\nERROR: ", DEBUG_EVAL );
     debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
-    struct cons_space_object cell = pointer2cell( message );
+    struct cons_space_object *cell = &pointer2cell( message );
 
-    if ( cell.tag.value == EXCEPTIONTV ) {
+    if ( cell->tag.value == EXCEPTIONTV ) {
         result = message;
     } else {
-        result = make_exception( message, frame_pointer );
+        result =
+            make_exception( make_cons
+                            ( make_cons( privileged_keyword_location,
+                                         location ),
+                              make_cons( make_cons
+                                         ( privileged_keyword_payload,
+                                           message ), NIL ) ), frame_pointer );
     }
 
     return result;
@@ -1295,7 +1367,7 @@ throw_exception( struct cons_pointer message,
  * normally return. A function which detects a problem it cannot resolve
  * *should* return an exception.
  *
- * * (exception message frame)
+ * * (exception message location)
  *
  * @param frame my stack frame.
  * @param frame_pointer a pointer to my stack_frame.
@@ -1310,7 +1382,9 @@ struct cons_pointer
 lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
+
     return exceptionp( message ) ? message : throw_exception( message,
+                                                              frame->arg[1],
                                                               frame->previous );
 }
 
@@ -1444,24 +1518,24 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
                                  struct cons_pointer frame_pointer,
                                  struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
+    struct cons_space_object *cell = &pointer2cell( frame->arg[0] );
     struct cons_pointer source_key = c_string_to_lisp_keyword( L"source" );
-    switch ( cell.tag.value ) {
+    switch ( cell->tag.value ) {
         case FUNCTIONTV:
-            result = c_assoc( source_key, cell.payload.function.meta );
+            result = c_assoc( source_key, cell->payload.function.meta );
             break;
         case SPECIALTV:
-            result = c_assoc( source_key, cell.payload.special.meta );
+            result = c_assoc( source_key, cell->payload.special.meta );
             break;
         case LAMBDATV:
             result = make_cons( c_string_to_lisp_symbol( L"lambda" ),
-                                make_cons( cell.payload.lambda.args,
-                                           cell.payload.lambda.body ) );
+                                make_cons( cell->payload.lambda.args,
+                                           cell->payload.lambda.body ) );
             break;
         case NLAMBDATV:
             result = make_cons( c_string_to_lisp_symbol( L"nlambda" ),
-                                make_cons( cell.payload.lambda.args,
-                                           cell.payload.lambda.body ) );
+                                make_cons( cell->payload.lambda.args,
+                                           cell->payload.lambda.body ) );
             break;
     }
     // \todo suffers from premature GC, and I can't see why!
@@ -1484,7 +1558,8 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
                                       c_append( c_cdr( l1 ), l2 ) );
                 }
             } else {
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"append" ),
+                                 c_string_to_lisp_string
                                  ( L"Can't append: not same type" ), NIL );
             }
             break;
@@ -1505,12 +1580,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
                                                 pointer2cell( l1 ).tag.value );
                 }
             } else {
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"append" ),
+                                 c_string_to_lisp_string
                                  ( L"Can't append: not same type" ), NIL );
             }
             break;
         default:
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"append" ),
+                             c_string_to_lisp_string
                              ( L"Can't append: not a sequence" ), NIL );
             break;
     }
@@ -1622,7 +1699,8 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
             bindings = make_cons( make_cons( symbol, val ), bindings );
         } else {
             result =
-                throw_exception( c_string_to_lisp_string
+                throw_exception( c_string_to_lisp_symbol( L"let" ),
+                                 c_string_to_lisp_string
                                  ( L"Let: cannot bind, not a symbol" ),
                                  frame_pointer );
             break;
diff --git a/src/ops/lispops.h b/src/ops/lispops.h
index 06407c2..da2428a 100644
--- a/src/ops/lispops.h
+++ b/src/ops/lispops.h
@@ -196,7 +196,8 @@ struct cons_pointer lisp_cond( struct stack_frame *frame,
  * signature of a lisp function; but it is nevertheless to be preferred to
  * make_exception. A real `throw_exception`, which does, will be needed.
  */
-struct cons_pointer throw_exception( struct cons_pointer message,
+struct cons_pointer throw_exception( struct cons_pointer location,
+                                     struct cons_pointer message,
                                      struct cons_pointer frame_pointer );
 
 struct cons_pointer lisp_exception( struct stack_frame *frame,

From bcb227a5f99b172b48e629dd88941f5eebdcf21b Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 28 Feb 2026 18:09:48 +0000
Subject: [PATCH 4/6] Still not working, but I have increasing confidence I'm
 on the right track.

---
 src/arith/peano.c            | 58 +++++++++++++++++++-----------------
 src/arith/ratio.c            | 21 +++++++------
 src/init.c                   |  5 +++-
 src/io/io.c                  |  4 +--
 src/io/read.c                | 20 ++++++-------
 src/memory/consspaceobject.c |  8 ++---
 src/memory/dump.c            |  8 ++---
 src/memory/stack.c           |  4 +++
 src/ops/intern.c             | 33 ++++++++++----------
 src/ops/lispops.c            | 57 ++++++++++++++++-------------------
 10 files changed, 110 insertions(+), 108 deletions(-)

diff --git a/src/arith/peano.c b/src/arith/peano.c
index 3e85412..9a1b478 100644
--- a/src/arith/peano.c
+++ b/src/arith/peano.c
@@ -296,10 +296,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
-                                                  ( L"Cannot add: not a number" ),
-                                                  frame_pointer );
+                        result =
+                            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                             c_string_to_lisp_string
+                                             ( L"Cannot add: not a number" ),
+                                             frame_pointer );
                         break;
                 }
                 break;
@@ -320,10 +321,11 @@ struct cons_pointer add_2( struct stack_frame *frame,
                                        to_long_double( arg2 ) );
                         break;
                     default:
-                        result = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
-                                                  ( L"Cannot add: not a number" ),
-                                                  frame_pointer );
+                        result =
+                            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                             c_string_to_lisp_string
+                                             ( L"Cannot add: not a number" ),
+                                             frame_pointer );
                         break;
                 }
                 break;
@@ -334,8 +336,8 @@ struct cons_pointer add_2( struct stack_frame *frame,
                 break;
             default:
                 result = exceptionp( arg2 ) ? arg2 :
-                    throw_exception( c_string_to_lisp_symbol( L"+"),
-                            c_string_to_lisp_string
+                    throw_exception( c_string_to_lisp_symbol( L"+" ),
+                                     c_string_to_lisp_string
                                      ( L"Cannot add: not a number" ),
                                      frame_pointer );
         }
@@ -431,8 +433,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                             make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number: " ),
                                                c_type( arg2 ) ),
@@ -458,8 +460,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                         break;
                     default:
                         result =
-                            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons
+                            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                             make_cons
                                              ( c_string_to_lisp_string
                                                ( L"Cannot multiply: argument 2 is not a number" ),
                                                c_type( arg2 ) ),
@@ -472,8 +474,8 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
                                to_long_double( arg2 ) );
                 break;
             default:
-                result = throw_exception( c_string_to_lisp_symbol( L"*"),
-                            make_cons( c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"*" ),
+                                          make_cons( c_string_to_lisp_string
                                                      ( L"Cannot multiply: argument 1 is not a number" ),
                                                      c_type( arg1 ) ),
                                           frame_pointer );
@@ -626,8 +628,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -657,8 +659,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                                    to_long_double( arg2 ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot subtract: not a number" ),
                                               frame_pointer );
                     break;
@@ -669,8 +671,8 @@ struct cons_pointer subtract_2( struct stack_frame *frame,
                 make_real( to_long_double( arg1 ) - to_long_double( arg2 ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_symbol( L"-"),
-                            c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"-" ),
+                                      c_string_to_lisp_string
                                       ( L"Cannot subtract: not a number" ),
                                       frame_pointer );
             break;
@@ -741,8 +743,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -772,8 +774,8 @@ struct cons_pointer lisp_divide( struct
                                    to_long_double( frame->arg[1] ) );
                     break;
                 default:
-                    result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+                    result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                              c_string_to_lisp_string
                                               ( L"Cannot divide: not a number" ),
                                               frame_pointer );
                     break;
@@ -785,8 +787,8 @@ struct cons_pointer lisp_divide( struct
                            to_long_double( frame->arg[1] ) );
             break;
         default:
-            result = throw_exception( c_string_to_lisp_symbol( L"/"),
-                            c_string_to_lisp_string
+            result = throw_exception( c_string_to_lisp_symbol( L"/" ),
+                                      c_string_to_lisp_string
                                       ( L"Cannot divide: not a number" ),
                                       frame_pointer );
             break;
diff --git a/src/arith/ratio.c b/src/arith/ratio.c
index 011ef43..82f9138 100644
--- a/src/arith/ratio.c
+++ b/src/arith/ratio.c
@@ -114,9 +114,8 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                                              cell1->payload.ratio.divisor ) );
         r = make_ratio( dividend, divisor, true );
     } else {
-        r = throw_exception( c_string_to_lisp_symbol( L"+"),
-                            make_cons( 
-                            c_string_to_lisp_string
+        r = throw_exception( c_string_to_lisp_symbol( L"+" ),
+                             make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_ratio_ratio" ),
                                         make_cons( arg1,
                                                    make_cons( arg2, NIL ) ) ),
@@ -156,8 +155,8 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
         dec_ref( ratio );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"+"),
-                            make_cons( c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"+" ),
+                             make_cons( c_string_to_lisp_string
                                         ( L"Shouldn't happen: bad arg to add_integer_ratio" ),
                                         make_cons( intarg,
                                                    make_cons( ratarg,
@@ -237,8 +236,8 @@ struct cons_pointer multiply_ratio_ratio( struct
         release_integer( divisor );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                             c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_ratio_ratio" ),
                              NIL );
     }
@@ -273,8 +272,8 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
         release_integer( one );
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"*"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"*" ),
+                             c_string_to_lisp_string
                              ( L"Shouldn't happen: bad arg to multiply_integer_ratio" ),
                              NIL );
     }
@@ -342,8 +341,8 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"make_ratio"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"make_ratio" ),
+                             c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
diff --git a/src/init.c b/src/init.c
index 8c8da7c..04eeeed 100644
--- a/src/init.c
+++ b/src/init.c
@@ -293,6 +293,8 @@ int main( int argc, char *argv[] ) {
      */
     bind_symbol_value( privileged_symbol_nil, NIL, true );
     bind_value( L"t", TRUE, true );
+    bind_symbol_value( privileged_keyword_location, TRUE, true );
+    bind_symbol_value( privileged_keyword_payload, TRUE, true );
 
     /*
      * standard input, output, error and sink streams
@@ -413,7 +415,8 @@ int main( int argc, char *argv[] ) {
     bind_function( L"keys",
                    L"`(keys store)`: Return a list of all keys in this `store`.",
                    &lisp_keys );
-    bind_function( L"list", L"`(list args...): Return a list of these `args`.",
+    bind_function( L"list",
+                   L"`(list args...)`: Return a list of these `args`.",
                    &lisp_list );
     bind_function( L"mapcar",
                    L"`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.",
diff --git a/src/io/io.c b/src/io/io.c
index 51a05cc..cf0894f 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
-                           stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.
+                           stream.stream ), NIL );
     }
 
     return result;
diff --git a/src/io/read.c b/src/io/read.c
index 5ffb143..fee80b3 100644
--- a/src/io/read.c
+++ b/src/io/read.c
@@ -167,8 +167,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
 
     if ( url_feof( input ) ) {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+            throw_exception( c_string_to_lisp_symbol( L"read" ),
+                             c_string_to_lisp_string
                              ( L"End of file while reading" ), frame_pointer );
     } else {
         switch ( c ) {
@@ -178,8 +178,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                 /* skip all characters from semi-colon to the end of the line */
                 break;
             case EOF:
-                result = throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                result = throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                          c_string_to_lisp_string
                                           ( L"End of input while reading" ),
                                           frame_pointer );
                 break;
@@ -268,8 +268,8 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
                     result = read_symbol_or_key( input, SYMBOLTV, c );
                 } else {
                     result =
-                        throw_exception(c_string_to_lisp_symbol( L"read"),
-                             make_cons( c_string_to_lisp_string
+                        throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                         make_cons( c_string_to_lisp_string
                                                     ( L"Unrecognised start of input character" ),
                                                     make_string( c, NIL ) ),
                                          frame_pointer );
@@ -316,8 +316,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                            c_string_to_lisp_string
                                             ( L"Malformed number: too many periods" ),
                                             frame_pointer );
                 } else {
@@ -328,8 +328,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             case LSLASH:
                 if ( seen_period || !nilp( dividend ) ) {
-                    return throw_exception( c_string_to_lisp_symbol( L"read"),
-                            c_string_to_lisp_string
+                    return throw_exception( c_string_to_lisp_symbol( L"read" ),
+                                            c_string_to_lisp_string
                                             ( L"Malformed number: dividend of rational must be integer" ),
                                             frame_pointer );
                 } else {
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index c461f10..2848b83 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -39,8 +39,6 @@ struct cons_pointer privileged_keyword_location = NIL;
  */
 struct cons_pointer privileged_keyword_payload = NIL;
 
-
-
 /**
  * True if the value of the tag on the cell at this `pointer` is this `value`,
  * or, if the tag of the cell is `VECP`, if the value of the tag of the
@@ -49,11 +47,11 @@ struct cons_pointer privileged_keyword_payload = NIL;
 bool check_tag( struct cons_pointer pointer, uint32_t value ) {
     bool result = false;
 
-    struct cons_space_object cell = pointer2cell( pointer );
-    result = cell.tag.value == value;
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    result = cell->tag.value == value;
 
     if ( result == false ) {
-        if ( cell.tag.value == VECTORPOINTTV ) {
+        if ( cell->tag.value == VECTORPOINTTV ) {
             struct vector_space_object *vec = pointer_to_vso( pointer );
 
             if ( vec != NULL ) {
diff --git a/src/memory/dump.c b/src/memory/dump.c
index b065661..3a83866 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
-                          integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
-                          integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).
+                          payload.integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/memory/stack.c b/src/memory/stack.c
index b6833c9..7f5d581 100644
--- a/src/memory/stack.c
+++ b/src/memory/stack.c
@@ -161,6 +161,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
                                 env );
                 frame->more = more;
                 inc_ref( more );
+
+                for ( ; !nilp( args ); args = c_cdr( args ) ) {
+                    frame->args++;
+                }
             }
         }
         debug_print( L"make_stack_frame: returning\n", DEBUG_STACK );
diff --git a/src/ops/intern.c b/src/ops/intern.c
index 2764bae..ee15485 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -311,17 +311,17 @@ struct cons_pointer interned( struct cons_pointer key,
                                   map->payload.hashmap.buckets[bucket_no] );
                 } else {
                     result =
-                        throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                            make_cons
-                                         ( c_string_to_lisp_string
-                                           ( L"Unexpected store type: " ),
-                                           c_type( store ) ), NIL );
+                        throw_exception( c_string_to_lisp_symbol
+                                         ( L"interned?" ),
+                                         make_cons( c_string_to_lisp_string
+                                                    ( L"Unexpected store type: " ),
+                                                    c_type( store ) ), NIL );
                 }
                 break;
             default:
                 result =
-                    throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                            make_cons
+                    throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                                     make_cons
                                      ( c_string_to_lisp_string
                                        ( L"Unexpected store type: " ),
                                        c_type( store ) ), NIL );
@@ -329,8 +329,8 @@ struct cons_pointer interned( struct cons_pointer key,
         }
     } else {
         result =
-            throw_exception( c_string_to_lisp_symbol( L"interned?"),
-                make_cons
+            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+                             make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
@@ -392,11 +392,12 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                             result = hashmap_get( entry_ptr, key );
                             break;
                         default:
-                            throw_exception( c_string_to_lisp_symbol( L"assoc"),
-                            c_append
-                                             ( c_string_to_lisp_string
-                                               ( L"Store entry is of unknown type: " ),
-                                               c_type( entry_ptr ) ), NIL );
+                            throw_exception( c_string_to_lisp_symbol
+                                             ( L"assoc" ),
+                                             c_append( c_string_to_lisp_string
+                                                       ( L"Store entry is of unknown type: " ),
+                                                       c_type( entry_ptr ) ),
+                                             NIL );
                     }
 
 // #ifdef DEBUG
@@ -417,8 +418,8 @@ struct cons_pointer c_assoc( struct cons_pointer key,
 //             debug_print( L"`\n", DEBUG_BIND );
 // #endif
             result =
-                throw_exception( c_string_to_lisp_symbol(L"assoc"),
-                    c_append
+                throw_exception( c_string_to_lisp_symbol( L"assoc" ),
+                                 c_append
                                  ( c_string_to_lisp_string
                                    ( L"Store is of unknown type: " ),
                                    c_type( store ) ), NIL );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 3cb0287..98497f6 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -336,44 +336,43 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                                                     struct cons_pointer
                                                     fn_pointer ) {
     struct cons_pointer result = r;
-        
-    if ( exceptionp( result ) && (functionp( fn_pointer) || specialp(fn_pointer))) {
+
+    if ( exceptionp( result )
+         && ( functionp( fn_pointer ) || specialp( fn_pointer ) ) ) {
         struct cons_space_object *fn_cell = &pointer2cell( fn_pointer );
 
         struct cons_pointer payload =
             pointer2cell( result ).payload.exception.payload;
         /* TODO: should name_key also be a privileged keyword? */
-        struct cons_pointer name_key =
-                        c_string_to_lisp_keyword( L"name" );
+        struct cons_pointer name_key = c_string_to_lisp_keyword( L"name" );
 
         switch ( get_tag_value( payload ) ) {
             case NILTV:
             case CONSTV:
             case HASHTV:
                 {
-                    if ( nilp( c_assoc( privileged_keyword_location ,
-                           payload ) )) {
+                    if ( nilp( c_assoc( privileged_keyword_location,
+                                        payload ) ) ) {
                         pointer2cell( result ).payload.exception.payload =
                             set( privileged_keyword_location,
-                                    c_assoc( name_key,
-                                             fn_cell->payload.function.meta ),
-                                    payload );
+                                 c_assoc( name_key,
+                                          fn_cell->payload.function.meta ),
+                                 payload );
                     }
                 }
                 break;
             default:
                 pointer2cell( result ).payload.exception.payload =
-                    make_cons( 
-                        make_cons( privileged_keyword_location,
-                                 c_assoc( name_key,
-                                          fn_cell->payload.function.meta ) ),
-                               make_cons( 
-                                    make_cons( privileged_keyword_payload,
-                                            payload ) , 
-                                            NIL ));
+                    make_cons( make_cons( privileged_keyword_location,
+                                          c_assoc( name_key,
+                                                   fn_cell->payload.function.
+                                                   meta ) ),
+                               make_cons( make_cons
+                                          ( privileged_keyword_payload,
+                                            payload ), NIL ) );
         }
 
-        dec_ref( name_key);
+        dec_ref( name_key );
     }
 
     return result;
@@ -421,10 +420,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     function.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.function.executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -498,10 +494,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->
-                                                                     payload.
-                                                                     special.
-                                                                     executable ) )
+                                                                   ( fn_cell->payload.special.executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1385,7 +1378,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     return exceptionp( message ) ? message : throw_exception( message,
                                                               frame->arg[1],
-                                                              frame->previous );
+                                                              frame->
+                                                              previous );
 }
 
 /**
@@ -1569,13 +1563,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ), l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
-                                                  string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 3a1f64d7ffc17bc5b2a1b1d0bd187d073d336693 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sun, 1 Mar 2026 20:04:21 +0000
Subject: [PATCH 5/6] Well, I'm back to the same failed unit tests as the
 develop branch

and I *feel* that the intern code is better. But it's not without
problems and I don't think I can release at this. But it may be
ready to merge back.
---
 docs/Interning-strings.md    |  44 +++----
 lisp/documentation.lisp      |  29 +++++
 src/debug.c                  |  19 +++
 src/debug.h                  |   1 +
 src/init.c                   |   2 +-
 src/io/io.c                  |   4 +-
 src/io/print.c               |   2 +-
 src/memory/conspage.c        |   5 +-
 src/memory/consspaceobject.c |  31 +++--
 src/memory/consspaceobject.h |  10 +-
 src/memory/dump.c            |   8 +-
 src/ops/equal.c              |   4 +-
 src/ops/intern.c             | 227 ++++++++++++++++++-----------------
 src/ops/intern.h             |  11 +-
 src/ops/lispops.c            |  71 ++++++++---
 15 files changed, 284 insertions(+), 184 deletions(-)

diff --git a/docs/Interning-strings.md b/docs/Interning-strings.md
index b92ded5..af135a1 100644
--- a/docs/Interning-strings.md
+++ b/docs/Interning-strings.md
@@ -12,58 +12,50 @@ causes an unbound variable exception to be thrown, while
 
 returns the value **"froboz"**. This begs the question of whether there's any difference between **"froboz"** and **'froboz**, and the answer is that at this point I don't know.
 
-There will be a concept of a root [namespace](Namespace.html), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. 
+There will be a concept of a root [namespace](Namespace.md), in which other namespaces may be bound recursively to form a directed graph. Because at least some namespaces are mutable, the graph is not necessarily acyclic. There will be a concept of a current namespace, that is to say the namespace in which the user is currently working. 
 
 There must be some notation to say distinguish a request for the value of a name in the root namespace and the value of a name in the current namespace. For now I'm proposing that:
 
-    (eval froboz)
+    (eval 'froboz)
 
 will return the value that **froboz** is bound to in the current namespace;
 
-    (eval .froboz)
+    (eval ::/froboz)
 
 will return the value that **froboz** is bound to in the root namespace;
 
-    (eval foobar.froboz)
+    (eval 'foobar/froboz)
 
 will return the value that **froboz** is bound to in a namespace which is the value of the name **foobar** in the current namespace; and that
 
-    (eval .system.users.simon.environment.froboz)
+    (eval ::users:simon:environment/froboz)
 
-will return the value that **froboz** is bound to in the environment of the user of the system called **simon**.
+will return the value that **froboz** is bound to in the environment of the user of the system called **simon** (if that is readable by you).
 
-The exact path separator syntax may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain.
+The [exact path separator syntax](Paths.md) may change, but the principal that when interning a symbol it is broken down into a path of tokens, and that the value of each token is sought in a namespace bound to the previous token, is likely to remain.
 
-Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.html) of individual path elements.
+Obviously if **froboz** is interned in one namespace it is not necessarily interned in another, and vice versa. There's a potentially nasty problem here that two lexically identical strings might be bound in different namespaces, so that there is not one canonical interned **froboz**; if this turns out to cause problems in practice there will need to be a separate canonical [hashtable](Hashtable.md) of individual path elements.
 
 Obviously this means there may be arbitrarily many paths which reference the same data item. This is intended.
 
 ## Related functions
 
-### (intern! string)
+### (intern! path)
 
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
+Binds *path* to **NIL**. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
 
-### (intern! string T)
+### (intern! path T)
 
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
-
-### (intern! string T write-access-list)
-
-Binds *string*, considered as a path, to **NIL**. If some namespace along the path doesn't exist, create it as the current user with the read [access control](https://www.journeyman.cc/blog/posts-output/2006-02-20-postscarcity-software/) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
+Binds *path* to **NIL**. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **:friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
 
 ### (set! string value)
 
-Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
+Binds *path* to *value*. If some namespace along the path doesn't exist, throws an exception. Obviously if the current user is not entitled to write to the terminal namespace, also throws an exception.
 
 ### (set! string value T)
 
 Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with both read and write [access control](Access-control.html) lists taken from the current binding of **friends** in the current environment. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
 
-### (set! string value T write-access-list)
-
-Binds *string*, considered as a path, to *value*. If some namespace along the path doesn't exist, create it as the current user with the read [access control](Access-control.html) list taken from the current binding of **friends** in the current environment, and the write access control list taken from the value of *write-access-list*. Obviously if the current user is not entitled to write to the last pre-existing namespace, throws an exception.
-
 ### (put! string token value)
 
 Considers *string* as the path to some namespace, and binds *token* in that namespace to *value*. *Token* should not contain any path separator syntax. If the namespace doesn't exist or if the current user is not entitled to write to the namespace, throws an exception.
@@ -71,16 +63,16 @@ Considers *string* as the path to some namespace, and binds *token* in that name
 ### (string-to-path string)
 
 Behaviour as follows:
-    (string-to-path "foo.bar.ban") => ("foo" "bar" "ban")
-    (string-to-path ".foo.bar.ban") => ("" "foo" "bar" "ban")
+    (string-to-path ":foo:bar/ban") => (-> (environment) :foo :bar 'ban)
+    (string-to-path "::foo:bar/ban") => (-> (oblist) :foo :bar 'ban)
 
-Obviously if the current user can't read the string, throws an exception.
+Obviously if the current user can't read the string, throws an exception. `(oblist)` is currently (version 0.0.6) a function which returns the current value of the root namespace; `(environment)` is a proposed function which returns the current value of the environment of current user (with possibly `(environmnt user-name)` returning the value of the environment of the user indicated by `user-name`, if that is readable by you). The symbol `->` represents a threading macro [similar to Clojure's](https://clojuredocs.org/clojure.core/-%3E).
 
 ### (path-to-string list-of-strings)
 
 Behaviour as follows:
-    (path-to-string '("foo" "bar" "ban")) => "foo.bar.ban"
-    (path-to-string '("" "foo" "bar" "ban")) => ".foo.bar.ban"
+    (path-to-string '(:foo :bar 'ban)) => ":foo:bar/ban"
+    (path-to-string '("" :foo :bar 'ban)) => "::foo:bar/ban"
 
 Obviously if the current user can't read some element of *list-of-strings*, throws an exception.
 
diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 33fd1e5..7f5867b 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -3,6 +3,31 @@
 ;; `nth` (from `nth.lisp`)
 ;; `string?` (from `types.lisp`)
 
+(set! nil? (lambda 
+          (o) 
+          "`(nil? object)`: Return `t` if object is `nil`, else `t`."
+          (= o nil)))
+
+(set! member? (lambda
+            (item collection)
+            "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
+            ;; (print (list "In member? item is " item "; collection is " collection))
+            ;; (println)
+            (cond
+              ((= nil collection) nil)
+              ((= item (car collection)) t)
+              (t (member? item (cdr collection))))))
+
+;; (member? (type member?) '("LMDA" "NLMD"))
+
+(set! nth (lambda (n l) 
+    "Return the `n`th member of this list `l`, or `nil` if none."
+    (cond ((= nil l) nil)
+        ((= n 1) (car l))
+        (t (nth (- n 1) (cdr l))))))
+
+(set! string? (lambda (o) "True if `o` is a string." (= (type o) "STRG") ) )
+
 (set! documentation (lambda (object)
     "`(documentation object)`:  Return documentation for the specified `object`, if available, else `nil`."
    (cond ((member? (type object) '("FUNC" "SPFM"))
@@ -15,3 +40,7 @@
 
 (set! doc documentation)
 
+(documentation apply)
+
+;; (documentation member?)
+
diff --git a/src/debug.c b/src/debug.c
index 1b895c2..631149d 100644
--- a/src/debug.c
+++ b/src/debug.c
@@ -32,6 +32,25 @@
  */
 int verbosity = 0;
 
+/**
+ * When debugging, we want to see exceptions as they happen, because they may
+ * not make their way back down the stack to whatever is expected to handle
+ * them.
+ */
+void debug_print_exception( struct cons_pointer ex_ptr ) {
+#ifdef DEBUG
+    if ( ( verbosity != 0 ) && exceptionp( ex_ptr ) ) {
+        fwide( stderr, 1 );
+        fputws( L"EXCEPTION: ", stderr );
+
+        URL_FILE *ustderr = file_to_url_file( stderr );
+        fwide( stderr, 1 );
+        print( ustderr, ex_ptr );
+        free( ustderr );
+    }
+#endif
+}
+
 /**
  * @brief print this debug `message` to stderr, if `verbosity` matches `level`.
  *
diff --git a/src/debug.h b/src/debug.h
index ef3799d..2e59932 100644
--- a/src/debug.h
+++ b/src/debug.h
@@ -81,6 +81,7 @@
 
 extern int verbosity;
 
+void debug_print_exception( struct cons_pointer ex_ptr );
 void debug_print( wchar_t *message, int level );
 void debug_print_128bit( __int128_t n, int level );
 void debug_println( int level );
diff --git a/src/init.c b/src/init.c
index 04eeeed..74b6d94 100644
--- a/src/init.c
+++ b/src/init.c
@@ -325,7 +325,7 @@ int main( int argc, char *argv[] ) {
                                                   ( c_string_to_lisp_keyword
                                                     ( L"url" ),
                                                     c_string_to_lisp_string
-                                                    ( L"system:standard output]" ) ),
+                                                    ( L"system:standard output" ) ),
                                                   NIL ) ), false );
     bind_value( L"*log*",
                 make_write_stream( file_to_url_file( stderr ),
diff --git a/src/io/io.c b/src/io/io.c
index cf0894f..51a05cc 100644
--- a/src/io/io.c
+++ b/src/io/io.c
@@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream.stream ), NIL );
+                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                           stream ), NIL );
     }
 
     return result;
diff --git a/src/io/print.c b/src/io/print.c
index fdd6ed4..a8f2770 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -101,7 +101,7 @@ void print_map( URL_FILE *output, struct cons_pointer map ) {
             struct cons_pointer key = c_car( ks );
             print( output, key );
             url_fputwc( btowc( ' ' ), output );
-            print( output, hashmap_get( map, key ) );
+            print( output, hashmap_get( map, key, false ) );
 
             if ( !nilp( c_cdr( ks ) ) ) {
                 url_fputws( L", ", output );
diff --git a/src/memory/conspage.c b/src/memory/conspage.c
index d7d5cd0..3d96647 100644
--- a/src/memory/conspage.c
+++ b/src/memory/conspage.c
@@ -250,8 +250,9 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
             total_cells_allocated++;
 
             debug_printf( DEBUG_ALLOC,
-                          L"Allocated cell of type '%4.4s' at %d, %d \n",
-                          cell->tag.bytes, result.page, result.offset );
+                          L"Allocated cell of type %4.4s at %u, %u \n",
+                          ( ( char * ) cell->tag.bytes ), result.page,
+                          result.offset );
         } else {
             debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" );
         }
diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c
index 2848b83..3d8fe78 100644
--- a/src/memory/consspaceobject.c
+++ b/src/memory/consspaceobject.c
@@ -78,7 +78,7 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
         cell->count++;
 #ifdef DEBUG
         debug_printf( DEBUG_ALLOC,
-                      L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d",
+                      L"\nIncremented cell of type %4.4s at page %u, offset %u to count %u",
                       ( ( char * ) cell->tag.bytes ), pointer.page,
                       pointer.offset, cell->count );
         if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
@@ -131,6 +131,19 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
     return pointer;
 }
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+uint32_t get_tag_value( struct cons_pointer pointer ) {
+    uint32_t result = pointer2cell( pointer ).tag.value;
+
+    if ( result == VECTORPOINTTV ) {
+        result = pointer_to_vso( pointer )->header.tag.value;
+    }
+
+    return result;
+}
+
 /**
  * Get the Lisp type of the single argument.
  * @param pointer a pointer to the object whose type is requested.
@@ -399,15 +412,15 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
     if ( tag == SYMBOLTV || tag == KEYTV ) {
         result = make_string_like_thing( c, tail, tag );
 
-        if ( tag == KEYTV ) {
-            struct cons_pointer r = interned( result, oblist );
+        // if ( tag == KEYTV ) {
+        //     struct cons_pointer r = interned( result, oblist );
 
-            if ( nilp( r ) ) {
-                intern( result, oblist );
-            } else {
-                result = r;
-            }
-        }
+        //     if ( nilp( r ) ) {
+        //         intern( result, oblist );
+        //     } else {
+        //         result = r;
+        //     }
+        // }
     } else {
         result =
             make_exception( c_string_to_lisp_string
diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h
index bddd232..1357f34 100644
--- a/src/memory/consspaceobject.h
+++ b/src/memory/consspaceobject.h
@@ -308,11 +308,6 @@ extern struct cons_pointer privileged_keyword_payload;
  */
 #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
 
-/**
- * given a cons_pointer as argument, return the tag.
- */
-#define get_tag_value(conspoint) ((pointer2cell(conspoint)).tag.value)
-
 /**
  * true if `conspoint` points to the special cell NIL, else false
  * (there should only be one of these so it's slightly redundant).
@@ -727,6 +722,11 @@ struct cons_pointer inc_ref( struct cons_pointer pointer );
 
 struct cons_pointer dec_ref( struct cons_pointer pointer );
 
+/**
+ * given a cons_pointer as argument, return the tag.
+ */
+uint32_t get_tag_value( struct cons_pointer pointer );
+
 struct cons_pointer c_type( struct cons_pointer pointer );
 
 struct cons_pointer c_car( struct cons_pointer arg );
diff --git a/src/memory/dump.c b/src/memory/dump.c
index 3a83866..b065661 100644
--- a/src/memory/dump.c
+++ b/src/memory/dump.c
@@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).
-                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).
-                          payload.integer.value, cell.count );
+                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          integer.value,
+                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );
diff --git a/src/ops/equal.c b/src/ops/equal.c
index ea813a9..b2d0fa2 100644
--- a/src/ops/equal.c
+++ b/src/ops/equal.c
@@ -272,7 +272,9 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
 
         for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
             struct cons_pointer key = c_car( i );
-            if ( !equal( hashmap_get( a, key ), hashmap_get( b, key ) ) ) {
+            if ( !equal
+                 ( hashmap_get( a, key, false ),
+                   hashmap_get( b, key, false ) ) ) {
                 result = false;
                 break;
             }
diff --git a/src/ops/intern.c b/src/ops/intern.c
index ee15485..ae9800a 100644
--- a/src/ops/intern.c
+++ b/src/ops/intern.c
@@ -205,7 +205,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
             for ( struct cons_pointer keys = hashmap_keys( assoc );
                   !nilp( keys ); keys = c_cdr( keys ) ) {
                 struct cons_pointer key = c_car( keys );
-                hashmap_put( mapp, key, hashmap_get( assoc, key ) );
+                hashmap_put( mapp, key, hashmap_get( assoc, key, false ) );
             }
         }
     }
@@ -216,17 +216,33 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
 /** Get a value from a hashmap. 
   *
   * Note that this is here, rather than in memory/hashmap.c, because it is 
-  * closely tied in with c_assoc, q.v.
+  * closely tied in with search_store, q.v.
   */
 struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key ) {
+                                 struct cons_pointer key, bool return_key ) {
+#ifdef DEBUG
+    debug_print( L"\nhashmap_get: key is `", DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
+    debug_print( L"`; store of type `", DEBUG_BIND );
+    debug_print_object( c_type( mapp ), DEBUG_BIND );
+    debug_printf( DEBUG_BIND, L"`; returning `%s`.\n",
+                  return_key ? "key" : "value" );
+#endif
+
     struct cons_pointer result = NIL;
     if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) ) && !nilp( key ) ) {
         struct vector_space_object *map = pointer_to_vso( mapp );
         uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
 
-        result = c_assoc( key, map->payload.hashmap.buckets[bucket_no] );
+        result =
+            search_store( key, map->payload.hashmap.buckets[bucket_no],
+                          return_key );
     }
+#ifdef DEBUG
+    debug_print( L"\nhashmap_get returning: `", DEBUG_BIND );
+    debug_print_object( result, DEBUG_BIND );
+    debug_print( L"`\n", DEBUG_BIND );
+#endif
 
     return result;
 }
@@ -267,82 +283,134 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
     return result;
 }
 
-// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
-
 /**
- * If this key is lexically identical to a key in this store, return the key
- * from the store (so that later when we want to retrieve a value, an eq test
- * will work); otherwise return NIL.
+ * @brief `(search-store key store return-key?)` Search this `store` for this
+ * a key lexically identical to this `key`. 
+ *
+ * If found, then, if `return-key?` is non-nil, return the copy found in the 
+ * `store`, else return the value associated with it.
+ *
+ * At this stage the following structures are legal stores:
+ * 1. an association list comprising (key . value) dotted pairs;
+ * 2. a hashmap;
+ * 3. a namespace (which for these purposes is identical to a hashmap);
+ * 4. a hybrid list comprising both (key . value) pairs and hashmaps as first
+ *    level items;
+ * 5. such a hybrid list, but where the last CDR pointer is to a hashmap
+ *    rather than to a cons sell or to `nil`.
+ *
+ * This is over-complex and type 5 should be disallowed, but it will do for 
+ * now.
  */
-struct cons_pointer interned( struct cons_pointer key,
-                              struct cons_pointer store ) {
+struct cons_pointer search_store( struct cons_pointer key,
+                                  struct cons_pointer store,
+                                  bool return_key ) {
     struct cons_pointer result = NIL;
 
-    debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
+#ifdef DEBUG
+    debug_print( L"\nsearch_store; key is `", DEBUG_BIND );
     debug_print_object( key, DEBUG_BIND );
-    debug_print( L"`\n", DEBUG_BIND );
+    debug_print( L"`; store of type `", DEBUG_BIND );
+    debug_print_object( c_type( store ), DEBUG_BIND );
+    debug_printf( DEBUG_BIND, L"`; returning `%s`.\n",
+                  return_key ? "key" : "value" );
+#endif
 
     if ( symbolp( key ) || keywordp( key ) ) {
-        struct cons_space_object *cell = &pointer2cell( store );
+        struct cons_space_object *store_cell = &pointer2cell( store );
 
-        switch ( cell->tag.value ) {
+        switch ( get_tag_value( store ) ) {
             case CONSTV:
-                for ( struct cons_pointer next = store;
-                      nilp( result ) && consp( next ); next = c_cdr( next ) ) {
-                    if ( !nilp( next ) ) {
-                        // struct cons_space_object entry =
-                        //     pointer2cell( c_car( next) );
+                for ( struct cons_pointer cursor = store;
+                      nilp( result ) && ( consp( cursor )
+                                          || hashmapp( cursor ) );
+                      cursor = pointer2cell( cursor ).payload.cons.cdr ) {
+                    switch ( get_tag_value( cursor ) ) {
+                        case CONSTV:
+                            struct cons_pointer entry_ptr = c_car( cursor );
 
-                        if ( equal( key, c_car( next ) ) ) {
-                            result = key;
-                        }
+                            switch ( get_tag_value( entry_ptr ) ) {
+                                case CONSTV:
+                                    if ( equal( key, c_car( entry_ptr ) ) ) {
+                                        result =
+                                            return_key ? c_car( entry_ptr ) :
+                                            c_cdr( entry_ptr );
+                                    }
+                                    break;
+                                case HASHTV:
+                                case NAMESPACETV:
+                                    // TODO: I think this should be impossible, and we should maybe
+                                    // throw an exception.
+                                    result =
+                                        hashmap_get( entry_ptr, key,
+                                                     return_key );
+                                    break;
+                                default:
+                                    result =
+                                        throw_exception
+                                        ( c_string_to_lisp_symbol
+                                          ( L"search-store (entry)" ),
+                                          make_cons( c_string_to_lisp_string
+                                                     ( L"Unexpected store type: " ),
+                                                     c_type( c_car
+                                                             ( entry_ptr ) ) ),
+                                          NIL );
+
+                            }
+                            break;
+                        case HASHTV:
+                        case NAMESPACETV:
+                            debug_print
+                                ( L"\n\tHashmap as top-level value in list",
+                                  DEBUG_BIND );
+                            result = hashmap_get( cursor, key, return_key );
+                            break;
+                        default:
+                            result =
+                                throw_exception( c_string_to_lisp_symbol
+                                                 ( L"search-store (cursor)" ),
+                                                 make_cons
+                                                 ( c_string_to_lisp_string
+                                                   ( L"Unexpected store type: " ),
+                                                   c_type( cursor ) ), NIL );
                     }
                 }
                 break;
-            case VECTORPOINTTV:
-                if ( hashmapp( store ) || namespacep( store ) ) {
-                    // get the right hash bucket and recursively call interned on that.
-                    struct vector_space_object *map = pointer_to_vso( store );
-                    uint32_t bucket_no =
-                        get_hash( key ) % map->payload.hashmap.n_buckets;
-
-                    result =
-                        interned( key,
-                                  map->payload.hashmap.buckets[bucket_no] );
-                } else {
-                    result =
-                        throw_exception( c_string_to_lisp_symbol
-                                         ( L"interned?" ),
-                                         make_cons( c_string_to_lisp_string
-                                                    ( L"Unexpected store type: " ),
-                                                    c_type( store ) ), NIL );
-                }
+            case HASHTV:
+            case NAMESPACETV:
+                result = hashmap_get( store, key, return_key );
                 break;
             default:
                 result =
-                    throw_exception( c_string_to_lisp_symbol( L"interned?" ),
-                                     make_cons
-                                     ( c_string_to_lisp_string
-                                       ( L"Unexpected store type: " ),
-                                       c_type( store ) ), NIL );
+                    throw_exception( c_string_to_lisp_symbol
+                                     ( L"search-store (store)" ),
+                                     make_cons( c_string_to_lisp_string
+                                                ( L"Unexpected store type: " ),
+                                                c_type( store ) ), NIL );
                 break;
         }
     } else {
+        // failing with key type NIL here (?). Probably worth dumping the stack?
         result =
-            throw_exception( c_string_to_lisp_symbol( L"interned?" ),
+            throw_exception( c_string_to_lisp_symbol( L"search-store (key)" ),
                              make_cons
                              ( c_string_to_lisp_string
                                ( L"Unexpected key type: " ), c_type( key ) ),
                              NIL );
     }
 
-    debug_print( L"interned: returning `", DEBUG_BIND );
+    debug_print( L"search-store: returning `", DEBUG_BIND );
     debug_print_object( result, DEBUG_BIND );
     debug_print( L"`\n", DEBUG_BIND );
 
     return result;
 }
 
+struct cons_pointer interned( struct cons_pointer key,
+                              struct cons_pointer store ) {
+    return search_store( key, store, true );
+}
+
 /**
  * @brief Implementation of `interned?` in C: predicate wrapped around interned.
  * 
@@ -365,68 +433,7 @@ struct cons_pointer internedp( struct cons_pointer key,
  */
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store ) {
-    struct cons_pointer result = NIL;
-
-    if ( !nilp( key ) ) {
-        if ( consp( store ) ) {
-            for ( struct cons_pointer next = store;
-                  nilp( result ) && ( consp( next ) || hashmapp( next ) );
-                  next = pointer2cell( next ).payload.cons.cdr ) {
-                if ( consp( next ) ) {
-// #ifdef DEBUG
-//                     debug_print( L"\nc_assoc; key is `", DEBUG_BIND );
-//                     debug_print_object( key, DEBUG_BIND );
-//                     debug_print( L"`\n", DEBUG_BIND );
-// #endif
-
-                    struct cons_pointer entry_ptr = c_car( next );
-                    struct cons_space_object entry = pointer2cell( entry_ptr );
-
-                    switch ( entry.tag.value ) {
-                        case CONSTV:
-                            if ( equal( key, entry.payload.cons.car ) ) {
-                                result = entry.payload.cons.cdr;
-                            }
-                            break;
-                        case VECTORPOINTTV:
-                            result = hashmap_get( entry_ptr, key );
-                            break;
-                        default:
-                            throw_exception( c_string_to_lisp_symbol
-                                             ( L"assoc" ),
-                                             c_append( c_string_to_lisp_string
-                                                       ( L"Store entry is of unknown type: " ),
-                                                       c_type( entry_ptr ) ),
-                                             NIL );
-                    }
-
-// #ifdef DEBUG
-//                     debug_print( L"c_assoc `", DEBUG_BIND );
-//                     debug_print_object( key, DEBUG_BIND );
-//                     debug_print( L"` returning: ", DEBUG_BIND );
-//                     debug_print_object( result, DEBUG_BIND );
-//                     debug_println( DEBUG_BIND );
-// #endif
-                }
-            }
-        } else if ( hashmapp( store ) || namespacep( store ) ) {
-            result = hashmap_get( store, key );
-        } else if ( !nilp( store ) ) {
-// #ifdef DEBUG        
-//             debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
-//             debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
-//             debug_print( L"`\n", DEBUG_BIND );
-// #endif
-            result =
-                throw_exception( c_string_to_lisp_symbol( L"assoc" ),
-                                 c_append
-                                 ( c_string_to_lisp_string
-                                   ( L"Store is of unknown type: " ),
-                                   c_type( store ) ), NIL );
-        }
-    }
-
-    return result;
+    return search_store( key, store, false );
 }
 
 /**
diff --git a/src/ops/intern.h b/src/ops/intern.h
index 4043e66..18fc084 100644
--- a/src/ops/intern.h
+++ b/src/ops/intern.h
@@ -20,6 +20,9 @@
 #ifndef __intern_h
 #define __intern_h
 
+#include <stdbool.h>
+
+
 extern struct cons_pointer privileged_symbol_nil;
 
 extern struct cons_pointer oblist;
@@ -31,7 +34,7 @@ void free_hashmap( struct cons_pointer ptr );
 void dump_map( URL_FILE * output, struct cons_pointer pointer );
 
 struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
+                                 struct cons_pointer key, bool return_key );
 
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
@@ -46,6 +49,9 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
                                   struct cons_pointer hash_fn,
                                   struct cons_pointer write_acl );
 
+struct cons_pointer search_store( struct cons_pointer key,
+                                  struct cons_pointer store, bool return_key );
+
 struct cons_pointer c_assoc( struct cons_pointer key,
                              struct cons_pointer store );
 
@@ -55,9 +61,6 @@ struct cons_pointer interned( struct cons_pointer key,
 struct cons_pointer internedp( struct cons_pointer key,
                                struct cons_pointer environment );
 
-struct cons_pointer hashmap_get( struct cons_pointer mapp,
-                                 struct cons_pointer key );
-
 struct cons_pointer hashmap_put( struct cons_pointer mapp,
                                  struct cons_pointer key,
                                  struct cons_pointer val );
diff --git a/src/ops/lispops.c b/src/ops/lispops.c
index 98497f6..c2b0e70 100644
--- a/src/ops/lispops.c
+++ b/src/ops/lispops.c
@@ -365,8 +365,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
                 pointer2cell( result ).payload.exception.payload =
                     make_cons( make_cons( privileged_keyword_location,
                                           c_assoc( name_key,
-                                                   fn_cell->payload.function.
-                                                   meta ) ),
+                                                   fn_cell->payload.
+                                                   function.meta ) ),
                                make_cons( make_cons
                                           ( privileged_keyword_payload,
                                             payload ), NIL ) );
@@ -420,7 +420,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                             get_stack_frame( next_pointer );
 
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.function.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     function.
+                                                                     executable ) )
                                                                  ( next,
                                                                    next_pointer,
                                                                    env ),
@@ -494,7 +497,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result = maybe_fixup_exception_location( ( *
-                                                                   ( fn_cell->payload.special.executable ) )
+                                                                   ( fn_cell->
+                                                                     payload.
+                                                                     special.
+                                                                     executable ) )
                                                                  ( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1052,11 +1058,15 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
         frame->arg[0] : get_default_stream( true, env );
 
     if ( readp( in_stream ) ) {
-        debug_print( L"lisp_read: setting input stream\n", DEBUG_IO );
+        debug_print( L"lisp_read: setting input stream\n",
+                     DEBUG_IO | DEBUG_REPL );
         debug_dump_object( in_stream, DEBUG_IO );
         input = pointer2cell( in_stream ).payload.stream.stream;
         inc_ref( in_stream );
     } else {
+        /* should not happen, but has done. */
+        debug_print( L"WARNING: invalid input stream; defaulting!\n",
+                     DEBUG_IO | DEBUG_REPL );
         input = file_to_url_file( stdin );
     }
 
@@ -1332,10 +1342,17 @@ struct cons_pointer
 throw_exception( struct cons_pointer location,
                  struct cons_pointer message,
                  struct cons_pointer frame_pointer ) {
-    debug_print( L"\nERROR: ", DEBUG_EVAL );
-    debug_dump_object( message, DEBUG_EVAL );
     struct cons_pointer result = NIL;
 
+#ifdef DEBUG
+    debug_print( L"\nERROR: `", 511 );
+    debug_print_object( message, 511 );
+    debug_print( L"` at `", 511 );
+    debug_print_object( location, 511 );
+    debug_print( L"`\n", 511 );
+    debug_print_object( location, 511 );
+#endif
+
     struct cons_space_object *cell = &pointer2cell( message );
 
     if ( cell->tag.value == EXCEPTIONTV ) {
@@ -1378,8 +1395,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     return exceptionp( message ) ? message : throw_exception( message,
                                                               frame->arg[1],
-                                                              frame->
-                                                              previous );
+                                                              frame->previous );
 }
 
 /**
@@ -1399,7 +1415,11 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
                                struct cons_pointer env ) {
     struct cons_pointer expr = NIL;
 
-    debug_printf( DEBUG_REPL, L"Entering new inner REPL\n" );
+#ifdef DEBUG
+    debug_print( L"Entering new inner REPL\n\tenv is `", DEBUG_REPL );
+    debug_print_object( env, DEBUG_REPL );
+    debug_print( L"`\n", DEBUG_REPL );
+#endif
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
@@ -1414,7 +1434,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
             set( c_string_to_lisp_symbol( L"*in*" ), frame->arg[1], new_env );
         input = frame->arg[1];
     }
-    if ( readp( frame->arg[2] ) ) {
+    if ( writep( frame->arg[2] ) ) {
         new_env =
             set( c_string_to_lisp_symbol( L"*out*" ), frame->arg[2], new_env );
         output = frame->arg[2];
@@ -1424,8 +1444,16 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     inc_ref( output );
     inc_ref( prompt_name );
 
-    URL_FILE *os = pointer2cell( output ).payload.stream.stream;
-
+    /* output should NEVER BE nil; but during development it has happened.
+     * To allow debugging under such circumstances, we need an emergency 
+     * default. */
+    URL_FILE *os =
+        !writep( output ) ? file_to_url_file( stdout ) :
+        pointer2cell( output ).payload.stream.stream;
+    if ( !writep( output ) ) {
+        debug_print( L"WARNING: invalid output; defaulting!\n",
+                     DEBUG_IO | DEBUG_REPL );
+    }
 
     /* \todo this is subtly wrong. If we were evaluating
      *   (print (eval (read)))
@@ -1442,7 +1470,10 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
          * \todo the whole process of resolving symbol values needs to be revisited
          * when we get onto namespaces. */
         /* OK, there's something even more subtle here if the root namespace is a map.
-         * H'mmmm... */
+         * H'mmmm... 
+         * I think that now the oblist is a hashmap masquerading as a namespace,
+         * we should no longer have to do this. TODO: test, and if so, delete this
+         * statement. */
         if ( !eq( oblist, old_oblist ) ) {
             struct cons_pointer cursor = oblist;
 
@@ -1486,6 +1517,9 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
         dec_ref( expr );
     }
 
+    if ( nilp( output ) ) {
+        free( os );
+    }
     dec_ref( input );
     dec_ref( output );
     dec_ref( prompt_name );
@@ -1563,14 +1597,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
-                                                l2,
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ), l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  payload.string.character ),
+                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                                                  string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }

From 72a8bc09e049b99c0514189272897fba9d985a7b Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sun, 1 Mar 2026 20:37:16 +0000
Subject: [PATCH 6/6] Very minor fixes/

---
 lisp/documentation.lisp | 4 ++--
 src/init.c              | 2 +-
 src/io/print.c          | 9 +--------
 3 files changed, 4 insertions(+), 11 deletions(-)

diff --git a/lisp/documentation.lisp b/lisp/documentation.lisp
index 7f5867b..b303856 100644
--- a/lisp/documentation.lisp
+++ b/lisp/documentation.lisp
@@ -11,10 +11,10 @@
 (set! member? (lambda
             (item collection)
             "`(member item collection)`: Return `t` if this `item` is a member of this `collection`, else `nil`."
-            ;; (print (list "In member? item is " item "; collection is " collection))
+            (print (list "In member? item is " item "; collection is " collection))
             ;; (println)
             (cond
-              ((= nil collection) nil)
+              ((= 0 (count collection)) nil)
               ((= item (car collection)) t)
               (t (member? item (cdr collection))))))
 
diff --git a/src/init.c b/src/init.c
index 74b6d94..565065f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -94,7 +94,7 @@ void maybe_bind_init_symbols(  ) {
         privileged_keyword_location = c_string_to_lisp_keyword( L"location" );
     }
     if ( nilp( privileged_keyword_payload ) ) {
-        privileged_keyword_location = c_string_to_lisp_keyword( L"payload" );
+        privileged_keyword_payload = c_string_to_lisp_keyword( L"payload" );
     }
 }
 
diff --git a/src/io/print.c b/src/io/print.c
index a8f2770..f5f80a5 100644
--- a/src/io/print.c
+++ b/src/io/print.c
@@ -348,16 +348,9 @@ lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
 
     if ( writep( out_stream ) ) {
         output = pointer2cell( out_stream ).payload.stream.stream;
-        inc_ref( out_stream );
-    } else {
-        output = file_to_url_file( stderr );
-    }
 
-    println( output );
+        println( output );
 
-    if ( writep( out_stream ) ) {
-        dec_ref( out_stream );
-    } else {
         free( output );
     }