Still making progress. Dropped the archive because it was causing problems.
This commit is contained in:
parent
eed4711fee
commit
8d2acbeb0f
97 changed files with 490 additions and 13322 deletions
164
src/c/io/io.c
164
src/c/io/io.c
|
|
@ -26,6 +26,7 @@
|
|||
*/
|
||||
#include <wchar.h>
|
||||
#include <wctype.h>
|
||||
#include <wctype.h>
|
||||
|
||||
#include <curl/curl.h>
|
||||
|
||||
|
|
@ -149,65 +150,79 @@ int initialise_io( ) {
|
|||
return result;
|
||||
}
|
||||
|
||||
struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
|
||||
struct pso_pointer initialise_default_streams( struct pso_pointer stack_frame,
|
||||
struct pso_pointer env ) {
|
||||
// todo: issue #21: should this have stack frame passed in?
|
||||
// It's called in initialisation before everything else is set
|
||||
// up, so **possibly** not?
|
||||
lisp_io_in = c_string_to_lisp_symbol( C_IO_IN );
|
||||
lisp_io_out = c_string_to_lisp_symbol( C_IO_OUT );
|
||||
lisp_io_log = c_string_to_lisp_symbol( C_IO_LOG );
|
||||
lisp_io_prompt = c_string_to_lisp_symbol( C_IO_PROMPT );
|
||||
lisp_io_in = c_string_to_lisp_symbol( stack_frame, C_IO_IN );
|
||||
lisp_io_out = c_string_to_lisp_symbol( stack_frame, C_IO_OUT );
|
||||
lisp_io_log = c_string_to_lisp_symbol( stack_frame, C_IO_LOG );
|
||||
lisp_io_prompt = c_string_to_lisp_symbol( stack_frame, C_IO_PROMPT );
|
||||
|
||||
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO,
|
||||
0 );
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
env =
|
||||
c_bind( lisp_io_prompt, c_string_to_lisp_string( INITIAL_PROMPT ),
|
||||
env );
|
||||
|
||||
lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ),
|
||||
make_cons( make_cons
|
||||
( c_string_to_lisp_keyword
|
||||
( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"::system:standard-input" ) ),
|
||||
nil ) ) );
|
||||
|
||||
env = c_bind( lisp_io_in, lisp_stdin, env );
|
||||
lisp_bind( make_frame
|
||||
( 3, stack_frame, lisp_io_prompt,
|
||||
c_string_to_lisp_string( stack_frame, INITIAL_PROMPT ),
|
||||
env ) );
|
||||
|
||||
lisp_stdin =
|
||||
lock_object( make_read_stream
|
||||
( stack_frame, file_to_url_file( stdin ),
|
||||
make_cons( stack_frame,
|
||||
make_cons( stack_frame,
|
||||
c_string_to_lisp_keyword
|
||||
( stack_frame, L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( stack_frame,
|
||||
L"::system:standard-input" ) ),
|
||||
stack_frame ) ) );
|
||||
env =
|
||||
lisp_bind( make_frame( 3, stack_frame, lisp_io_in, lisp_stdin, env ) );
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
if ( !nilp( env ) && !exceptionp( env ) ) {
|
||||
if ( !c_nilp( env ) && !exceptionp( env ) ) {
|
||||
lisp_stdout =
|
||||
lock_object( make_write_stream
|
||||
( file_to_url_file( stdout ),
|
||||
make_cons( make_cons
|
||||
( c_string_to_lisp_keyword( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"::system:standard-output" ) ),
|
||||
nil ) ) );
|
||||
|
||||
env = c_bind( lisp_io_out, lisp_stdout, env );
|
||||
lock_object( make_write_stream( stack_frame,
|
||||
file_to_url_file( stdout ),
|
||||
make_cons( stack_frame,
|
||||
make_cons( stack_frame,
|
||||
c_string_to_lisp_keyword
|
||||
( stack_frame,
|
||||
L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( stack_frame,
|
||||
L"::system:standard-output" ) ),
|
||||
nil ) ) );
|
||||
env =
|
||||
lisp_bind( make_frame
|
||||
( 3, stack_frame, lisp_io_out, lisp_stdout, env ) );
|
||||
}
|
||||
|
||||
if ( !nilp( env ) && !exceptionp( env ) ) {
|
||||
if ( !c_nilp( env ) && !exceptionp( env ) ) {
|
||||
lisp_stderr =
|
||||
lock_object( make_write_stream
|
||||
( file_to_url_file( stderr ),
|
||||
make_cons( make_cons
|
||||
( c_string_to_lisp_keyword( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"::system:standard-output" ) ),
|
||||
( stack_frame, file_to_url_file( stderr ),
|
||||
make_cons( stack_frame,
|
||||
make_cons( stack_frame,
|
||||
c_string_to_lisp_keyword
|
||||
( stack_frame, L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( stack_frame,
|
||||
L"::system:standard-output" ) ),
|
||||
nil ) ) );
|
||||
|
||||
env = c_bind( lisp_io_log, lisp_stderr, env );
|
||||
env =
|
||||
lisp_bind( make_frame
|
||||
( 3, frame_pointer, lisp_io_log, lisp_stderr, env ) );
|
||||
}
|
||||
|
||||
debug_print( L"Leaving initialise_default_streams; environment is: ",
|
||||
DEBUG_IO, 0 );
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
return env;
|
||||
}
|
||||
|
||||
|
|
@ -222,20 +237,17 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
|
|||
*/
|
||||
char *lisp_string_to_c_string( struct pso_pointer s ) {
|
||||
char *result = NULL;
|
||||
|
||||
if ( stringp( s ) || symbolp( s ) ) {
|
||||
int len = 0;
|
||||
|
||||
for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) {
|
||||
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
|
||||
len++;
|
||||
}
|
||||
|
||||
char32_t *buffer = calloc( len + 1, sizeof( char32_t ) );
|
||||
/* worst case, one wide char = four utf bytes */
|
||||
result = calloc( ( len * 4 ) + 1, sizeof( char ) );
|
||||
|
||||
int i = 0;
|
||||
for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) {
|
||||
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
|
||||
buffer[i++] = pointer_to_object( c )->payload.string.character;
|
||||
}
|
||||
|
||||
|
|
@ -246,7 +258,6 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
|
|||
debug_print( L"lisp_string_to_c_string( ", DEBUG_IO, 0 );
|
||||
debug_print_object( s, DEBUG_IO, 0 );
|
||||
debug_printf( DEBUG_IO, 0, L") => '%s'\n", result );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -258,7 +269,6 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
|
|||
*/
|
||||
wint_t url_fgetwc( URL_FILE *input ) {
|
||||
wint_t result = -1;
|
||||
|
||||
if ( ungotten != 0 ) {
|
||||
/* TODO: not thread safe */
|
||||
result = ungotten;
|
||||
|
|
@ -269,14 +279,11 @@ wint_t url_fgetwc( URL_FILE *input ) {
|
|||
fwide( input->handle.file, 1 ); /* wide characters */
|
||||
result = fgetwc( input->handle.file ); /* passthrough */
|
||||
break;
|
||||
|
||||
case CFTYPE_CURL:{
|
||||
char *cbuff =
|
||||
calloc( sizeof( char32_t ) + 2, sizeof( char ) );
|
||||
char32_t *wbuff = calloc( 2, sizeof( char32_t ) );
|
||||
|
||||
size_t count = 0;
|
||||
|
||||
debug_print( L"url_fgetwc: about to call url_fgets\n",
|
||||
DEBUG_IO, 0 );
|
||||
url_fgets( cbuff, 2, input );
|
||||
|
|
@ -312,10 +319,10 @@ wint_t url_fgetwc( URL_FILE *input ) {
|
|||
}
|
||||
mbstowcs( wbuff, cbuff, 2 ); //(char *)(&input->buffer[input->buffer_pos]), 1 );
|
||||
result = wbuff[0];
|
||||
|
||||
free( wbuff );
|
||||
free( cbuff );
|
||||
} break;
|
||||
}
|
||||
break;
|
||||
case CFTYPE_NONE:
|
||||
break;
|
||||
}
|
||||
|
|
@ -328,13 +335,11 @@ wint_t url_fgetwc( URL_FILE *input ) {
|
|||
|
||||
wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
|
||||
wint_t result = -1;
|
||||
|
||||
switch ( input->type ) {
|
||||
case CFTYPE_FILE:
|
||||
fwide( input->handle.file, 1 ); /* wide characters */
|
||||
result = ungetwc( wc, input->handle.file ); /* passthrough */
|
||||
break;
|
||||
|
||||
case CFTYPE_CURL:{
|
||||
ungotten = wc;
|
||||
break;
|
||||
|
|
@ -356,12 +361,11 @@ wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
|
|||
*/
|
||||
struct pso_pointer get_character( struct pso_pointer read_stream ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( readp( read_stream ) ) {
|
||||
result =
|
||||
make_character( url_fgetwc
|
||||
( pointer_to_object_of_size_class( read_stream, 2 )
|
||||
->payload.stream.stream ) );
|
||||
( pointer_to_object_of_size_class
|
||||
( read_stream, 2 )->payload.stream.stream ) );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -378,7 +382,6 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
|
|||
struct pso_pointer push_back_character( struct pso_pointer c,
|
||||
struct pso_pointer r ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( characterp( c ) && readp( r ) ) {
|
||||
if ( url_ungetwc( ( wint_t )
|
||||
( pointer_to_object( c )->payload.character.
|
||||
|
|
@ -407,10 +410,11 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
|
||||
if ( url_fclose( pointer_to_object( fetch_arg( frame, 0 ) )
|
||||
->payload.stream.stream ) == 0 ) {
|
||||
if ( url_fclose
|
||||
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.
|
||||
stream )
|
||||
== 0 ) {
|
||||
result = t;
|
||||
}
|
||||
}
|
||||
|
|
@ -433,7 +437,6 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key,
|
|||
value = trim( value );
|
||||
char32_t buffer[strlen( value ) + 1];
|
||||
mbstowcs( buffer, value, strlen( value ) + 1 );
|
||||
|
||||
return
|
||||
make_cons( make_cons
|
||||
( c_string_to_lisp_keyword( frame_pointer, key ),
|
||||
|
|
@ -444,10 +447,8 @@ struct pso_pointer add_meta_time( struct pso_pointer meta, char32_t *key,
|
|||
time_t *value ) {
|
||||
// todo: issue #21: must have stack frame passed in.
|
||||
char datestring[256];
|
||||
|
||||
strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ),
|
||||
localtime( value ) );
|
||||
|
||||
return add_meta_string( meta, key, datestring );
|
||||
}
|
||||
|
||||
|
|
@ -458,43 +459,33 @@ struct pso_pointer add_meta_time( struct pso_pointer meta, char32_t *key,
|
|||
static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
|
||||
struct pso_pointer stream ) {
|
||||
struct pso2 *cell = pointer_to_object( stream );
|
||||
|
||||
// TODO: reimplement
|
||||
|
||||
/* make a copy of the string that we can destructively change */
|
||||
// char *s = calloc( strlen( string ), sizeof( char ) );
|
||||
|
||||
// strcpy( s, string );
|
||||
|
||||
// if ( check_tag( cell, READTV) ||
|
||||
// check_tag( cell, WRITETV) ) {
|
||||
// int offset = index_of( ':', s );
|
||||
|
||||
// if ( offset != -1 ) {
|
||||
// s[offset] = ( char ) 0;
|
||||
// char *name = trim( s );
|
||||
// char *value = trim( &s[++offset] );
|
||||
// char32_t wname[strlen( name )];
|
||||
|
||||
// mbstowcs( wname, name, strlen( name ) + 1 );
|
||||
|
||||
// cell->payload.stream.meta =
|
||||
// add_meta_string( cell->payload.stream.meta, wname, value );
|
||||
|
||||
// debug_printf( DEBUG_IO,
|
||||
// L"write_meta_callback: added header '%s': value
|
||||
// '%s'\n", name, value );
|
||||
// } else if ( strncmp( "HTTP", s, 4 ) == 0 ) {
|
||||
// int offset = index_of( ' ', s );
|
||||
// char *value = trim( &s[offset] );
|
||||
|
||||
// cell->payload.stream.meta =
|
||||
// add_meta_integer( add_meta_string
|
||||
// ( cell->payload.stream.meta, L"status",
|
||||
// value ), L"status-code", strtol( value,
|
||||
// NULL,
|
||||
// 10 ) );
|
||||
|
||||
// debug_printf( DEBUG_IO,
|
||||
// L"write_meta_callback: added header 'status': value
|
||||
// '%s'\n", value );
|
||||
|
|
@ -510,7 +501,6 @@ static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
|
|||
// DEBUG_IO );
|
||||
// debug_dump_object( stream, DEBUG_IO );
|
||||
// }
|
||||
|
||||
// free( s );
|
||||
return 0; // strlen( string );
|
||||
}
|
||||
|
|
@ -519,12 +509,12 @@ void collect_meta( struct pso_pointer stream, char *url ) {
|
|||
struct pso2 *cell = pointer_to_object( stream );
|
||||
URL_FILE *s = pointer_to_object( stream )->payload.stream.stream;
|
||||
struct pso_pointer meta =
|
||||
add_meta_string( cell->payload.stream.meta, L"url", url );
|
||||
add_meta_string( cell->payload.stream.meta, L"url",
|
||||
url );
|
||||
struct stat statbuf;
|
||||
int result = stat( url, &statbuf );
|
||||
struct passwd *pwd;
|
||||
struct group *grp;
|
||||
|
||||
switch ( s->type ) {
|
||||
case CFTYPE_NONE:
|
||||
break;
|
||||
|
|
@ -545,7 +535,6 @@ void collect_meta( struct pso_pointer stream, char *url ) {
|
|||
meta =
|
||||
add_meta_integer( meta, L"size",
|
||||
( intmax_t ) statbuf.st_size );
|
||||
|
||||
meta = add_meta_time( meta, L"modified", &statbuf.st_mtime );
|
||||
}
|
||||
break;
|
||||
|
|
@ -569,9 +558,7 @@ void collect_meta( struct pso_pointer stream, char *url ) {
|
|||
struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer stream_name = inputp ? lisp_io_in : lisp_io_out;
|
||||
|
||||
result = c_assoc( stream_name, env );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -581,10 +568,8 @@ struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
|
|||
*/
|
||||
URL_FILE *stream_get_url_file( struct pso_pointer s ) {
|
||||
URL_FILE *result = NULL;
|
||||
|
||||
if ( readp( s ) || writep( s ) ) {
|
||||
struct pso2 *obj = pointer_to_object( s );
|
||||
|
||||
result = obj->payload.stream.stream;
|
||||
}
|
||||
|
||||
|
|
@ -610,18 +595,14 @@ struct pso_pointer lisp_open( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
// if ( stringp( fetch_arg( frame, 0) ) ) {
|
||||
// char *url = lisp_string_to_c_string( fetch_arg( frame, 0) );
|
||||
|
||||
// if ( nilp( fetch_arg( frame, 1) ) ) {
|
||||
// if ( c_nilp( fetch_arg( frame, 1) ) ) {
|
||||
// URL_FILE *stream = url_fopen( url, "r" );
|
||||
|
||||
// debug_printf( DEBUG_IO, 0,
|
||||
// L"lisp_open: stream @ %ld, stream type = %d, stream
|
||||
// handle = %ld\n", ( long int ) &stream, ( int )
|
||||
// stream->type, ( long int ) stream->handle.file );
|
||||
|
||||
// switch ( stream->type ) {
|
||||
// case CFTYPE_NONE:
|
||||
// return
|
||||
|
|
@ -641,23 +622,19 @@ struct pso_pointer lisp_open( struct pso_pointer frame_pointer,
|
|||
// /* can't tell whether a URL is bad without reading it */
|
||||
// break;
|
||||
// }
|
||||
|
||||
// result = make_read_stream( stream, nil );
|
||||
// } else {
|
||||
// // TODO: anything more complex is a problem for another day.
|
||||
// URL_FILE *stream = url_fopen( url, "w" );
|
||||
// result = make_write_stream( stream, nil );
|
||||
// }
|
||||
|
||||
// if ( pointer_to_object( result )->payload.stream.stream == NULL ) {
|
||||
// result = nil;
|
||||
// } else {
|
||||
// collect_meta( result, url );
|
||||
// }
|
||||
|
||||
// free( url );
|
||||
// }
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -677,12 +654,11 @@ struct pso_pointer lisp_read_char( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer env ) {
|
||||
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 ) ) {
|
||||
result =
|
||||
make_string( frame_pointer, url_fgetwc( stream_get_url_file( stream_pointer ) ),
|
||||
nil );
|
||||
result = make_string( frame_pointer,
|
||||
url_fgetwc( stream_get_url_file
|
||||
( stream_pointer ) ), nil );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -706,12 +682,11 @@ struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( readp( fetch_arg( frame, 0 ) ) ) {
|
||||
URL_FILE *stream = stream_get_url_file( fetch_arg( frame, 0 ) );
|
||||
struct pso_pointer cursor = make_string( frame_pointer, url_fgetwc( stream ), nil );
|
||||
struct pso_pointer cursor = make_string( frame_pointer,
|
||||
url_fgetwc( stream ), nil );
|
||||
result = cursor;
|
||||
|
||||
for ( wint_t c = url_fgetwc( stream ); !url_feof( stream ) && c != 0;
|
||||
c = url_fgetwc( stream ) ) {
|
||||
debug_print( L"slurp: cursor is: ", DEBUG_IO, 0 );
|
||||
|
|
@ -719,7 +694,6 @@ struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer,
|
|||
debug_print( L"; result is: ", DEBUG_IO, 0 );
|
||||
debug_dump_object( result, DEBUG_IO, 0 );
|
||||
debug_println( DEBUG_IO );
|
||||
|
||||
struct pso2 *cell = pointer_to_object( cursor );
|
||||
cursor = make_string( frame_pointer, ( char32_t ) c, nil );
|
||||
cell->payload.string.cdr = cursor;
|
||||
|
|
|
|||
|
|
@ -12,6 +12,13 @@
|
|||
#define __psse_io_io_h
|
||||
#include <curl/curl.h>
|
||||
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
#include <uchar.h>
|
||||
#include <wchar.h>
|
||||
#include <wctype.h>
|
||||
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
|
|
@ -19,7 +26,9 @@
|
|||
extern CURLSH *io_share;
|
||||
|
||||
int initialise_io( );
|
||||
struct pso_pointer initialise_default_streams( struct pso_pointer env );
|
||||
struct pso_pointer initialise_default_streams( struct pso_pointer
|
||||
frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
#define C_IO_IN L"*in*"
|
||||
#define C_IO_OUT L"*out*"
|
||||
|
|
|
|||
|
|
@ -42,6 +42,7 @@
|
|||
#include "payloads/exception.h"
|
||||
#include "payloads/integer.h"
|
||||
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
|
||||
|
|
@ -78,7 +79,7 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
|
|||
}
|
||||
|
||||
if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
|
||||
for ( struct pso_pointer cursor = p; !nilp( cursor );
|
||||
for ( struct pso_pointer cursor = p; !c_nilp( cursor );
|
||||
cursor = pointer_to_object( cursor )->payload.string.cdr ) {
|
||||
char32_t wc =
|
||||
pointer_to_object( cursor )->payload.string.character;
|
||||
|
|
@ -190,7 +191,9 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
|
|||
* This is kind of modelled after the implementation of PRIN* variants on page
|
||||
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
|
||||
*
|
||||
* @param p pointer to the object to print.
|
||||
* (write object stream escape? nl_before? nl_after?)
|
||||
*
|
||||
* @param object pointer to the object to print.
|
||||
* @param output stream to print to.
|
||||
* @param escape if true, print everything so that it can be read by the Lisp
|
||||
* reader; otherwise, print it appropriately for human readers.
|
||||
|
|
@ -198,9 +201,14 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
|
|||
* @param nl_after if true, print a newline *after* printing `p`; else a space.
|
||||
* @return p on success, exception on failure.
|
||||
*/
|
||||
struct pso_pointer write( struct pso_pointer p, struct pso_pointer stream,
|
||||
bool escape, bool nl_before, bool nl_after ) {
|
||||
struct pso_pointer result = p;
|
||||
struct pso_pointer write( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer object = fetch_arg( frame, 0 );
|
||||
struct pso_pointer stream = fetch_arg( frame, 1 );
|
||||
bool escape = c_truep( fetch_arg( frame, 2 ) );
|
||||
bool nl_before = c_truep( fetch_arg( frame, 3 ) );
|
||||
bool nl_after = c_truep( fetch_arg( frame, 4 ) );
|
||||
struct pso_pointer result = object;
|
||||
URL_FILE *output = writep( stream )
|
||||
? pointer_to_object( stream )->payload.stream.stream
|
||||
: file_to_url_file( stdout );
|
||||
|
|
@ -211,16 +219,17 @@ struct pso_pointer write( struct pso_pointer p, struct pso_pointer stream,
|
|||
if ( nl_before )
|
||||
url_fputwc( L'\n', output );
|
||||
|
||||
result = in_write( p, output, true );
|
||||
result = in_write( object, output, true );
|
||||
|
||||
url_fputwc( nl_after ? L'\n' : L' ', output );
|
||||
|
||||
dec_ref( stream );
|
||||
} else {
|
||||
result =
|
||||
make_exception( c_string_to_lisp_string
|
||||
( L"Bad write stream passed to write." ), nil, nil,
|
||||
nil );
|
||||
make_exception( make_frame( 1, frame_pointer,
|
||||
c_string_to_lisp_string
|
||||
( frame_pointer,
|
||||
L"Bad write stream passed to write." ) ) );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -233,13 +242,21 @@ struct pso_pointer write( struct pso_pointer p, struct pso_pointer stream,
|
|||
* @param stream if a pointer to an open write stream, print to there.
|
||||
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
|
||||
*/
|
||||
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
|
||||
return write( p, stream, true, true, false );
|
||||
struct pso_pointer print( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
return write( make_frame( 5, frame_pointer,
|
||||
fetch_arg( frame, 0 ), fetch_arg( frame, 1 ), t,
|
||||
t, nil ) );
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief princ is pretty much like print except things are printed `unescaped`
|
||||
*/
|
||||
struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream ) {
|
||||
return write( p, stream, false, true, false );
|
||||
struct pso_pointer princ( struct pso_pointer frame_pointer ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
return write( make_frame( 5, frame_pointer,
|
||||
fetch_arg( frame, 0 ), fetch_arg( frame, 1 ),
|
||||
nil, t, nil ) );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -16,8 +16,8 @@
|
|||
#include <stdbool.h>
|
||||
|
||||
#include "io/fopen.h"
|
||||
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream );
|
||||
struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream );
|
||||
struct pso_pointer print( struct pso_pointer frame_pointer );
|
||||
struct pso_pointer princ( struct pso_pointer frame_pointer );
|
||||
|
||||
#define PRINT_VARIANT_PRINT 0
|
||||
#define PRINT_VARIANT_PRIN1 1
|
||||
|
|
|
|||
|
|
@ -98,12 +98,7 @@ struct pso_pointer read_example(
|
|||
* 1. The read table currently in use;
|
||||
* 2. The character most recently read from that stream.
|
||||
*/
|
||||
struct pso_pointer read_number(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
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 );
|
||||
|
|
@ -115,10 +110,10 @@ struct pso_pointer read_number(
|
|||
int64_t value = 0;
|
||||
|
||||
if ( readp( stream ) ) {
|
||||
if ( nilp( character ) ) {
|
||||
if ( c_nilp( character ) ) {
|
||||
character = get_character( stream );
|
||||
}
|
||||
char32_t c = nilp( character )
|
||||
char32_t c = c_nilp( character )
|
||||
? 0 : pointer_to_object( character )->payload.character.character;
|
||||
|
||||
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
|
||||
|
|
@ -127,18 +122,13 @@ struct pso_pointer read_number(
|
|||
}
|
||||
|
||||
url_ungetwc( c, input );
|
||||
result = make_integer( value );
|
||||
result = make_integer( frame_pointer, value );
|
||||
} // else exception?
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
struct pso_pointer read_symbol(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
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 );
|
||||
|
|
@ -146,16 +136,17 @@ struct pso_pointer read_symbol(
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if ( readp( stream ) ) {
|
||||
if ( nilp( character ) ) {
|
||||
if ( c_nilp( character ) ) {
|
||||
character = get_character( stream );
|
||||
}
|
||||
|
||||
char32_t c = nilp( character )
|
||||
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( c, result, SYMBOLTAG );
|
||||
result =
|
||||
make_string_like_thing( frame_pointer, c, result, SYMBOLTAG );
|
||||
}
|
||||
|
||||
url_ungetwc( c, input );
|
||||
|
|
@ -176,12 +167,7 @@ struct pso_pointer read_symbol(
|
|||
* 1. The read table currently in use;
|
||||
* 2. The character most recently read from that stream.
|
||||
*/
|
||||
struct pso_pointer read(
|
||||
#ifndef MANAGED_POINTER_ONLY
|
||||
struct pso4 *frame,
|
||||
#endif
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
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 );
|
||||
|
|
@ -189,22 +175,23 @@ struct pso_pointer read(
|
|||
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( nilp( stream ) ) {
|
||||
stream = make_read_stream( file_to_url_file( stdin ), nil );
|
||||
if ( c_nilp( stream ) ) {
|
||||
stream =
|
||||
make_read_stream( frame_pointer, file_to_url_file( stdin ), nil );
|
||||
}
|
||||
|
||||
if ( nilp( readtable ) ) {
|
||||
if ( c_nilp( readtable ) ) {
|
||||
// TODO: check for the value of `*read-table*` in the environment and
|
||||
// use that.
|
||||
}
|
||||
|
||||
if ( nilp( character ) ) {
|
||||
if ( c_nilp( character ) ) {
|
||||
character = get_character( stream );
|
||||
}
|
||||
|
||||
struct pso_pointer readmacro = c_assoc( character, readtable );
|
||||
|
||||
if ( !nilp( readmacro ) ) {
|
||||
if ( !c_nilp( readmacro ) ) {
|
||||
// invoke the read macro on the stream
|
||||
} else if ( readp( stream ) && characterp( character ) ) {
|
||||
char32_t c =
|
||||
|
|
@ -228,12 +215,13 @@ struct pso_pointer read(
|
|||
default:
|
||||
struct pso_pointer next = make_frame( 3, frame_pointer, stream,
|
||||
readtable,
|
||||
make_character( c ) );
|
||||
make_character
|
||||
( frame_pointer, c ) );
|
||||
inc_ref( next );
|
||||
if ( iswdigit( c ) ) {
|
||||
result = read_number( next, env );
|
||||
result = read_number( next );
|
||||
} else if ( iswalpha( c ) ) {
|
||||
result = read_symbol( next, env );
|
||||
result = read_symbol( next );
|
||||
} else {
|
||||
// result =
|
||||
// throw_exception(
|
||||
|
|
|
|||
|
|
@ -13,13 +13,10 @@
|
|||
|
||||
#ifndef __psse_io_read_h
|
||||
#define __psse_io_read_h
|
||||
struct pso_pointer read_number( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
struct pso_pointer read_number( struct pso_pointer frame_pointer );
|
||||
|
||||
struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
struct pso_pointer read_symbol( struct pso_pointer frame_pointer );
|
||||
|
||||
struct pso_pointer read( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
struct pso_pointer read( struct pso_pointer frame_pointer );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue