Hashmaps sort-of work but there are still bugs and one test is failing that wasn't.

src/init.c

@@ -23,10 +23,10 @@
 #include "conspage.h"
 #include "consspaceobject.h"
 #include "debug.h"
+#include "hashmap.h"
 #include "intern.h"
 #include "io.h"
 #include "lispops.h"
-#include "map.h"
 #include "meta.h"
 #include "peano.h"
 #include "print.h"
@@ -225,8 +225,10 @@ int main( int argc, char *argv[] ) {
     bind_function( L"equal", &lisp_equal );
     bind_function( L"eval", &lisp_eval );
     bind_function( L"exception", &lisp_exception );
+    bind_function( L"gethash", &lisp_get_hash);
+    bind_function(L"hashmap", lisp_make_hashmap);
     bind_function( L"inspect", &lisp_inspect );
-    bind_function( L"make-map", &lisp_make_map);
+    bind_function( L"keys", &lisp_keys);
     bind_function( L"meta", &lisp_metadata );
     bind_function( L"metadata", &lisp_metadata );
     bind_function( L"multiply", &lisp_multiply );
@@ -235,6 +237,8 @@ int main( int argc, char *argv[] ) {
     bind_function( L"open", &lisp_open );
     bind_function( L"print", &lisp_print );
     bind_function( L"progn", &lisp_progn );
+    bind_function( L"put", lisp_hashmap_put);
+    bind_function( L"put-all", &lisp_hashmap_put_all);
     bind_function( L"read", &lisp_read );
     bind_function( L"read-char", &lisp_read_char );
     bind_function( L"repl", &lisp_repl );

src/io/print.c

@@ -19,9 +19,9 @@
 
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "hashmap.h"
 #include "integer.h"
 #include "intern.h"
-#include "map.h"
 #include "stack.h"
 #include "print.h"
 #include "psse_time.h"
@@ -88,40 +88,38 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) {
     url_fputws( L")", output );
 }
 
+void print_map( URL_FILE *output, struct cons_pointer map ) {
+  if ( hashmapp( map ) ) {
+    struct vector_space_object *vso = pointer_to_vso( map );
 
-void print_map( URL_FILE * output, struct cons_pointer map) {
-    if ( vectorpointp( map)) {
-        struct vector_space_object *vso = pointer_to_vso( map);
-
-        if ( mapp( vso ) ) {
     url_fputwc( btowc( '{' ), output );
 
-            for ( struct cons_pointer ks = keys( map);
+    for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks );
-                 !nilp( ks); ks = c_cdr( ks)) {
+          ks = c_cdr( ks ) ) {
-                print( output, c_car( ks));
+              struct cons_pointer key = c_car( ks);
+      print( output, key );
       url_fputwc( btowc( ' ' ), output );
-                print( output, c_assoc( c_car( ks), map));
+      print( output, hashmap_get( map, key ) );
 
-                if ( !nilp( c_cdr( ks))) {
+      if ( !nilp( c_cdr( ks ) ) ) {
         url_fputws( L", ", output );
       }
     }
 
     url_fputwc( btowc( '}' ), output );
   }
-    }
 }
 
-
 void print_vso( URL_FILE * output, struct cons_pointer pointer) {
-    struct vector_space_object *vso =
+    struct vector_space_object *vso = pointer_to_vso(pointer);
-        pointer2cell( pointer ).payload.vectorp.address;
-
     switch ( vso->header.tag.value) {
-        case MAPTV:
+        case HASHTV:
             print_map( output, pointer);
             break;
         // \todo: others.
+        default:
+          fwprintf( stderr, L"Unrecognised vector-space type '%d'\n",
+                    vso->header.tag.value );
     }
 }
 

src/io/read.c

@@ -20,11 +20,11 @@
 #include "consspaceobject.h"
 #include "debug.h"
 #include "dump.h"
+#include "hashmap.h"
 #include "integer.h"
 #include "intern.h"
 #include "io.h"
 #include "lispops.h"
-#include "map.h"
 #include "peano.h"
 #include "print.h"
 #include "ratio.h"
@@ -323,11 +323,11 @@ struct cons_pointer read_list( struct stack_frame *frame,
     return result;
 }
 
-
 struct cons_pointer read_map( struct stack_frame *frame,
                               struct cons_pointer frame_pointer,
-                             URL_FILE * input, wint_t initial ) {
+                              URL_FILE *input, wint_t initial ) {
-    struct cons_pointer result = make_empty_map( NIL);
+  // set write ACL to true whilst creating to prevent GC churn
+  struct cons_pointer result = make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE );
   wint_t c = initial;
 
   while ( c != L'}' ) {
@@ -335,25 +335,27 @@ struct cons_pointer read_map( struct stack_frame *frame,
         read_continuation( frame, frame_pointer, input, c );
 
     /* skip whitespace */
-        for (c = url_fgetwc( input );
+    for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c );
-             iswblank( c ) || iswcntrl( c );
+          c = url_fgetwc( input ) )
-             c = url_fgetwc( input ));
+      ;
 
     struct cons_pointer value =
         read_continuation( frame, frame_pointer, input, c );
 
     /* skip commaa and whitespace at this point. */
-        for (c = url_fgetwc( input );
+    for ( c = url_fgetwc( input ); c == L',' || iswblank( c ) || iswcntrl( c );
-             c == L',' || iswblank( c ) || iswcntrl( c );
+          c = url_fgetwc( input ) )
-             c = url_fgetwc( input ));
+      ;
 
-        result = merge_into_map( result, make_cons( make_cons( key, value), NIL));
+    result = hashmap_put( result, key, value );
   }
 
+  // default write ACL for maps should be NIL.
+  pointer_to_vso( result )->payload.hashmap.write_acl = NIL;
+
   return result;
 }
 
-
 /**
  * Read a string. This means either a string delimited by double quotes
  * (is_quoted == true), in which case it may contain whitespace but may

src/memory/dump.c

@@ -21,8 +21,8 @@
 #include "conspage.h"
 #include "consspaceobject.h"
 #include "debug.h"
+#include "hashmap.h"
 #include "intern.h"
-#include "map.h"
 #include "print.h"
 #include "stack.h"
 #include "vectorspace.h"
@@ -141,14 +141,12 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
                               L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n",
                               &vso->header.tag.bytes, vso->header.tag.value,
                               vso->header.size );
-                if ( stackframep( vso ) ) {
+
-                    dump_frame( output, pointer );
-                }
                 switch ( vso->header.tag.value ) {
                     case STACKFRAMETV:
                         dump_frame( output, pointer );
                         break;
-                    case MAPTV:
+                    case HASHTV:
                         dump_map( output, pointer);
                         break;
                 }

src/memory/hashmap.c

@@ -11,6 +11,8 @@
 #include "arith/peano.h"
 #include "authorise.h"
 #include "debug.h"
+#include "intern.h"
+#include "memory/conspage.h"
 #include "memory/consspaceobject.h"
 #include "memory/hashmap.h"
 #include "memory/vectorspace.h"
@@ -81,11 +83,13 @@ void free_hashmap( struct cons_pointer pointer ) {
     dec_ref( payload.write_acl );
 
     for ( int i = 0; i < payload.n_buckets; i++ ) {
+      if ( !nilp( payload.buckets[i] ) ) {
         debug_printf( DEBUG_ALLOC,
-                    L"Decrementing buckets[%d] of hashmap at 0x%lx\n", i,
+                      L"Decrementing bucket [%d] of hashmap at 0x%lx\n", i,
                       cell->payload.vectorp.address );
         dec_ref( payload.buckets[i] );
       }
+    }
   } else {
     debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" );
   }
@@ -137,7 +141,7 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
 struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        struct cons_pointer env ) {
-  uint32_t n = 32;
+  uint32_t n = DFLT_HASHMAP_BUCKETS;
   struct cons_pointer hash_fn = NIL;
   struct cons_pointer result = NIL;
 
@@ -185,6 +189,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
   return result;
 }
 
+
+
 /**
  * If this `ptr` is a pointer to a hashmap, return a new identical hashmap; 
  * else return `NIL`. TODO: should return an exception if ptr is not a 
@@ -243,6 +249,19 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
   return mapp;
 }
 
+struct cons_pointer hashmap_get( struct cons_pointer mapp,
+                                 struct cons_pointer key ) {
+  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] );
+  }
+
+  return result;
+}
+
 /**
  * Expects `frame->arg[1]` to be a hashmap or namespace; `frame->arg[2]` to be
  * a string-like-thing (perhaps necessarily a keyword); frame->arg[3] to be 
@@ -294,3 +313,44 @@ struct cons_pointer lisp_hashmap_put_all( struct stack_frame *frame,
   return hashmap_put_all( frame->arg[0], frame->arg[1] );
 }
 
+/**
+ * return a flat list of all the keys in the hashmap indicated by `map`.
+ */
+struct cons_pointer hashmap_keys( struct cons_pointer mapp) {
+  struct cons_pointer result = NIL;
+  if ( hashmapp( mapp ) && truep( authorised( mapp, NIL ) )) {
+        struct vector_space_object *map = pointer_to_vso( mapp );
+
+    for (int i = 0; i < map->payload.hashmap.n_buckets; i++) {
+      for (struct cons_pointer c = map->payload.hashmap.buckets[i];
+      !nilp(c);
+      c = c_cdr(c)) {
+        result = make_cons(c_car( c_car(c)), result);
+      }
+
+    }
+  }
+
+  return result;
+}
+
+struct cons_pointer lisp_hashmap_keys( struct stack_frame *frame,
+                                       struct cons_pointer frame_pointer,
+                                       struct cons_pointer env ) {
+  return hashmap_keys( frame->arg[0] );
+}
+
+void dump_map( URL_FILE *output, struct cons_pointer pointer ) {
+  struct hashmap_payload *payload = &pointer_to_vso( pointer )->payload.hashmap;
+  url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets );
+  url_fwprintf( output, L"\tHash function: " );
+  print( output, payload->hash_fn );
+  url_fwprintf( output, L"\n\tWrite ACL: " );
+  print( output, payload->write_acl );
+  url_fwprintf( output, L"\n\tBuckets:" );
+  for ( int i = 0; i < payload->n_buckets; i++ ) {
+    url_fwprintf( output, L"\n\t\t[%d]: ", i );
+    print( output, payload->buckets[i] );
+  }
+  url_fwprintf( output, L"\n" );
+}

