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

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
Download patch file Download diff file Expand all files Collapse all files

237
src/io/print.c Normal file
View file

@ -0,0 +1,237 @@
/*
* print.c
*
* First pass at a printer, for bootstrapping.
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
/*
* wide characters
*/
#include <wchar.h>
#include <wctype.h>
#include "conspage.h"
#include "consspaceobject.h"
#include "integer.h"
#include "stack.h"
#include "print.h"
/**
* Whether or not we colorise output.
* \todo this should be a Lisp symbol binding, not a C variable.
*/
int print_use_colours = 0;
/**
* print all the characters in the symbol or string indicated by `pointer`
* onto this `output`; if `pointer` does not indicate a string or symbol,
* don't print anything but just return.
*/
void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
while ( stringp( pointer ) || symbolp( pointer ) || keywordp( pointer ) ) {
struct cons_space_object *cell = &pointer2cell( pointer );
wchar_t c = cell->payload.string.character;
if ( c != '\0' ) {
url_fputwc( c, output );
}
pointer = cell->payload.string.cdr;
}
}
/**
* print all the characters in the string indicated by `pointer` onto
* the stream at this `output`, prepending and appending double quote
* characters.
*/
void print_string( URL_FILE * output, struct cons_pointer pointer ) {
url_fputwc( btowc( '"' ), output );
print_string_contents( output, pointer );
url_fputwc( btowc( '"' ), output );
}
/**
* Print a single list cell (cons cell) indicated by `pointer` to the
* stream indicated by `output`. if `initial_space` is `true`, prepend
* a space character.
*/
void
print_list_contents( URL_FILE * output, struct cons_pointer pointer,
bool initial_space ) {
struct cons_space_object *cell = &pointer2cell( pointer );
switch ( cell->tag.value ) {
case CONSTV:
if ( initial_space ) {
url_fputwc( btowc( ' ' ), output );
}
print( output, cell->payload.cons.car );
print_list_contents( output, cell->payload.cons.cdr, true );
break;
case NILTV:
break;
default:
url_fwprintf( output, L" . " );
print( output, pointer );
}
}
void print_list( URL_FILE * output, struct cons_pointer pointer ) {
if ( print_use_colours ) {
url_fwprintf( output, L"%s(%s", "\x1B[31m", "\x1B[39m" );
} else {
url_fputws( L"(", output );
};
print_list_contents( output, pointer, false );
if ( print_use_colours ) {
url_fwprintf( output, L"%s)%s", "\x1B[31m", "\x1B[39m" );
} else {
url_fputws( L")", output );
}
}
/**
* Print the cons-space object indicated by `pointer` to the stream indicated
* by `output`.
*/
struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
char *buffer;
/*
* Because tags have values as well as bytes, this if ... else if
* statement can ultimately be replaced by a switch, which will be neater.
*/
switch ( cell.tag.value ) {
case CONSTV:
print_list( output, pointer );
break;
case EXCEPTIONTV:
url_fwprintf( output, L"\n%sException: ",
print_use_colours ? "\x1B[31m" : "" );
dump_stack_trace( output, pointer );
break;
case FUNCTIONTV:
url_fwprintf( output, L"<Function>" );
break;
case INTEGERTV:{
struct cons_pointer s = integer_to_string( pointer, 10 );
inc_ref( s );
if ( print_use_colours ) {
url_fputws( L"\x1B[34m", output );
}
print_string_contents( output, s );
dec_ref( s );
}
break;
case KEYTV:
if ( print_use_colours ) {
url_fputws( L"\x1B[1;33m", output );
}
url_fputws( L":", output );
print_string_contents( output, pointer );
break;
case LAMBDATV:{
struct cons_pointer to_print =
make_cons( c_string_to_lisp_symbol( L"lambda" ),
make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) );
inc_ref( to_print );
print( output, to_print );
dec_ref( to_print );
}
break;
case NILTV:
url_fwprintf( output, L"nil" );
break;
case NLAMBDATV:{
struct cons_pointer to_print =
make_cons( c_string_to_lisp_symbol( L"nlambda" ),
make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) );
inc_ref( to_print );
print( output, to_print );
dec_ref( to_print );
}
break;
case RATIOTV:
print( output, cell.payload.ratio.dividend );
url_fputws( L"/", output );
print( output, cell.payload.ratio.divisor );
break;
case READTV:
url_fwprintf( output, L"<Input stream>" );
break;
case REALTV:
/* \todo using the C heap is a bad plan because it will fragment.
* As soon as I have working vector space I'll use a special purpose
* vector space object */
buffer = ( char * ) malloc( 24 );
memset( buffer, 0, 24 );
/* format it really long, then clear the trailing zeros */
sprintf( buffer, "%-.23Lg", cell.payload.real.value );
if ( strchr( buffer, '.' ) != NULL ) {
for ( int i = strlen( buffer ) - 1; buffer[i] == '0'; i-- ) {
buffer[i] = '\0';
}
}
if ( print_use_colours ) {
url_fputws( L"\x1B[34m", output );
}
url_fwprintf( output, L"%s", buffer );
free( buffer );
break;
case STRINGTV:
if ( print_use_colours ) {
url_fputws( L"\x1B[36m", output );
}
print_string( output, pointer );
break;
case SYMBOLTV:
if ( print_use_colours ) {
url_fputws( L"\x1B[1;33m", output );
}
print_string_contents( output, pointer );
break;
case SPECIALTV:
url_fwprintf( output, L"<Special form>" );
break;
case TRUETV:
url_fwprintf( output, L"t" );
break;
case WRITETV:
url_fwprintf( output, L"<Output stream>" );
break;
default:
fwprintf( stderr,
L"%sError: Unrecognised tag value %d (%c%c%c%c)\n",
print_use_colours ? "\x1B[31m" : "",
cell.tag.value, cell.tag.bytes[0], cell.tag.bytes[1],
cell.tag.bytes[2], cell.tag.bytes[3] );
break;
}
if ( print_use_colours ) {
url_fputws( L"\x1B[39m", output );
}
return pointer;
}
void println( URL_FILE * output ) {
url_fputws( L"\n", output );
}