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

Converted everything to the new lisp calling convention.

Browse source 
Fixes #19
This commit is contained in:
Simon Brooke 2026-04-01 17:11:10 +01:00
parent f3a26bc02e
commit b6480aebd5
53 changed files with 590 additions and 520 deletions
Download patch file Download diff file Expand all files Collapse all files

90
src/c/io/io.c
View file

@ -114,8 +114,7 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
if ( stringp( s ) || symbolp( s ) ) {
int len = 0;
for ( struct pso_pointer c = s; !nilp( c );
c = cdr(c)) {
for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) {
len++;
}
@ -124,8 +123,7 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
result = calloc( ( len * 4 ) + 1, sizeof( char ) );
int i = 0;
for ( struct pso_pointer c = s; !nilp( c );
c = cdr(c)) {
for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) {
buffer[i++] = pointer_to_object( c )->payload.string.character;
}
@ -134,7 +132,7 @@ 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_print_object( s, DEBUG_IO, 0 );
debug_printf( DEBUG_IO, 0, L") => '%s'\n", result );
return result;
@ -262,13 +260,16 @@ wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
* @return a pointer to a character object on success, or `nil` on failure.
*/
struct pso_pointer get_character( struct pso_pointer read_stream ) {
struct pso_pointer result = nil;
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));
}
if ( readp( read_stream ) ) {
result =
make_character( url_fgetwc
( pointer_to_object_of_size_class
( read_stream, 2 )->payload.stream.stream ) );
}
return result;
return result;
}
/**
@ -279,16 +280,20 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
*
* @return `t` on success, else `nil`.
*/
struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r) {
struct pso_pointer result = nil;
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.character),
pointer_to_object(r)->payload.stream.stream) >= 0) {
result = t;
}
}
return result;
if ( characterp( c ) && readp( r ) ) {
if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.character.
character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
result = t;
}
}
return result;
}
/**
@ -304,12 +309,14 @@ struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer
* @return T if the stream was successfully closed, else nil.
*/
struct pso_pointer
lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
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 )
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 ) {
result = t;
}
@ -319,25 +326,25 @@ lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
}
struct pso_pointer add_meta_integer( struct pso_pointer meta, wchar_t *key,
long int value ) {
long int value ) {
return
cons( 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, wchar_t *key,
char *value ) {
char *value ) {
value = trim( value );
wchar_t buffer[strlen( value ) + 1];
mbstowcs( buffer, value, strlen( value ) + 1 );
return cons( cons( c_string_to_lisp_keyword( key ),
c_string_to_lisp_string( buffer ) ), meta );
c_string_to_lisp_string( buffer ) ), meta );
}
struct pso_pointer add_meta_time( struct pso_pointer meta, wchar_t *key,
time_t *value ) {
time_t *value ) {
/* I don't yet have a concept of a date-time object, which is a
* bit of an oversight! */
char datestring[256];
@ -409,7 +416,7 @@ static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
// }
// free( s );
return 0; // strlen( string );
return 0; // strlen( string );
}
void collect_meta( struct pso_pointer stream, char *url ) {
@ -489,8 +496,8 @@ struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
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) ) ) {
@ -556,14 +563,14 @@ lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
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) ) ) {
if ( readp( fetch_arg( frame, 0 ) ) ) {
result =
make_string( url_fgetwc
( pointer_to_object( fetch_arg( frame, 0) )->payload.
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
stream.stream ), nil );
}
@ -585,18 +592,19 @@ lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
* on my stream, if any, else nil.
*/
struct pso_pointer
lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env ) {
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;
if ( readp( fetch_arg( frame, 0 ) ) ) {
URL_FILE *stream =
pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.stream;
struct pso_pointer cursor = make_string( 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);
debug_print( L"slurp: cursor is: ", DEBUG_IO, 0 );
debug_dump_object( cursor, DEBUG_IO, 0 );
debug_print( L"; result is: ", DEBUG_IO, 0 );
debug_dump_object( result, DEBUG_IO, 0 );

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

@ -8,8 +8,8 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#ifndef __psse_io_h
#define __psse_io_h
#ifndef __psse_io_io_h
#define __psse_io_io_h
#include <curl/curl.h>
#include "memory/pointer.h"
@ -32,22 +32,19 @@ wint_t url_ungetwc( wint_t wc, URL_FILE * input );
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 push_back_character( struct pso_pointer c,
struct pso_pointer r );
struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env );
struct pso_pointer
lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env );
struct pso_pointer
lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env );
struct pso_pointer
lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env );
struct pso_pointer
lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer env );
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env );
char *lisp_string_to_c_string( struct pso_pointer s );
#endif

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

