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

Right, I'm committing this session because I'm too cold and tired to go on.

Browse source 
It does not at present build (and it's going to take a good bit more work
before it does).
This commit is contained in:
Simon Brooke 2026-04-20 18:29:28 +01:00
parent f05d1af9d6
commit 6148d3699f
32 changed files with 364 additions and 309 deletions
Download patch file Download diff file Expand all files Collapse all files

46
src/c/io/io.c
View file

@ -150,9 +150,9 @@ int initialise_io( ) {
}
struct pso_pointer initialise_default_streams( 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?
// 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 );
@ -168,11 +168,11 @@ struct pso_pointer initialise_default_streams( struct pso_pointer 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 ) ) );
( 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 );
@ -183,10 +183,10 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
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 ) ) );
( 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 );
}
@ -196,10 +196,10 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
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" ) ),
nil ) ) );
( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_string
( L"::system:standard-output" ) ),
nil ) ) );
env = c_bind( lisp_io_log, lisp_stderr, env );
}
@ -420,29 +420,29 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
struct pso_pointer add_meta_integer( struct pso_pointer meta, char32_t *key,
long int value ) {
// todo: issue #21: must have stack frame passed in.
// todo: issue #21: must have stack frame passed in.
return
make_cons( make_cons
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
meta );
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
meta );
}
struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key,
char *value ) {
// todo: issue #21: must have stack frame passed in.
// todo: issue #21: must have stack frame passed in.
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( key ),
c_string_to_lisp_string( buffer ) ), meta );
( c_string_to_lisp_keyword( key ),
c_string_to_lisp_string( buffer ) ), meta );
}
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.
// todo: issue #21: must have stack frame passed in.
char datestring[256];
strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ),

2
src/c/io/io.h
View file

@ -21,7 +21,7 @@ extern CURLSH *io_share;
int initialise_io( );
struct pso_pointer initialise_default_streams( struct pso_pointer env );
#define C_IO_IN L"*in*"
#define C_IO_IN L"*in*"
#define C_IO_OUT L"*out*"
#define C_IO_LOG L"*log*"

256
src/c/io/print.c
View file

