Hashmaps now *mostly* work
This commit is contained in:
parent
4fc9545be8
commit
eadb125b83
2
.gitignore
vendored
2
.gitignore
vendored
|
|
@ -40,3 +40,5 @@ src/io/fopen
|
|||
hi\.*
|
||||
|
||||
.vscode/
|
||||
|
||||
core
|
||||
|
|
|
|||
|
|
@ -225,7 +225,7 @@ int main( int argc, char *argv[] ) {
|
|||
bind_function( L"equal", &lisp_equal );
|
||||
bind_function( L"eval", &lisp_eval );
|
||||
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"inspect", &lisp_inspect );
|
||||
bind_function( L"keys", &lisp_keys);
|
||||
|
|
|
|||
30
src/io/io.c
30
src/io/io.c
|
|
@ -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.
|
||||
* F0 to FF hex (240 to 255): first byte of a four-byte sequence.
|
||||
*/
|
||||
if ( c <= 0x07 ) {
|
||||
if ( c <= 0xf7 ) {
|
||||
count = 1;
|
||||
} else if ( c >= '0xc2' && c <= '0xdf' ) {
|
||||
} else if ( c >= 0xc2 && c <= 0xdf ) {
|
||||
count = 2;
|
||||
} else if ( c >= '0xe0' && c <= '0xef' ) {
|
||||
} else if ( c >= 0xe0 && c <= 0xef ) {
|
||||
count = 3;
|
||||
} else if ( c >= '0xf0' && c <= '0xff' ) {
|
||||
} else if ( c >= 0xf0 && c <= 0xff ) {
|
||||
count = 4;
|
||||
}
|
||||
|
||||
|
|
@ -395,6 +395,24 @@ void collect_meta( struct cons_pointer stream, char *url ) {
|
|||
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;
|
||||
|
|
@ -423,8 +441,8 @@ lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
URL_FILE *stream = url_fopen( url, "r" );
|
||||
|
||||
debug_printf( DEBUG_IO,
|
||||
L"lisp_open: stream @ %d, stream type = %d, stream handle = %d\n",
|
||||
(int) &stream, (int)stream->type, (int)stream->handle.file);
|
||||
L"lisp_open: stream @ %ld, stream type = %d, stream handle = %ld\n",
|
||||
(long int) &stream, (int)stream->type, (long int)stream->handle.file);
|
||||
|
||||
switch (stream->type) {
|
||||
case CFTYPE_NONE:
|
||||
|
|
|
|||
|
|
@ -21,6 +21,8 @@ URL_FILE *file_to_url_file( FILE * f );
|
|||
wint_t url_fgetwc( 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
|
||||
lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
|
|
|||
|
|
@ -39,11 +39,11 @@ bool check_tag( struct cons_pointer pointer, char *tag ) {
|
|||
result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0;
|
||||
|
||||
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 );
|
||||
|
||||
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 STRINGTV:
|
||||
case SYMBOLTV:
|
||||
if (nilp(ptr))
|
||||
if (nilp(cell->payload.string.cdr))
|
||||
{
|
||||
result = (uint32_t)c;
|
||||
}
|
||||
|
|
@ -296,6 +296,7 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr)
|
|||
cell->payload.string.hash) &
|
||||
0xffffffff;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
#include "debug.h"
|
||||
#include "hashmap.h"
|
||||
#include "intern.h"
|
||||
#include "io.h"
|
||||
#include "print.h"
|
||||
#include "stack.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 );
|
||||
} else {
|
||||
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,
|
||||
( wint_t ) cell.payload.string.character,
|
||||
cell.payload.string.character,
|
||||
cell.payload.string.hash,
|
||||
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: " );
|
||||
print( output, pointer );
|
||||
url_fwprintf( output, L"\n" );
|
||||
|
|
@ -56,19 +59,18 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix,
|
|||
*/
|
||||
void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
url_fwprintf( output,
|
||||
L"\t%4.4s (%d) at page %d, offset %d count %u\n",
|
||||
cell.tag.bytes,
|
||||
cell.tag.value, pointer.page, pointer.offset, cell.count );
|
||||
url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n",
|
||||
cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset,
|
||||
cell.count );
|
||||
|
||||
switch ( cell.tag.value ) {
|
||||
case CONSTV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u :",
|
||||
cell.payload.cons.car.page,
|
||||
cell.payload.cons.car.offset,
|
||||
cell.payload.cons.cdr.page,
|
||||
cell.payload.cons.cdr.offset, cell.count );
|
||||
L"\t\tCons cell: car at page %d offset %d, cdr at page %d "
|
||||
L"offset %d, count %u :",
|
||||
cell.payload.cons.car.page, cell.payload.cons.car.offset,
|
||||
cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset,
|
||||
cell.count );
|
||||
print( output, pointer );
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
|
|
@ -77,20 +79,20 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
dump_stack_trace( output, pointer );
|
||||
break;
|
||||
case FREETV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tFree cell: next at page %d offset %d\n",
|
||||
cell.payload.cons.cdr.page,
|
||||
cell.payload.cons.cdr.offset );
|
||||
url_fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
|
||||
cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tInteger cell: value %ld, count %u\n",
|
||||
url_fwprintf( output, L"\t\tInteger cell: value %ld, count %u\n",
|
||||
cell.payload.integer.value, cell.count );
|
||||
if ( !nilp( cell.payload.integer.more ) ) {
|
||||
url_fputws( L"\t\tBIGNUM! More at:\n", output );
|
||||
dump_object( output, cell.payload.integer.more );
|
||||
}
|
||||
break;
|
||||
case KEYTV:
|
||||
dump_string_cell( output, L"Keyword", pointer );
|
||||
break;
|
||||
case LAMBDATV:
|
||||
url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " );
|
||||
print( output, cell.payload.lambda.args );
|
||||
|
|
@ -108,12 +110,11 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
url_fputws( L"\n", output );
|
||||
break;
|
||||
case RATIOTV:
|
||||
url_fwprintf( output,
|
||||
L"\t\tRational cell: value %ld/%ld, count %u\n",
|
||||
pointer2cell( cell.payload.ratio.dividend ).
|
||||
payload.integer.value,
|
||||
pointer2cell( cell.payload.ratio.divisor ).
|
||||
payload.integer.value, cell.count );
|
||||
url_fwprintf(
|
||||
output, L"\t\tRational cell: value %ld/%ld, count %u\n",
|
||||
pointer2cell( cell.payload.ratio.dividend ).payload.integer.value,
|
||||
pointer2cell( cell.payload.ratio.divisor ).payload.integer.value,
|
||||
cell.count );
|
||||
break;
|
||||
case READTV:
|
||||
url_fputws( L"\t\tInput stream; metadata: ", output );
|
||||
|
|
@ -133,12 +134,12 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
case TRUETV:
|
||||
break;
|
||||
case VECTORPOINTTV: {
|
||||
url_fwprintf( output,
|
||||
L"\t\tPointer to vector-space object at %p\n",
|
||||
url_fwprintf( output, L"\t\tPointer to vector-space object at %p\n",
|
||||
cell.payload.vectorp.address );
|
||||
struct vector_space_object *vso = cell.payload.vectorp.address;
|
||||
url_fwprintf( output,
|
||||
L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n",
|
||||
L"\t\tVector space object of type %4.4s (%d), payload size "
|
||||
L"%d bytes\n",
|
||||
&vso->header.tag.bytes, vso->header.tag.value,
|
||||
vso->header.size );
|
||||
|
||||
|
|
@ -150,8 +151,7 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
dump_map( output, pointer );
|
||||
break;
|
||||
}
|
||||
}
|
||||
break;
|
||||
} break;
|
||||
case WRITETV:
|
||||
url_fputws( L"\t\tOutput stream; metadata: ", output );
|
||||
print( output, cell.payload.stream.meta );
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
#include "authorise.h"
|
||||
#include "debug.h"
|
||||
#include "intern.h"
|
||||
#include "io/print.h"
|
||||
#include "memory/conspage.h"
|
||||
#include "memory/consspaceobject.h"
|
||||
#include "memory/hashmap.h"
|
||||
|
|
|
|||
|
|
@ -119,11 +119,11 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
|
|||
* object. Dangerous! */
|
||||
|
||||
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",
|
||||
cell->payload.vectorp.address );
|
||||
struct vector_space_object *vso = cell->payload.vectorp.address;
|
||||
cell.payload.vectorp.address );
|
||||
struct vector_space_object *vso = cell.payload.vectorp.address;
|
||||
|
||||
switch ( vso->header.tag.value ) {
|
||||
case HASHTV:
|
||||
|
|
@ -134,7 +134,18 @@ void free_vso( struct cons_pointer pointer ) {
|
|||
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",
|
||||
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;
|
||||
// }
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* 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
|
||||
* 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] );
|
||||
}
|
||||
|
||||
/**
|
||||
* 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
|
||||
|
|
@ -976,8 +994,8 @@ struct cons_pointer lisp_reverse( struct stack_frame *frame,
|
|||
*
|
||||
* @param frame my stack_frame.
|
||||
* @param frame_pointer a pointer to my stack_frame.
|
||||
* @param env my environment (ignored).
|
||||
* @return the value of `expr`.
|
||||
* @param env my environment (from which the stream may be extracted).
|
||||
* @return NIL.
|
||||
*/
|
||||
struct cons_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
|
||||
* (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
|
||||
*
|
||||
* * (inspect expression)
|
||||
* * (inspect expression <write-stream>)
|
||||
*
|
||||
* @param frame my stack frame.
|
||||
* @param frame_pointer a pointer to my stack_frame.
|
||||
* @param env the environment.
|
||||
* @return the value of the first argument - `expression`.
|
||||
*/
|
||||
struct cons_pointer lisp_inspect( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env ) {
|
||||
debug_print( L"Entering print\n", DEBUG_IO );
|
||||
URL_FILE *output;
|
||||
struct cons_pointer out_stream = writep( frame->arg[1] ) ?
|
||||
frame->arg[1] : get_default_stream( false, env );
|
||||
// /**
|
||||
// * 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]`.
|
||||
// *
|
||||
// * * (inspect expression)
|
||||
// * * (inspect expression <write-stream>)
|
||||
// *
|
||||
// * @param frame my stack frame.
|
||||
// * @param frame_pointer a pointer to my stack_frame.
|
||||
// * @param env the environment.
|
||||
// * @return the value of the first argument - `expression`.
|
||||
// */
|
||||
// struct cons_pointer lisp_inspect( struct stack_frame *frame,
|
||||
// struct cons_pointer frame_pointer,
|
||||
// struct cons_pointer env ) {
|
||||
// debug_print( L"Entering print\n", DEBUG_IO );
|
||||
// URL_FILE *output;
|
||||
// struct cons_pointer out_stream = writep( frame->arg[1] ) ?
|
||||
// frame->arg[1] : get_default_stream( false, env );
|
||||
|
||||
if ( writep( out_stream ) ) {
|
||||
debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
|
||||
debug_dump_object( out_stream, DEBUG_IO );
|
||||
output = pointer2cell( out_stream ).payload.stream.stream;
|
||||
inc_ref( out_stream );
|
||||
} else {
|
||||
output = file_to_url_file( stdout );
|
||||
}
|
||||
// if ( writep( out_stream ) ) {
|
||||
// debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
|
||||
// debug_dump_object( out_stream, DEBUG_IO );
|
||||
// output = pointer2cell( out_stream ).payload.stream.stream;
|
||||
// inc_ref( out_stream );
|
||||
// } else {
|
||||
// output = file_to_url_file( stdout );
|
||||
// }
|
||||
|
||||
dump_object( output, frame->arg[0] );
|
||||
url_fputws( L"\n", output );
|
||||
// dump_object( output, frame->arg[0] );
|
||||
// url_fputws( L"\n", output );
|
||||
|
||||
if ( writep( out_stream ) ) {
|
||||
dec_ref( out_stream );
|
||||
} else {
|
||||
free( output );
|
||||
}
|
||||
// if ( writep( out_stream ) ) {
|
||||
// dec_ref( out_stream );
|
||||
// } else {
|
||||
// free( output );
|
||||
// }
|
||||
|
||||
return frame->arg[0];
|
||||
}
|
||||
// return frame->arg[0];
|
||||
// }
|
||||
|
|
|
|||
|
|
@ -114,6 +114,9 @@ struct cons_pointer lisp_quote( struct stack_frame *frame,
|
|||
/*
|
||||
* 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 frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
|
@ -123,7 +126,7 @@ struct cons_pointer lisp_car( struct stack_frame *frame,
|
|||
struct cons_pointer lisp_cdr( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
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 env );
|
||||
struct cons_pointer lisp_eq( struct stack_frame *frame,
|
||||
|
|
@ -199,8 +202,4 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
|
|||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
struct cons_pointer lisp_inspect( struct stack_frame *frame,
|
||||
struct cons_pointer frame_pointer,
|
||||
struct cons_pointer env );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Reference in a new issue