Hashmaps sort-of work but there are still bugs and one test is failing that wasn't.
This commit is contained in:
parent
bfd7304da1
commit
4fc9545be8
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
!nilp( ks); ks = c_cdr( ks)) {
|
||||
print( output, c_car( ks));
|
||||
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, 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 =
|
||||
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 );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ) {
|
||||
struct cons_pointer result = make_empty_map( NIL);
|
||||
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'}' ) {
|
||||
|
|
@ -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 );
|
||||
iswblank( c ) || iswcntrl( c );
|
||||
c = url_fgetwc( input ));
|
||||
for ( c = url_fgetwc( input ); iswblank( c ) || iswcntrl( c );
|
||||
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 );
|
||||
c == L',' || iswblank( c ) || iswcntrl( c );
|
||||
c = url_fgetwc( input ));
|
||||
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 );
|
||||
}
|
||||
|
||||
// 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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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" );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
289
src/memory/map.c
289
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]);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
*
|
||||
|
|
|
|||
|
|
@ -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,16 +68,20 @@ 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 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 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 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 );
|
||||
|
||||
/**
|
||||
|
|
@ -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
|
||||
lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
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,
|
||||
|
|
@ -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
|
||||
lisp_type( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
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
|
||||
* 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
|
||||
lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer lisp_progn( struct stack_frame *frame,
|
||||
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
|
||||
lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
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 lisp_exception( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer lisp_source( struct stack_frame *frame,
|
||||
|
|
|
|||
Loading…
Reference in a new issue