/* backend */
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#define N_VARS 26
enum { NIL, VAL, CONS, HEAD, YES, };
#define type_name(x) [x] = #x
const char *type_names[] = {
type_name(NIL),
type_name(VAL),
type_name(CONS),
type_name(HEAD),
type_name(YES),
};
struct obj {
int type, count;
union {
int val;
struct { struct obj *l, *r; }; // cons yes
struct { int n; struct obj *o; }; // head
};
};
struct obj *vars[N_VARS];
struct obj **gc_list;
int gc_len;
int
var(const int c)
{
const int v = c - 'a';
if (v < 0 || v >= N_VARS) {
puts("ERR invalid var name.");
return -1; }
return v;
}
int
type(const struct obj * const v)
{
return v ? v->type : NIL;
}
void
show_nil(void)
{
puts("$ (nil)");
}
void
show_val(const struct obj * const v)
{
printf("%d (%d %p)\n", v->val, v->count, v);
}
void show_cons_outer(const struct obj *v);
void
show_cons_inner(const struct obj * const v)
{
switch (type(v)) {
case NIL: putchar('$'); break;
case VAL: printf("%d", v->val); break;
case YES: putchar('['); show_cons_inner(v->l); printf(" ...]"); break;
case HEAD: printf("(head %d ", v->n); show_cons_inner(v->o); putchar(')'); break;
case CONS: show_cons_outer(v); break; }
}
void
show_cons_outer(const struct obj *v)
{
putchar('(');
show_cons_inner(v->l);
while (v = v->r) {
putchar(' ');
if (v->type != CONS) {
printf(". ");
show_cons_inner(v); break; }
show_cons_inner(v->l); }
putchar(')');
}
void
show_cons(const struct obj * const v)
{
show_cons_outer(v);
printf(" (%d %p (%p %p))\n", v->count, v, v->l, v->r);
}
void
show_yes(const struct obj * const v)
{
show_cons_inner(v);
printf(" (%d %p (%p))\n", v->count, v, v->l);
}
void
show_head(const struct obj * const v)
{
show_cons_inner(v);
printf(" (%d %p (%p))\n", v->count, v, v->o);
}
void
show_obj(const struct obj * const v)
{
switch (v->type) {
case VAL: return show_val(v);
case YES: return show_yes(v);
case HEAD: return show_head(v);
case CONS: return show_cons(v);
default: puts("ERR unknown data type."); }
}
void
show_all_vars(void)
{
for (int i = 0; i < N_VARS; i++)
if (vars[i]) {
printf("%c: ", i + 'a');
show_obj(vars[i]); }
}
void
show(const char x, const char * const y)
{
if (x == '?') return show_all_vars();
const int n = var(x); if (n < 0) return;
const struct obj * const v = vars[n];
return v ? show_obj(v) : show_nil();
}
struct obj *
new_obj(const struct obj * const o)
{
const size_t size = sizeof *o;
struct obj * const n = malloc(size);
if (!n) {
puts("ERR runtime error - out of memory.");
return NULL; }
*n = *o;
return n;
}
struct obj *
new_val(const char * s)
{
int n = 0;
for (; *s; s++) {
int c = *s - '0';
if (c < 0 || c > 9) break;
n = n * 10 + c; }
const struct obj t = { .type = VAL, .val = n, };
return new_obj(&t);
}
struct obj *
head_car(const struct obj * const o)
{
// assert(type(o) == HEAD);
switch (type(o->o)) {
case CONS:
case YES:
return o->o->l;
}
puts("ERR unsupported type.");
return NULL;
}
struct obj *
head_cdr(const struct obj * const o)
{
const int n = o->n;
if (n - 1 <= 0) return NULL; // end
struct obj * const p = o->o;
struct obj *r;
// assert(type(o) == HEAD);
switch (type(p)) {
case CONS:
r = p->r; break;
case YES:
r = p; break;
default:
puts("ERR unsupported type."); return NULL;
}
const struct obj t = { .type = HEAD, .n = n - 1, .o = r, };
return new_obj(&t);
}
// move an item into gc_list
void
discard(struct obj * const o)
{
printf("NOTE %p will be free'ed\n", o);
const size_t size = (gc_len + 1) * sizeof *o;
struct obj ** const t = realloc(gc_list, size);
if (!t) {
puts("ERR runtime error - out of memory.");
return; }
gc_list = t;
gc_list[gc_len++] = o;
// XXX Debug
for (int i = 0; i < gc_len; i++)
if (gc_list[i])
printf("NOTE gc_list %3d %p [%s]\n", i, gc_list[i],
type_names[gc_list[i]->type]);
}
void
update_var(const int n, struct obj * const o)
{
if (o) o->count++;
struct obj * const p = vars[n];
if (p && p->count && !--p->count) discard(p);
vars[n] = o;
}
void
setv(const char x, const char * const y)
{
const int n = var(x);
if (n < 0) return;
struct obj * o = NULL;
switch (*y) {
case '0'...'9': o = new_val(y); break;
case 'a'...'z': o = vars[var(*y)]; break;
default: puts("ERR unknown data type."); return; }
update_var(n, o);
}
void
null(const char x, const char * const y)
{
const int n = var(x);
if (n < 0) return;
update_var(n, NULL);
}
void
yes(const char x, const char * const y)
{
const int n = var(x); if (n < 0) return;
const int l = var(*y); if (l < 0) return;
const struct obj t = { .type = YES, .l = vars[l], };
struct obj * const o = new_obj(&t); if (!o) return;
if (t.l) t.l->count++;
update_var(n, o);
}
void
head(const char x, const char * const y)
{
const int n = var(x); if (n < 0) return;
const int l = var(y[0]); if (l < 0) return;
const int r = var(y[1]); if (r < 0) return;
if (type(vars[l]) != VAL) {
puts("ERR invalid data type."); return; }
const struct obj t = { .type = HEAD, .n = vars[l]->val, .o = vars[r], };
struct obj * const o = new_obj(&t); if (!o) return;
if (t.o) t.o->count++;
update_var(n, o);
}
void
cons(const char x, const char * const y)
{
const int n = var(x); if (n < 0) return;
const int l = var(y[0]); if (l < 0) return;
const int r = var(y[1]); if (r < 0) return;
const struct obj t = { .type = CONS, .l = vars[l], .r = vars[r], };
struct obj * const o = new_obj(&t);
if (!o) return;
if (t.l) t.l->count++;
if (t.r) t.r->count++;
update_var(n, o);
}
void
cxr(const char x, const char * const y, const int a_or_d)
{
const int n = var(x); if (n < 0) return;
const int m = var(*y); if (m < 0) return;
const int l = a_or_d == 'a'; // car or cdr: true if car, false otherwise
struct obj * const v = vars[m];
struct obj * o;
switch (type(v)) {
case CONS:
o = l ? v->l : v->r; break;
case HEAD:
o = l ? head_car(v) : head_cdr(v); break;
case YES:
if (!l && n == m) return;
o = l ? v->l : v; break;
default:
puts("ERR invalid data type."); return; }
update_var(n, o);
}
void
car(const char x, const char * const y)
{
return cxr(x, y, 'a');
}
void
cdr(const char x, const char * const y)
{
return cxr(x, y, 'd');
}
void
gc(const char x, const char * const y)
{
printf("NOTE freeing %d items.\n", gc_len);
// cannot use pointer as loop counter -- gc_list may move when discard.
// also gc_len may grow when discard.
for (int i = 0; i < gc_len; i++) {
struct obj * const p = gc_list[i];
if (!p) continue;
printf("NOTE freeing %p...\n", p);
if (p->type == CONS) {
if (p->l && p->l->count && !--p->l->count) discard(p->l);
if (p->r && p->r->count && !--p->r->count) discard(p->r); }
if (p->type == YES) {
if (p->l && p->l->count && !--p->l->count) discard(p->l); }
free(p); gc_list[i] = NULL; }
printf("NOTE %d items free'ed.\n", gc_len);
free(gc_list); gc_list = NULL;
gc_len = 0;
}
void
sub(const char *s)
{
const char * const t = &s[2];
switch (s[1]) {
case '?': return show(*s, t);
case '=': return setv(*s, t);
case '$': return null(*s, t);
case '(': return cons(*s, t);
case '^': return head(*s, t);
case '@': return yes (*s, t);
case '<': return car (*s, t);
case '>': return cdr (*s, t);
case '+': return gc (*s, t);
case '-': return; // comment(--)
}
puts("ERR unknown command.");
}
// this chomp is evil ... delete everything after the first newline.
void
chomp(char *s)
{
for (; *s; s++)
if (*s == '\n') {
*s = '\0';
return; }
}
void
prompt(void)
{
if (isatty(STDIN_FILENO)) fputs("* ", stderr);
}
void
prompt_exit(void)
{
if (isatty(STDIN_FILENO)) fputs("EXIT\n", stderr);
}
int
main(void)
{
char buf[80];
while (prompt(), fgets(buf, sizeof buf, stdin)) {
chomp(buf);
if (!*buf) continue;
sub(buf); }
prompt_exit();
return 0;
}