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

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

View file

@ -42,9 +42,9 @@
#include "ops/assoc.h"
#include "ops/reverse.h"
#include "payloads/stack.h"
#include "ops/string_ops.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.
// 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) {
return make_exception( make_frame( 1, frame_pointer,
c_string_to_lisp_string
( frame_pointer,
L"Read: end of input while reading" ) ) );
return make_exception(
make_frame(1, frame_pointer,
c_string_to_lisp_string(
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 result = nil;
do {
if (!characterp(character)) {
character = read_character(make_frame( 1, frame_pointer, stream));
}
if (characterp(character)) {
wchar_t wc =
pointer_to_object( character )->payload.character.character;
if ( !iswspace( wc ) && wc != L',' ) {
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;
}
}
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 );
}
} while (c_nilp(result));
return result;
}
@ -173,37 +168,35 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
character = nil;
}
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 ) &&
pointer_to_object( character )->
payload.character.character !=
SYNTAX_RPAR ) ) {
character =
skip_whitespace( make_frame
( 3, frame_pointer, stream, readtable,
character ) );
do {
character = skip_whitespace(
make_frame(3, frame_pointer, stream, readtable, character));
struct pso_pointer r =
read( make_frame
( 3, frame_pointer, stream, readtable, character ) );
read(make_frame(3, frame_pointer, stream, readtable, character));
if (exceptionp(r)) {
result = r;
break;
} else {
result = make_cons(frame_pointer, r, result);
character =
skip_whitespace( make_frame
( 3, frame_pointer, stream, readtable,
character ) );
}
character = skip_whitespace(
make_frame(3, frame_pointer, stream, readtable, character));
struct pso2 *ch = pointer_to_object(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;
}
/**
* @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 (c_nilp(character)) {
character =
read_character( make_frame( 1, frame_pointer, stream ) );
character = read_character(make_frame(1, frame_pointer, stream));
}
wchar_t c = c_nilp( character )
? 0 : pointer_to_object( character )->payload.character.character;
wchar_t c =
c_nilp(character)
? 0
: pointer_to_object(character)->payload.character.character;
URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
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 (c_nilp(character)) {
character =
read_character( make_frame( 1, frame_pointer, stream ) );
character = read_character(make_frame(1, frame_pointer, stream));
}
wchar_t c = c_nilp( character )
? 0 : pointer_to_object( character )->payload.character.character;
wchar_t c =
c_nilp(character)
? 0
: pointer_to_object(character)->payload.character.character;
URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
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;
if (c_nilp(stream)) {
stream =
make_read_stream( frame_pointer, file_to_url_file( stdin ), nil );
stream = make_read_stream(frame_pointer, file_to_url_file(stdin), nil);
}
if (c_nilp(readtable)) {
@ -323,28 +317,25 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
if (!c_nilp(readmacro)) {
// invoke the read macro on the stream
} else if (readp(stream) && characterp(character)) {
wchar_t c =
pointer_to_object( character )->payload.character.character;
wchar_t c = pointer_to_object(character)->payload.character.character;
URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
switch (c) {
case SYNTAX_SEMICOLON:
for ( c = url_fgetwc( input ); c != '\n';
c = url_fgetwc( input ) );
for (c = url_fgetwc(input); c != '\n'; c = url_fgetwc(input))
;
/* skip all characters from semi-colon to the end of the line */
break;
case SYNTAX_LPAR:
result =
read_list( make_frame( 3, stream, readtable, character ) );
result = read_list(make_frame(3, frame_pointer, stream, readtable, character));
break;
case EOF:
result = make_eof_exception(frame_pointer);
break;
default:
struct pso_pointer next = make_frame( 3, frame_pointer, stream,
readtable,
make_character
( frame_pointer, c ) );
struct pso_pointer next =
make_frame(3, frame_pointer, stream, readtable,
make_character(frame_pointer, c));
inc_ref(next);
if (iswdigit(c)) {
result = push_local(frame_pointer, read_number(next));
@ -353,17 +344,20 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
} else {
// result =
// throw_exception(
// c_string_to_lisp_symbol( L"read" ),
// c_string_to_lisp_symbol( L"read"
// ),
// make_cons(
// c_string_to_lisp_string
// (
// L"Unrecognised
// start of
// start
// of
// input
// character"
// ),
// make_string(
// c, NIL )
// c, NIL
// )
// ),
// frame_pointer );
}

View file

@ -197,7 +197,9 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) {
// url_fputws( L"\n", output );
// 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 ) ) {
// 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 );
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:
url_fwprintf( output,
L"\t\tCons object: car at page %d offset %d, cdr at page %d "