/** * 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 * Licensed under GPL version 2.0, or, at your option, any later version. */ #include #include #include #include #include #include /* * wide characters */ #include #include /* libcurl, used for io */ #include #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/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_write(struct pso_pointer p, URL_FILE *output, bool escape); /** * @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( wchar_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: url_fputwc(L':', output); break; case STRINGTV: if (escape) url_fputwc(L'"', output); break; } if (keywordp(p) || stringp(p) || symbolp(p)) { for (struct pso_pointer cursor = p; !nilp(cursor); cursor = pointer_to_object(cursor)->payload.string.cdr) { wchar_t wc = pointer_to_object(cursor)->payload.string.character; write_char( wc, output, escape); } } if (stringp(p)) { if (escape) url_fputwc(L'"', output); } 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); if (exceptionp(result)) break; switch (get_tag_value(object->payload.cons.cdr)) { case NILTV: break; case CONSTV: url_fputwc(L' ', output); break; default: url_fputws(L" . ", output); result = in_write(object->payload.cons.cdr, output, escape); } } } 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. * * @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; 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: url_fputwc(L'(', output); result = write_list_content(p, output, escape); url_fputwc(L')', output); 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); url_fputwc(L'>', output); break; case TRUETV: url_fputwc(L't', output); 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. * * @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. * @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 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 : file_to_url_file(stdout); if (writep(stream)) { inc_ref(stream); 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); }