Hashmaps now *mostly* work

This commit is contained in:
Simon Brooke 2021-08-16 23:23:03 +01:00
parent 4fc9545be8
commit eadb125b83
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
10 changed files with 238 additions and 186 deletions

2
.gitignore vendored
View file

@ -40,3 +40,5 @@ src/io/fopen
hi\.* hi\.*
.vscode/ .vscode/
core

View file

@ -225,7 +225,7 @@ int main( int argc, char *argv[] ) {
bind_function( L"equal", &lisp_equal ); bind_function( L"equal", &lisp_equal );
bind_function( L"eval", &lisp_eval ); bind_function( L"eval", &lisp_eval );
bind_function( L"exception", &lisp_exception ); bind_function( L"exception", &lisp_exception );
bind_function( L"gethash", &lisp_get_hash); bind_function( L"get-hash", &lisp_get_hash);
bind_function(L"hashmap", lisp_make_hashmap); bind_function(L"hashmap", lisp_make_hashmap);
bind_function( L"inspect", &lisp_inspect ); bind_function( L"inspect", &lisp_inspect );
bind_function( L"keys", &lisp_keys); bind_function( L"keys", &lisp_keys);

View file

@ -177,13 +177,13 @@ wint_t url_fgetwc( URL_FILE * input ) {
* E0 to EF hex (224 to 239): first byte of a three-byte sequence. * E0 to EF hex (224 to 239): first byte of a three-byte sequence.
* F0 to FF hex (240 to 255): first byte of a four-byte sequence. * F0 to FF hex (240 to 255): first byte of a four-byte sequence.
*/ */
if ( c <= 0x07 ) { if ( c <= 0xf7 ) {
count = 1; count = 1;
} else if ( c >= '0xc2' && c <= '0xdf' ) { } else if ( c >= 0xc2 && c <= 0xdf ) {
count = 2; count = 2;
} else if ( c >= '0xe0' && c <= '0xef' ) { } else if ( c >= 0xe0 && c <= 0xef ) {
count = 3; count = 3;
} else if ( c >= '0xf0' && c <= '0xff' ) { } else if ( c >= 0xf0 && c <= 0xff ) {
count = 4; count = 4;
} }
@ -395,6 +395,24 @@ void collect_meta( struct cons_pointer stream, char *url ) {
cell->payload.stream.meta = meta; cell->payload.stream.meta = meta;
} }
/**
* Resutn the current default input, or of `inputp` is false, output stream from
* this `env`ironment.
*/
struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_pointer stream_name =
c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" );
inc_ref( stream_name );
result = c_assoc( stream_name, env );
dec_ref( stream_name );
return result;
}
/** /**
* Function: return a stream open on the URL indicated by the first argument; * Function: return a stream open on the URL indicated by the first argument;
@ -423,8 +441,8 @@ lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer,
URL_FILE *stream = url_fopen( url, "r" ); URL_FILE *stream = url_fopen( url, "r" );
debug_printf( DEBUG_IO, debug_printf( DEBUG_IO,
L"lisp_open: stream @ %d, stream type = %d, stream handle = %d\n", L"lisp_open: stream @ %ld, stream type = %d, stream handle = %ld\n",
(int) &stream, (int)stream->type, (int)stream->handle.file); (long int) &stream, (int)stream->type, (long int)stream->handle.file);
switch (stream->type) { switch (stream->type) {
case CFTYPE_NONE: case CFTYPE_NONE:

View file

@ -21,6 +21,8 @@ URL_FILE *file_to_url_file( FILE * f );
wint_t url_fgetwc( URL_FILE * input ); wint_t url_fgetwc( URL_FILE * input );
wint_t url_ungetwc( wint_t wc, URL_FILE * input ); wint_t url_ungetwc( wint_t wc, URL_FILE * input );
struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env );
struct cons_pointer struct cons_pointer
lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );

View file

@ -35,15 +35,15 @@
bool check_tag( struct cons_pointer pointer, char *tag ) { bool check_tag( struct cons_pointer pointer, char *tag ) {
bool result = false; bool result = false;
struct cons_space_object cell = pointer2cell( pointer ); struct cons_space_object cell = pointer2cell( pointer );
result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0; result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0;
if ( result == false ) { if ( result == false ) {
if ( strncmp( &cell.tag.bytes[0], VECTORPOINTTAG, TAGLENGTH ) == 0 ) { if ( cell.tag.value == VECTORPOINTTV ) {
struct vector_space_object *vec = pointer_to_vso( pointer ); struct vector_space_object *vec = pointer_to_vso( pointer );
if ( vec != NULL ) { if ( vec != NULL ) {
result = strncmp( &vec->header.tag.bytes[0], tag, TAGLENGTH ) == 0; result = strncmp( &(vec->header.tag.bytes[0]), tag, TAGLENGTH ) == 0;
} }
} }
} }
@ -286,7 +286,7 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr)
case KEYTV: case KEYTV:
case STRINGTV: case STRINGTV:
case SYMBOLTV: case SYMBOLTV:
if (nilp(ptr)) if (nilp(cell->payload.string.cdr))
{ {
result = (uint32_t)c; result = (uint32_t)c;
} }
@ -296,6 +296,7 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr)
cell->payload.string.hash) & cell->payload.string.hash) &
0xffffffff; 0xffffffff;
} }
break;
} }
return result; return result;

View file

@ -23,6 +23,7 @@
#include "debug.h" #include "debug.h"
#include "hashmap.h" #include "hashmap.h"
#include "intern.h" #include "intern.h"
#include "io.h"
#include "print.h" #include "print.h"
#include "stack.h" #include "stack.h"
#include "vectorspace.h" #include "vectorspace.h"
@ -39,12 +40,14 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix,
cell.payload.string.cdr.offset, cell.count ); cell.payload.string.cdr.offset, cell.count );
} else { } else {
url_fwprintf( output, url_fwprintf( output,
L"\t\t%ls cell: character '%lc' (%d) next at page %d offset %d, count %u\n", L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n",
prefix, prefix,
( wint_t ) cell.payload.string.character, ( wint_t ) cell.payload.string.character,
cell.payload.string.character, cell.payload.string.character,
cell.payload.string.hash,
cell.payload.string.cdr.page, cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count ); cell.payload.string.cdr.offset,
cell.count );
url_fwprintf( output, L"\t\t value: " ); url_fwprintf( output, L"\t\t value: " );
print( output, pointer ); print( output, pointer );
url_fwprintf( output, L"\n" ); url_fwprintf( output, L"\n" );
@ -54,108 +57,105 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix,
/** /**
* dump the object at this cons_pointer to this output stream. * dump the object at this cons_pointer to this output stream.
*/ */
void dump_object( URL_FILE * output, struct cons_pointer pointer ) { void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer ); struct cons_space_object cell = pointer2cell( pointer );
url_fwprintf( output, url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n",
L"\t%4.4s (%d) at page %d, offset %d count %u\n", cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset,
cell.tag.bytes, cell.count );
cell.tag.value, pointer.page, pointer.offset, cell.count );
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case CONSTV: case CONSTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u :", L"\t\tCons cell: car at page %d offset %d, cdr at page %d "
cell.payload.cons.car.page, L"offset %d, count %u :",
cell.payload.cons.car.offset, cell.payload.cons.car.page, cell.payload.cons.car.offset,
cell.payload.cons.cdr.page, cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset,
cell.payload.cons.cdr.offset, cell.count ); cell.count );
print( output, pointer ); print( output, pointer );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case EXCEPTIONTV: case EXCEPTIONTV:
url_fwprintf( output, L"\t\tException cell: " ); url_fwprintf( output, L"\t\tException cell: " );
dump_stack_trace( output, pointer ); dump_stack_trace( output, pointer );
break; break;
case FREETV: case FREETV:
url_fwprintf( output, url_fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
L"\t\tFree cell: next at page %d offset %d\n", cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset );
cell.payload.cons.cdr.page, break;
cell.payload.cons.cdr.offset ); case INTEGERTV:
break; url_fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n",
case INTEGERTV: cell.payload.integer.value, cell.count );
url_fwprintf( output, if ( !nilp( cell.payload.integer.more ) ) {
L"\t\tInteger cell: value %ld, count %u\n", url_fputws( L"\t\tBIGNUM! More at:\n", output );
cell.payload.integer.value, cell.count ); dump_object( output, cell.payload.integer.more );
if ( !nilp( cell.payload.integer.more ) ) { }
url_fputws( L"\t\tBIGNUM! More at:\n", output ); break;
dump_object( output, cell.payload.integer.more ); case KEYTV:
} dump_string_cell( output, L"Keyword", pointer );
break; break;
case LAMBDATV: case LAMBDATV:
url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " );
print( output, cell.payload.lambda.args ); print( output, cell.payload.lambda.args );
url_fwprintf( output, L";\n\t\t\tbody: " ); url_fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body ); print( output, cell.payload.lambda.body );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case NILTV: case NILTV:
break; break;
case NLAMBDATV: case NLAMBDATV:
url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " );
print( output, cell.payload.lambda.args ); print( output, cell.payload.lambda.args );
url_fwprintf( output, L";\n\t\t\tbody: " ); url_fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body ); print( output, cell.payload.lambda.body );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case RATIOTV: case RATIOTV:
url_fwprintf( output, url_fwprintf(
L"\t\tRational cell: value %ld/%ld, count %u\n", output, L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ). pointer2cell( cell.payload.ratio.dividend ).payload.integer.value,
payload.integer.value, pointer2cell( cell.payload.ratio.divisor ).payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ). cell.count );
payload.integer.value, cell.count ); break;
break; case READTV:
case READTV: url_fputws( L"\t\tInput stream; metadata: ", output );
url_fputws( L"\t\tInput stream; metadata: ", output ); print( output, cell.payload.stream.meta );
print( output, cell.payload.stream.meta ); url_fputws( L"\n", output );
url_fputws( L"\n", output ); break;
break; case REALTV:
case REALTV: url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", cell.payload.real.value, cell.count );
cell.payload.real.value, cell.count ); break;
break; case STRINGTV:
case STRINGTV: dump_string_cell( output, L"String", pointer );
dump_string_cell( output, L"String", pointer ); break;
break; case SYMBOLTV:
case SYMBOLTV: dump_string_cell( output, L"Symbol", pointer );
dump_string_cell( output, L"Symbol", pointer ); break;
break; case TRUETV:
case TRUETV: break;
break; case VECTORPOINTTV: {
case VECTORPOINTTV:{ url_fwprintf( output, L"\t\tPointer to vector-space object at %p\n",
url_fwprintf( output, cell.payload.vectorp.address );
L"\t\tPointer to vector-space object at %p\n", struct vector_space_object *vso = cell.payload.vectorp.address;
cell.payload.vectorp.address ); url_fwprintf( output,
struct vector_space_object *vso = cell.payload.vectorp.address; L"\t\tVector space object of type %4.4s (%d), payload size "
url_fwprintf( output, L"%d bytes\n",
L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n", &vso->header.tag.bytes, vso->header.tag.value,
&vso->header.tag.bytes, vso->header.tag.value, vso->header.size );
vso->header.size );
switch ( vso->header.tag.value ) { switch ( vso->header.tag.value ) {
case STACKFRAMETV: case STACKFRAMETV:
dump_frame( output, pointer ); dump_frame( output, pointer );
break; break;
case HASHTV: case HASHTV:
dump_map( output, pointer); dump_map( output, pointer );
break; break;
} }
} } break;
break; case WRITETV:
case WRITETV: url_fputws( L"\t\tOutput stream; metadata: ", output );
url_fputws( L"\t\tOutput stream; metadata: ", output ); print( output, cell.payload.stream.meta );
print( output, cell.payload.stream.meta ); url_fputws( L"\n", output );
url_fputws( L"\n", output ); break;
break; }
}
} }

