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

Fixed, working.

Browse source
This commit is contained in:
Simon Brooke 2019-01-29 22:36:20 +00:00
parent eb394d153f
commit f9bcac10e7
14 changed files with 159 additions and 155 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
src/init.c
View file

@ -41,17 +41,16 @@
* more readable and aid debugging generally. * more readable and aid debugging generally.
*/ */
void bind_function( wchar_t *name, struct cons_pointer ( *executable ) void bind_function( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta = make_cons( struct cons_pointer meta =
make_cons(c_string_to_lisp_keyword(L"primitive"), TRUE), make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
c_string_to_lisp_keyword(L"name"), n ),
n), NIL ) );
NIL));
deep_bind( n, make_function( meta, executable ) ); deep_bind( n, make_function( meta, executable ) );
} }
/** /**
@ -62,12 +61,11 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta = make_cons( struct cons_pointer meta =
make_cons(c_string_to_lisp_keyword(L"primitive"), TRUE), make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
c_string_to_lisp_keyword(L"name"), n ),
n), NIL ) );
NIL));
deep_bind( n, make_special( NIL, executable ) ); deep_bind( n, make_special( NIL, executable ) );
} }
@ -94,9 +92,9 @@ int main( int argc, char *argv[] ) {
bool show_prompt = false; bool show_prompt = false;
setlocale( LC_ALL, "" ); setlocale( LC_ALL, "" );
if (io_init() != 0) { if ( io_init( ) != 0 ) {
fputs("Failed to initialise I/O subsystem\n", stderr); fputs( "Failed to initialise I/O subsystem\n", stderr );
exit(1); exit( 1 );
} }
while ( ( option = getopt( argc, argv, "cpdv:" ) ) != -1 ) { while ( ( option = getopt( argc, argv, "cpdv:" ) ) != -1 ) {

2
src/io/fopen.c
View file

@ -223,7 +223,7 @@ URL_FILE *url_fopen( const char *url, const char *operation ) {
curl_easy_setopt( file->handle.curl, CURLOPT_WRITEFUNCTION, curl_easy_setopt( file->handle.curl, CURLOPT_WRITEFUNCTION,
write_callback ); write_callback );
/* use the share object */ /* use the share object */
curl_easy_setopt(file->handle.curl, CURLOPT_SHARE, io_share); curl_easy_setopt( file->handle.curl, CURLOPT_SHARE, io_share );
if ( !multi_handle ) if ( !multi_handle )

170
src/io/io.c
View file

