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\.*
|
hi\.*
|
||||||
|
|
||||||
.vscode/
|
.vscode/
|
||||||
|
|
||||||
|
core
|
||||||
|
|
|
@ -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);
|
||||||
|
|
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.
|
* 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:
|
||||||
|
|
|
@ -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 );
|
||||||
|
|
|
@ -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;
|
||||||
|
|
|
@ -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;
|
}
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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;
|
||||||
|
// }
|
||||||
|
|
|
@ -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];
|
||||||
}
|
// }
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue