From f36436a9e145740ae937064298f9b2f6156313cf Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 7 Feb 2019 09:02:28 +0000 Subject: [PATCH] #8: Done I'm now of the opinion that this is done at the wrong level in the stack and needs to be redone later; but it works for now. There's a regression in `open`, but I can't see why. --- src/init.c | 2 +- src/io/io.c | 7 ++- src/io/print.c | 30 ++++++++----- src/io/read.c | 79 ++++++++++++++++++++++++++++----- src/memory/map.c | 36 +++++++++++---- src/memory/map.h | 6 ++- src/ops/intern.c | 4 +- src/ops/lispops.c | 1 + src/utils.c | 2 +- src/utils.h | 4 +- unit-tests/eval-quote-symbol.sh | 2 +- unit-tests/slurp.sh | 2 +- 12 files changed, 134 insertions(+), 41 deletions(-) diff --git a/src/init.c b/src/init.c index 82b497a..275cc40 100644 --- a/src/init.c +++ b/src/init.c @@ -69,7 +69,7 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable ) n ), NIL ) ); - deep_bind( n, make_special( NIL, executable ) ); + deep_bind( n, make_special( meta, executable ) ); } /** diff --git a/src/io/io.c b/src/io/io.c index b82c6ba..7e6a3c0 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -15,6 +15,7 @@ #include #include #include +#include #include #include #include @@ -277,9 +278,11 @@ struct cons_pointer add_meta_time( struct cons_pointer meta, wchar_t *key, /* I don't yet have a concept of a date-time object, which is a * bit of an oversight! */ char datestring[256]; - struct tm *tm = localtime( value ); - strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ), tm ); + strftime( datestring, + sizeof( datestring ), + nl_langinfo( D_T_FMT ), + localtime( value ) ); return add_meta_string( meta, key, datestring ); } diff --git a/src/io/print.c b/src/io/print.c index f4c98aa..343160e 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -104,18 +104,18 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) { } -void print_map( URL_FILE * output, struct cons_pointer pointer) { - if ( vectorpointp( pointer)) { - struct vector_space_object *vso = pointer_to_vso( pointer); +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(pointer); - !nilp(ks); ks = c_cdr(ks)) { - print( output, c_car(ks)); + for ( struct cons_pointer ks = keys( map); + !nilp( ks); ks = c_cdr( ks)) { + print( output, c_car( ks)); url_fputwc( btowc( ' ' ), output ); - print( output, c_assoc( pointer, c_car(ks))); + print( output, c_assoc( c_car( ks), map)); if ( !nilp( c_cdr( ks))) { url_fputws( L", ", output ); @@ -162,7 +162,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { dump_stack_trace( output, pointer ); break; case FUNCTIONTV: - url_fwprintf( output, L"" ); + url_fputws( L"', output); break; case INTEGERTV:{ struct cons_pointer s = integer_to_string( pointer, 10 ); @@ -214,7 +216,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print( output, cell.payload.ratio.divisor ); break; case READTV: - url_fwprintf( output, L"" ); + url_fwprintf( output, L"', output); break; case REALTV: /* \todo using the C heap is a bad plan because it will fragment. @@ -248,7 +252,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print_string_contents( output, pointer ); break; case SPECIALTV: - url_fwprintf( output, L"" ); + url_fwprintf( output, L"', output); break; case TIMETV: print_string(output, time_to_string( pointer)); @@ -260,7 +266,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print_vso( output, pointer); break; case WRITETV: - url_fwprintf( output, L"" ); + url_fwprintf( output, L"', output); break; default: fwprintf( stderr, diff --git a/src/io/read.c b/src/io/read.c index c49d043..4f3ed0a 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -24,6 +24,7 @@ #include "intern.h" #include "io.h" #include "lispops.h" +#include "map.h" #include "peano.h" #include "print.h" #include "ratio.h" @@ -44,6 +45,9 @@ struct cons_pointer read_number( struct stack_frame *frame, struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE * input, wint_t initial ); +struct cons_pointer read_map( struct stack_frame *frame, + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag, wint_t initial ); @@ -100,6 +104,10 @@ struct cons_pointer read_continuation( struct stack_frame *frame, read_list( frame, frame_pointer, input, url_fgetwc( input ) ); break; + case '{': + result = read_map( frame, frame_pointer, input, + url_fgetwc( input ) ); + break; case '"': result = read_string( input, url_fgetwc( input ) ); break; @@ -126,9 +134,10 @@ struct cons_pointer read_continuation( struct stack_frame *frame, } else if ( iswblank( next ) ) { /* dotted pair. \todo this isn't right, we * really need to backtrack up a level. */ - result = - read_continuation( frame, frame_pointer, input, + result = read_continuation( frame, frame_pointer, input, url_fgetwc( input ) ); + debug_print( L"read_continuation: dotted pair; read cdr ", + DEBUG_IO); } else { read_symbol_or_key( input, SYMBOLTAG, c ); } @@ -275,19 +284,38 @@ struct cons_pointer read_number( struct stack_frame *frame, * left parenthesis. */ struct cons_pointer read_list( struct stack_frame *frame, - struct cons_pointer frame_pointer, - URL_FILE * input, wint_t initial ) { + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ) { struct cons_pointer result = NIL; + wint_t c; + if ( initial != ')' ) { debug_printf( DEBUG_IO, - L"read_list starting '%C' (%d)\n", initial, initial ); + L"read_list starting '%C' (%d)\n", initial, initial ); struct cons_pointer car = read_continuation( frame, frame_pointer, input, - initial ); - result = - make_cons( car, - read_list( frame, frame_pointer, input, - url_fgetwc( input ) ) ); + initial ); + + /* skip whitespace */ + for (c = url_fgetwc( input ); + iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input )); + + if ( c == L'.') { + /* might be a dotted pair; indeed, if we rule out numbers with + * initial periods, it must be a dotted pair. \todo Ought to check, + * howerver, that there's only one form after the period. */ + result = + make_cons( car, + c_car( read_list( frame, + frame_pointer, + input, + url_fgetwc( input ) ) ) ); + } else { + result = + make_cons( car, + read_list( frame, frame_pointer, input, c ) ); + } } else { debug_print( L"End of list detected\n", DEBUG_IO ); } @@ -295,6 +323,37 @@ 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); + wint_t c = initial; + + while ( c != L'}' ) { + struct cons_pointer key = + read_continuation( frame, frame_pointer, input, c ); + + /* skip whitespace */ + 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 )); + + result = merge_into_map( result, make_cons( make_cons( key, value), 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 diff --git a/src/memory/map.c b/src/memory/map.c index 7224a12..cbad3df 100644 --- a/src/memory/map.c +++ b/src/memory/map.c @@ -15,6 +15,7 @@ #include "dump.h" #include "fopen.h" #include "intern.h" +#include "io.h" #include "lookup3.h" #include "map.h" #include "print.h" @@ -61,10 +62,10 @@ struct map_payload *get_map_payload( struct cons_pointer pointer ) { if (vectorpointp(pointer) && mapp( vso ) ) { result = ( struct map_payload * ) &( vso->payload ); - debug_printf( DEBUG_STACK, + 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_STACK ); + debug_print( L"get_map_payload: fail, returning NULL\n", DEBUG_BIND ); } return result; @@ -79,7 +80,7 @@ struct map_payload *get_map_payload( struct cons_pointer pointer ) { * @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_ALLOC ); + debug_print( L"Entering make_empty_map\n", DEBUG_BIND ); struct cons_pointer result = make_vso( MAPTAG, sizeof( struct map_payload ) ); @@ -94,6 +95,7 @@ struct cons_pointer make_empty_map( struct cons_pointer hash_function ) { } } + debug_print( L"Leaving make_empty_map\n", DEBUG_BIND ); return result; } @@ -143,6 +145,7 @@ struct cons_pointer bind_in_map( struct cons_pointer parent, 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 ); @@ -158,18 +161,27 @@ struct cons_pointer keys( struct cons_pointer store) { pointer2cell( store ).payload.vectorp.address; if ( mapp( vso ) ) { - struct map_payload * payload = get_map_payload( result ); + 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; } @@ -187,6 +199,7 @@ struct cons_pointer keys( struct cons_pointer store) { */ 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)) { @@ -202,24 +215,31 @@ struct cons_pointer merge_into_map( struct cons_pointer parent, } } + debug_print( L"Leaving merge_into_map\n", DEBUG_BIND ); + return result; } -struct cons_pointer assoc_in_map( struct cons_pointer map, - struct cons_pointer key) { +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. @@ -251,7 +271,7 @@ void dump_map( URL_FILE * output, struct cons_pointer map_pointer ) { struct map_payload *payload = get_map_payload( map_pointer ); if ( payload != NULL ) { - url_fputws( L"Immutable map; hash function:", output ); + url_fputws( L"Immutable map; hash function: ", output ); if (nilp(payload->hash_function)) { url_fputws( L"default", output); diff --git a/src/memory/map.h b/src/memory/map.h index 76a7193..c9b5cfc 100644 --- a/src/memory/map.h +++ b/src/memory/map.h @@ -73,6 +73,8 @@ 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); @@ -82,8 +84,8 @@ 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 map, - struct cons_pointer key); +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, diff --git a/src/ops/intern.c b/src/ops/intern.c index 02deb23..cf86e6b 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -94,9 +94,7 @@ struct cons_pointer c_assoc( struct cons_pointer key, debug_print( L"c_assoc; key is `", DEBUG_BIND); debug_print_object( key, DEBUG_BIND); - debug_print( L"`; store is \n", DEBUG_BIND); - debug_dump_object( store, DEBUG_BIND); - debug_println(DEBUG_BIND); + debug_print( L"`\n", DEBUG_BIND); if (consp(store)) { for ( struct cons_pointer next = store; diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 1624261..cb58cf9 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -1288,6 +1288,7 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame, } dump_object( output, frame->arg[0] ); + url_fputws( L"\n", output ); if ( writep( out_stream ) ) { dec_ref( out_stream ); diff --git a/src/utils.c b/src/utils.c index ea3919f..9919dbe 100644 --- a/src/utils.c +++ b/src/utils.c @@ -12,7 +12,7 @@ #include -int index_of( char c, char *s ) { +int index_of( char c, const char *s ) { int i; for ( i = 0; s[i] != c && s[i] != 0; i++ ); diff --git a/src/utils.h b/src/utils.h index e56fd6e..456e4d0 100644 --- a/src/utils.h +++ b/src/utils.h @@ -10,6 +10,8 @@ #ifndef __psse_utils_h #define __psse_utils_h -int index_of( char c, char *s ); +int index_of( char c, const char *s ); + char *trim( char *s ); + #endif diff --git a/unit-tests/eval-quote-symbol.sh b/unit-tests/eval-quote-symbol.sh index 7e80c48..e977461 100755 --- a/unit-tests/eval-quote-symbol.sh +++ b/unit-tests/eval-quote-symbol.sh @@ -1,6 +1,6 @@ #!/bin/bash -expected='' +expected='' actual=`echo "(eval 'cond)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] diff --git a/unit-tests/slurp.sh b/unit-tests/slurp.sh index b389143..0a9bc7c 100755 --- a/unit-tests/slurp.sh +++ b/unit-tests/slurp.sh @@ -1,6 +1,6 @@ #!/bin/bash -tmp=hi$$ +tmp=hi.$$ echo "Hello, there." > ${tmp} expected='"Hello, there.' actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1`