simon/post-scarcity
1
0
Fork 0
Code Issues 3 Pull requests Projects Releases Packages Wiki Activity Actions

OK, big win: the oblist is now a hashmap, and it works. I have clear ideas now

Browse source 
about how to implement namespaces. There are probably regressions in this, but
progress nevertheless!
This commit is contained in:
Simon Brooke 2026-02-03 17:20:55 +00:00
parent 7b2deae88c
commit e41ae1aa8b
11 changed files with 345 additions and 263 deletions
Download patch file Download diff file Expand all files Collapse all files

231
src/memory/hashmap.c
View file

@ -18,81 +18,6 @@
#include "memory/hashmap.h"
#include "memory/vectorspace.h"
/**
* Return a hash value for the structure indicated by `ptr` such that if
* `x`,`y` are two separate structures whose print representation is the same
* then `(sxhash x)` and `(sxhash y)` will always be equal.
*/
uint32_t sxhash( struct cons_pointer ptr ) {
// TODO: Not Yet Implemented
/* TODO: should look at the implementation of Common Lisp sxhash?
* My current implementation of `print` only addresses URL_FILE
* streams. It would be better if it also addressed strings but
* currently it doesn't. Creating a print string of the structure
* and taking the hash of that would be one simple (but not necessarily
* cheap) solution.
*/
/* TODO: sbcl's implementation of `sxhash` is in src/compiler/sxhash.lisp
* and is EXTREMELY complex, and essentially has a different dispatch for
* every type of object. It's likely we need to do the same.
*/
return 0;
}
/**
* Get the hash value for the cell indicated by this `ptr`; currently only
* implemented for string like things and integers.
*/
uint32_t get_hash( struct cons_pointer ptr ) {
struct cons_space_object *cell = &pointer2cell( ptr );
uint32_t result = 0;
switch ( cell->tag.value ) {
case INTEGERTV:
/* Note that we're only hashing on the least significant word of an
* integer. */
result = cell->payload.integer.value & 0xffffffff;
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
result = cell->payload.string.hash;
break;
case TRUETV:
result = 1; // arbitrarily
break;
default:
result = sxhash( ptr );
break;
}
return result;
}
/**
* Free the hashmap indicated by this `pointer`.
*/
void free_hashmap( struct cons_pointer pointer ) {
struct cons_space_object *cell = &pointer2cell( pointer );
if ( hashmapp( pointer ) ) {
struct vector_space_object *vso = cell->payload.vectorp.address;
dec_ref( vso->payload.hashmap.hash_fn );
dec_ref( vso->payload.hashmap.write_acl );
for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) {
if ( !nilp( vso->payload.hashmap.buckets[i] ) ) {
debug_printf( DEBUG_ALLOC,
L"Decrementing bucket [%d] of hashmap at 0x%lx\n",
i, cell->payload.vectorp.address );
dec_ref( vso->payload.hashmap.buckets[i] );
}
}
} else {
debug_printf( DEBUG_ALLOC, L"Non-hashmap passed to `free_hashmap`\n" );
}
}
/**
* A lisp function signature conforming wrapper around get_hash, q.v..
@ -103,32 +28,6 @@ struct cons_pointer lisp_get_hash( struct stack_frame *frame,
return make_integer( get_hash( frame->arg[0] ), NIL );
}
/**
* Make a hashmap with this number of buckets, using this `hash_fn`. If
* `hash_fn` is `NIL`, use the standard hash funtion.
*/
struct cons_pointer make_hashmap( uint32_t n_buckets,
struct cons_pointer hash_fn,
struct cons_pointer write_acl ) {
struct cons_pointer result = make_vso( HASHTV,
( sizeof( struct cons_pointer ) *
( n_buckets + 2 ) ) +
( sizeof( uint32_t ) * 2 ) );
struct hashmap_payload *payload =
( struct hashmap_payload * ) &pointer_to_vso( result )->payload;
payload->hash_fn = inc_ref( hash_fn );
payload->write_acl = inc_ref( write_acl );
payload->n_buckets = n_buckets;
for ( int i = 0; i < n_buckets; i++ ) {
payload->buckets[i] = NIL;
}
return result;
}
/**
* Lisp funtion of up to four args (all optional), where
*
@ -195,80 +94,9 @@ 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 an exception.
*/
struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
struct cons_pointer result = NIL;
if ( truep( authorised( ptr, NIL ) ) ) {
if ( hashmapp( ptr ) ) {
struct vector_space_object const *from = pointer_to_vso( ptr );
if ( from != NULL ) {
struct hashmap_payload from_pl = from->payload.hashmap;
result =
make_hashmap( from_pl.n_buckets, from_pl.hash_fn,
from_pl.write_acl );
struct vector_space_object const *to = pointer_to_vso( result );
struct hashmap_payload to_pl = to->payload.hashmap;
for ( int i = 0; i < to_pl.n_buckets; i++ ) {
to_pl.buckets[i] = from_pl.buckets[i];
inc_ref( to_pl.buckets[i] );
}
}
}
} else {
result =
make_exception( c_string_to_lisp_string
( L"Arg to `clone_hashmap` must "
L"be a readable hashmap.`" ), NIL );
}
return result;
}
/**
* Store this `val` as the value of this `key` in this hashmap `mapp`. If
* current user is authorised to write to this hashmap, modifies the hashmap and
* returns it; if not, clones the hashmap, modifies the clone, and returns that.
*/
struct cons_pointer hashmap_put( struct cons_pointer mapp,
struct cons_pointer key,
struct cons_pointer val ) {
// TODO: if current user has write access to this hashmap
if ( hashmapp( mapp ) && !nilp( key ) ) {
struct vector_space_object *map = pointer_to_vso( mapp );
if ( nilp( authorised( mapp, map->payload.hashmap.write_acl ) ) ) {
mapp = clone_hashmap( mapp );
map = pointer_to_vso( mapp );
}
uint32_t bucket_no = get_hash( key ) % map->payload.hashmap.n_buckets;
map->payload.hashmap.buckets[bucket_no] =
inc_ref( make_cons( make_cons( key, val ),
map->payload.hashmap.buckets[bucket_no] ) );
}
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] );
}
// TODO: I am not sure this is right! We do not inc_ref a string when
// we make it.
inc_ref(result);
return result;
}
@ -282,35 +110,20 @@ struct cons_pointer hashmap_get( struct cons_pointer mapp,
struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) {
// TODO: if current user has write access to this hashmap
struct cons_pointer mapp = frame->arg[0];
struct cons_pointer key = frame->arg[1];
struct cons_pointer val = frame->arg[2];
return hashmap_put( mapp, key, val );
}
struct cons_pointer result = hashmap_put( mapp, key, val );
struct cons_space_object *cell = &pointer2cell( result);
// if (cell->count <= 1) {
// inc_ref( result); // TODO: I DO NOT BELIEVE this is the right place!
// }
return result;
/**
* Copy all key/value pairs in this association list `assoc` into this hashmap `mapp`. If
* current user is authorised to write to this hashmap, modifies the hashmap and
* returns it; if not, clones the hashmap, modifies the clone, and returns that.
*/
struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
struct cons_pointer assoc ) {
// TODO: if current user has write access to this hashmap
if ( hashmapp( mapp ) && !nilp( assoc ) ) {
struct vector_space_object *map = pointer_to_vso( mapp );
if ( hashmapp( mapp ) && consp( assoc ) ) {
for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
pair = c_car( assoc ) ) {
/* TODO: this is really hammering the memory management system, because
* it will make a new lone for every key/value pair added. Fix. */
mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
}
}
}
return mapp;
// TODO: else clone and return clone.
}
/**
@ -323,26 +136,6 @@ 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 ) {