diff --git a/lisp/defun.lisp b/lisp/defun.lisp index a6d80f5..a18c33a 100644 --- a/lisp/defun.lisp +++ b/lisp/defun.lisp @@ -1,5 +1,3 @@ -(set! list (lambda l l)) - (set! symbolp (lambda (x) (equal (type x) "SYMB"))) (set! defun! diff --git a/src/init.c b/src/init.c index 3f3566c..4443469 100644 --- a/src/init.c +++ b/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) diff --git a/src/io/io.h b/src/io/io.h index f350c13..dc9e8de 100644 --- a/src/io/io.h +++ b/src/io/io.h @@ -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 diff --git a/src/io/print.c b/src/io/print.c index 8f4b88e..5061b10 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -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 ); } } diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index fcbff31..f2911e5 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -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 ) { diff --git a/src/memory/hashmap.h b/src/memory/hashmap.h index b6c4a74..05823bb 100644 --- a/src/memory/hashmap.h +++ b/src/memory/hashmap.h @@ -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 diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 3616bf3..c46c798 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -25,6 +25,7 @@ #include "memory/hashmap.h" #include "memory/stack.h" #include "memory/vectorspace.h" +#include "ops/intern.h" /** diff --git a/src/ops/intern.c b/src/ops/intern.c index cd80612..e908d56 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -18,12 +18,20 @@ */ #include +/* + * wide characters + */ +#include +#include +#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 ); diff --git a/src/ops/intern.h b/src/ops/intern.h index fa17563..6be9cbc 100644 --- a/src/ops/intern.h +++ b/src/ops/intern.h @@ -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 ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 7d1a761..236a290 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -527,7 +527,8 @@ 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; + * 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]; diff --git a/src/repl.c b/src/repl.c index bef08b1..b68fa1c 100644 --- a/src/repl.c +++ b/src/repl.c @@ -10,6 +10,7 @@ #include #include #include +#include #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 =