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:
parent
d1bfb029b8
commit
6f39dae75f
2 changed files with 217 additions and 217 deletions
294
src/c/io/read.c
294
src/c/io/read.c
|
|
@ -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
|
||||
|
|
@ -77,21 +77,21 @@
|
|||
* 1. The read table currently in use;
|
||||
* 2. The character most recently read from that stream.
|
||||
*/
|
||||
struct pso_pointer read_example( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer stream = fetch_arg( frame, 0 );
|
||||
struct pso_pointer readtable = fetch_arg( frame, 1 );
|
||||
struct pso_pointer character = fetch_arg( frame, 2 );
|
||||
struct pso_pointer read_example(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer stream = fetch_arg(frame, 0);
|
||||
struct pso_pointer readtable = fetch_arg(frame, 1);
|
||||
struct pso_pointer character = fetch_arg(frame, 2);
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
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" ) ) );
|
||||
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")));
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -106,16 +106,16 @@ struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer ) {
|
|||
* @return a string of one character, namely the next available character
|
||||
* on my stream, if any, else nil.
|
||||
*/
|
||||
struct pso_pointer read_character( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer read_character(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer stream_pointer = fetch_arg( frame, 0 );
|
||||
if ( readp( stream_pointer ) ) {
|
||||
wint_t chr = url_fgetwc( stream_get_url_file( stream_pointer ) );
|
||||
result = make_character( frame_pointer, chr );
|
||||
struct pso_pointer stream_pointer = fetch_arg(frame, 0);
|
||||
if (readp(stream_pointer)) {
|
||||
wint_t chr = url_fgetwc(stream_get_url_file(stream_pointer));
|
||||
result = make_character(frame_pointer, chr);
|
||||
|
||||
#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
|
||||
}
|
||||
|
||||
|
|
@ -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
|
||||
* encountered, or an exception.
|
||||
*/
|
||||
struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer stream = fetch_arg( frame, 0 );
|
||||
struct pso_pointer readtable = fetch_arg( frame, 1 );
|
||||
struct pso_pointer character = fetch_arg( frame, 2 );
|
||||
struct pso_pointer skip_whitespace(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer stream = fetch_arg(frame, 0);
|
||||
struct pso_pointer readtable = fetch_arg(frame, 1);
|
||||
struct pso_pointer character = fetch_arg(frame, 2);
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( characterp( character ) ) {
|
||||
wchar_t wc =
|
||||
pointer_to_object( character )->payload.character.character;
|
||||
if ( !iswspace( wc ) && wc != L',' ) {
|
||||
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) && !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;
|
||||
}
|
||||
|
||||
struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer stream = fetch_arg( frame, 0 );
|
||||
struct pso_pointer readtable = fetch_arg( frame, 1 );
|
||||
struct pso_pointer character = fetch_arg( frame, 2 );
|
||||
struct pso_pointer read_list(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer stream = fetch_arg(frame, 0);
|
||||
struct pso_pointer readtable = fetch_arg(frame, 1);
|
||||
struct pso_pointer character = fetch_arg(frame, 2);
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( !c_nilp( character ) && characterp( character ) &&
|
||||
pointer_to_object( character )->payload.character.character ==
|
||||
SYNTAX_LPAR ) {
|
||||
if (!c_nilp(character) && characterp(character) &&
|
||||
pointer_to_object(character)->payload.character.character ==
|
||||
SYNTAX_LPAR) {
|
||||
// it's OK if an LPAR is passed in, but we don't want it now.
|
||||
character = nil;
|
||||
}
|
||||
if ( !c_nilp( character ) ) {
|
||||
// if anything other than LPAR is passed in as character, TODO: throw exception.
|
||||
if (!c_nilp(character)) {
|
||||
// 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 ) ) {
|
||||
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 ) );
|
||||
}
|
||||
}
|
||||
result = make_cons(frame_pointer, r, result);
|
||||
character = skip_whitespace(
|
||||
make_frame(3, frame_pointer, stream, readtable, character));
|
||||
struct pso2 *ch = pointer_to_object(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.
|
||||
*
|
||||
|
|
@ -214,73 +207,75 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) {
|
|||
* 1. The read table currently in use;
|
||||
* 2. The character most recently read from that stream.
|
||||
*/
|
||||
struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer stream = fetch_arg( frame, 0 );
|
||||
struct pso_pointer readtable = fetch_arg( frame, 1 );
|
||||
struct pso_pointer character = fetch_arg( frame, 2 );
|
||||
struct pso_pointer read_number(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer stream = fetch_arg(frame, 0);
|
||||
struct pso_pointer readtable = fetch_arg(frame, 1);
|
||||
struct pso_pointer character = fetch_arg(frame, 2);
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
int base = 10;
|
||||
// TODO: should check for *read-base* in the environment
|
||||
int64_t value = 0;
|
||||
|
||||
if ( readp( stream ) ) {
|
||||
if ( c_nilp( character ) ) {
|
||||
character =
|
||||
read_character( make_frame( 1, frame_pointer, stream ) );
|
||||
if (readp(stream)) {
|
||||
if (c_nilp(character)) {
|
||||
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 ) ) {
|
||||
if ( iswdigit( c ) ) {
|
||||
value = ( value * base ) + ( ( int ) c - ( int ) L'0' );
|
||||
URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
|
||||
for (; iswdigit(c) || c == L','; c = url_fgetwc(input)) {
|
||||
if (iswdigit(c)) {
|
||||
value = (value * base) + ((int)c - (int)L'0');
|
||||
}
|
||||
}
|
||||
|
||||
url_ungetwc( c, input );
|
||||
result = make_integer( frame_pointer, value );
|
||||
url_ungetwc(c, input);
|
||||
result = make_integer(frame_pointer, value);
|
||||
} // else exception?
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value );
|
||||
debug_dump_object( result, DEBUG_IO, 1 );
|
||||
debug_printf(DEBUG_IO, 0, L"\nRead number %ld\n", value);
|
||||
debug_dump_object(result, DEBUG_IO, 1);
|
||||
#endif
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer stream = fetch_arg( frame, 0 );
|
||||
struct pso_pointer readtable = fetch_arg( frame, 1 );
|
||||
struct pso_pointer character = fetch_arg( frame, 2 );
|
||||
struct pso_pointer read_symbol(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer stream = fetch_arg(frame, 0);
|
||||
struct pso_pointer readtable = fetch_arg(frame, 1);
|
||||
struct pso_pointer character = fetch_arg(frame, 2);
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( readp( stream ) ) {
|
||||
if ( c_nilp( character ) ) {
|
||||
character =
|
||||
read_character( make_frame( 1, frame_pointer, stream ) );
|
||||
if (readp(stream)) {
|
||||
if (c_nilp(character)) {
|
||||
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 ) ) {
|
||||
URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
|
||||
for (; symbol_char_p(c); c = url_fgetwc(input)) {
|
||||
result =
|
||||
make_string_like_thing( frame_pointer, c, result, SYMBOLTAG );
|
||||
make_string_like_thing(frame_pointer, c, result, SYMBOLTAG);
|
||||
}
|
||||
|
||||
url_ungetwc( c, input );
|
||||
result = c_reverse( frame_pointer, result );
|
||||
url_ungetwc(c, input);
|
||||
result = c_reverse(frame_pointer, result);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
debug_print( L"\nRead symbol `", DEBUG_IO, 0 );
|
||||
debug_print_object( result, DEBUG_IO, 0 );
|
||||
debug_print( L"`\n\t", DEBUG_IO, 0 );
|
||||
debug_dump_object( result, DEBUG_IO, 1 );
|
||||
debug_print(L"\nRead symbol `", DEBUG_IO, 0);
|
||||
debug_print_object(result, DEBUG_IO, 0);
|
||||
debug_print(L"`\n\t", DEBUG_IO, 0);
|
||||
debug_dump_object(result, DEBUG_IO, 1);
|
||||
#endif
|
||||
|
||||
return result;
|
||||
|
|
@ -297,85 +292,84 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
|
|||
* 1. The read table currently in use;
|
||||
* 2. The character most recently read from that stream.
|
||||
*/
|
||||
struct pso_pointer read( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer stream = fetch_arg( frame, 0 );
|
||||
struct pso_pointer readtable = fetch_arg( frame, 1 );
|
||||
struct pso_pointer character = fetch_arg( frame, 2 );
|
||||
struct pso_pointer read(struct pso_pointer frame_pointer) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer stream = fetch_arg(frame, 0);
|
||||
struct pso_pointer readtable = fetch_arg(frame, 1);
|
||||
struct pso_pointer character = fetch_arg(frame, 2);
|
||||
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( c_nilp( stream ) ) {
|
||||
stream =
|
||||
make_read_stream( frame_pointer, file_to_url_file( stdin ), nil );
|
||||
if (c_nilp(stream)) {
|
||||
stream = make_read_stream(frame_pointer, file_to_url_file(stdin), nil);
|
||||
}
|
||||
|
||||
if ( c_nilp( readtable ) ) {
|
||||
readtable = c_assoc( lisp_io_read_table, fetch_env( frame_pointer ) );
|
||||
if (c_nilp(readtable)) {
|
||||
readtable = c_assoc(lisp_io_read_table, fetch_env(frame_pointer));
|
||||
}
|
||||
|
||||
if ( c_nilp( character ) ) {
|
||||
character = skip_whitespace( make_frame( 1, frame_pointer, stream ) );
|
||||
if (c_nilp(character)) {
|
||||
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
|
||||
} else if ( readp( stream ) && characterp( character ) ) {
|
||||
wchar_t c =
|
||||
pointer_to_object( character )->payload.character.character;
|
||||
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
||||
} else if (readp(stream) && characterp(character)) {
|
||||
wchar_t c = pointer_to_object(character)->payload.character.character;
|
||||
URL_FILE *input = pointer_to_object(stream)->payload.stream.stream;
|
||||
|
||||
switch ( c ) {
|
||||
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 );
|
||||
result = make_eof_exception(frame_pointer);
|
||||
break;
|
||||
default:
|
||||
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 ) );
|
||||
} else if ( symbol_char_p( c ) ) {
|
||||
result = push_local( frame_pointer, read_symbol( next ) );
|
||||
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));
|
||||
} else if (symbol_char_p(c)) {
|
||||
result = push_local(frame_pointer, read_symbol(next));
|
||||
} 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 );
|
||||
}
|
||||
// dec_ref( next );
|
||||
// dec_ref( next );
|
||||
break;
|
||||
}
|
||||
}
|
||||
#ifdef DEBUG
|
||||
debug_print( L"Read expression: `", DEBUG_IO, 0 );
|
||||
debug_print_object( result, DEBUG_IO, 0 );
|
||||
debug_print( L"`\n", DEBUG_IO, 0 );
|
||||
debug_dump_object( result, DEBUG_IO, 1 );
|
||||
debug_print(L"Read expression: `", DEBUG_IO, 0);
|
||||
debug_print_object(result, DEBUG_IO, 0);
|
||||
debug_print(L"`\n", DEBUG_IO, 0);
|
||||
debug_dump_object(result, DEBUG_IO, 1);
|
||||
#endif
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -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 "
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue