334 lines
11 KiB
C
334 lines
11 KiB
C
/**
|
|
* io/print.c
|
|
*
|
|
* Post Scarcity Software Environment: print.
|
|
*
|
|
* Print basic Lisp objects..This is :bootstrap layer print; it needs to be
|
|
* able to print characters, symbols, integers, lists and dotted pairs. I
|
|
* don't think it needs to be able to print anything else.
|
|
*
|
|
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
|
*/
|
|
|
|
#include <ctype.h>
|
|
#include <stdbool.h>
|
|
#include <stdint.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
/*
|
|
* wide characters
|
|
*/
|
|
#include <uchar.h>
|
|
#include <wchar.h>
|
|
#include <wctype.h>
|
|
/* libcurl, used for io */
|
|
#include <curl/curl.h>
|
|
|
|
#include "io/fopen.h"
|
|
#include "io/io.h"
|
|
#include "io/print.h"
|
|
|
|
#include "memory/node.h"
|
|
#include "memory/pointer.h"
|
|
#include "memory/pso.h"
|
|
#include "memory/pso2.h"
|
|
#include "memory/pso3.h"
|
|
#include "memory/pso4.h"
|
|
#include "memory/tags.h"
|
|
|
|
#include "ops/string_ops.h"
|
|
#include "payloads/character.h"
|
|
#include "payloads/cons.h"
|
|
#include "payloads/exception.h"
|
|
#include "payloads/integer.h"
|
|
|
|
#include "ops/stack_ops.h"
|
|
#include "ops/truth.h"
|
|
|
|
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
|
|
bool escape, int indent );
|
|
|
|
/**
|
|
* @brief write this character `wc` to this `output` stream, escaping it if
|
|
* 1. `escape` is true; and
|
|
* 2. it is a character which the reader would otherwise not cope with.
|
|
*
|
|
* 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 );
|
|
}
|
|
}
|
|
|
|
|
|
struct pso_pointer print_string_like_thing( struct pso_pointer p,
|
|
URL_FILE *output, bool escape ) {
|
|
switch ( get_tag_value( p ) ) {
|
|
case KEYTV:
|
|
write_char( L':', output, escape );
|
|
break;
|
|
case STRINGTV:
|
|
if ( escape )
|
|
write_char( L'"', output, escape );
|
|
break;
|
|
}
|
|
|
|
if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
|
|
for ( struct pso_pointer cursor = p; !c_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 );
|
|
}
|
|
}
|
|
|
|
if ( stringp( p ) ) {
|
|
if ( escape )
|
|
write_char( L'"', output, escape );
|
|
}
|
|
|
|
return p;
|
|
}
|
|
|
|
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 );
|
|
|
|
result = in_write( object->payload.cons.car, output, escape, 0 );
|
|
|
|
if ( exceptionp( result ) )
|
|
break;
|
|
|
|
switch ( get_tag_value( object->payload.cons.cdr ) ) {
|
|
case NILTV:
|
|
break;
|
|
case CONSTV:
|
|
write_char( L' ', output, escape );
|
|
break;
|
|
default:
|
|
url_fputws( L" . ", output );
|
|
result =
|
|
in_write( object->payload.cons.cdr, output, escape,
|
|
0 );
|
|
}
|
|
}
|
|
} else {
|
|
// TODO: return exception
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
void in_write_nl( URL_FILE *output, int indent ) {
|
|
write_char( L'\n', output, false );
|
|
for ( int i = 0; i < indent; i++ ) {
|
|
write_char( L'\t', output, false );
|
|
}
|
|
}
|
|
|
|
/**
|
|
* This is kind of modelled after the implementation of PRIN* variants on page
|
|
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
|
|
*
|
|
* @param p pointer to the object to print.
|
|
* @param output stream to print to.
|
|
* @param escape if true, print everything so that it can be read by the Lisp
|
|
* 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, int indent ) {
|
|
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:
|
|
write_char( L'(', output, escape );
|
|
result = write_list_content( p, output, escape );
|
|
write_char( L')', output, escape );
|
|
break;
|
|
case EXCEPTIONTV:{
|
|
struct pso3 *exception = pointer_to_pso3( p );
|
|
|
|
if ( exception != NULL ) {
|
|
url_fputws( L"<exception: ", output );
|
|
in_write( exception->payload.exception.message, output,
|
|
escape, indent );
|
|
if ( !c_nilp( exception->payload.exception.meta ) ) {
|
|
in_write_nl( output, indent + 1 );
|
|
url_fputws( L"metadata: ", output );
|
|
in_write( exception->payload.exception.meta,
|
|
output, escape, indent );
|
|
}
|
|
|
|
if ( !c_nilp( exception->payload.exception.cause ) ) {
|
|
in_write_nl( output, indent + 1 );
|
|
url_fputws( L"cause: ", output );
|
|
in_write( exception->payload.exception.cause,
|
|
output, escape, indent );
|
|
}
|
|
write_char( L'>', output, escape );
|
|
} else {
|
|
url_fputws( L"<broken exception :-( >", output );
|
|
}
|
|
} break;
|
|
case FUNCTIONTV: {
|
|
struct pso2 *function = pointer_to_object(p);
|
|
url_fputws(L"<function: ", output);
|
|
in_write(function->payload.function.meta, output, escape,
|
|
indent);
|
|
write_char( L'>', output, escape );
|
|
} 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,
|
|
indent );
|
|
write_char( L'>', output, escape );
|
|
break;
|
|
case SPECIALTV: {
|
|
struct pso2 *function = pointer_to_object(p);
|
|
url_fputws(L"<special form: ", output);
|
|
in_write(function->payload.function.meta, output, escape,
|
|
indent);
|
|
write_char( L'>', output, escape );
|
|
} break;
|
|
case TRUETV:
|
|
write_char( L't', output, escape );
|
|
break;
|
|
default:
|
|
// TODO: return exception
|
|
}
|
|
} else {
|
|
// TODO: return exception
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* This is kind of modelled after the implementation of PRIN* variants on page
|
|
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
|
|
*
|
|
* (write object stream escape? nl_before? nl_after?)
|
|
*
|
|
* @param object pointer to the object to print.
|
|
* @param output stream to print to.
|
|
* @param escape if true, print everything so that it can be read by the Lisp
|
|
* reader; otherwise, print it appropriately for human readers.
|
|
* @param nl_before if true, print a newline *before* printing `p`.
|
|
* @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 frame_pointer ) {
|
|
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
|
struct pso_pointer object = fetch_arg( frame, 0 );
|
|
struct pso_pointer stream = fetch_arg( frame, 1 );
|
|
bool escape = c_truep( fetch_arg( frame, 2 ) );
|
|
bool nl_before = c_truep( fetch_arg( frame, 3 ) );
|
|
bool nl_after = c_truep( fetch_arg( frame, 4 ) );
|
|
struct pso_pointer result = object;
|
|
struct pso2 *stream_obj = pointer_to_object( stream );
|
|
|
|
if ( writep( stream ) ) {
|
|
URL_FILE *output = stream_obj->payload.stream.stream;
|
|
|
|
if ( nl_before )
|
|
url_fputwc( L'\n', output );
|
|
|
|
result = in_write( object, output, escape, 0 );
|
|
|
|
url_fputwc( nl_after ? L'\n' : L' ', output );
|
|
} else {
|
|
result =
|
|
make_exception( make_frame( 1, frame_pointer,
|
|
c_string_to_lisp_string
|
|
( frame_pointer,
|
|
L"Bad write stream passed to write." ) ) );
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
struct pso_pointer c_write(struct pso_pointer frame_pointer,
|
|
struct pso_pointer object, struct pso_pointer stream,
|
|
bool escape, bool nl_before, bool nl_after) {
|
|
struct pso_pointer next_pointer =
|
|
push_local(frame_pointer, make_frame(5, frame_pointer, object, stream, escape ? t : nil,
|
|
nl_before ? t : nil, nl_after ? t : nil));
|
|
struct pso_pointer result = push_local(frame_pointer, write(next_pointer));
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* @brief Simple print for bootstrap layer.
|
|
*
|
|
* @param p pointer to the object to print.
|
|
* @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 frame_pointer ) {
|
|
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
|
|
|
struct pso_pointer next = inc_ref( make_frame( 5, frame_pointer,
|
|
fetch_arg( frame, 0 ),
|
|
fetch_arg( frame, 1 ), t,
|
|
t, nil ) );
|
|
|
|
struct pso_pointer result = write( next );
|
|
|
|
dec_ref( next );
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* @brief princ is pretty much like print except things are printed `unescaped`
|
|
*/
|
|
struct pso_pointer princ( struct pso_pointer frame_pointer ) {
|
|
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
|
|
|
struct pso_pointer next = inc_ref( make_frame( 5, frame_pointer,
|
|
fetch_arg( frame, 0 ),
|
|
fetch_arg( frame, 1 ),
|
|
nil, t, nil ) );
|
|
|
|
struct pso_pointer result = write( next );
|
|
|
|
dec_ref( next );
|
|
|
|
return result;
|
|
}
|
|
|