@ -36,28 +36,29 @@
#include "payloads/cons.h"
#include "payloads/integer.h"
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output);
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE * output) {
struct pso_pointer result = nil;
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) {
struct pso_pointer result = nil;
if (consp(p)) {
for (; consp( p); p = cdr(p)) {
struct pso2* object = pointer_to_object(p);
result = in_print( object->payload.cons.car, output);
if ( consp( p ) ) {
for ( ; consp( p ); p = cdr( p ) ) {
struct pso2 *object = pointer_to_object( p );
if (exceptionp(result)) break;
result = in_print( object->payload.cons.car, output );
switch (get_tag_value(object->payload.cons.cdr)) {
case NILTV :
if ( exceptionp( result ) )
break;
switch ( get_tag_value( object->payload.cons.cdr ) ) {
case NILTV:
break;
case CONSTV :
case CONSTV:
url_fputwc( L' ', output );
break;
default :
url_fputws( L" . ", output);
result = in_print( object->payload.cons.cdr, output);
default:
url_fputws( L" . ", output );
result = in_print( object->payload.cons.cdr, output );
}
}
@ -68,33 +69,34 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE * output)
return result;
}
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output) {
struct pso2* object = pointer_to_object(p);
struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
struct pso2 *object = pointer_to_object( p );
struct pso_pointer result = nil;
if (object != NULL) {
switch (get_tag_value( p)) {
case CHARACTERTV :
url_fputwc( object->payload.character.character, output);
if ( object != NULL ) {
switch ( get_tag_value( p ) ) {
case CHARACTERTV:
url_fputwc( object->payload.character.character, output );
break;
case CONSTV :
case CONSTV:
url_fputwc( L'(', output );
result = print_list_content( p, output);
result = print_list_content( p, output );
url_fputwc( L')', output );
break;
case INTEGERTV :
url_fwprintf( output, L"%d", (int64_t)(object->payload.integer.value));
case INTEGERTV:
url_fwprintf( output, L"%d",
( int64_t ) ( object->payload.integer.value ) );
break;
case TRUETV :
case TRUETV:
url_fputwc( L't', output );
break;
case NILTV :
case NILTV:
url_fputws( L"nil", output );
default :
default:
// TODO: return exception
}
} else {
// TODO: return exception
// TODO: return exception
}
return result;
@ -107,16 +109,20 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output) {
* @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 print( struct pso_pointer p, struct pso_pointer stream) {
URL_FILE *output = writep( stream) ?
pointer_to_object( stream )->payload.stream.stream :
file_to_url_file(stdout);
struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ) {
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 );
}
struct pso_pointer result = in_print(p, output);
struct pso_pointer result = in_print( p, output );
if ( writep( stream)) { dec_ref( stream); }
if ( writep( stream ) ) {
dec_ref( stream );
}
return result;
}

4
src/c/io/print.h
View file

@ -14,6 +14,6 @@
#ifndef __psse_io_print_h
#define __psse_io_print_h
struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream);
struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream );
#endif
#endif

164
src/c/io/read.c
View file

@ -73,14 +73,14 @@
* 2. The character most recently read from that stream.
*/
struct pso_pointer read_example( struct pso_pointer frame_pointer,
struct pso_pointer env) {
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;
struct pso_pointer env ) {
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;
return result;
}
/**
@ -94,64 +94,62 @@ struct pso_pointer read_example( struct pso_pointer frame_pointer,
* 2. The character most recently read from that stream.
*/
struct pso_pointer read_number( struct pso_pointer frame_pointer,
struct pso_pointer env) {
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;
struct pso_pointer env ) {
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;
int base = 10;
// TODO: should check for *read-base* in the environment
int64_t value = 0;
if (readp(stream)) {
if (nilp( character)) {
character = get_character( stream);
}
wchar_t c = nilp(character) ? 0 :
pointer_to_object( character)->payload.character.character;
if ( readp( stream ) ) {
if ( nilp( character ) ) {
character = get_character( stream );
}
wchar_t 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_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( value);
} // else exception?
url_ungetwc( c, input );
result = make_integer( value );
} // else exception?
return result;
return result;
}
struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
struct pso_pointer env) {
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;
struct pso_pointer env ) {
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 (nilp( character)) {
character = get_character( stream);
}
if ( readp( stream ) ) {
if ( nilp( character ) ) {
character = get_character( stream );
}
wchar_t c = nilp(character) ? 0 :
pointer_to_object( character)->payload.character.character;
wchar_t 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);
}
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 );
}
url_ungetwc( c, input);
result = reverse( result);
}
url_ungetwc( c, input );
result = reverse( result );
}
return result;
return result;
}
/**
@ -166,34 +164,35 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
* 2. The character most recently read from that stream.
*/
struct pso_pointer read( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
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 env ) {
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;
struct pso_pointer result = nil;
if (nilp(stream)) {
stream = make_read_stream( file_to_url_file(stdin), nil);
}
if ( nilp( stream ) ) {
stream = make_read_stream( file_to_url_file( stdin ), nil );
}
if (nilp( readtable)) {
// TODO: check for the value of `*read-table*` in the environment and
// use that.
}
if ( nilp( readtable ) ) {
// TODO: check for the value of `*read-table*` in the environment and
// use that.
}
if (nilp( character)) {
character = get_character( stream);
}
if ( nilp( character ) ) {
character = get_character( stream );
}
struct pso_pointer readmacro = assoc(character, readtable);
struct pso_pointer readmacro = assoc( character, readtable );
if (!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;
if ( !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;
switch ( c ) {
case ';':
@ -208,11 +207,12 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
// frame_pointer );
break;
default:
struct pso_pointer next = make_frame( frame_pointer, stream, readtable, make_character(c));
inc_ref( next);
if ( iswdigit( c ) ) {
result =
read_number( next, env );
struct pso_pointer next =
make_frame( frame_pointer, stream, readtable,
make_character( c ) );
inc_ref( next );
if ( iswdigit( c ) ) {
result = read_number( next, env );
} else if ( iswalpha( c ) ) {
result = read_symbol( next, env );
} else {
@ -223,10 +223,10 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
// make_string( c, NIL ) ),
// frame_pointer );
}
dec_ref( next);
dec_ref( next );
break;
}
}
}
return result;
return result;
}

25
src/c/io/read.h
View file

@ -0,0 +1,25 @@
/**
* read.h
*
* 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.
*/
#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_symbol( struct pso_pointer frame_pointer,
struct pso_pointer env );
struct pso_pointer read( struct pso_pointer frame_pointer,
struct pso_pointer env );
#endif