@ -44,22 +44,23 @@ wint_t ungotten = 0;
* *
* @return 0 on success; any other value means failure. * @return 0 on success; any other value means failure.
*/ */
int io_init() { int io_init( ) {
CURL *curl; CURL *curl;
CURLcode res; CURLcode res;
int result = curl_global_init( CURL_GLOBAL_SSL ); int result = curl_global_init( CURL_GLOBAL_SSL );
io_share = curl_share_init(); io_share = curl_share_init( );
if (result == 0) { if ( result == 0 ) {
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT );
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE ); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS ); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_SSL_SESSION ); curl_share_setopt( io_share, CURLSHOPT_SHARE,
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL ); CURL_LOCK_DATA_SSL_SESSION );
} curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL );
}
return result; return result;
} }
/** /**
@ -243,67 +244,72 @@ lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer,
return result; return result;
} }
int index_of( char c, char * s) { int index_of( char c, char *s ) {
int i; int i;
for (i = 0; s[i] != c && s[i] != 0; i++); for ( i = 0; s[i] != c && s[i] != 0; i++ );
return s[i] == c ? i : -1; return s[i] == c ? i : -1;
} }
char * trim(char *s) { char *trim( char *s ) {
int i; int i;
for (i = strlen(s); (isblank(s[i]) || iscntrl(s[i])) && i > -1; i--) { for ( i = strlen( s ); ( isblank( s[i] ) || iscntrl( s[i] ) ) && i > -1;
s[i] = (char) 0; i-- ) {
} s[i] = ( char ) 0;
for (i = 0; isblank(s[i]) && s[i] != 0; i++); }
for ( i = 0; isblank( s[i] ) && s[i] != 0; i++ );
return (char *)&s[i]; return ( char * ) &s[i];
} }
/** /**
* Callback to assemble metadata for a URL stream. This is naughty because * Callback to assemble metadata for a URL stream. This is naughty because
* it modifies data, but it's really the only way to create metadata. * it modifies data, but it's really the only way to create metadata.
*/ */
static size_t write_meta_callback(void *ptr, size_t size, size_t nmemb, struct cons_pointer stream) static size_t write_meta_callback( void *ptr, size_t size, size_t nmemb,
{ struct cons_pointer stream ) {
struct cons_space_object * cell = &pointer2cell(stream); struct cons_space_object *cell = &pointer2cell( stream );
if (strncmp(&cell->tag.bytes[0], READTAG, 4) || if ( strncmp( &cell->tag.bytes[0], READTAG, 4 ) ||
strncmp(&cell->tag.bytes[0], WRITETAG, 4)) { strncmp( &cell->tag.bytes[0], WRITETAG, 4 ) ) {
char * s = (char *)ptr; char *s = ( char * ) ptr;
int offset = index_of (':', ptr); int offset = index_of( ':', ptr );
if (offset != -1) { if ( offset != -1 ) {
s[offset] = (char)0; s[offset] = ( char ) 0;
char * name = s; char *name = s;
char * value = trim( &s[++offset]); char *value = trim( &s[++offset] );
wchar_t * wname = calloc(strlen(name), sizeof(wchar_t)); wchar_t *wname = calloc( strlen( name ), sizeof( wchar_t ) );
wchar_t * wvalue = calloc(strlen(value), sizeof(wchar_t)); wchar_t *wvalue = calloc( strlen( value ), sizeof( wchar_t ) );
mbstowcs(wname, name, strlen(name)); mbstowcs( wname, name, strlen( name ) );
mbstowcs(wvalue, value, strlen(value)); mbstowcs( wvalue, value, strlen( value ) );
cell->payload.stream.meta = make_cons( cell->payload.stream.meta =
make_cons( make_cons( make_cons
c_string_to_lisp_keyword( wname), ( c_string_to_lisp_keyword( wname ),
c_string_to_lisp_string(wvalue)), c_string_to_lisp_string( wvalue ) ),
cell->payload.stream.meta); cell->payload.stream.meta );
debug_printf( DEBUG_IO, L"write_meta_callback: added header '%s': value '%s'\n", name, value); debug_printf( DEBUG_IO,
L"write_meta_callback: added header '%s': value '%s'\n",
name, value );
}
} else {
debug_print
( L"Pointer passed to write_meta_callback did not point to a stream: ",
DEBUG_IO );
debug_dump_object( stream, DEBUG_IO );
} }
} else {
debug_print( L"Pointer passed to write_meta_callback did not point to a stream: ", DEBUG_IO);
debug_dump_object(stream, DEBUG_IO);
}
return nmemb; return nmemb;
} }
void collect_meta( struct cons_pointer stream, struct cons_pointer url ) { void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
URL_FILE * s = pointer2cell(stream).payload.stream.stream; URL_FILE *s = pointer2cell( stream ).payload.stream.stream;
switch ( s->type ) { switch ( s->type ) {
case CFTYPE_NONE: case CFTYPE_NONE:
@ -315,8 +321,9 @@ void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
case CFTYPE_CURL: case CFTYPE_CURL:
curl_easy_setopt( s->handle.curl, CURLOPT_VERBOSE, 1L ); curl_easy_setopt( s->handle.curl, CURLOPT_VERBOSE, 1L );
curl_easy_setopt( s->handle.curl, CURLOPT_HEADER, 1L ); curl_easy_setopt( s->handle.curl, CURLOPT_HEADER, 1L );
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION, write_meta_callback); curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION,
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream); write_meta_callback );
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream );
break; break;
} }
} }
@ -338,38 +345,37 @@ void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
* on my stream, if any, else NIL. * on my stream, if any, else NIL.
*/ */
struct cons_pointer struct cons_pointer
lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
if ( stringp( frame->arg[0] ) ) { if ( stringp( frame->arg[0] ) ) {
struct cons_pointer meta = struct cons_pointer meta =
make_cons( make_cons( make_cons( make_cons( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_keyword( L"url" ), frame->arg[0] ),
frame->arg[0] ), NIL );
NIL );
char *url = lisp_string_to_c_string( frame->arg[0] ); char *url = lisp_string_to_c_string( frame->arg[0] );
if ( nilp( frame->arg[1] ) ) { if ( nilp( frame->arg[1] ) ) {
URL_FILE *stream = url_fopen( url, "r" ); URL_FILE *stream = url_fopen( url, "r" );
result = make_read_stream( stream, meta ); result = make_read_stream( stream, meta );
} else { } else {
// TODO: anything more complex is a problem for another day. // TODO: anything more complex is a problem for another day.
URL_FILE *stream = url_fopen( url, "w" ); URL_FILE *stream = url_fopen( url, "w" );
result = make_write_stream( stream, meta); result = make_write_stream( stream, meta );
}
free( url );
if ( pointer2cell( result ).payload.stream.stream == NULL ) {
result = NIL;
} else {
collect_meta( result, frame->arg[0] );
}
} }
free( url ); return result;
if ( pointer2cell( result ).payload.stream.stream == NULL ) {
result = NIL;
} else {
collect_meta( result, frame->arg[0]);
}
}
return result;
} }
/** /**
@ -392,8 +398,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( frame->arg[0] ) ) { if ( readp( frame->arg[0] ) ) {
result = result =
make_string( url_fgetwc make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload. ( pointer2cell( frame->arg[0] ).payload.stream.
stream.stream ), NIL ); stream ), NIL );
} }
return result; return result;

2
src/io/io.h
View file

@ -15,7 +15,7 @@
extern CURLSH *io_share; extern CURLSH *io_share;
int io_init(); int io_init( );
URL_FILE *file_to_url_file( FILE * f ); URL_FILE *file_to_url_file( FILE * f );
wint_t url_fgetwc( URL_FILE * input ); wint_t url_fgetwc( URL_FILE * input );

2
src/ops/print.c → src/io/print.c
View file

@ -35,7 +35,7 @@ int print_use_colours = 0;
* don't print anything but just return. * don't print anything but just return.
*/ */
void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) { void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
while ( stringp( pointer ) || symbolp( pointer ) || keywordp(pointer)) { while ( stringp( pointer ) || symbolp( pointer ) || keywordp( pointer ) ) {
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
wchar_t c = cell->payload.string.character; wchar_t c = cell->payload.string.character;

0
src/ops/print.h → src/io/print.h
View file

4
src/ops/read.c → src/io/read.c
View file

@ -355,8 +355,8 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
make_symbol_or_key( initial, make_symbol_or_key( initial,
read_symbol_or_key( input, read_symbol_or_key( input,
tag, tag,
url_fgetwc( input ) ), url_fgetwc
tag ); ( input ) ), tag );
} else { } else {
result = NIL; result = NIL;
/* /*

0
src/ops/read.h → src/io/read.h
View file

2
src/memory/conspage.c
View file

@ -168,7 +168,7 @@ void free_cell( struct cons_pointer pointer ) {
break; break;
case READTV: case READTV:
case WRITETV: case WRITETV:
dec_ref(cell->payload.stream.meta); dec_ref( cell->payload.stream.meta );
url_fclose( cell->payload.stream.stream ); url_fclose( cell->payload.stream.stream );
break; break;
case SPECIALTV: case SPECIALTV:

14
src/memory/consspaceobject.c
View file

@ -158,7 +158,7 @@ make_function( struct cons_pointer meta, struct cons_pointer ( *executable )
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer pointer = allocate_cell( FUNCTIONTAG ); struct cons_pointer pointer = allocate_cell( FUNCTIONTAG );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( meta); inc_ref( meta );
cell->payload.function.meta = meta; cell->payload.function.meta = meta;
cell->payload.function.executable = executable; cell->payload.function.executable = executable;
@ -261,11 +261,11 @@ struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
if ( strncmp( tag, KEYTAG, 4 ) == 0 ) { if ( strncmp( tag, KEYTAG, 4 ) == 0 ) {
struct cons_pointer r = internedp( result, oblist ); struct cons_pointer r = internedp( result, oblist );
if ( nilp(r)) { if ( nilp( r ) ) {
intern(result, oblist); intern( result, oblist );
} else { } else {
result = r; result = r;
} }
} }
return result; return result;
@ -280,7 +280,7 @@ make_special( struct cons_pointer meta, struct cons_pointer ( *executable )
struct cons_pointer, struct cons_pointer env ) ) { struct cons_pointer, struct cons_pointer env ) ) {
struct cons_pointer pointer = allocate_cell( SPECIALTAG ); struct cons_pointer pointer = allocate_cell( SPECIALTAG );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( meta); inc_ref( meta );
cell->payload.special.meta = meta; cell->payload.special.meta = meta;
cell->payload.special.executable = executable; cell->payload.special.executable = executable;

16
src/memory/dump.c
View file

@ -108,14 +108,14 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
case RATIOTV: case RATIOTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n", L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).payload. pointer2cell( cell.payload.ratio.dividend ).
integer.value, payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload. pointer2cell( cell.payload.ratio.divisor ).
integer.value, cell.count ); payload.integer.value, cell.count );
break; break;
case READTV: case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output ); url_fputws( L"\t\tInput stream; metadata: ", output );
print(output, cell.payload.stream.meta); print( output, cell.payload.stream.meta );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
case REALTV: case REALTV:
@ -150,8 +150,8 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
} }
break; break;
case WRITETV: case WRITETV:
url_fputws( L"\t\tOutput stream; metadata: ", output ); url_fputws( L"\t\tOutput stream; metadata: ", output );
print(output, cell.payload.stream.meta); print( output, cell.payload.stream.meta );
url_fputws( L"\n", output ); url_fputws( L"\n", output );
break; break;
} }

17
src/ops/lispops.c
View file

@ -352,10 +352,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer; result = next_pointer;
} else { } else {
result = result =
( *fn_cell.payload. ( *fn_cell.payload.special.
special.executable ) ( get_stack_frame executable ) ( get_stack_frame( next_pointer ),
( next_pointer ), next_pointer, env );
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
@ -842,7 +841,9 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) {
result = make_string( o.payload.string.character, result ); result = make_string( o.payload.string.character, result );
break; break;
case SYMBOLTV: case SYMBOLTV:
result = make_symbol_or_key( o.payload.string.character, result, SYMBOLTAG ); result =
make_symbol_or_key( o.payload.string.character, result,
SYMBOLTAG );
break; break;
} }
} }
@ -1208,13 +1209,13 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( frame->arg[0] ); struct cons_space_object cell = pointer2cell( frame->arg[0] );
struct cons_pointer source_key = c_string_to_lisp_keyword(L"source"); struct cons_pointer source_key = c_string_to_lisp_keyword( L"source" );
switch ( cell.tag.value ) { switch ( cell.tag.value ) {
case FUNCTIONTV: case FUNCTIONTV:
result = c_assoc( source_key, cell.payload.function.meta); result = c_assoc( source_key, cell.payload.function.meta );
break; break;
case SPECIALTV: case SPECIALTV:
result = c_assoc( source_key, cell.payload.special.meta); result = c_assoc( source_key, cell.payload.special.meta );
break; break;
case LAMBDATV: case LAMBDATV:
result = make_cons( c_string_to_lisp_symbol( L"lambda" ), result = make_cons( c_string_to_lisp_symbol( L"lambda" ),

44
src/ops/meta.c
View file

@ -17,31 +17,29 @@
* *
* @return a pointer to the metadata of my first argument, or nil if none. * @return a pointer to the metadata of my first argument, or nil if none.
*/ */
struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_metadata( struct stack_frame *frame,
struct cons_pointer env ) { struct cons_pointer frame_pointer,
debug_print(L"lisp_metadata: entered\n", DEBUG_EVAL); struct cons_pointer env ) {
debug_dump_object(frame->arg[0], DEBUG_EVAL); debug_print( L"lisp_metadata: entered\n", DEBUG_EVAL );
struct cons_pointer result = NIL; debug_dump_object( frame->arg[0], DEBUG_EVAL );
struct cons_space_object cell = pointer2cell(frame->arg[0]); struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( frame->arg[0] );
switch( cell.tag.value) { switch ( cell.tag.value ) {
case FUNCTIONTV: case FUNCTIONTV:
result = cell.payload.function.meta; result = cell.payload.function.meta;
break; break;
case SPECIALTV: case SPECIALTV:
result = cell.payload.special.meta; result = cell.payload.special.meta;
break; break;
case READTV: case READTV:
case WRITETV: case WRITETV:
result = cell.payload.special.meta; result = cell.payload.stream.meta;
break; break;
} }
return make_cons( return make_cons( make_cons( c_string_to_lisp_keyword( L"type" ),
make_cons( c_type( frame->arg[0] ) ), result );
c_string_to_lisp_keyword( L"type"),
c_type(frame->arg[0])),
result);
// return result; // return result;
} }

5
src/ops/meta.h
View file

@ -11,7 +11,8 @@
#define __psse_meta_h #define __psse_meta_h
struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_metadata( struct stack_frame *frame,
struct cons_pointer env ) ; struct cons_pointer frame_pointer,
struct cons_pointer env );
#endif #endif