View file

@ -12,6 +12,7 @@
#include "authorise.h" #include "authorise.h"
#include "debug.h" #include "debug.h"
#include "intern.h" #include "intern.h"
#include "io/print.h"
#include "memory/conspage.h" #include "memory/conspage.h"
#include "memory/consspaceobject.h" #include "memory/consspaceobject.h"
#include "memory/hashmap.h" #include "memory/hashmap.h"

View file

@ -119,11 +119,11 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
* object. Dangerous! */ * object. Dangerous! */
void free_vso( struct cons_pointer pointer ) { void free_vso( struct cons_pointer pointer ) {
struct cons_space_object * cell = &pointer2cell( pointer); struct cons_space_object cell = pointer2cell( pointer );
debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n", debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n",
cell->payload.vectorp.address ); cell.payload.vectorp.address );
struct vector_space_object *vso = cell->payload.vectorp.address; struct vector_space_object *vso = cell.payload.vectorp.address;
switch ( vso->header.tag.value ) { switch ( vso->header.tag.value ) {
case HASHTV: case HASHTV:
@ -134,7 +134,18 @@ void free_vso( struct cons_pointer pointer ) {
break; break;
} }
free( (void *)cell->payload.vectorp.address ); // free( (void *)cell.payload.vectorp.address );
debug_printf( DEBUG_ALLOC, L"Freed vector-space object at 0x%lx\n", debug_printf( DEBUG_ALLOC, L"Freed vector-space object at 0x%lx\n",
cell->payload.vectorp.address ); cell.payload.vectorp.address );
} }
// bool check_vso_tag( struct cons_pointer pointer, char * tag) {
// bool result = false;
// if (check_tag(pointer, VECTORPOINTTAG)) {
// struct vector_space_object * vso = pointer_to_vso(pointer);
// result = strncmp( vso->header.tag.bytes[0], tag, TAGLENGTH);
// }
// return result;
// }

