From 0687b0baebacc2940922c74f31f8b3133a388ddd Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 6 Feb 2019 11:17:31 +0000 Subject: [PATCH] #8: Buggy, but a lot of it works. --- src/init.c | 2 ++ src/io/print.c | 42 ++++++++++++++++++++++++++++++++++++++++++ src/memory/dump.c | 5 +++++ src/memory/map.c | 22 ++++++++++++++++++++-- src/memory/map.h | 6 +++++- src/ops/intern.c | 30 ++++++++++++++++++++++++------ 6 files changed, 98 insertions(+), 9 deletions(-) diff --git a/src/init.c b/src/init.c index 06494e9..82b497a 100644 --- a/src/init.c +++ b/src/init.c @@ -26,6 +26,7 @@ #include "intern.h" #include "io.h" #include "lispops.h" +#include "map.h" #include "meta.h" #include "peano.h" #include "print.h" @@ -196,6 +197,7 @@ int main( int argc, char *argv[] ) { bind_function( L"eval", &lisp_eval ); bind_function( L"exception", &lisp_exception ); bind_function( L"inspect", &lisp_inspect ); + bind_function( L"make-map", &lisp_make_map); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); bind_function( L"multiply", &lisp_multiply ); diff --git a/src/io/print.c b/src/io/print.c index fb0d8a1..f4c98aa 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -20,9 +20,12 @@ #include "conspage.h" #include "consspaceobject.h" #include "integer.h" +#include "intern.h" +#include "map.h" #include "stack.h" #include "print.h" #include "time.h" +#include "vectorspace.h" /** * Whether or not we colorise output. @@ -98,7 +101,43 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) { } else { url_fputws( L")", output ); } +} + +void print_map( URL_FILE * output, struct cons_pointer pointer) { + if ( vectorpointp( pointer)) { + struct vector_space_object *vso = pointer_to_vso( pointer); + + if ( mapp( vso ) ) { + url_fputwc( btowc( '{' ), output ); + + for ( struct cons_pointer ks = keys(pointer); + !nilp(ks); ks = c_cdr(ks)) { + print( output, c_car(ks)); + url_fputwc( btowc( ' ' ), output ); + print( output, c_assoc( pointer, c_car(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; + + switch ( vso->header.tag.value) { + case MAPTV: + print_map( output, pointer); + break; + // \todo: others. + } } /** @@ -217,6 +256,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { case TRUETV: url_fwprintf( output, L"t" ); break; + case VECTORPOINTTV: + print_vso( output, pointer); + break; case WRITETV: url_fwprintf( output, L"" ); break; diff --git a/src/memory/dump.c b/src/memory/dump.c index 28bd36a..074d1c4 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -21,6 +21,8 @@ #include "conspage.h" #include "consspaceobject.h" #include "debug.h" +#include "intern.h" +#include "map.h" #include "print.h" #include "stack.h" #include "vectorspace.h" @@ -146,6 +148,9 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { case STACKFRAMETV: dump_frame( output, pointer ); break; + case MAPTV: + dump_map( output, pointer); + break; } } break; diff --git a/src/memory/map.c b/src/memory/map.c index 358b2e4..7224a12 100644 --- a/src/memory/map.c +++ b/src/memory/map.c @@ -30,7 +30,7 @@ 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)) { + if (keywordp(key) || stringp(key) || symbolp( key)) { if ( l > 0) { uint32_t buffer[l]; @@ -44,7 +44,7 @@ uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key) { result = hashword( buffer, l, 0); } } else { - fputws(L"Hashing is thud far implemented only for keys and strings.\n", stderr); + fputws(L"Hashing is thus far implemented only for keys, strings and symbols.\n", stderr); } return result; @@ -220,6 +220,24 @@ struct cons_pointer assoc_in_map( struct cons_pointer map, 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 diff --git a/src/memory/map.h b/src/memory/map.h index 143c7b9..76a7193 100644 --- a/src/memory/map.h +++ b/src/memory/map.h @@ -83,7 +83,11 @@ struct cons_pointer merge_into_map( struct cons_pointer parent, struct cons_pointer to_merge); struct cons_pointer assoc_in_map( struct cons_pointer map, - struct cons_pointer key); + struct cons_pointer key); + +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 ); diff --git a/src/ops/intern.c b/src/ops/intern.c index b4eafd2..02deb23 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -52,7 +52,7 @@ struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer store ) { struct cons_pointer result = NIL; - if ( symbolp( key ) ) { + if ( symbolp( key ) || keywordp( key ) ) { for ( struct cons_pointer next = store; nilp( result ) && consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { @@ -74,7 +74,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { debug_print_object( key, DEBUG_BIND ); debug_print( L"` is a ", DEBUG_BIND ); debug_print_object( c_type( key ), DEBUG_BIND ); - debug_print( L", not a SYMB", DEBUG_BIND ); + debug_print( L", not a KEYW or SYMB", DEBUG_BIND ); } return result; @@ -113,6 +113,10 @@ struct cons_pointer c_assoc( struct cons_pointer key, result = assoc_in_map( key, store); } + debug_print( L"c_assoc returning ", DEBUG_BIND); + debug_print_object( result, DEBUG_BIND); + debug_println( DEBUG_BIND); + return result; } @@ -125,18 +129,24 @@ struct cons_pointer struct cons_pointer store ) { struct cons_pointer result = NIL; - debug_print( L"Binding ", DEBUG_BIND ); + debug_print( L"set: binding `", DEBUG_BIND ); debug_print_object( key, DEBUG_BIND ); - debug_print( L" to ", DEBUG_BIND ); + debug_print( L"` to `", DEBUG_BIND ); debug_print_object( value, DEBUG_BIND ); + debug_print( L"` in store ", DEBUG_BIND ); + debug_dump_object( store, DEBUG_BIND); debug_println( DEBUG_BIND ); - if (consp(store)) { + if (nilp( store) || consp(store)) { result = make_cons( make_cons( key, value ), store ); } else if (vectorpointp( store)) { result = bind_in_map( store, key, value); } + debug_print( L"set returning ", DEBUG_BIND); + debug_print_object( result, DEBUG_BIND); + debug_println( DEBUG_BIND); + return result; } @@ -150,11 +160,19 @@ 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 ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"` to ", DEBUG_BIND ); + debug_print_object( value, DEBUG_BIND ); + debug_println( DEBUG_BIND ); + oblist = set( key, value, oblist ); inc_ref( oblist ); dec_ref( old ); - debug_print( L"Leaving deep_bind\n", DEBUG_BIND ); + debug_print( L"deep_bind returning ", DEBUG_BIND ); + debug_print_object( oblist, DEBUG_BIND ); + debug_println( DEBUG_BIND ); return oblist; }