From c63c262b740024dccfec261185fa520876d5354f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 18 Aug 2021 18:48:05 +0100 Subject: [PATCH] Compact path notation now expands correctly --- src/init.c | 5 ++ src/io/read.c | 97 ++++++++++++++++++++++++++++++++++++- src/memory/hashmap.c | 2 +- src/ops/intern.c | 9 ++-- src/repl.c | 8 ++- unit-tests/map.sh | 1 + unit-tests/path-notation.sh | 31 ++++++++++++ 7 files changed, 145 insertions(+), 8 deletions(-) create mode 100755 unit-tests/path-notation.sh diff --git a/src/init.c b/src/init.c index ca48b9d..dbd7acf 100644 --- a/src/init.c +++ b/src/init.c @@ -163,6 +163,9 @@ int main( int argc, char *argv[] ) { 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 +// oblist = inc_ref( make_hashmap( 32, NIL, TRUE ) ); + /* * privileged variables (keywords) */ @@ -271,7 +274,9 @@ int main( int argc, char *argv[] ) { bind_special( L"set!", &lisp_set_shriek ); debug_print( L"Initialised oblist\n", DEBUG_BOOTSTRAP ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); + repl( show_prompt ); + debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP ); dec_ref( oblist ); debug_dump_object( oblist, DEBUG_BOOTSTRAP ); diff --git a/src/io/read.c b/src/io/read.c index 9c87932..4425b77 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -60,6 +60,77 @@ struct cons_pointer c_quote( struct cons_pointer arg ) { make_cons( arg, NIL ) ); } +/** + * Read a path macro from the stream. A path macro is expected to be + * 1. optionally a leading character such as '/' or '$', followed by + * 2. one or more keywords with leading colons (':') but no intervening spaces; or + * 3. one or more symbols separated by slashes; or + * 4. keywords (with leading colons) interspersed with symbols (prefixed by slashes). + */ +struct cons_pointer read_path( URL_FILE * input, wint_t initial, + struct cons_pointer q ) { + bool done = false; + struct cons_pointer prefix = NIL; + + switch ( initial ) { + case '/': + prefix = c_string_to_lisp_symbol( L"oblist" ); + break; + case '$': + case L'§': + prefix = c_string_to_lisp_symbol( L"session" ); + break; + } + + while ( !done ) { + wint_t c = url_fgetwc( input ); + if ( iswblank( c ) || iswcntrl( c ) ) { + done = true; + } else if ( url_feof( input ) ) { + done = true; + } else { + switch ( c ) { + case ':': + q = make_cons( read_symbol_or_key + ( input, KEYTV, url_fgetwc( input ) ), q ); + break; + case '/': + q = make_cons( make_cons + ( c_string_to_lisp_symbol( L"quote" ), + make_cons( read_symbol_or_key + ( input, SYMBOLTV, + url_fgetwc( input ) ), + NIL ) ), q ); + break; + default: + if ( iswalpha( c ) ) { + q = make_cons( read_symbol_or_key + ( input, SYMBOLTV, c ), q ); + } else { + // TODO: it's really an error. Exception? + url_ungetwc( c, input ); + done = true; + } + } + } + } + + // right, we now have the path we want (reversed) in q. + struct cons_pointer r = NIL; + + for ( struct cons_pointer p = q; !nilp( p ); p = c_cdr( p ) ) { + r = make_cons( c_car( p ), r ); + } + + dec_ref( q ); + + if ( !nilp( prefix ) ) { + r = make_cons( prefix, r ); + } + + return make_cons( c_string_to_lisp_symbol( L"->" ), r ); +} + /** * Read the next object on this input stream and return a cons_pointer to it, * treating this initial character as the first character of the object @@ -149,6 +220,27 @@ struct cons_pointer read_continuation( struct stack_frame *frame, result = read_symbol_or_key( input, KEYTV, url_fgetwc( input ) ); break; + case '/': + { + /* slash followed by whitespace is legit provided it's not + * preceded by anything - it's the division operator. Otherwise, + * it's terminal, probably part of a path, and needs pushed back. + */ + wint_t cn = url_fgetwc( input ); + if ( nilp( result ) + && ( iswblank( cn ) || iswcntrl( cn ) ) ) { + url_ungetwc( cn, input ); + result = make_symbol_or_key( c, NIL, SYMBOLTV ); + } else { + url_ungetwc( cn, input ); + result = read_path( input, c, NIL ); + } + } + break; + case '$': + case L'§': + result = read_path( input, c, NIL ); + break; default: if ( iswdigit( c ) ) { result = @@ -398,9 +490,10 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag, /* unwise to allow embedded quotation marks in symbols */ case ')': case ':': + case '/': /* - * symbols and keywords may not include right-parenthesis - * or colons. + * symbols and keywords may not include right-parenthesis, + * slashes or colons. */ result = NIL; /* diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index efc0e88..cee9267 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -112,7 +112,7 @@ struct cons_pointer make_hashmap( uint32_t n_buckets, struct cons_pointer write_acl ) { struct cons_pointer result = make_vso( HASHTV, ( sizeof( struct cons_pointer ) * - ( n_buckets + 1 ) ) + + ( n_buckets + 2 ) ) + ( sizeof( uint32_t ) * 2 ) ); struct hashmap_payload *payload = diff --git a/src/ops/intern.c b/src/ops/intern.c index d7a6c0d..05d5822 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -25,7 +25,7 @@ #include "equal.h" #include "hashmap.h" #include "lispops.h" -#include "print.h" +// #include "print.h" /** * The global object list/or, to put it differently, the root namespace. @@ -181,8 +181,11 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) { debug_println( DEBUG_BIND ); oblist = set( key, value, oblist ); - inc_ref( oblist ); - dec_ref( old ); + + if ( consp( oblist ) ) { + inc_ref( oblist ); + dec_ref( old ); + } debug_print( L"deep_bind returning ", DEBUG_BIND ); debug_print_object( oblist, DEBUG_BIND ); diff --git a/src/repl.c b/src/repl.c index 0ea104d..39bbde6 100644 --- a/src/repl.c +++ b/src/repl.c @@ -24,12 +24,16 @@ void repl( ) { debug_print( L"Entered repl\n", DEBUG_REPL ); - struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, oblist ); + struct cons_pointer env = + consp( oblist ) ? oblist : make_cons( oblist, NIL ); + + /* bottom of stack */ + struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env ); if ( !nilp( frame_pointer ) ) { inc_ref( frame_pointer ); - lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, oblist ); + lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env ); dec_ref( frame_pointer ); } diff --git a/unit-tests/map.sh b/unit-tests/map.sh index c5fb834..65dc182 100755 --- a/unit-tests/map.sh +++ b/unit-tests/map.sh @@ -5,6 +5,7 @@ expected='{}' actual=`echo "$expected" | target/psse | tail -1` +echo -n "Empty map using compact map notation: " if [ "${expected}" = "${actual}" ] then echo "OK" diff --git a/unit-tests/path-notation.sh b/unit-tests/path-notation.sh new file mode 100755 index 0000000..a6cb669 --- /dev/null +++ b/unit-tests/path-notation.sh @@ -0,0 +1,31 @@ +#!/bin/bash + +##################################################################### +# Create a path from root using compact path notation +expected='(-> oblist :users :simon :functions (quote assoc))' +actual=`echo "'/:users:simon:functions/assoc" | target/psse | tail -1` + +echo -n "Path from root (oblist) using compact notation: " +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +##################################################################### +# Create a path from the current session using compact path notation +expected='(-> session :input-stream)' +actual=`echo "'$:input-stream" | target/psse | tail -1` + +echo -n "Path from current session using compact notation: " +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + exit 1 +fi + +