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

116
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
@ -88,10 +88,10 @@ struct pso_pointer read_example( struct pso_pointer frame_pointer ) {
} }
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")));
} }
/** /**
@ -135,26 +135,21 @@ struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) {
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;
do {
if (!characterp(character)) {
character = read_character(make_frame( 1, frame_pointer, stream));
}
if (characterp(character)) { if (characterp(character)) {
wchar_t wc = wchar_t wc = pointer_to_object(character)->payload.character.character;
pointer_to_object( character )->payload.character.character; if (!iswspace(wc) && !iswcntrl(wc) && wc != L',') {
if ( !iswspace( wc ) && wc != L',' ) {
result = character; result = character;
} else if (exceptionp(character)){
result = character;
} else {
character = nil;
} }
} }
} while (c_nilp(result));
if ( c_nilp( result ) && readp( stream ) ) {
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; return result;
} }
@ -173,37 +168,35 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
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 ) ) {
character =
skip_whitespace( make_frame
( 3, frame_pointer, stream, readtable,
character ) );
struct pso_pointer r = struct pso_pointer r =
read( make_frame read(make_frame(3, frame_pointer, stream, readtable, character));
( 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 ) );
} 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; 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.
* *
@ -227,11 +220,12 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
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 (; iswdigit(c) || c == L','; c = url_fgetwc(input)) { for (; iswdigit(c) || c == L','; c = url_fgetwc(input)) {
@ -260,12 +254,13 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
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)) {
@ -306,8 +301,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
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)) {
@ -323,28 +317,25 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
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 = make_frame( 3, frame_pointer, stream, struct pso_pointer next =
readtable, make_frame(3, frame_pointer, stream, readtable,
make_character make_character(frame_pointer, c));
( frame_pointer, c ) );
inc_ref(next); inc_ref(next);
if (iswdigit(c)) { if (iswdigit(c)) {
result = push_local(frame_pointer, read_number(next)); result = push_local(frame_pointer, read_number(next));
@ -353,17 +344,20 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
} else { } else {
// result = // result =
// throw_exception( // throw_exception(
// c_string_to_lisp_symbol( L"read" ), // 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 of // start
// of
// input // input
// character" // character"
// ), // ),
// make_string( // make_string(
// c, NIL ) // c, NIL
// )
// ), // ),
// frame_pointer ); // frame_pointer );
} }

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 "