Closures/Value capture/C
Very quickly hacked up dynamically typed environment, with no garbage collection, and abort
for error handling.
<lang c>#include <stdio.h>
- include <stdarg.h>
- include <stdlib.h>
- include <assert.h>
- include <string.h>
struct function; struct number; struct symbol; struct string; struct cons;
enum type_tag {
FUN, NUM, SYM, STR, CON
};
typedef struct obj *val;
- define nil ((val) 0)
- define nao ((val) 1) /* "not an object" */
struct number {
int n;
};
struct string {
const char *s; int dynamic;
};
struct symbol {
val name;
};
struct cons {
val car, cdr;
};
struct function {
val nargs; val has_env; val env; union { /* First arg is environment */ val (*f0)(val); val (*f1)(val, val); val (*f2)(val, val, val); /* No environment */ val (*n0)(void); val (*n1)(val); val (*n2)(val, val); } u;
};
struct obj {
enum type_tag tt; union { struct function fun; struct number num; struct string str; struct symbol sym; struct cons cons; } u;
};
val t, x; val sym_list = nil;
val mkobj(enum type_tag tt) {
val v = malloc(sizeof *v); if (!v) abort(); v->tt = tt; return v;
}
val cons(val car, val cdr) {
val c = mkobj(CON); c->u.cons.car = car; c->u.cons.cdr = cdr; return c;
}
val car(val cons) {
if (cons == nil) return nil; assert (cons->tt == CON); return cons->u.cons.car;
}
val cdr(val cons) {
if (cons == nil) return nil; assert (cons->tt == CON); return cons->u.cons.cdr;
}
val num(int n) {
val vn = mkobj(NUM); vn->u.num.n = n; return vn;
}
int cnum(val vn) {
assert (vn->tt == NUM); return vn->u.num.n;
}
val str(const char *s) {
size_t size = strlen(s) + 1; val sv = mkobj(STR); char *sd = malloc(size);
if (!sv || !sd) abort();
memcpy(sd, s, size); sv->u.str.s = sd; sv->u.str.dynamic = 1; return sv;
}
val lit(const char *s) {
val sv = mkobj(STR);
if (!sv) abort();
sv->u.str.s = s; sv->u.str.dynamic = 0; return sv;
}
const char *cstr(val vs) {
assert (vs->tt == STR); return vs->u.str.s;
}
val equal(val left, val right) {
if (left == right) /* same object */ return t;
if (left == nil || right == nil) /* nil only equal to itself */ return nil;
if (left->tt != right->tt) /* different types are not equal */ return nil;
switch (left->tt) { case FUN: /* identity equivalence */ case SYM: /* ditto, of course */ /* left and right are different objects, so ... */ break; case NUM: /* numeric equivalence */ if (left->u.num.n == right->u.num.n) return t; break; case STR: /* case sensitive equality */ if (strcmp(left->u.str.s, right->u.str.s) == 0) return t; break; case CON: /* similar structure and equal atoms! */ if (equal(car(left), car(right)) && equal(cdr(left), cdr(right))) return t; break; }
return nil;
}
val assoc(val list, val key) {
for (; list != nil; list = cdr(list)) { val item = car(list); if (equal(key, car(item))) return item; } return nil;
}
val intern(val name) {
val exist = assoc(sym_list, name);
if (exist) { return cdr(exist); } else { val sym = mkobj(SYM);
sym->u.sym.name = name; sym_list = cons(cons(name, sym), sym_list); return sym; }
}
/*
* Hoist C functions into environment-carrying closures. */
val func_f0(val env, val (*cfun)(val)) {
val f = mkobj(FUN); f->u.fun.nargs = num(0); f->u.fun.has_env = t; f->u.fun.env = env; f->u.fun.u.f0 = cfun; return f;
}
val func_f1(val env, val (*cfun)(val, val)) {
val f = mkobj(FUN); f->u.fun.nargs = num(1); f->u.fun.has_env = t; f->u.fun.env = env; f->u.fun.u.f1 = cfun; return f;
}
val func_f2(val env, val (*cfun)(val, val, val)) {
val f = mkobj(FUN); f->u.fun.nargs = num(2); f->u.fun.has_env = t; f->u.fun.env = env; f->u.fun.u.f2 = cfun; return f;
}
/*
* Hoist C functions into environment-free functions */
val func_n0(val (*cfun)(void)) {
val f = mkobj(FUN); f->u.fun.nargs = num(0); f->u.fun.has_env = nil; f->u.fun.env = nil; f->u.fun.u.n0 = cfun; return f;
}
val func_n1(val (*cfun)(val)) {
val f = mkobj(FUN); f->u.fun.nargs = num(1); f->u.fun.has_env = nil; f->u.fun.env = nil; f->u.fun.u.n1 = cfun; return f;
}
val func_n2(val (*cfun)(val, val)) {
val f = mkobj(FUN); f->u.fun.nargs = num(2); f->u.fun.has_env = nil; f->u.fun.env = nil; f->u.fun.u.n2 = cfun; return f;
}
val funcall(val f, ...)
{
va_list vl; int argc; val arg[5];
assert (f->tt == FUN);
va_start (vl, f);
for (argc = 0; argc < 5; argc++) { val v = va_arg (vl, val); if (v == nao) break; arg[argc] = v; }
if (argc != cnum(f->u.fun.nargs)) abort();
if (f->u.fun.has_env) { switch (cnum(f->u.fun.nargs)) { case 0: return f->u.fun.u.f0(f->u.fun.env); case 1: return f->u.fun.u.f1(f->u.fun.env, arg[0]); case 2: return f->u.fun.u.f2(f->u.fun.env, arg[0], arg[1]); } } else { switch (cnum(f->u.fun.nargs)) { case 0: return f->u.fun.u.n0(); case 1: return f->u.fun.u.n1(arg[0]); case 2: return f->u.fun.u.n2(arg[0], arg[1]); } }
abort();
}
void init(void) {
t = intern(lit("t")); x = intern(lit("x"));
}
val square(val env) {
val xbind = assoc(env, x); /* look up binding of variable x in env */ val xval = cdr(xbind); /* value is the cdr of the binding cell */ return num(cnum(xval) * cnum(xval));
}
int main(void) {
int i; val funlist = nil, iter;
init();
for (i = 0; i < 10; i++) { val closure_env = cons(cons(x, num(i)), nil); funlist = cons(func_f0(closure_env, square), funlist); }
for (iter = funlist; iter != nil; iter = cdr(iter)) { val fun = car(iter); val square = funcall(fun, nao);
printf("%d\n", cnum(square)); } return 0;
}</lang>