simon/post-scarcity
1
0
Fork 0
Code Issues 15 Pull requests Projects Releases Packages Wiki Activity Actions

Well, we have a REPL. It blows up horribly, but we have one.

Browse source
This commit is contained in:
Simon Brooke 2026-04-17 14:20:31 +01:00
parent 4efe9eab87
commit cf05e30540
19 changed files with 422 additions and 144 deletions
Download patch file Download diff file Expand all files Collapse all files

187
src/c/io/io.c
View file

@ -15,9 +15,9 @@
#include <pwd.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <time.h>
#include <unistd.h>
#include <uuid/uuid.h>
/*
@ -28,7 +28,7 @@
#include <curl/curl.h>
//#include "arith/integer.h"
// #include "arith/integer.h"
#include "debug.h"
#include "io/fopen.h"
#include "io/io.h"
@ -42,6 +42,8 @@
// #include "ops/intern.h"
// #include "ops/lispops.h"
#include "ops/assoc.h"
#include "ops/bind.h"
#include "ops/stack_ops.h"
#include "ops/string_ops.h"
#include "ops/truth.h"
@ -50,7 +52,9 @@
#include "payloads/cons.h"
#include "payloads/exception.h"
#include "payloads/integer.h"
#include "payloads/read_stream.h"
#include "payloads/stack.h"
#include "payloads/write_stream.h"
#include "utils.h"
@ -62,21 +66,36 @@
CURLSH *io_share;
/**
* @brief bound to the Lisp string representing C_IO_IN in initialisation.
* @brief bound to the Lisp symbol representing C_IO_IN in initialisation.
*/
struct pso_pointer lisp_io_in;
/**
* @brief bound to the Lisp string representing C_IO_OUT in initialisation.
* @brief bound to the Lisp symbol representing C_IO_OUT in initialisation.
*/
struct pso_pointer lisp_io_out;
/**
* Allow a one-character unget facility. This may not be enough - we may need
* to allocate a buffer.
*/
wint_t ungotten = 0;
/**
* given this file handle f, return a new url_file handle wrapping it.
*
* @param f the file to be wrapped;
* @return the new handle, or null if no such handle could be allocated.
*/
URL_FILE *file_to_url_file( FILE *f ) {
URL_FILE *result = ( URL_FILE * ) malloc( sizeof( URL_FILE ) );
if ( result != NULL ) {
result->type = CFTYPE_FILE, result->handle.file = f;
}
return result;
}
/**
* Initialise the I/O subsystem.
*
@ -99,6 +118,32 @@ int initialise_io( ) {
return result;
}
struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
lisp_io_in = c_string_to_lisp_symbol( C_IO_IN );
lisp_io_out = c_string_to_lisp_symbol( C_IO_OUT );
env = c_bind( lisp_io_in,
make_read_stream( file_to_url_file( stdin ),
c_cons( c_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard input" ) ),
nil ) ), env );
if ( !nilp( env ) && !exceptionp( env ) ) {
env = c_bind( lisp_io_out,
make_write_stream( file_to_url_file( stdout ),
c_cons( c_cons
( c_string_to_lisp_keyword
( L"url" ),
c_string_to_lisp_string
( L"system:standard input" ) ),
nil ) ), env );
}
return env;
}
/**
* Convert this lisp string-like-thing (also works for symbols, and, later
* keywords) into a UTF-8 string. NOTE that the returned value has been
@ -138,24 +183,6 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
return result;
}
/**
* given this file handle f, return a new url_file handle wrapping it.
*
* @param f the file to be wrapped;
* @return the new handle, or null if no such handle could be allocated.
*/
URL_FILE *file_to_url_file( FILE *f ) {
URL_FILE *result = ( URL_FILE * ) malloc( sizeof( URL_FILE ) );
if ( result != NULL ) {
result->type = CFTYPE_FILE, result->handle.file = f;
}
return result;
}
/**
* get one wide character from the buffer.
*
@ -193,13 +220,15 @@ wint_t url_fgetwc( URL_FILE *input ) {
debug_printf( DEBUG_IO, 0,
L"url_fgetwc: cbuff is '%s'; (first) character = %d (%c)\n",
cbuff, c, c & 0xf7 );
/* The value of each individual byte indicates its UTF-8 function, as follows:
/* The value of each individual byte indicates its UTF-8 function,
* as follows:
*
* 00 to 7F hex (0 to 127): first and only byte of a sequence.
* 80 to BF hex (128 to 191): continuing byte in a multi-byte sequence.
* C2 to DF hex (194 to 223): first byte of a two-byte sequence.
* E0 to EF hex (224 to 239): first byte of a three-byte sequence.
* F0 to FF hex (240 to 255): first byte of a four-byte sequence.
* 80 to BF hex (128 to 191): continuing byte in a multi-byte
* sequence. C2 to DF hex (194 to 223): first byte of a two-byte
* sequence. E0 to EF hex (224 to 239): first byte of a three-byte
* sequence. F0 to FF hex (240 to 255): first byte of a four-byte
* sequence.
*/
if ( c <= 0xf7 ) {
count = 1;
@ -219,8 +248,7 @@ wint_t url_fgetwc( URL_FILE *input ) {
free( wbuff );
free( cbuff );
}
break;
} break;
case CFTYPE_NONE:
break;
}
@ -265,8 +293,8 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
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;
@ -286,8 +314,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
if ( characterp( c ) && readp( r ) ) {
if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.
character.character ),
( pointer_to_object( c )->payload.character.
character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
result = t;
@ -308,16 +336,14 @@ struct pso_pointer push_back_character( struct pso_pointer c,
* @param env my environment.
* @return T if the stream was successfully closed, else nil.
*/
struct pso_pointer
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) {
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;
}
}
@ -328,8 +354,9 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) {
struct pso_pointer add_meta_integer( struct pso_pointer meta, wchar_t *key,
long int value ) {
return
c_cons( c_cons( c_string_to_lisp_keyword( key ),
make_integer( value ) ), meta );
c_cons( c_cons
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
meta );
}
struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key,
@ -338,8 +365,10 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key,
wchar_t buffer[strlen( value ) + 1];
mbstowcs( buffer, value, strlen( value ) + 1 );
return c_cons( c_cons( c_string_to_lisp_keyword( key ),
c_string_to_lisp_string( buffer ) ), meta );
return
c_cons( c_cons
( c_string_to_lisp_keyword( key ),
c_string_to_lisp_string( buffer ) ), meta );
}
struct pso_pointer add_meta_time( struct pso_pointer meta, wchar_t *key,
@ -348,9 +377,8 @@ struct pso_pointer add_meta_time( struct pso_pointer meta, wchar_t *key,
* bit of an oversight! */
char datestring[256];
strftime( datestring,
sizeof( datestring ),
nl_langinfo( D_T_FMT ), localtime( value ) );
strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ),
localtime( value ) );
return add_meta_string( meta, key, datestring );
}
@ -386,8 +414,8 @@ static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
// 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 );
// 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] );
@ -400,16 +428,17 @@ static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
// 10 ) );
// debug_printf( DEBUG_IO,
// L"write_meta_callback: added header 'status': value '%s'\n",
// value );
// L"write_meta_callback: added header 'status': value
// '%s'\n", value );
// } else {
// debug_printf( DEBUG_IO,
// L"write_meta_callback: header passed with no colon: '%s'\n",
// s );
// L"write_meta_callback: header passed with no colon:
// '%s'\n", s );
// }
// } else {
// debug_print
// ( L"Pointer passed to write_meta_callback did not point to a stream: ",
// ( L"Pointer passed to write_meta_callback did not point to a
// stream: ",
// DEBUG_IO );
// debug_dump_object( stream, DEBUG_IO );
// }
@ -471,13 +500,28 @@ 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;
struct pso_pointer stream_name = inputp ? lisp_io_in : lisp_io_out;
// result = c_assoc( stream_name, env );
result = c_assoc( stream_name, env );
return result;
}
/**
* @brief if `s` points to either an input or an output stream, return the
* URL_FILE pointer underlying that stream, else NULL.
*/
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;
}
return result;
}
/**
* Function: return a stream open on the URL indicated by the first argument;
@ -494,8 +538,8 @@ struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
* @return a string of one character, namely the next available character
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
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;
@ -505,10 +549,10 @@ lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
// if ( 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 );
// 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:
@ -561,16 +605,16 @@ lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
* @return a string of one character, namely the next available character
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
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;
if ( readp( fetch_arg( frame, 0 ) ) ) {
struct pso_pointer stream_pointer = fetch_arg( frame, 0 );
if ( readp( stream_pointer ) ) {
result =
make_string( url_fgetwc
( pointer_to_object( fetch_arg( frame, 0 ) )->
payload.stream.stream ), nil );
make_string( url_fgetwc( stream_get_url_file( stream_pointer ) ),
nil );
}
return result;
@ -590,14 +634,13 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
* @return a string of one character, namely the next available character
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env ) {
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 =
pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.stream;
URL_FILE *stream = stream_get_url_file( fetch_arg( frame, 0 ) );
struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil );
result = cursor;