src/memory/hashmap.h

@@ -15,14 +15,27 @@
 #include "memory/consspaceobject.h"
 #include "memory/vectorspace.h"
 
+#define DFLT_HASHMAP_BUCKETS 32 
+
 uint32_t get_hash( struct cons_pointer ptr );
 
 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 hashmap_put( struct cons_pointer mapp,
+                                 struct cons_pointer key,
+                                 struct cons_pointer val );
+
 struct cons_pointer lisp_get_hash( struct stack_frame *frame,
                                    struct cons_pointer frame_pointer,
                                    struct cons_pointer env );
 
+struct cons_pointer hashmap_keys( struct cons_pointer map );
+
 struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
                                       struct cons_pointer frame_pointer,
                                       struct cons_pointer env );
@@ -35,4 +48,8 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        struct cons_pointer env );
 
+struct cons_pointer make_hashmap( uint32_t n_buckets,
+                                  struct cons_pointer hash_fn,
+                                  struct cons_pointer write_acl );
+
 #endif

src/memory/map.c

@@ -1,289 +0,0 @@
-/*
- * map.c
- *
- * An immutable hashmap in vector space.
- *
- * (c) 2019 Simon Brooke <simon@journeyman.cc>
- * Licensed under GPL version 2.0, or, at your option, any later version.
- */
-
-#include <stdlib.h>
-
-#include "consspaceobject.h"
-#include "conspage.h"
-#include "debug.h"
-#include "dump.h"
-#include "fopen.h"
-#include "intern.h"
-#include "io.h"
-#include "lookup3.h"
-#include "map.h"
-#include "print.h"
-#include "vectorspace.h"
-
-/* \todo: a lot of this will be inherited by namespaces, regularities and
- * homogeneities. Exactly how I don't yet know. */
-
-/**
- * Get a hash value for this key.
- */
-uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key) {
-    uint32_t result = 0;
-    int l =  c_length(key);
-
-    if (keywordp(key) || stringp(key) || symbolp( key)) {
-        if ( l > 0) {
-            uint32_t buffer[l];
-
-            if (!nilp(f)) {
-                fputws(L"Custom hashing functions are not yet implemented.\n", stderr);
-            }
-            for (int i = 0; i < l; i++) {
-                buffer[i] = (uint32_t)pointer2cell(key).payload.string.character;
-            }
-
-            result = hashword( buffer, l, 0);
-        }
-    } else {
-        fputws(L"Hashing is thus far implemented only for keys, strings and symbols.\n", stderr);
-    }
-
-    return result;
-}
-
-/**
- * get the actual map object from this `pointer`, or NULL if
- * `pointer` is not a map pointer.
- */
-struct map_payload *get_map_payload( struct cons_pointer pointer ) {
-    struct map_payload *result = NULL;
-    struct vector_space_object *vso =
-        pointer2cell( pointer ).payload.vectorp.address;
-
-    if (vectorpointp(pointer) && mapp( vso ) ) {
-        result = ( struct map_payload * ) &( vso->payload );
-        debug_printf( DEBUG_BIND,
-                      L"get_map_payload: all good, returning %p\n", result );
-    } else {
-        debug_print( L"get_map_payload: fail, returning NULL\n", DEBUG_BIND );
-    }
-
-    return result;
-}
-
-
-/**
- * Make an empty immutable map, and return it.
- *
- * @param hash_function a pointer to a function of one argument, which
- * returns an integer; or (more usually) `nil`.
- * @return the new map, or NULL if memory is exhausted.
- */
-struct cons_pointer make_empty_map( struct cons_pointer hash_function ) {
-    debug_print( L"Entering make_empty_map\n", DEBUG_BIND );
-    struct cons_pointer result =
-        make_vso( MAPTAG, sizeof( struct map_payload ) );
-
-    if ( !nilp( result ) ) {
-        struct map_payload *payload = get_map_payload( result );
-
-        payload->hash_function = functionp( hash_function) ? hash_function : NIL;
-        inc_ref(hash_function);
-
-        for ( int i = 0; i < BUCKETSINMAP; i++) {
-            payload->buckets[i] = NIL;
-        }
-    }
-
-    debug_print( L"Leaving make_empty_map\n", DEBUG_BIND );
-    return result;
-}
-
-
-struct cons_pointer make_duplicate_map( struct cons_pointer parent) {
-    struct cons_pointer result = NIL;
-    struct map_payload * parent_payload = get_map_payload(parent);
-
-    if (parent_payload != NULL) {
-        result =
-            make_vso( MAPTAG, sizeof( struct map_payload ) );
-
-        if ( !nilp( result ) ) {
-            struct map_payload *payload = get_map_payload( result );
-
-            payload->hash_function = parent_payload->hash_function;
-            inc_ref(payload->hash_function);
-
-            for ( int i = 0; i < BUCKETSINMAP; i++) {
-                payload->buckets[i] = parent_payload->buckets[i];
-                inc_ref(payload->buckets[i]);
-            }
-        }
-    }
-
-    return result;
-}
-
-
-struct cons_pointer bind_in_map( struct cons_pointer parent,
-                                struct cons_pointer key,
-                                struct cons_pointer value) {
-    struct cons_pointer result = make_duplicate_map(parent);
-
-    if ( !nilp( result)) {
-        struct map_payload * payload = get_map_payload( result );
-        int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP;
-
-        payload->buckets[bucket] = make_cons(
-            make_cons(key, value), payload->buckets[bucket]);
-
-        inc_ref(payload->buckets[bucket]);
-    }
-
-    return result;
-}
-
-
-struct cons_pointer keys( struct cons_pointer store) {
-    debug_print( L"Entering keys\n", DEBUG_BIND );
-    struct cons_pointer result = NIL;
-
-    struct cons_space_object cell = pointer2cell( store );
-
-    switch (pointer2cell( store ).tag.value) {
-        case CONSTV:
-        for (struct cons_pointer c = store; !nilp(c); c = c_cdr(c)) {
-            result = make_cons( c_car( c_car( c)), result);
-        }
-        break;
-        case VECTORPOINTTV: {
-            struct vector_space_object *vso =
-                pointer2cell( store ).payload.vectorp.address;
-
-            if ( mapp( vso ) ) {
-                struct map_payload * payload = get_map_payload( store );
-
-                for (int bucket = 0; bucket < BUCKETSINMAP; bucket++) {
-                    for (struct cons_pointer c = payload->buckets[bucket];
-                         !nilp(c); c = c_cdr(c)) {
-                        debug_print( L"keys: c is ", DEBUG_BIND);
-                        debug_print_object( c, DEBUG_BIND);
-
-                        result = make_cons( c_car( c_car( c)), result);
-                        debug_print( L"; result is ", DEBUG_BIND);
-                        debug_print_object( result, DEBUG_BIND);
-                        debug_println( DEBUG_BIND);
-                    }
-                }
-            }
-        }
-        break;
-    }
-    debug_print( L"keys returning ", DEBUG_BIND );
-    debug_print_object( result, DEBUG_BIND );
-    debug_println( DEBUG_BIND);
-
-    return result;
-}
-
-/**
- * Return a new map which represents the merger of `to_merge` into
- * `parent`. `parent` must be a map, but `to_merge` may be a map or
- * an assoc list.
- *
- * @param parent a map;
- * @param to_merge an association from which key/value pairs will be merged.
- * @result a new map, containing all key/value pairs from `to_merge`
- * together with those key/value pairs from `parent` whose keys did not
- * collide.
- */
-struct cons_pointer merge_into_map( struct cons_pointer parent,
-                                   struct cons_pointer to_merge) {
-    debug_print( L"Entering merge_into_map\n", DEBUG_BIND );
-    struct cons_pointer result = make_duplicate_map(parent);
-
-    if (!nilp(result)) {
-        struct map_payload *payload = get_map_payload( result );
-        for (struct cons_pointer c = keys(to_merge);
-             !nilp(c); c = c_cdr(c)) {
-            struct cons_pointer key = c_car( c);
-            int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP;
-
-            payload->buckets[bucket] = make_cons(
-                make_cons( key, c_assoc( key, to_merge)),
-                payload->buckets[bucket]);
-        }
-    }
-
-    debug_print( L"Leaving merge_into_map\n", DEBUG_BIND );
-
-    return result;
-}
-
-
-struct cons_pointer assoc_in_map( struct cons_pointer key,
-                                  struct cons_pointer map) {
-    debug_print( L"Entering assoc_in_map\n", DEBUG_BIND );
-    struct cons_pointer result = NIL;
-    struct map_payload *payload = get_map_payload( map );
-
-    if (payload != NULL) {
-        int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP;
-        result = c_assoc(key, payload->buckets[bucket]);
-    }
-
-    debug_print( L"assoc_in_map returning ", DEBUG_BIND );
-    debug_print_object( result, DEBUG_BIND);
-    debug_println( DEBUG_BIND);
-
-    return result;
-}
-
-
-/**
- * Function: create a map initialised with key/value pairs from my
- * first argument.
- *
- * * (make-map)
- * * (make-map store)
- *
- * @param frame the stack frame in which the expression is to be interpreted;
- * @param frame_pointer a pointer to my stack_frame.
- * @param env the environment in which it is to be intepreted.
- * @return a new containing all the key/value pairs from store.
- */
-struct cons_pointer
-lisp_make_map( struct stack_frame *frame, struct cons_pointer frame_pointer,
-             struct cons_pointer env ) {
-    return merge_into_map( make_empty_map( NIL), frame->arg[0]);
-}
-
-/**
- * Dump a map to this stream for debugging
- * @param output the stream
- * @param map_pointer the pointer to the frame
- */
-void dump_map( URL_FILE * output, struct cons_pointer map_pointer ) {
-    struct vector_space_object *vso =
-        pointer2cell( map_pointer ).payload.vectorp.address;
-
-    if (vectorpointp(map_pointer) && mapp( vso ) ) {
-        struct map_payload *payload = get_map_payload( map_pointer );
-
-        if ( payload != NULL ) {
-            url_fputws( L"Immutable map; hash function: ", output );
-
-            if (nilp(payload->hash_function)) {
-                url_fputws( L"default", output);
-            } else {
-                dump_object( output, payload->hash_function);
-            }
-
-            for (int i = 0; i < BUCKETSINMAP; i++) {
-                url_fwprintf(output, L"\n\tBucket %d: ", i);
-                print( output, payload->buckets[i]);
-            }
-        }
-    }
-}
-

