Compact path notation now expands correctly
This commit is contained in:
parent
5c6ac7f75d
commit
c63c262b74
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
|
||||
if ( consp( oblist ) ) {
|
||||
inc_ref( oblist );
|
||||
dec_ref( old );
|
||||
}
|
||||
|
||||
debug_print( L"deep_bind returning ", DEBUG_BIND );
|
||||
debug_print_object( oblist, DEBUG_BIND );
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
31
unit-tests/path-notation.sh
Executable file
31
unit-tests/path-notation.sh
Executable file
|
|
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in a new issue