From 4fc9545be8610b94b4bc55e19cbcce696f576446 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 16 Aug 2021 18:55:02 +0100 Subject: [PATCH] Hashmaps sort-of work but there are still bugs and one test is failing that wasn't. --- src/init.c | 8 +- src/io/print.c | 46 +++---- src/io/read.c | 48 +++---- src/memory/dump.c | 8 +- src/memory/hashmap.c | 70 +++++++++- src/memory/hashmap.h | 17 +++ src/memory/map.c | 289 --------------------------------------- src/memory/map.h | 96 ------------- src/memory/vectorspace.h | 8 +- src/ops/intern.c | 8 +- src/ops/lispops.c | 23 +++- src/ops/lispops.h | 72 +++++----- 12 files changed, 206 insertions(+), 487 deletions(-) delete mode 100644 src/memory/map.c delete mode 100644 src/memory/map.h diff --git a/src/init.c b/src/init.c index dbfdd5d..7b1649c 100644 --- a/src/init.c +++ b/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 ); diff --git a/src/io/print.c b/src/io/print.c index c68c03e..3f33252 100644 --- a/src/io/print.c +++ b/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); + url_fputwc( btowc( '{' ), output ); - if ( mapp( vso ) ) { - url_fputwc( btowc( '{' ), output ); + for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks ); + ks = c_cdr( ks ) ) { + struct cons_pointer key = c_car( ks); + print( output, key ); + url_fputwc( btowc( ' ' ), output ); + print( output, hashmap_get( map, key ) ); - for ( struct cons_pointer ks = keys( map); - !nilp( ks); ks = c_cdr( ks)) { - print( output, c_car( ks)); - url_fputwc( btowc( ' ' ), output ); - print( output, c_assoc( c_car( ks), map)); - - if ( !nilp( c_cdr( ks))) { - url_fputws( L", ", output ); - } - } - - url_fputwc( btowc( '}' ), output ); - } + 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 = - pointer2cell( pointer ).payload.vectorp.address; - + struct vector_space_object *vso = pointer_to_vso(pointer); 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 ); } } diff --git a/src/io/read.c b/src/io/read.c index 0f32815..ede44ad 100644 --- a/src/io/read.c +++ b/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,37 +323,39 @@ 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 ) { - struct cons_pointer result = make_empty_map( NIL); - wint_t c = initial; + struct cons_pointer frame_pointer, + URL_FILE *input, wint_t initial ) { + // 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'}' ) { - struct cons_pointer key = - read_continuation( frame, frame_pointer, input, c ); + while ( c != L'}' ) { + struct cons_pointer key = + read_continuation( frame, frame_pointer, input, c ); - /* skip whitespace */ - for (c = url_fgetwc( input ); - iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input )); + /* skip whitespace */ + for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ) + ; - struct cons_pointer value = - read_continuation( frame, frame_pointer, input, c ); + struct cons_pointer value = + read_continuation( frame, frame_pointer, input, c ); - /* skip commaa and whitespace at this point. */ - for (c = url_fgetwc( input ); - c == L',' || iswblank( c ) || iswcntrl( c ); - c = url_fgetwc( input )); + /* skip commaa and whitespace at this point. */ + for ( c = url_fgetwc( input ); c == L',' || iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ) + ; - result = merge_into_map( result, make_cons( make_cons( key, value), NIL)); - } + result = hashmap_put( result, key, value ); + } - return result; + // 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 diff --git a/src/memory/dump.c b/src/memory/dump.c index 074d1c4..b992bb2 100644 --- a/src/memory/dump.c +++ b/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; } diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index 9be7d64..11a03f0 100644 --- a/src/memory/hashmap.c +++ b/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,10 +83,12 @@ void free_hashmap( struct cons_pointer pointer ) { dec_ref( payload.write_acl ); for ( int i = 0; i < payload.n_buckets; i++ ) { - debug_printf( DEBUG_ALLOC, - L"Decrementing buckets[%d] of hashmap at 0x%lx\n", i, - cell->payload.vectorp.address ); - dec_ref( payload.buckets[i] ); + if ( !nilp( payload.buckets[i] ) ) { + debug_printf( DEBUG_ALLOC, + 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" ); +} diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h index 579b56d..4602f3e 100644 --- a/src/memory/hashmap.h +++ b/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 \ No newline at end of file diff --git a/src/memory/map.c b/src/memory/map.c deleted file mode 100644 index cbad3df..0000000 --- a/src/memory/map.c +++ /dev/null @@ -1,289 +0,0 @@ -/* - * map.c - * - * An immutable hashmap in vector space. - * - * (c) 2019 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#include - -#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]); - } - } - } -} - diff --git a/src/memory/map.h b/src/memory/map.h deleted file mode 100644 index c9b5cfc..0000000 --- a/src/memory/map.h +++ /dev/null @@ -1,96 +0,0 @@ -/* - * map.h - * - * An immutable hashmap in vector space. - * - * (c) 2019 Simon Brooke - * 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 diff --git a/src/memory/vectorspace.h b/src/memory/vectorspace.h index ed050bc..2c163e8 100644 --- a/src/memory/vectorspace.h +++ b/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)) diff --git a/src/ops/intern.c b/src/ops/intern.c index 802bc82..07b9693 100644 --- a/src/ops/intern.c +++ b/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)) { - result = bind_in_map( store, key, value); + } else if (hashmapp( store)) { + 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; } + diff --git a/src/ops/lispops.c b/src/ops/lispops.c index c96b1be..3a972a5 100644 --- a/src/ops/lispops.c +++ b/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. * diff --git a/src/ops/lispops.h b/src/ops/lispops.h index f359252..4669493 100644 --- a/src/ops/lispops.h +++ b/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 -c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer expressions, struct cons_pointer env ); +struct cons_pointer c_progn( struct stack_frame *frame, + struct cons_pointer frame_pointer, + 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,17 +68,21 @@ struct cons_pointer lisp_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); -struct cons_pointer -lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_keys( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); -struct cons_pointer -lisp_set( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_oblist( struct stack_frame *frame, + 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 ); +struct cons_pointer lisp_set( struct stack_frame *frame, + 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 ); /** * Construct an interpretable function. @@ -90,17 +95,17 @@ struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); struct cons_pointer lisp_length( struct stack_frame *frame, - struct cons_pointer frame_pointer, - struct cons_pointer env ); + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Construct an interpretable special form. * * @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 -lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_nlambda( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_quote( struct stack_frame *frame, struct cons_pointer frame_pointer, @@ -146,10 +151,9 @@ 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 -lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); - +struct cons_pointer lisp_type( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Function; evaluate the forms which are listed in my single argument @@ -161,9 +165,9 @@ 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 -lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_progn( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Special form: conditional. Each arg is expected to be a list; if the first @@ -174,22 +178,22 @@ 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 -lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_cond( struct stack_frame *frame, + 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 - * lisp function; but it is nevertheless to be preferred to make_exception. A - * real `throw_exception`, which does, will be needed. + * `throw_exception` is a misnomer, because it doesn't obey the calling + * 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 frame_pointer ); -struct cons_pointer -lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ); +struct cons_pointer lisp_exception( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); struct cons_pointer lisp_source( struct stack_frame *frame, struct cons_pointer frame_pointer,