src/memory/map.h

@@ -1,96 +0,0 @@
-/*
- * map.h
- *
- * An immutable hashmap in vector space.
- *
- * (c) 2019 Simon Brooke <simon@journeyman.cc>
- * Licensed under GPL version 2.0, or, at your option, any later version.
- */
-
-#ifndef __psse_map_h
-#define __psse_map_h
-
-#include "consspaceobject.h"
-#include "conspage.h"
-
-/**
- * macros for the tag of a mutable map.
- */
-#define MAPTAG "IMAP"
-#define MAPTV 1346456905
-
-/**
- * Number of buckets in a single tier map.
- */
-#define BUCKETSINMAP 256
-
-/**
- * Maximum number of entries in an association-list bucket.
- */
-#define MAXENTRIESINASSOC 16
-
-/**
- * true if this vector_space_object is a map, else false.
- */
-#define mapp( vso) (((struct vector_space_object *)vso)->header.tag.value == MAPTV)
-
-/**
- * The vector-space payload of a map object. Essentially a vector of
- * `BUCKETSINMAP` + 1 `cons_pointer`s, but the first one is considered
- * special.
- */
-struct map_payload {
-    /**
-     * There is a default hash function, which is used if `hash_function` is
-     * `nil` (which it normally should be); and keywords will probably carry
-     * their own hash values. But it will be possible to override the hash
-     * function by putting a function of one argument returning an integer
-     * here. */
-    struct cons_pointer hash_function;
-
-    /**
-     * Obviously the number of buckets in a map is a trade off, and this may need
-     * tuning - or it may even be necessary to have different sized base maps. The
-     * idea here is that the value of a bucket is
-     *
-     * 1. `nil`; or
-     * 2. an association list; or
-     * 3. a map.
-     *
-     * All buckets are initially `nil`. Adding a value to a `nil` bucket returns
-     * a map with a new bucket in the form of an assoc list. Subsequent additions
-     * cons new key/value pairs onto the assoc list, until there are
-     * `MAXENTRIESINASSOC` pairs, at which point if a further value is added to
-     * the same bucket the bucket returned will be in the form of a second level
-     * map. My plan is that buckets the first level map will be indexed on the
-     * first sixteen bits of the hash value, those in the second on the second
-     * sixteen, and, potentially, so on.
-     */
-    struct cons_pointer buckets[BUCKETSINMAP];
-};
-
-uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key);
-
-struct map_payload *get_map_payload( struct cons_pointer pointer );
-
-struct cons_pointer make_empty_map( struct cons_pointer hash_function );
-
-struct cons_pointer bind_in_map( struct cons_pointer parent,
-                                struct cons_pointer key,
-                                struct cons_pointer value);
-
-struct cons_pointer keys( struct cons_pointer store);
-
-struct cons_pointer merge_into_map( struct cons_pointer parent,
-                                   struct cons_pointer to_merge);
-
-struct cons_pointer assoc_in_map( struct cons_pointer key,
-                                  struct cons_pointer map);
-
-struct cons_pointer lisp_make_map( struct stack_frame *frame,
-                                  struct cons_pointer frame_pointer,
-                                  struct cons_pointer env );
-
-void dump_map( URL_FILE * output, struct cons_pointer map_pointer );
-
-#endif

