int main(int argc, char **argv) {
// Debug flags
debug_gc = getEnvFlag("MINILISP_DEBUG_GC");
always_gc = getEnvFlag("MINILISP_ALWAYS_GC");
// Memory allocation
memory = alloc_semispace();
// Constants and primitives
Symbols = Nil;
void *root = NULL;
DEFINE2(env, expr);
*env = make_env(root, &Nil, &Nil);
define_constants(root, env);
define_primitives(root, env);
// The main loop
printf("%s", ">");
for (;;) {
*expr = read_expr(root);
if (!*expr)
return 0;
if (*expr == Cparen)
error("Stray close parenthesis");
if (*expr == Dot)
error("Stray dot");
print(eval(root, env, expr));
printf("\n%s", ">");
}
}
// Evaluates the list elements from head and returns the last return value.
static Obj *progn(void *root, Obj **env, Obj **list) {
DEFINE2(lp, r);
for (*lp = *list; *lp != Nil; *lp = (*lp)->cdr) {
*r = (*lp)->car;
*r = eval(root, env, r);
}
return *r;
}
// Reader marcro ' (single quote). It reads an expression and returns (quote <expr>).
static Obj *read_quote(void *root) {
DEFINE2(sym, tmp);
*sym = intern(root, "quote");
*tmp = read_expr(root);
*tmp = cons(root, tmp, &Nil);
*tmp = cons(root, sym, tmp);
return *tmp;
}
// (define <symbol> expr)
static Obj *prim_define(void *root, Obj **env, Obj **list) {
if (length(*list) != 2 || (*list)->car->type != TSYMBOL)
error("Malformed define");
DEFINE2(sym, value);
*sym = (*list)->car;
*value = (*list)->cdr->car;
*value = eval(root, env, value);
add_variable(root, env, sym, value);
return *value;
}
// (while cond expr ...)
static Obj *prim_while(void *root, Obj **env, Obj **list) {
if (length(*list) < 2)
error("Malformed while");
DEFINE2(cond, exprs);
*cond = (*list)->car;
while (eval(root, env, cond) != Nil) {
*exprs = (*list)->cdr;
eval_list(root, env, exprs);
}
return Nil;
}
// (setq <symbol> expr)
static Obj *prim_setq(void *root, Obj **env, Obj **list) {
if (length(*list) != 2 || (*list)->car->type != TSYMBOL)
error("Malformed setq");
DEFINE2(bind, value);
*bind = find(env, (*list)->car);
if (!*bind)
error("Unbound variable %s", (*list)->car->name);
*value = (*list)->cdr->car;
*value = eval(root, env, value);
(*bind)->cdr = *value;
return *value;
}
static Obj *handle_function(void *root, Obj **env, Obj **list, int type) {
if ((*list)->type != TCELL || !is_list((*list)->car) || (*list)->cdr->type != TCELL)
error("Malformed lambda");
Obj *p = (*list)->car;
for (; p->type == TCELL; p = p->cdr)
if (p->car->type != TSYMBOL)
error("Parameter must be a symbol");
if (p != Nil && p->type != TSYMBOL)
error("Parameter must be a symbol");
DEFINE2(params, body);
*params = (*list)->car;
*body = (*list)->cdr;
return make_function(root, env, type, params, body);
}
int main() {
// Debug flags
debug_gc = getEnvFlag("MINILISP_DEBUG_GC");
always_gc = getEnvFlag("MINILISP_ALWAYS_GC");
// Memory allocation
memory = (void *)memory1;
// Init constants
Obj trueObj, nilObj, dotObj, cparenObj;
True = &trueObj;
Nil = &nilObj;
Dot = &dotObj;
Cparen = &cparenObj;
True->type = TTRUE;
Nil->type = TNIL;
Dot->type = TDOT;
Cparen->type = TCPAREN;
// Constants and primitives
Symbols = Nil;
void *root = NULL;
DEFINE2(env, expr);
*env = make_env(root, &Nil, &Nil);
define_constants(root, env);
define_primitives(root, env);
// The main loop
for (;;) {
setjmp(&jmpbuf);
*expr = read_expr(root);
if (!*expr)
return 0;
if (*expr == Cparen)
error("Stray close parenthesis");
if (*expr == Dot)
error("Stray dot");
print(eval(root, env, expr));
printf("\n");
}
}
static void add_primitive(void *root, Obj **env, char *name, Primitive *fn) {
DEFINE2(sym, prim);
*sym = intern(root, name);
*prim = make_primitive(root, fn);
add_variable(root, env, sym, prim);
}
static void add_variable(void *root, Obj **env, Obj **sym, Obj **val) {
DEFINE2(vars, tmp);
*vars = (*env)->vars;
*tmp = acons(root, sym, val, vars);
(*env)->vars = *tmp;
}