OK, big win: the oblist is now a hashmap, and it works. I have clear ideas now
about how to implement namespaces. There are probably regressions in this, but progress nevertheless!
This commit is contained in:
parent
7b2deae88c
commit
e41ae1aa8b
11 changed files with 345 additions and 263 deletions
|
|
@ -1,5 +1,3 @@
|
|||
(set! list (lambda l l))
|
||||
|
||||
(set! symbolp (lambda (x) (equal (type x) "SYMB")))
|
||||
|
||||
(set! defun!
|
||||
|
|
|
|||
19
src/init.c
19
src/init.c
|
|
@ -36,7 +36,6 @@
|
|||
#include "io/fopen.h"
|
||||
#include "time/psse_time.h"
|
||||
|
||||
// extern char *optarg; /* defined in unistd.h */
|
||||
|
||||
/**
|
||||
* Bind this compiled `executable` function, as a Lisp function, to
|
||||
|
|
@ -160,14 +159,22 @@ int main( int argc, char *argv[] ) {
|
|||
print_banner( );
|
||||
}
|
||||
|
||||
debug_print( L"About to initialise cons pages\n", DEBUG_BOOTSTRAP );
|
||||
|
||||
initialise_cons_pages( );
|
||||
|
||||
debug_print( L"Initialised cons pages, about to bind\n", DEBUG_BOOTSTRAP );
|
||||
// TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly.
|
||||
// What actually goes wrong is:
|
||||
// 1. the hashmap is created;
|
||||
// 2. everything bound in init seems to get initialised properly;
|
||||
// 3. the REPL starts up;
|
||||
// 4. Anything typed into the REPL (except ctrl-D) results in immediate segfault.
|
||||
// 5. If ctrl-D is the first thing typed into the REPL, shutdown proceeds normally.
|
||||
// Hypothesis: binding stuff into a hashmap oblist either isn't happening or
|
||||
// is wrking ok, but retrieving from a hashmap oblist is failing.
|
||||
debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP );
|
||||
|
||||
// TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly
|
||||
// oblist = inc_ref( make_hashmap( 32, NIL, TRUE ) );
|
||||
oblist = make_hashmap( 32, NIL, TRUE );
|
||||
|
||||
debug_print( L"About to bind\n", DEBUG_BOOTSTRAP );
|
||||
|
||||
/*
|
||||
* privileged variables (keywords)
|
||||
|
|
|
|||
|
|
@ -36,5 +36,5 @@ struct cons_pointer
|
|||
lisp_slurp( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
|
||||
char *lisp_string_to_c_string( struct cons_pointer s );
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -102,7 +102,7 @@ void print_map( URL_FILE * output, struct cons_pointer map ) {
|
|||
print( output, hashmap_get( map, key ) );
|
||||
|
||||
if ( !nilp( c_cdr( ks ) ) ) {
|
||||
url_fputws( L", ", output );
|
||||
url_fputws( L" ", output );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ) {
|
||||
|
|
|
|||
|
|
@ -17,25 +17,11 @@
|
|||
|
||||
#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 );
|
||||
|
|
@ -48,8 +34,5 @@ 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
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@
|
|||
#include "memory/hashmap.h"
|
||||
#include "memory/stack.h"
|
||||
#include "memory/vectorspace.h"
|
||||
#include "ops/intern.h"
|
||||
|
||||
|
||||
/**
|
||||
|
|
|
|||
292
src/ops/intern.c
292
src/ops/intern.c
|
|
@ -18,12 +18,20 @@
|
|||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
#include <wchar.h>
|
||||
#include <wctype.h>
|
||||
|
||||
#include "authorise.h"
|
||||
#include "debug.h"
|
||||
#include "io/io.h"
|
||||
#include "memory/conspage.h"
|
||||
#include "memory/consspaceobject.h"
|
||||
#include "debug.h"
|
||||
#include "ops/equal.h"
|
||||
#include "memory/hashmap.h"
|
||||
#include "ops/equal.h"
|
||||
#include "ops/intern.h"
|
||||
#include "ops/lispops.h"
|
||||
// #include "print.h"
|
||||
|
||||
|
|
@ -39,6 +47,219 @@
|
|||
*/
|
||||
struct cons_pointer oblist = NIL;
|
||||
|
||||
/**
|
||||
* 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" );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* 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;
|
||||
}
|
||||
|
||||
/**
|
||||
* 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;
|
||||
}
|
||||
|
||||
/**
|
||||
* 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 ) ) {
|
||||
struct vector_space_object *map = pointer_to_vso( mapp );
|
||||
|
||||
if ( 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. */
|
||||
if (consp( pair)) {
|
||||
mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
|
||||
} else if (hashmapp( pair)) {
|
||||
hashmap_put_all( mapp, pair);
|
||||
} else {
|
||||
hashmap_put( mapp, pair, TRUE);
|
||||
}
|
||||
assoc = c_cdr( assoc);
|
||||
}
|
||||
} else if (hashmapp( assoc)) {
|
||||
for (struct cons_pointer keys = hashmap_keys( mapp); !nilp( keys);
|
||||
keys = c_cdr( keys)) {
|
||||
struct cons_pointer key = c_car( keys);
|
||||
hashmap_put( mapp, key, hashmap_get( assoc, key));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return mapp;
|
||||
}
|
||||
|
||||
/** Get a value from a hashmap.
|
||||
*
|
||||
* Note that this is here, rather than in memory/hashmap.c, because it is
|
||||
* closely tied in with c_assoc, q.v.
|
||||
*/
|
||||
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;
|
||||
}
|
||||
|
||||
/**
|
||||
* 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;
|
||||
}
|
||||
|
||||
/**
|
||||
* Implementation of interned? in C. The final implementation if interned? will
|
||||
* deal with stores which can be association lists or hashtables or hybrids of
|
||||
|
|
@ -53,21 +274,26 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
|
|||
struct cons_pointer result = NIL;
|
||||
|
||||
if ( symbolp( key ) || keywordp( key ) ) {
|
||||
for ( struct cons_pointer next = store;
|
||||
nilp( result ) && consp( next );
|
||||
next = pointer2cell( next ).payload.cons.cdr ) {
|
||||
struct cons_space_object entry =
|
||||
pointer2cell( pointer2cell( next ).payload.cons.car );
|
||||
// TODO: I see what I was doing here and it would be the right thing to
|
||||
// do for stores which are old-fashioned assoc lists, but it will not work
|
||||
// for my new hybrid stores.
|
||||
// for ( struct cons_pointer next = store;
|
||||
// nilp( result ) && consp( next );
|
||||
// next = pointer2cell( next ).payload.cons.cdr ) {
|
||||
// struct cons_space_object entry =
|
||||
// pointer2cell( pointer2cell( next ).payload.cons.car );
|
||||
|
||||
debug_print( L"Internedp: checking whether `", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` equals `", DEBUG_BIND );
|
||||
debug_print_object( entry.payload.cons.car, DEBUG_BIND );
|
||||
debug_print( L"`\n", DEBUG_BIND );
|
||||
// debug_print( L"Internedp: checking whether `", DEBUG_BIND );
|
||||
// debug_print_object( key, DEBUG_BIND );
|
||||
// debug_print( L"` equals `", DEBUG_BIND );
|
||||
// debug_print_object( entry.payload.cons.car, DEBUG_BIND );
|
||||
// debug_print( L"`\n", DEBUG_BIND );
|
||||
|
||||
if ( equal( key, entry.payload.cons.car ) ) {
|
||||
result = entry.payload.cons.car;
|
||||
}
|
||||
// if ( equal( key, entry.payload.cons.car ) ) {
|
||||
// result = entry.payload.cons.car;
|
||||
// }
|
||||
if (!nilp( c_assoc( store, key))) {
|
||||
result = key;
|
||||
}
|
||||
} else {
|
||||
debug_print( L"`", DEBUG_BIND );
|
||||
|
|
@ -135,6 +361,34 @@ struct cons_pointer c_assoc( struct cons_pointer key,
|
|||
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 ) {
|
||||
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;
|
||||
|
||||
// TODO: if there are too many values in the bucket, rehash the whole
|
||||
// hashmap to a bigger number of buckets, and return that.
|
||||
|
||||
map->payload.hashmap.buckets[bucket_no] =
|
||||
inc_ref( make_cons( make_cons( key, val ),
|
||||
map->payload.hashmap.buckets[bucket_no] ) );
|
||||
}
|
||||
|
||||
return mapp;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return a new key/value store containing all the key/value pairs in this
|
||||
* store with this key/value pair added to the front.
|
||||
|
|
@ -151,9 +405,14 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
|
|||
debug_dump_object( store, DEBUG_BIND );
|
||||
debug_println( DEBUG_BIND );
|
||||
|
||||
if ( nilp( store ) || consp( store ) ) {
|
||||
debug_printf( DEBUG_BIND, L"set: store is %s\n`", lisp_string_to_c_string( c_type( store)) );
|
||||
if (nilp( value)) {
|
||||
result = store;
|
||||
}
|
||||
else if ( nilp( store ) || consp( store ) ) {
|
||||
result = make_cons( make_cons( key, value ), store );
|
||||
} else if ( hashmapp( store ) ) {
|
||||
debug_print( L"set: storing in hashmap\n", DEBUG_BIND);
|
||||
result = hashmap_put( store, key, value );
|
||||
}
|
||||
|
||||
|
|
@ -172,6 +431,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
|
|||
struct cons_pointer
|
||||
deep_bind( struct cons_pointer key, struct cons_pointer value ) {
|
||||
debug_print( L"Entering deep_bind\n", DEBUG_BIND );
|
||||
|
||||
struct cons_pointer old = oblist;
|
||||
|
||||
debug_print( L"deep_bind: binding `", DEBUG_BIND );
|
||||
|
|
|
|||
|
|
@ -22,12 +22,41 @@
|
|||
|
||||
extern struct cons_pointer oblist;
|
||||
|
||||
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 hashmap_put_all( struct cons_pointer mapp,
|
||||
struct cons_pointer assoc );
|
||||
|
||||
struct cons_pointer hashmap_keys( struct cons_pointer map );
|
||||
|
||||
struct cons_pointer make_hashmap( uint32_t n_buckets,
|
||||
struct cons_pointer hash_fn,
|
||||
struct cons_pointer write_acl );
|
||||
|
||||
struct cons_pointer c_assoc( struct cons_pointer key,
|
||||
struct cons_pointer store );
|
||||
|
||||
struct cons_pointer internedp( struct cons_pointer key,
|
||||
struct cons_pointer environment );
|
||||
|
||||
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 set( struct cons_pointer key,
|
||||
struct cons_pointer value,
|
||||
struct cons_pointer store );
|
||||
|
|
|
|||
|
|
@ -528,6 +528,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
* \todo
|
||||
* the Clojure practice of having a map serve in the function place of
|
||||
* an s-expression is a good one and I should adopt it;
|
||||
* H'mmm... this is working, but it isn't here. Where is it?
|
||||
*/
|
||||
default:
|
||||
result = frame->arg[0];
|
||||
|
|
|
|||
10
src/repl.c
10
src/repl.c
|
|
@ -10,6 +10,7 @@
|
|||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <wchar.h>
|
||||
#include <signal.h>
|
||||
|
||||
#include "memory/consspaceobject.h"
|
||||
#include "debug.h"
|
||||
|
|
@ -17,11 +18,20 @@
|
|||
#include "ops/lispops.h"
|
||||
#include "memory/stack.h"
|
||||
|
||||
/**
|
||||
* @brief Handle an interrupt signal.
|
||||
*
|
||||
* @param dummy
|
||||
*/
|
||||
void int_handler(int dummy) {
|
||||
wprintf(L"TODO: handle ctrl-C in a more interesting way\n");
|
||||
}
|
||||
|
||||
/**
|
||||
* The read/eval/print loop.
|
||||
*/
|
||||
void repl( ) {
|
||||
signal(SIGINT, int_handler);
|
||||
debug_print( L"Entered repl\n", DEBUG_REPL );
|
||||
|
||||
struct cons_pointer env =
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue