Things working much better now. assoc works. Currently printing of

string-like-things does not work, but I suspect that's shallow.
This commit is contained in:
Simon Brooke 2026-04-18 15:44:14 +01:00
parent 02a4bc3e28
commit 9a0f186f29
13 changed files with 400 additions and 38 deletions

View file

@ -11,6 +11,7 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <stdbool.h>
#include <ctype.h>
#include <stdint.h>
#include <stdio.h>
@ -26,6 +27,7 @@
#include "io/fopen.h"
#include "io/io.h"
#include "io/print.h"
#include "memory/node.h"
#include "memory/pointer.h"
@ -33,22 +35,26 @@
#include "memory/pso2.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/truth.h"
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool escape );
struct pso_pointer print_string_like_thing( struct pso_pointer p,
URL_FILE *output ) {
URL_FILE *output, bool escape ) {
switch ( get_tag_value( p ) ) {
case KEYTV:
url_fputwc( L':', output );
break;
case STRINGTV:
url_fputwc( L'"', output );
if ( !escape )
url_fputwc( L'"', output );
break;
}
@ -61,18 +67,20 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
}
if ( stringp( p ) ) {
url_fputwc( L'"', output );
if ( !escape )
url_fputwc( L'"', output );
}
}
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) {
struct pso_pointer print_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_print( object->payload.cons.car, output );
result = in_write( object->payload.cons.car, output, escape );
if ( exceptionp( result ) )
break;
@ -85,7 +93,8 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
break;
default:
url_fputws( L" . ", output );
result = in_print( object->payload.cons.cdr, output );
result =
in_write( object->payload.cons.cdr, output, escape );
}
}
} else {
@ -95,7 +104,18 @@ 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 ) {
/**
* 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 ) {
struct pso2 *object = pointer_to_object( p );
struct pso_pointer result = nil;
@ -107,7 +127,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
break;
case CONSTV:
url_fputwc( L'(', output );
result = print_list_content( p, output );
result = print_list_content( p, output, escape );
url_fputwc( L')', output );
break;
case INTEGERTV:
@ -117,7 +137,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
print_string_like_thing( p, output );
print_string_like_thing( p, output, escape );
break;
case NILTV:
url_fputws( L"nil", output );
@ -126,7 +146,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
case WRITETV:
url_fwprintf( output, L"<%s stream: ",
v == READTV ? "read" : "write" );
in_print( object->payload.stream.meta, output );
in_write( object->payload.stream.meta, output, escape );
url_fputwc( L'>', output );
break;
case TRUETV:
@ -143,13 +163,19 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
}
/**
* @brief Simple print for bootstrap layer.
* 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 stream if a pointer to an open write stream, print to there.
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
* @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 c_print( struct pso_pointer p, struct pso_pointer stream ) {
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
@ -158,10 +184,38 @@ struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
if ( writep( stream ) ) {
inc_ref( stream );
result = in_print( p, output );
if ( nl_before )
url_fputwc( L'\n', output );
result = in_write( p, output, true );
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 );
}
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 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 );
}