simon/post-scarcity
1
0
Fork 0
Code Issues 18 Pull requests Projects Releases Packages Wiki Activity Actions

Tactical commit only. Something is badly broken in read, although I think

Browse source 
this version is better thwan the last one.
This commit is contained in:
Simon Brooke 2026-05-07 21:07:16 +01:00
parent d1bfb029b8
commit 6f39dae75f
2 changed files with 217 additions and 217 deletions
Download patch file Download diff file Expand all files Collapse all files

424
src/c/io/read.c
View file

@ -42,9 +42,9 @@
#include "ops/assoc.h" #include "ops/assoc.h"
#include "ops/reverse.h" #include "ops/reverse.h"
#include "payloads/stack.h"
#include "ops/string_ops.h" #include "ops/string_ops.h"
#include "ops/truth.h" #include "ops/truth.h"
#include "payloads/stack.h"
// TODO: what I've copied from 0.0.6 is *weirdly* over-complex for just now. // TODO: what I've copied from 0.0.6 is *weirdly* over-complex for just now.
// I think I'm going to essentially delete all this and start again. We need // I think I'm going to essentially delete all this and start again. We need
@ -77,21 +77,21 @@
* 1. The read table currently in use; * 1. The read table currently in use;
* 2. The character most recently read from that stream. * 2. The character most recently read from that stream.
*/ */
struct pso_pointer read_example( struct pso_pointer frame_pointer ) { struct pso_pointer read_example(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg(frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg(frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg(frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
return result; return result;
} }
struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer ) { struct pso_pointer make_eof_exception(struct pso_pointer frame_pointer) {
return make_exception( make_frame( 1, frame_pointer, return make_exception(
c_string_to_lisp_string make_frame(1, frame_pointer,
( frame_pointer, c_string_to_lisp_string(
L"Read: end of input while reading" ) ) ); frame_pointer, L"Read: end of input while reading")));
} }
/** /**
@ -106,20 +106,20 @@ struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer ) {
* @return a string of one character, namely the next available character * @return a string of one character, namely the next available character
* on my stream, if any, else nil. * on my stream, if any, else nil.
*/ */
struct pso_pointer read_character( struct pso_pointer frame_pointer ) { struct pso_pointer read_character(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer result = nil; struct pso_pointer result = nil;
struct pso_pointer stream_pointer = fetch_arg( frame, 0 ); struct pso_pointer stream_pointer = fetch_arg(frame, 0);
if ( readp( stream_pointer ) ) { if (readp(stream_pointer)) {
wint_t chr = url_fgetwc( stream_get_url_file( stream_pointer ) ); wint_t chr = url_fgetwc(stream_get_url_file(stream_pointer));
result = make_character( frame_pointer, chr ); result = make_character(frame_pointer, chr);
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_IO, 0, L"\nRead character %lc\n", chr ); debug_printf(DEBUG_IO, 0, L"\nRead character %lc\n", chr);
#endif #endif
} }
return result; return result;
} }
/** /**
@ -128,82 +128,75 @@ struct pso_pointer read_character( struct pso_pointer frame_pointer ) {
* potentially the first such character. Returns the first non-space character * potentially the first such character. Returns the first non-space character
* encountered, or an exception. * encountered, or an exception.
*/ */
struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) { struct pso_pointer skip_whitespace(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg(frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg(frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg(frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( characterp( character ) ) { do {
wchar_t wc = if (!characterp(character)) {
pointer_to_object( character )->payload.character.character; character = read_character(make_frame( 1, frame_pointer, stream));
if ( !iswspace( wc ) && wc != L',' ) { }
result = character; if (characterp(character)) {
} wchar_t wc = pointer_to_object(character)->payload.character.character;
} if (!iswspace(wc) && !iswcntrl(wc) && wc != L',') {
result = character;
} else if (exceptionp(character)){
result = character;
} else {
character = nil;
}
}
} while (c_nilp(result));
if ( c_nilp( result ) && readp( stream ) ) { return result;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
wint_t wc = url_fgetwc( input );
while ( iswspace( wc ) || wc == L',' ) {
wc = url_fgetwc( input );
}
result =
( wc ==
WEOF ) ? make_eof_exception( frame_pointer ) :
make_character( frame_pointer, wc );
}
return result;
} }
struct pso_pointer read_list( struct pso_pointer frame_pointer ) { struct pso_pointer read_list(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg(frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg(frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg(frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( !c_nilp( character ) && characterp( character ) && if (!c_nilp(character) && characterp(character) &&
pointer_to_object( character )->payload.character.character == pointer_to_object(character)->payload.character.character ==
SYNTAX_LPAR ) { SYNTAX_LPAR) {
// it's OK if an LPAR is passed in, but we don't want it now. // it's OK if an LPAR is passed in, but we don't want it now.
character = nil; character = nil;
} }
if ( !c_nilp( character ) ) { if (!c_nilp(character)) {
// if anything other than LPAR is passed in as character, TODO: throw exception. // if anything other than LPAR is passed in as character, TODO: throw
} // exception.
}
while ( c_nilp( character ) || ( characterp( character ) && do {
pointer_to_object( character )-> character = skip_whitespace(
payload.character.character != make_frame(3, frame_pointer, stream, readtable, character));
SYNTAX_RPAR ) ) { struct pso_pointer r =
character = read(make_frame(3, frame_pointer, stream, readtable, character));
skip_whitespace( make_frame
( 3, frame_pointer, stream, readtable,
character ) );
struct pso_pointer r =
read( make_frame
( 3, frame_pointer, stream, readtable, character ) );
if ( exceptionp( r ) ) { if (exceptionp(r)) {
result = r; result = r;
break; break;
} else { } else {
result = make_cons( frame_pointer, r, result ); result = make_cons(frame_pointer, r, result);
character = character = skip_whitespace(
skip_whitespace( make_frame make_frame(3, frame_pointer, stream, readtable, character));
( 3, frame_pointer, stream, readtable, struct pso2 *ch = pointer_to_object(character);
character ) );
}
}
return consp( result ) ? c_reverse( frame_pointer, result ) : result; debug_dump_object(character, DEBUG_IO, 2);
}
} while (c_nilp(character) ||
(characterp(character) &&
pointer_to_object(character)->payload.character.character !=
SYNTAX_RPAR));
return consp(result) ? c_reverse(frame_pointer, result) : result;
} }
/** /**
* @brief Read one integer from the stream and return it. * @brief Read one integer from the stream and return it.
* *
@ -214,76 +207,78 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
* 1. The read table currently in use; * 1. The read table currently in use;
* 2. The character most recently read from that stream. * 2. The character most recently read from that stream.
*/ */
struct pso_pointer read_number( struct pso_pointer frame_pointer ) { struct pso_pointer read_number(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg(frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg(frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg(frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
int base = 10; int base = 10;
// TODO: should check for *read-base* in the environment // TODO: should check for *read-base* in the environment
int64_t value = 0; int64_t value = 0;
if ( readp( stream ) ) { if (readp(stream)) {
if ( c_nilp( character ) ) { if (c_nilp(character)) {
character = character = read_character(make_frame(1, frame_pointer, stream));
read_character( make_frame( 1, frame_pointer, stream ) ); }
} wchar_t c =
wchar_t c = c_nilp( character ) c_nilp(character)
? 0 : pointer_to_object( character )->payload.character.character; ? 0
: pointer_to_object(character)->payload.character.character;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
for ( ; iswdigit( c ) || c == L','; c = url_fgetwc( input ) ) { for (; iswdigit(c) || c == L','; c = url_fgetwc(input)) {
if ( iswdigit( c ) ) { if (iswdigit(c)) {
value = ( value * base ) + ( ( int ) c - ( int ) L'0' ); value = (value * base) + ((int)c - (int)L'0');
} }
} }
url_ungetwc( c, input ); url_ungetwc(c, input);
result = make_integer( frame_pointer, value ); result = make_integer(frame_pointer, value);
} // else exception? } // else exception?
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value ); debug_printf(DEBUG_IO, 0, L"\nRead number %ld\n", value);
debug_dump_object( result, DEBUG_IO, 1 ); debug_dump_object(result, DEBUG_IO, 1);
#endif #endif
return result; return result;
} }
struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) { struct pso_pointer read_symbol(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg(frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg(frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg(frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( readp( stream ) ) { if (readp(stream)) {
if ( c_nilp( character ) ) { if (c_nilp(character)) {
character = character = read_character(make_frame(1, frame_pointer, stream));
read_character( make_frame( 1, frame_pointer, stream ) ); }
}
wchar_t c = c_nilp( character ) wchar_t c =
? 0 : pointer_to_object( character )->payload.character.character; c_nilp(character)
? 0
: pointer_to_object(character)->payload.character.character;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
for ( ; symbol_char_p( c ); c = url_fgetwc( input ) ) { for (; symbol_char_p(c); c = url_fgetwc(input)) {
result = result =
make_string_like_thing( frame_pointer, c, result, SYMBOLTAG ); make_string_like_thing(frame_pointer, c, result, SYMBOLTAG);
} }
url_ungetwc( c, input ); url_ungetwc(c, input);
result = c_reverse( frame_pointer, result ); result = c_reverse(frame_pointer, result);
} }
#ifdef DEBUG #ifdef DEBUG
debug_print( L"\nRead symbol `", DEBUG_IO, 0 ); debug_print(L"\nRead symbol `", DEBUG_IO, 0);
debug_print_object( result, DEBUG_IO, 0 ); debug_print_object(result, DEBUG_IO, 0);
debug_print( L"`\n\t", DEBUG_IO, 0 ); debug_print(L"`\n\t", DEBUG_IO, 0);
debug_dump_object( result, DEBUG_IO, 1 ); debug_dump_object(result, DEBUG_IO, 1);
#endif #endif
return result; return result;
} }
/** /**
@ -297,86 +292,85 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
* 1. The read table currently in use; * 1. The read table currently in use;
* 2. The character most recently read from that stream. * 2. The character most recently read from that stream.
*/ */
struct pso_pointer read( struct pso_pointer frame_pointer ) { struct pso_pointer read(struct pso_pointer frame_pointer) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4(frame_pointer);
struct pso_pointer stream = fetch_arg( frame, 0 ); struct pso_pointer stream = fetch_arg(frame, 0);
struct pso_pointer readtable = fetch_arg( frame, 1 ); struct pso_pointer readtable = fetch_arg(frame, 1);
struct pso_pointer character = fetch_arg( frame, 2 ); struct pso_pointer character = fetch_arg(frame, 2);
struct pso_pointer result = nil; struct pso_pointer result = nil;
if ( c_nilp( stream ) ) { if (c_nilp(stream)) {
stream = stream = make_read_stream(frame_pointer, file_to_url_file(stdin), nil);
make_read_stream( frame_pointer, file_to_url_file( stdin ), nil ); }
}
if ( c_nilp( readtable ) ) { if (c_nilp(readtable)) {
readtable = c_assoc( lisp_io_read_table, fetch_env( frame_pointer ) ); readtable = c_assoc(lisp_io_read_table, fetch_env(frame_pointer));
} }
if ( c_nilp( character ) ) { if (c_nilp(character)) {
character = skip_whitespace( make_frame( 1, frame_pointer, stream ) ); character = skip_whitespace(make_frame(1, frame_pointer, stream));
} }
struct pso_pointer readmacro = c_assoc( character, readtable ); struct pso_pointer readmacro = c_assoc(character, readtable);
if ( !c_nilp( readmacro ) ) { if (!c_nilp(readmacro)) {
// invoke the read macro on the stream // invoke the read macro on the stream
} else if ( readp( stream ) && characterp( character ) ) { } else if (readp(stream) && characterp(character)) {
wchar_t c = wchar_t c = pointer_to_object(character)->payload.character.character;
pointer_to_object( character )->payload.character.character; URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
switch ( c ) { switch (c) {
case SYNTAX_SEMICOLON: case SYNTAX_SEMICOLON:
for ( c = url_fgetwc( input ); c != '\n'; for (c = url_fgetwc(input); c != '\n'; c = url_fgetwc(input))
c = url_fgetwc( input ) ); ;
/* skip all characters from semi-colon to the end of the line */ /* skip all characters from semi-colon to the end of the line */
break; break;
case SYNTAX_LPAR: case SYNTAX_LPAR:
result = result = read_list(make_frame(3, frame_pointer, stream, readtable, character));
read_list( make_frame( 3, stream, readtable, character ) ); break;
break; case EOF:
case EOF: result = make_eof_exception(frame_pointer);
result = make_eof_exception( frame_pointer ); break;
break; default:
default: struct pso_pointer next =
struct pso_pointer next = make_frame( 3, frame_pointer, stream, make_frame(3, frame_pointer, stream, readtable,
readtable, make_character(frame_pointer, c));
make_character inc_ref(next);
( frame_pointer, c ) ); if (iswdigit(c)) {
inc_ref( next ); result = push_local(frame_pointer, read_number(next));
if ( iswdigit( c ) ) { } else if (symbol_char_p(c)) {
result = push_local( frame_pointer, read_number( next ) ); result = push_local(frame_pointer, read_symbol(next));
} else if ( symbol_char_p( c ) ) { } else {
result = push_local( frame_pointer, read_symbol( next ) ); // result =
} else { // throw_exception(
// result = // c_string_to_lisp_symbol( L"read"
// throw_exception( // ),
// c_string_to_lisp_symbol( L"read" ), // make_cons(
// make_cons( // c_string_to_lisp_string
// c_string_to_lisp_string // (
// ( // L"Unrecognised
// L"Unrecognised // start
// start of // of
// input // input
// character" // character"
// ), // ),
// make_string( // make_string(
// c, NIL ) // c, NIL
// ), // )
// frame_pointer ); // ),
} // frame_pointer );
// dec_ref( next ); }
break; // dec_ref( next );
} break;
} }
}
#ifdef DEBUG #ifdef DEBUG
debug_print( L"Read expression: `", DEBUG_IO, 0 ); debug_print(L"Read expression: `", DEBUG_IO, 0);
debug_print_object( result, DEBUG_IO, 0 ); debug_print_object(result, DEBUG_IO, 0);
debug_print( L"`\n", DEBUG_IO, 0 ); debug_print(L"`\n", DEBUG_IO, 0);
debug_dump_object( result, DEBUG_IO, 1 ); debug_dump_object(result, DEBUG_IO, 1);
#endif #endif
return result; return result;
} }

8
src/c/memory/dump.c
View file

@ -197,7 +197,9 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) {
// url_fputws( L"\n", output ); // url_fputws( L"\n", output );
// fflush(stderr); // fflush(stderr);
URL_FILE *output = pointer_to_object( stream )->payload.stream.stream; URL_FILE *output = writep(stream) ?
pointer_to_object( stream )->payload.stream.stream :
file_to_url_file(stderr);
if ( c_nilp( pointer ) ) { if ( c_nilp( pointer ) ) {
// the object at (node, 0, 0) ought to have been initialised, but may not // the object at (node, 0, 0) ought to have been initialised, but may not
@ -214,6 +216,10 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) {
pointer.offset, object->header.count ); pointer.offset, object->header.count );
switch ( get_tag_value( pointer ) ) { switch ( get_tag_value( pointer ) ) {
case CHARACTERTV: {
wchar_t wc = pointer_to_object(pointer)->payload.character.character;
url_fwprintf(output, L"\t\tCharacter object: character `%lc` (%d)\n", wc, wc);
} break;
case CONSTV: case CONSTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tCons object: car at page %d offset %d, cdr at page %d " L"\t\tCons object: car at page %d offset %d, cdr at page %d "