src/memory/vectorspace.h

@@ -27,15 +27,17 @@
  * part of the implementation structure of a namespace.
  */
 #define HASHTAG "HASH"
-#define HASHTV 0
+#define HASHTV 1213415752
 
 #define hashmapp(conspoint)((check_tag(conspoint,HASHTAG)))
 
 /*
  * a namespace (i.e. a binding of names to values, implemented as a hashmap)
+ * TODO: but note that a namespace is now essentially a hashmap with a write ACL
+ * whose name is interned.
  */
 #define NAMESPACETAG "NMSP"
-#define NAMESPACETV 0
+#define NAMESPACETV 1347636558
 
 #define namespacep(conspoint)(check_tag(conspoint,NAMESPACETAG))
 
@@ -43,7 +45,7 @@
  * a vector of cons pointers.
  */
 #define VECTORTAG "VECT"
-#define VECTORTV 0
+#define VECTORTV 1413694806
 
 #define vectorp(conspoint)(check_tag(conspoint,VECTORTAG))
 

src/ops/intern.c

@@ -25,7 +25,6 @@
 #include "equal.h"
 #include "hashmap.h"
 #include "lispops.h"
-#include "map.h"
 #include "print.h"
 
 /**
@@ -109,7 +108,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
             }
         }
     } else if (hashmapp( store)) {
-        result = assoc_in_map( key, store);
+        result = hashmap_get( store, key);
     } else {
         result = throw_exception(c_string_to_lisp_string(L"Store is of unknown type"), NIL);
     }
@@ -140,8 +139,8 @@ struct cons_pointer
 
     if (nilp( store) || consp(store)) {
         result = make_cons( make_cons( key, value ), store );
-    } else if (vectorpointp( store)) {
+    } else if (hashmapp( store)) {
-        result = bind_in_map( store, key, value);
+        result = hashmap_put( store, key, value);
     }
 
     debug_print( L"set returning ", DEBUG_BIND);
@@ -196,3 +195,4 @@ intern( struct cons_pointer key, struct cons_pointer environment ) {
 
     return result;
 }
+

src/ops/lispops.c

@@ -33,7 +33,6 @@
 #include "intern.h"
 #include "io.h"
 #include "lispops.h"
-#include "map.h"
 #include "print.h"
 #include "read.h"
 #include "stack.h"
@@ -378,7 +377,7 @@ struct cons_pointer
 
             case VECTORPOINTTV:
             switch ( pointer_to_vso(fn_pointer)->header.tag.value) {
-                case MAPTV:
+                case HASHTV:
                 /* \todo: if arg[0] is a CONS, treat it as a path */
                 result = c_assoc( eval_form(frame,
                                             frame_pointer,
@@ -803,6 +802,26 @@ lisp_assoc( struct stack_frame *frame, struct cons_pointer frame_pointer,
     return c_assoc( frame->arg[0], frame->arg[1] );
 }
 
+struct cons_pointer c_keys(struct cons_pointer store) {
+  struct cons_pointer result = NIL;
+
+  if ( hashmapp( store ) ) {
+    result = hashmap_keys( store );
+  } else if ( consp( store ) ) {
+    for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) {
+      result = make_cons( c_car( c ), result );
+    }
+  }
+
+  return result;
+}
+
+struct cons_pointer lisp_keys( struct stack_frame *frame,
+                               struct cons_pointer frame_pointer,
+                               struct cons_pointer env ) {
+  return c_keys( frame->arg[0]);
+}
+
 /**
  * Function; are these two objects the same object? Shallow, cheap equality.
  *

src/ops/lispops.h

@@ -26,12 +26,14 @@
  * utilities
  */
 
+struct cons_pointer c_keys( struct cons_pointer store );
 
 struct cons_pointer c_reverse( struct cons_pointer arg );
 
-struct cons_pointer
+struct cons_pointer c_progn( struct stack_frame *frame,
-c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                             struct cons_pointer frame_pointer,
-         struct cons_pointer expressions, struct cons_pointer env );
+                             struct cons_pointer expressions,
+                             struct cons_pointer env );
 
 /**
  * Useful building block; evaluate this single form in the context of this
@@ -56,7 +58,6 @@ struct cons_pointer eval_forms( struct stack_frame *frame,
                                 struct cons_pointer list,
                                 struct cons_pointer env );
 
-
 /*
  * special forms
  */
