lumbda/c/printer.c

/*
 * printer.c — show/display/write for Scheme values
 */
#include "uncommonlisp.h"

/* Dynamic string builder */
typedef struct {
    char *buf;
    size_t len;
    size_t cap;
} StringBuilder;

static void sb_init(StringBuilder *sb) {
    sb->cap = 128;
    sb->buf = (char *)ul_malloc(sb->cap);
    sb->buf[0] = '\0';
    sb->len = 0;
}

static void sb_append(StringBuilder *sb, const char *s, size_t n) {
    while (sb->len + n + 1 > sb->cap) {
        sb->cap *= 2;
        sb->buf = (char *)ul_realloc(sb->buf, sb->cap);
    }
    memcpy(sb->buf + sb->len, s, n);
    sb->len += n;
    sb->buf[sb->len] = '\0';
}

static void sb_appendz(StringBuilder *sb, const char *s) {
    sb_append(sb, s, strlen(s));
}

static void sb_appendc(StringBuilder *sb, char c) {
    sb_append(sb, &c, 1);
}

static void show_value(Value v, bool display, StringBuilder *sb);

static void show_pair(Value v, bool display, StringBuilder *sb) {
    sb_appendc(sb, '(');
    Value n = v;
    bool first = true;
    while (IS_PAIR(n)) {
        if (!first) sb_appendc(sb, ' ');
        first = false;
        show_value(CAR(n), display, sb);
        n = CDR(n);
    }
    if (!IS_NIL(n)) {
        sb_appendz(sb, " . ");
        show_value(n, display, sb);
    }
    sb_appendc(sb, ')');
}

static void show_escaped_string(const char *s, size_t len, StringBuilder *sb) {
    sb_appendc(sb, '"');
    for (size_t i = 0; i < len; i++) {
        switch (s[i]) {
            case '\\': sb_appendz(sb, "\\\\"); break;
            case '"':  sb_appendz(sb, "\\\""); break;
            case '\n': sb_appendz(sb, "\\n"); break;
            case '\t': sb_appendz(sb, "\\t"); break;
            case '\r': sb_appendz(sb, "\\r"); break;
            default:   sb_appendc(sb, s[i]); break;
        }
    }
    sb_appendc(sb, '"');
}

