71 lines
1.2 KiB
C
71 lines
1.2 KiB
C
#include "wscm.h"
|
|
|
|
#include <stdio.h>
|
|
#include <inttypes.h>
|
|
|
|
void print(O obj);
|
|
|
|
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');
|
|
}
|