82 lines
1.4 KiB
C
82 lines
1.4 KiB
C
#include <inttypes.h>
|
|
#include <stdio.h>
|
|
|
|
#include <wolflisp.h>
|
|
|
|
void print(O obj);
|
|
|
|
void print_pair(O obj) {
|
|
O c = obj;
|
|
I f = 1;
|
|
|
|
printf("(");
|
|
while (c != NIL && !IMM(c)) {
|
|
Gh *h = UNBOX(c);
|
|
if (h->type != TYPE_PAIR) {
|
|
printf(" . ");
|
|
print(c);
|
|
printf(")");
|
|
return;
|
|
}
|
|
Pa *p = (Pa *)(h + 1);
|
|
if (!f)
|
|
printf(" ");
|
|
f = 0;
|
|
print(p->head);
|
|
c = p->tail;
|
|
}
|
|
if (c != NIL) {
|
|
printf(" . ");
|
|
print(c);
|
|
}
|
|
printf(")");
|
|
}
|
|
|
|
void print(O obj) {
|
|
if (obj == NIL) {
|
|
printf("NIL");
|
|
} else if (IMM(obj)) {
|
|
printf("%" PRIdPTR, ORD(obj));
|
|
} else {
|
|
switch (TAG_OF(obj)) {
|
|
case TAG_SYM: {
|
|
Sy *s = (Sy *)UNTAG(obj);
|
|
printf("%.*s", (int)s->len, s->data);
|
|
break;
|
|
}
|
|
case TAG_PRIM: {
|
|
Pr *p = (Pr *)UNTAG(obj);
|
|
printf("<#primitive %s>", p->name);
|
|
break;
|
|
}
|
|
default: {
|
|
Gh *h = UNBOX(obj);
|
|
switch (h->type) {
|
|
case TYPE_PAIR:
|
|
print_pair(obj);
|
|
break;
|
|
case TYPE_STR: {
|
|
Ss *s = (Ss *)(h + 1);
|
|
printf("%.*s", (int)s->len, s->data);
|
|
break;
|
|
}
|
|
case TYPE_CLOS: {
|
|
Cl *cl = (Cl *)(h + 1);
|
|
printf("<#fn ");
|
|
print(cl->args);
|
|
printf(">");
|
|
break;
|
|
}
|
|
default:
|
|
printf("<#obj type=%" PRId32 " @ %p>", h->type, (void *)h);
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
void println(O obj) {
|
|
print(obj);
|
|
putchar('\n');
|
|
}
|