wl/old/print.c

71 lines
1.2 KiB
C

#include "wscm.h"
#include <stdio.h>
#include <inttypes.h>
void print(O obj);
static void printcons(O obj) {
O c = obj;
I f = 1;
printf("(");
while (c != NIL && !IMM(c)) {
H *h = UNBOX(c);
if (h->type != OBJ_CONS) {
printf(" . ");
print(c);
printf(")");
return;
}
C *p = (C *)(h + 1);
if (!f)
printf(" ");
f = 0;
print(p->car);
c = p->cdr;
}
if (c != NIL) {
printf(" . ");
print(c);
}
printf(")");
}
void print(O obj) {
if (obj == NIL) {
printf("()");
} else if (IMM(obj)) {
printf("%" PRIdPTR, ORD(obj));
} else {
void *x = (void *)UNBOX(obj);
switch (TYPE(obj)) {
case TAG_SYM: {
S *s = (S *)((U)x & ~7);
printf("%.*s", (int)s->len, s->data);
break;
}
case TAG_PRIM: {
P *p = (P *)((U)x & ~7);
printf("<#primitive %s>", p->name);
break;
}
default: {
H *h = (H *)x;
switch (h->type) {
case OBJ_CONS:
printcons(obj);
break;
default:
printf("<#obj type=%" PRIdPTR " @ %p>", h->type, (void *)h);
break;
}
}
}
}
}
void println(O obj) {
print(obj);
putchar('\n');
}