static void show_value(Value v, bool display, StringBuilder *sb) {
    if (IS_NIL(v))  { sb_appendz(sb, "()"); return; }
    if (IS_VOID(v)) { return; } /* void prints nothing */
    if (IS_TRUE(v)) { sb_appendz(sb, "#t"); return; }
    if (IS_FALSE(v)){ sb_appendz(sb, "#f"); return; }
    if (IS_EOF(v))  { sb_appendz(sb, "#<eof>"); return; }

    if (IS_CHAR(v)) {
        int c = AS_CHAR(v);
        if (display) {
            sb_appendc(sb, (char)c);
        } else {
            sb_appendz(sb, "#\\");
            switch (c) {
                case ' ':  sb_appendz(sb, "space"); break;
                case '\n': sb_appendz(sb, "newline"); break;
                case '\t': sb_appendz(sb, "tab"); break;
                case '\r': sb_appendz(sb, "return"); break;
                case '\0': sb_appendz(sb, "null"); break;
                case '\x1b': sb_appendz(sb, "escape"); break;
                default: sb_appendc(sb, (char)c); break;
            }
        }
        return;
    }

    if (IS_INT(v)) {
        char buf[32];
        snprintf(buf, sizeof(buf), "%lld", (long long)as_int(v));
        sb_appendz(sb, buf);
        return;
    }

    if (IS_DOUBLE(v)) {
        double d = as_double(v);
        if (isinf(d)) {
            sb_appendz(sb, d > 0 ? "+inf.0" : "-inf.0");
            return;
        }
        if (isnan(d)) {
            sb_appendz(sb, "+nan.0");
            return;
        }
        char buf[64];
        snprintf(buf, sizeof(buf), "%.17g", d);
        /* Ensure a decimal point for Scheme compat */
        if (!strchr(buf, '.') && !strchr(buf, 'e') && !strchr(buf, 'n') && !strchr(buf, 'i')) {
            size_t n = strlen(buf);
            buf[n] = '.'; buf[n+1] = '0'; buf[n+2] = '\0';
        }
        sb_appendz(sb, buf);
        return;
    }

    if (IS_SYM(v)) {
        sb_appendz(sb, sym_name(v));
        return;
    }

    if (IS_RATIONAL(v)) {
        Rational *r = AS_RATIONAL(v);
        char buf[64];
        snprintf(buf, sizeof(buf), "%lld/%lld", (long long)r->num, (long long)r->den);
        sb_appendz(sb, buf);
        return;
    }

    if (IS_BUILTIN(v)) {
        sb_appendz(sb, "#<builtin>");
        return;
    }

    if (!IS_PTR(v)) {
        char buf[32];
        snprintf(buf, sizeof(buf), "#<unknown:%llx>", (unsigned long long)v);
        sb_appendz(sb, buf);
        return;
    }

    /* Heap objects */
    ObjType type = obj_type(v);

    switch (type) {
    case OBJ_PAIR:
        show_pair(v, display, sb);
        break;

    case OBJ_STRING:
    case OBJ_MUTABLE_STRING: {
        ULString *s = AS_STRING(v);
        if (display) {
            sb_append(sb, s->data, s->len);
        } else {
            show_escaped_string(s->data, s->len, sb);
        }
        break;
    }

    case OBJ_VECTOR: {
        ULVector *vec = AS_VECTOR(v);
        sb_appendz(sb, "#(");
        for (size_t i = 0; i < vec->len; i++) {
            if (i > 0) sb_appendc(sb, ' ');
            show_value(vec->data[i], display, sb);
        }
        sb_appendc(sb, ')');
        break;
    }

    case OBJ_HASHTABLE:
        sb_appendz(sb, "#<hash-table>");
        break;

    case OBJ_PROC: {
        Proc *p = AS_PROC(v);
        char buf[128];
        snprintf(buf, sizeof(buf), "#<procedure %s>", p->name ? p->name : "λ");
        sb_appendz(sb, buf);
        break;
    }

    case OBJ_COMPILED_PROC: {
        CompiledProc *cp = AS_COMPILED_PROC(v);
        char buf[128];
        snprintf(buf, sizeof(buf), "#<compiled %s>", cp->name ? cp->name : "λ");
        sb_appendz(sb, buf);
        break;
    }

    case OBJ_MACRO:
        sb_appendz(sb, "#<macro>");
        break;

    case OBJ_CONTINUATION:
        sb_appendz(sb, "#<continuation>");
        break;

    case OBJ_PORT: {
        ULPort *p = AS_PORT(v);
        char buf[64];
        snprintf(buf, sizeof(buf), "#<%s-%s-port>",
                 p->kind == PORT_STRING ? "string" : "file",
                 p->dir == PORT_INPUT ? "input" : "output");
        sb_appendz(sb, buf);
        break;
    }

    case OBJ_ERROR: {
        ErrorObject *e = AS_ERROR(v);
        char buf[256];
        snprintf(buf, sizeof(buf), "#<error-object \"%s\">", e->message);
        sb_appendz(sb, buf);
        break;
    }

    case OBJ_ENV:
        sb_appendz(sb, "#<environment>");
        break;

    case OBJ_CODE:
        sb_appendz(sb, "#<code>");
        break;

    case OBJ_SYNTAX_TRANSFORMER:
        sb_appendz(sb, "#<syntax-transformer>");
        break;

    case OBJ_RATIONAL: {
        Rational *r = AS_RATIONAL(v);
        char buf[64];
        snprintf(buf, sizeof(buf), "%lld/%lld", (long long)r->num, (long long)r->den);
        sb_appendz(sb, buf);
        break;
    }
    }
}

char *show(Value v, bool display) {
    StringBuilder sb;
    sb_init(&sb);
    show_value(v, display, &sb);
    return sb.buf;
}

void print_value(Value v, bool display, FILE *out) {
    char *s = show(v, display);
    fputs(s, out);
    ul_free(s);
}