Rewriting intern. This is badly broken, but I think on the road to better.

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

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

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 ( ;
+                    for ( ; ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
-                          ( i < ( STRING_SHIPYARD_SIZE - 1 ) ) && !nilp( a )
                           && !nilp( b ); i++ ) {
                         a_buff[i] = cell_a->payload.string.character;
                         a = c_cdr( a );

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
+struct cons_pointer interned( struct cons_pointer key,
-internedp( struct cons_pointer key, struct cons_pointer store ) {
+                              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 
+        struct cons_space_object *cell = &pointer2cell( store );
-        // do for stores which are old-fashioned assoc lists, but it will not work
+
-        // for my new hybrid stores.
+        switch ( cell->tag.value ) {
-        // for ( struct cons_pointer next = store;
+            case CONSTV:
-        //       nilp( result ) && consp( next );
+                for ( struct cons_pointer next = store;
-        //       next = pointer2cell( next ).payload.cons.cdr ) {
+                      nilp( result ) && consp( next );
+                      next = c_cdr( next) ) {
+                    if ( !nilp( next ) ) {
                         // struct cons_space_object entry =
-        //         pointer2cell( pointer2cell( next ).payload.cons.car );
+                        //     pointer2cell( c_car( next) );
 
-        //     debug_print( L"Internedp: checking whether `", DEBUG_BIND );
+                        if ( equal( key, c_car(next) ) ) {
-        //     debug_print_object( key, DEBUG_BIND );
-        //     debug_print( L"` equals `", DEBUG_BIND );
-        //     debug_print_object( entry.payload.cons.car, DEBUG_BIND );
-        //     debug_print( L"`\n", DEBUG_BIND );
-
-        //     if ( equal( key, entry.payload.cons.car ) ) {
-        //         result = entry.payload.cons.car;
-        //     }
-        if ( !nilp( c_assoc( key, store ) ) ) {
                             result = key;
-        } else if ( equal( key, privileged_symbol_nil ) ) {
+                        }
-            result = privileged_symbol_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( 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 );
+        result =
-        debug_print_object( key, DEBUG_BIND );
+            throw_exception( make_cons
-        debug_print( L"` is a ", DEBUG_BIND );
+                             ( c_string_to_lisp_string
-        debug_printf( DEBUG_BIND, L"%4.4s",
+                               ( L"Unexpected key type: " ), c_type( key ) ),
-                      ( char * ) pointer2cell( key ).tag.bytes );
+                             NIL );
-        debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
     }
 
     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 );
     }

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

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 =
+                struct cons_pointer canonical = interned( frame->arg[0], env );
-                    internedp( 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 ) {

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