View file

@ -854,26 +854,6 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL; return equal( frame->arg[0], frame->arg[1] ) ? TRUE : NIL;
} }
/**
* Resutn the current default input, or of `inputp` is false, output stream from
* this `env`ironment.
*/
struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
struct cons_pointer result = NIL;
struct cons_pointer stream_name =
c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" );
inc_ref( stream_name );
result = c_assoc( stream_name, env );
dec_ref( stream_name );
return result;
}
/** /**
* Function; read one complete lisp form and return it. If read-stream is specified and * Function; read one complete lisp form and return it. If read-stream is specified and
* is a read stream, then read from that stream, else the stream which is the value of * is a read stream, then read from that stream, else the stream which is the value of
@ -965,6 +945,44 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame,
return c_reverse( frame->arg[0] ); return c_reverse( frame->arg[0] );
} }
/**
* Function: dump/inspect one complete lisp expression and return NIL. If
* write-stream is specified and is a write stream, then print to that stream,
* else the stream which is the value of
* `*out*` in the environment.
*
* * (inspect expr)
* * (inspect expr write-stream)
*
* @param frame my stack_frame.
* @param frame_pointer a pointer to my stack_frame.
* @param env my environment (from which the stream may be extracted).
* @return NIL.
*/
struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print( L"Entering lisp_inspect\n", DEBUG_IO );
struct cons_pointer result = NIL;
struct cons_pointer out_stream = writep( frame->arg[1] )
? frame->arg[1]
: get_default_stream( false, env );
URL_FILE *output;
if ( writep( out_stream ) ) {
debug_print( L"lisp_inspect: setting output stream\n", DEBUG_IO );
debug_dump_object( out_stream, DEBUG_IO );
output = pointer2cell( out_stream ).payload.stream.stream;
} else {
output = file_to_url_file( stderr );
}
dump_object( output, frame->arg[0] );
debug_print( L"Leaving lisp_inspect", DEBUG_IO );
return result;
}
/** /**
* Function; print one complete lisp expression and return NIL. If write-stream is specified and * Function; print one complete lisp expression and return NIL. If write-stream is specified and
@ -976,8 +994,8 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame,
* *
* @param frame my stack_frame. * @param frame my stack_frame.
* @param frame_pointer a pointer to my stack_frame. * @param frame_pointer a pointer to my stack_frame.
* @param env my environment (ignored). * @param env my environment (from which the stream may be extracted).
* @return the value of `expr`. * @return NIL.
*/ */
struct cons_pointer struct cons_pointer
lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
@ -1332,43 +1350,43 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
} }
/** // /**
* Function; print the internal representation of the object indicated by `frame->arg[0]` to the // * Function; print the internal representation of the object indicated by `frame->arg[0]` to the
* (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. // * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
* // *
* * (inspect expression) // * * (inspect expression)
* * (inspect expression <write-stream>) // * * (inspect expression <write-stream>)
* // *
* @param frame my stack frame. // * @param frame my stack frame.
* @param frame_pointer a pointer to my stack_frame. // * @param frame_pointer a pointer to my stack_frame.
* @param env the environment. // * @param env the environment.
* @return the value of the first argument - `expression`. // * @return the value of the first argument - `expression`.
*/ // */
struct cons_pointer lisp_inspect( struct stack_frame *frame, // struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer, // struct cons_pointer frame_pointer,
struct cons_pointer env ) { // struct cons_pointer env ) {
debug_print( L"Entering print\n", DEBUG_IO ); // debug_print( L"Entering print\n", DEBUG_IO );
URL_FILE *output; // URL_FILE *output;
struct cons_pointer out_stream = writep( frame->arg[1] ) ? // struct cons_pointer out_stream = writep( frame->arg[1] ) ?
frame->arg[1] : get_default_stream( false, env ); // frame->arg[1] : get_default_stream( false, env );
if ( writep( out_stream ) ) { // if ( writep( out_stream ) ) {
debug_print( L"lisp_print: setting output stream\n", DEBUG_IO ); // debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
debug_dump_object( out_stream, DEBUG_IO ); // debug_dump_object( out_stream, DEBUG_IO );
output = pointer2cell( out_stream ).payload.stream.stream; // output = pointer2cell( out_stream ).payload.stream.stream;
inc_ref( out_stream ); // inc_ref( out_stream );
} else { // } else {
output = file_to_url_file( stdout ); // output = file_to_url_file( stdout );
} // }
dump_object( output, frame->arg[0] ); // dump_object( output, frame->arg[0] );
url_fputws( L"\n", output ); // url_fputws( L"\n", output );
if ( writep( out_stream ) ) { // if ( writep( out_stream ) ) {
dec_ref( out_stream ); // dec_ref( out_stream );
} else { // } else {
free( output ); // free( output );
} // }
return frame->arg[0]; // return frame->arg[0];
} // }

View file

@ -114,6 +114,9 @@ struct cons_pointer lisp_quote( struct stack_frame *frame,
/* /*
* functions * functions
*/ */
struct cons_pointer lisp_assoc( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
struct cons_pointer lisp_cons( struct stack_frame *frame, struct cons_pointer lisp_cons( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
@ -123,9 +126,9 @@ struct cons_pointer lisp_car( struct stack_frame *frame,
struct cons_pointer lisp_cdr( struct stack_frame *frame, struct cons_pointer lisp_cdr( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
struct cons_pointer lisp_assoc( struct stack_frame *frame, struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
struct cons_pointer lisp_eq( struct stack_frame *frame, struct cons_pointer lisp_eq( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
@ -199,8 +202,4 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
struct cons_pointer frame_pointer, struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env );
#endif #endif