277 lines
9.8 KiB
C
277 lines
9.8 KiB
C
/**
|
|
* read.c
|
|
*
|
|
* Read basic Lisp objects..This is :bootstrap layer print; it needs to be
|
|
* able to read characters, symbols, integers, lists and dotted pairs. I
|
|
* don't think it needs to be able to read anything else. It must, however,
|
|
* take a readtable as argument and expand reader macros.
|
|
*
|
|
*
|
|
* (c) 2017 Simon Brooke <simon@journeyman.cc>
|
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
|
*/
|
|
|
|
#include <math.h>
|
|
#include <stdbool.h>
|
|
#include <stdint.h>
|
|
#include <stdio.h>
|
|
|
|
/*
|
|
* wide characters
|
|
*/
|
|
#include <wchar.h>
|
|
#include <wctype.h>
|
|
|
|
#include "debug.h"
|
|
|
|
#include "io/io.h"
|
|
#include "io/read.h"
|
|
#include "memory/node.h"
|
|
#include "memory/pointer.h"
|
|
#include "memory/pso.h"
|
|
#include "memory/pso2.h"
|
|
#include "memory/tags.h"
|
|
|
|
#include "payloads/character.h"
|
|
#include "payloads/exception.h"
|
|
#include "payloads/function.h"
|
|
#include "payloads/integer.h"
|
|
#include "payloads/read_stream.h"
|
|
|
|
#include "ops/assoc.h"
|
|
#include "ops/reverse.h"
|
|
#include "ops/stack_ops.h"
|
|
#include "ops/string_ops.h"
|
|
#include "ops/truth.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
|
|
// to be able to despatch on readttables, and the initial readtable functions
|
|
// don't need to be written in Lisp.
|
|
//
|
|
// In the long run a readtable ought to be a hashtable, but for now an assoc
|
|
// list will do.
|
|
//
|
|
// A readtable function is a Lisp function so needs the stackframe and the
|
|
// environment. Other arguments (including the output stream) should be passed
|
|
// in the argument, so I think the first arg in the frame is the character read;
|
|
// the next is the input stream; the next is the readtable, if any.
|
|
|
|
/*
|
|
* for the time being things which may be read are:
|
|
* * integers
|
|
* * lists
|
|
* * atoms
|
|
* * dotted pairs
|
|
*/
|
|
|
|
/**
|
|
* An example wrapper function while I work out how I'm going to do this.
|
|
*
|
|
* For this and all other `read` functions unless documented otherwise, the
|
|
* arguments in the frame are expected to be:
|
|
*
|
|
* 0. The input stream to read from;
|
|
* 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 result = nil;
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* Function: return the next character from the stream indicated by arg 0;
|
|
* further arguments are ignored.
|
|
*
|
|
* * (read-char stream)
|
|
*
|
|
* @param frame my stack frame.
|
|
* @param frame_pointer a pointer to my stack frame.
|
|
* @param env my environment.
|
|
* @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 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 );
|
|
|
|
#ifdef DEBUG
|
|
debug_printf( DEBUG_IO, 0, L"\nRead character %lc\n", chr );
|
|
#endif
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* @brief Read one integer from the stream and return it.
|
|
*
|
|
* For this and all other `read` functions unless documented otherwise, the
|
|
* arguments in the frame are expected to be:
|
|
*
|
|
* 0. The input stream to read from;
|
|
* 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 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 ) );
|
|
}
|
|
char32_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 = url_fgetwc( input ) ) {
|
|
value = ( value * base ) + ( ( int ) c - ( int ) L'0' );
|
|
}
|
|
|
|
url_ungetwc( c, input );
|
|
result = make_integer( frame_pointer, value );
|
|
} // else exception?
|
|
|
|
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 result = nil;
|
|
|
|
if ( readp( stream ) ) {
|
|
if ( c_nilp( character ) ) {
|
|
character =
|
|
read_character( make_frame( 1, frame_pointer, stream ) );
|
|
}
|
|
|
|
char32_t c = c_nilp( character )
|
|
? 0 : pointer_to_object( character )->payload.character.character;
|
|
|
|
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
|
for ( ; iswalnum( c ); c = url_fgetwc( input ) ) {
|
|
result =
|
|
make_string_like_thing( frame_pointer, c, result, SYMBOLTAG );
|
|
}
|
|
|
|
url_ungetwc( c, input );
|
|
result = c_reverse( frame_pointer, result );
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* @brief Read the next object on the input stream indicated by this stack
|
|
* frame, and return a pso_pointer to the object read.
|
|
*
|
|
* For this and all other `read` functions unless documented otherwise, the
|
|
* arguments in the frame are expected to be:
|
|
*
|
|
* 0. The input stream to read from;
|
|
* 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 result = 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( character ) ) {
|
|
character = read_character( make_frame( 1, frame_pointer, stream ) );
|
|
}
|
|
|
|
struct pso_pointer readmacro = c_assoc( character, readtable );
|
|
|
|
if ( !c_nilp( readmacro ) ) {
|
|
// invoke the read macro on the stream
|
|
} else if ( readp( stream ) && characterp( character ) ) {
|
|
char32_t c =
|
|
pointer_to_object( character )->payload.character.character;
|
|
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
|
|
|
switch ( c ) {
|
|
case ';':
|
|
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 EOF:
|
|
result = make_exception( make_frame( 1, frame_pointer,
|
|
c_string_to_lisp_string
|
|
( frame_pointer,
|
|
L"Read: end of input while reading" ) ) );
|
|
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 ( iswalpha( c ) ) {
|
|
result = push_local( frame_pointer, read_symbol( next ) );
|
|
} else {
|
|
// result =
|
|
// throw_exception(
|
|
// c_string_to_lisp_symbol( L"read" ),
|
|
// make_cons(
|
|
// c_string_to_lisp_string
|
|
// (
|
|
// L"Unrecognised
|
|
// start of
|
|
// input
|
|
// character"
|
|
// ),
|
|
// make_string(
|
|
// c, NIL )
|
|
// ),
|
|
// frame_pointer );
|
|
}
|
|
// dec_ref( next );
|
|
break;
|
|
}
|
|
}
|
|
#ifdef DEBUG
|
|
debug_print( L"Read object: ", DEBUG_IO, 0 );
|
|
debug_print_object( result, DEBUG_IO, 0 );
|
|
debug_println( DEBUG_IO );
|
|
#endif
|
|
|
|
return result;
|
|
}
|