@ -44,9 +44,9 @@
#include "ops/truth.h"
struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output,
bool escape);
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool escape );
/**
* @brief write this character `wc` to this `output` stream, escaping it if
* 1. `escape` is true; and
@ -54,75 +54,77 @@ struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output,
*
* TODO: this does not yet even nearly cope with all the possible special
* cases.
*/
void write_char( char32_t wc, URL_FILE * output, bool escape) {
if (escape && !iswprint(wc)) {
url_fwprintf(output, L"\\%04x", wc);
// url_fputwc(L'\\', output);
} else {
url_fputwc(wc, output);
}
*/
void write_char( char32_t wc, URL_FILE *output, bool escape ) {
if ( escape && !iswprint( wc ) ) {
url_fwprintf( output, L"\\%04x", wc );
// url_fputwc(L'\\', output);
} else {
url_fputwc( wc, output );
}
}
struct pso_pointer print_string_like_thing(struct pso_pointer p,
URL_FILE *output, bool escape) {
switch (get_tag_value(p)) {
case KEYTV:
url_fputwc(L':', output);
break;
case STRINGTV:
if (escape)
url_fputwc(L'"', output);
break;
}
struct pso_pointer print_string_like_thing( struct pso_pointer p,
URL_FILE *output, bool escape ) {
switch ( get_tag_value( p ) ) {
case KEYTV:
url_fputwc( L':', output );
break;
case STRINGTV:
if ( escape )
url_fputwc( L'"', output );
break;
}
if (keywordp(p) || stringp(p) || symbolp(p)) {
for (struct pso_pointer cursor = p; !nilp(cursor);
cursor = pointer_to_object(cursor)->payload.string.cdr) {
char32_t wc = pointer_to_object(cursor)->payload.string.character;
if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
for ( struct pso_pointer cursor = p; !nilp( cursor );
cursor = pointer_to_object( cursor )->payload.string.cdr ) {
char32_t wc =
pointer_to_object( cursor )->payload.string.character;
write_char( wc, output, escape);
}
}
write_char( wc, output, escape );
}
}
if (stringp(p)) {
if (escape)
url_fputwc(L'"', output);
}
return p;
if ( stringp( p ) ) {
if ( escape )
url_fputwc( L'"', output );
}
return p;
}
struct pso_pointer write_list_content(struct pso_pointer p, URL_FILE *output,
bool escape) {
struct pso_pointer result = nil;
struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
bool escape ) {
struct pso_pointer result = nil;
if (consp(p)) {
for (; consp(p); p = c_cdr(p)) {
struct pso2 *object = pointer_to_object(p);
if ( consp( p ) ) {
for ( ; consp( p ); p = c_cdr( p ) ) {
struct pso2 *object = pointer_to_object( p );
result = in_write(object->payload.cons.car, output, escape);
result = in_write( object->payload.cons.car, output, escape );
if (exceptionp(result))
break;
if ( exceptionp( result ) )
break;
switch (get_tag_value(object->payload.cons.cdr)) {
case NILTV:
break;
case CONSTV:
url_fputwc(L' ', output);
break;
default:
url_fputws(L" . ", output);
result = in_write(object->payload.cons.cdr, output, escape);
}
}
} else {
// TODO: return exception
}
switch ( get_tag_value( object->payload.cons.cdr ) ) {
case NILTV:
break;
case CONSTV:
url_fputwc( L' ', output );
break;
default:
url_fputws( L" . ", output );
result =
in_write( object->payload.cons.cdr, output, escape );
}
}
} else {
// TODO: return exception
}
return result;
return result;
}
/**
@ -135,52 +137,53 @@ struct pso_pointer write_list_content(struct pso_pointer p, URL_FILE *output,
* reader; otherwise, print it appropriately for human readers.
* @return p on success, exception on failure.
*/
struct pso_pointer in_write(struct pso_pointer p, URL_FILE *output,
bool escape) {
struct pso2 *object = pointer_to_object(p);
struct pso_pointer result = nil;
struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
bool escape ) {
struct pso2 *object = pointer_to_object( p );
struct pso_pointer result = nil;
if (object != NULL) {
uint32_t v = get_tag_value(p);
switch (v) {
case CHARACTERTV:
write_char(object->payload.character.character, output, escape);
break;
case CONSTV:
url_fputwc(L'(', output);
result = write_list_content(p, output, escape);
url_fputwc(L')', output);
break;
case INTEGERTV:
url_fwprintf(output, L"%d",
(int64_t)(object->payload.integer.value));
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
print_string_like_thing(p, output, escape);
break;
case NILTV:
url_fputws(L"nil", output);
break;
case READTV:
case WRITETV:
url_fwprintf(output, L"<%s stream: ",
v == READTV ? "read" : "write");
in_write(object->payload.stream.meta, output, escape);
url_fputwc(L'>', output);
break;
case TRUETV:
url_fputwc(L't', output);
break;
default:
// TODO: return exception
}
} else {
// TODO: return exception
}
if ( object != NULL ) {
uint32_t v = get_tag_value( p );
switch ( v ) {
case CHARACTERTV:
write_char( object->payload.character.character, output,
escape );
break;
case CONSTV:
url_fputwc( L'(', output );
result = write_list_content( p, output, escape );
url_fputwc( L')', output );
break;
case INTEGERTV:
url_fwprintf( output, L"%d",
( int64_t ) ( object->payload.integer.value ) );
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
print_string_like_thing( p, output, escape );
break;
case NILTV:
url_fputws( L"nil", output );
break;
case READTV:
case WRITETV:
url_fwprintf( output, L"<%s stream: ",
v == READTV ? "read" : "write" );
in_write( object->payload.stream.meta, output, escape );
url_fputwc( L'>', output );
break;
case TRUETV:
url_fputwc( L't', output );
break;
default:
// TODO: return exception
}
} else {
// TODO: return exception
}
return result;
return result;
}
/**
@ -195,31 +198,32 @@ 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;
URL_FILE *output = writep(stream)
? pointer_to_object(stream)->payload.stream.stream
: file_to_url_file(stdout);
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;
URL_FILE *output = writep( stream )
? pointer_to_object( stream )->payload.stream.stream
: file_to_url_file( stdout );
if (writep(stream)) {
inc_ref(stream);
if ( writep( stream ) ) {
inc_ref( stream );
if (nl_before)
url_fputwc(L'\n', output);
if ( nl_before )
url_fputwc( L'\n', output );
result = in_write(p, output, true);
result = in_write( p, output, true );
url_fputwc(nl_after ? L'\n' : L' ', output);
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);
}
dec_ref( stream );
} else {
result =
make_exception( c_string_to_lisp_string
( L"Bad write stream passed to write." ), nil, nil,
nil );
}
return result;
return result;
}
/**
@ -229,13 +233,13 @@ 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 c_print( struct pso_pointer p, struct pso_pointer stream ) {
return write( p, stream, true, true, false );
}
/**
* @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 c_princ( struct pso_pointer p, struct pso_pointer stream ) {
return write( p, stream, false, true, false );
}