@@ -67,16 +68,20 @@ struct cons_pointer lisp_apply( struct stack_frame *frame,
                                 struct cons_pointer frame_pointer,
                                 struct cons_pointer env );
 
-struct cons_pointer
+struct cons_pointer lisp_keys( struct stack_frame *frame,
-lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                               struct cons_pointer frame_pointer,
                                struct cons_pointer env );
 
-struct cons_pointer
+struct cons_pointer lisp_oblist( struct stack_frame *frame,
-lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                                 struct cons_pointer frame_pointer,
                                  struct cons_pointer env );
 
-struct cons_pointer
+struct cons_pointer lisp_set( struct stack_frame *frame,
-lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                              struct cons_pointer frame_pointer,
+                              struct cons_pointer env );
+
+struct cons_pointer lisp_set_shriek( struct stack_frame *frame,
+                                     struct cons_pointer frame_pointer,
                                      struct cons_pointer env );
 
 /**
@@ -98,8 +103,8 @@ struct cons_pointer lisp_length( struct stack_frame *frame,
  * @param frame the stack frame in which the expression is to be interpreted;
  * @param env the environment in which it is to be intepreted.
  */
-struct cons_pointer
+struct cons_pointer lisp_nlambda( struct stack_frame *frame,
-lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                                  struct cons_pointer frame_pointer,
                                   struct cons_pointer env );
 
 struct cons_pointer lisp_quote( struct stack_frame *frame,
@@ -146,11 +151,10 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame,
  * @param env My environment (ignored).
  * @return As a Lisp string, the tag of the object which is the argument.
  */
-struct cons_pointer
+struct cons_pointer lisp_type( struct stack_frame *frame,
-lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                               struct cons_pointer frame_pointer,
                                struct cons_pointer env );
 
-
 /**
  * Function; evaluate the forms which are listed in my single argument
  * sequentially and return the value of the last. This function is called 'do'
@@ -161,8 +165,8 @@ lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * @return the value of the last form on the sequence which is my single
  * argument.
  */
-struct cons_pointer
+struct cons_pointer lisp_progn( struct stack_frame *frame,
-lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                                struct cons_pointer frame_pointer,
                                 struct cons_pointer env );
 
 /**
@@ -174,21 +178,21 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * @param env My environment (ignored).
  * @return the value of the last form of the first successful clause.
  */
-struct cons_pointer
+struct cons_pointer lisp_cond( struct stack_frame *frame,
-lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                               struct cons_pointer frame_pointer,
                                struct cons_pointer env );
 
 /**
  * Throw an exception.
- * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
+ * `throw_exception` is a misnomer, because it doesn't obey the calling
- * lisp function; but it is nevertheless to be preferred to make_exception. A
+ * signature of a lisp function; but it is nevertheless to be preferred to
- * real `throw_exception`, which does, will be needed.
+ * make_exception. A real `throw_exception`, which does, will be needed.
  */
 struct cons_pointer throw_exception( struct cons_pointer message,
                                      struct cons_pointer frame_pointer );
 
-struct cons_pointer
+struct cons_pointer lisp_exception( struct stack_frame *frame,
-lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
+                                    struct cons_pointer frame_pointer,
                                     struct cons_pointer env );
 
 struct cons_pointer lisp_source( struct stack_frame *frame,