Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1135 lines (1008 sloc) 28.9 KB
#include <stdio.h>
#include "eval.h"
#include "object.h"
#include "log.h"
#include "sform.h"
#include "env.h"
#include "procdef.h"
#include "gc.h"
#include "write.h"
static int is_self_evaluate(object *exp) {
return is_fixnum(exp) ||
is_flonum(exp) ||
is_boolean(exp) ||
is_character(exp) ||
is_string(exp) ||
is_env_frame(exp) ||
is_cont(exp) ||
is_primitive_proc(exp) ||
is_compound_proc(exp) ||
is_eof_object(exp);
}
static int is_variable(object *exp) {
return is_symbol(exp);
}
static int is_tagged_list(object *exp, object *tag) {
object *car_obj;
if (is_pair(exp)) {
car_obj = car(exp);
return car_obj == tag;
}
return 0;
}
/* quote functions */
static int is_quoted(object *exp) {
return is_tagged_list(exp, get_quote_symbol());
}
static object* eval_quote(object *exp) {
return cadr(exp);
}
static int is_quasiquote(object *exp) {
return is_tagged_list(exp, get_quasiquote_symbol());
}
static int is_unquote(object *exp) {
return is_tagged_list(exp, get_unquote_symbol());
}
static int is_unquotesplicing(object *exp) {
return is_tagged_list(exp, get_unquotesplicing_symbol());
}
static object* get_last_pair(object *list) {
object *rest = list;
while (!is_empty_list(cdr(rest))) {
rest = cdr(rest);
}
return rest;
}
static object* eval_quasiquote_rec(object *exp, object *env, int level, int outmost) {
object *obj, *cdr_obj, *car_obj;
int unquote_level;
if (is_pair(exp)) {
obj = car(exp);
if (is_unquote(obj)) {
unquote_level = level - 1;
/* unquote only at the same nesting level as the outermost backquote */
if (unquote_level == 0) {
car_obj = sc_eval(cadr(obj), env);
} else {
car_obj = eval_quasiquote_rec(obj, env, unquote_level, 0);
}
gc_protect(car_obj);
cdr_obj = eval_quasiquote_rec(cdr(exp), env, level, outmost);
gc_protect(cdr_obj);
obj = cons(car_obj, cdr_obj);
gc_abandon();
gc_abandon();
return obj;
} else if (is_unquotesplicing(obj)) {
unquote_level = level - 1;
/* unquote only at the same nesting level as the outermost backquote */
if (unquote_level == 0) {
car_obj = sc_eval(cadr(obj), env);
} else {
car_obj = eval_quasiquote_rec(obj, env, unquote_level, 0);
}
gc_protect(car_obj);
cdr_obj = eval_quasiquote_rec(cdr(exp), env, level, outmost);
gc_abandon();
if (unquote_level == 0) { /* do splicing */
if (is_empty_list(car_obj)) {
return cdr_obj;
} else {
object *last = get_last_pair(car_obj);
set_cdr(last, cdr_obj);
return car_obj;
}
} else {
object *result;
gc_protect(car_obj);
gc_protect(cdr_obj);
result = cons(car_obj, cdr_obj);
gc_abandon();
gc_abandon();
return result;
}
} else if (is_quasiquote(obj)) {
car_obj = eval_quasiquote_rec(obj, env, level+1, 0);
gc_protect(car_obj);
cdr_obj = eval_quasiquote_rec(cdr(exp), env, level, outmost);
gc_protect(cdr_obj);
obj = cons(car_obj, cdr_obj);
gc_abandon();
gc_abandon();
return obj;
} else {
/* handle improper list special case */
/* e.g `(1 . ,(+ 1 2)) */
if (obj == get_unquote_symbol() && level == 1 && outmost) {
obj = cadr(exp);
if (obj == NULL) {
return exp;
}
return sc_eval(obj, env);
} else if (obj == get_unquotesplicing_symbol() && level == 1 && outmost) {
obj = cadr(exp);
if (obj == NULL) {
return exp;
}
return sc_eval(obj, env);
} else {
car_obj = eval_quasiquote_rec(obj, env, level, 0);
gc_protect(car_obj);
cdr_obj = eval_quasiquote_rec(cdr(exp), env, level, outmost);
gc_protect(cdr_obj);
obj = cons(car_obj, cdr_obj);
gc_abandon();
gc_abandon();
return obj;
}
}
}
return exp;
}
static object* eval_quasiquote(object *exp, object *env) {
return eval_quasiquote_rec(cadr(exp), env, 1, 1);
}
/* assignment functions */
static int is_assignment(object *exp) {
return is_tagged_list(exp, get_set_symbol());
}
static object* assignment_variable(object *exp) {
return cadr(exp);
}
static object* assignment_value(object *exp) {
return caddr(exp);
}
static object* eval_assignment(object *exp, object *env) {
object *var, *val;
char msg[] = "wrong arity in `set! form\n";
int ret;
var = assignment_variable(exp);
val = assignment_value(exp);
if (val == NULL || var == NULL ||
!is_empty_list(cdddr(exp))) {
fprintf(stderr, "%s", msg);
return NULL;
}
if (!is_variable(var)) {
fprintf(stderr, "%s\n", "variable name must be symbol");
return NULL;
}
val = sc_eval(val, env);
if (val == NULL) {
return NULL;
}
ret = set_variable_val(var, val, env);
if (ret != 0) {
fprintf(stderr, "%s\n", "unbound variable");
return NULL;
}
return get_nrv_symbol();
}
/* lambda functions */
static object* make_lambda(object *parameters, object *body) {
object *obj;
obj = cons(parameters, body);
gc_protect(obj);
obj = cons(get_lambda_symbol(), obj);
gc_abandon();
return obj;
}
static int is_lambda(object *exp) {
return is_tagged_list(exp, get_lambda_symbol());
}
static object* lambda_parameters(object *exp) {
return cadr(exp);
}
static object* lambda_body(object *exp) {
return cddr(exp);
}
static int check_arity(object *args, int arity, int has_vararg) {
int i;
object *rest = args;
for (i = 0; i < arity; i++) {
rest = cdr(rest);
}
if (!has_vararg && !is_empty_list(rest)) {
return 0;
}
if (has_vararg && rest == NULL) {
return 0;
}
return 1;
}
static object* normalize_lambda_args(int argc, int has_vararg, object *raw_arg) {
object *norm_args = raw_arg;
if (!check_arity(raw_arg, argc, has_vararg)) {
return NULL;
}
if (has_vararg) {
if (argc == 0) {
norm_args = cons(raw_arg, get_empty_list());
} else {
object *cdr_obj = get_empty_list();
while (argc != 1) {
raw_arg = cdr(raw_arg);
argc--;
}
cdr_obj = cons(cdr(raw_arg), cdr_obj);
set_cdr(raw_arg, cdr_obj);
}
}
return norm_args;
}
/* begin form functions */
static object* make_begin(object *seq) {
return cons(get_begin_symbol(), seq);
}
static int is_begin(object *exp) {
return is_tagged_list(exp, get_begin_symbol());
}
static object* begin_actions(object *exp) {
return cdr(exp);
}
/* expression related common functions */
static int is_last_exp(object *exp) {
return is_empty_list(cdr(exp));
}
static object* first_exp(object *exp) {
return car(exp);
}
static object* rest_exps(object *exp) {
return cdr(exp);
}
/* define form funtions */
static int is_definition(object *exp) {
return is_tagged_list(exp, get_define_symbol());
}
static object* definition_variable(object *exp) {
if (is_symbol(cadr(exp))) {
return cadr(exp);
} else {
/* lambda syntax sugar */
return caadr(exp);
}
}
static object* definition_value(object *exp) {
if (is_symbol(cadr(exp))) {
return caddr(exp);
} else {
/* lambda syntax sugar */
return make_lambda(cdadr(exp), cddr(exp));
}
}
static object* eval_definition(object *exp, object *env) {
object *var, *val;
char msg[] = "wrong arity in `define form\n";
int ret;
var = definition_variable(exp);
val = definition_value(exp);
if (val == NULL || var == NULL ||
(is_symbol(cadr(exp)) && !is_empty_list(cdddr(exp)))) {
fprintf(stderr, "%s", msg);
return NULL;
}
if (!is_variable(var)) {
fprintf(stderr, "%s\n", "variable must be symbol");
return NULL;
}
gc_protect(val); /* protect lambda form */
val = sc_eval(val, env);
if (val == NULL) {
return NULL;
}
ret = define_variable(var, val, env);
gc_abandon();
if (ret != 0) {
fprintf(stderr, "%s\n",
"unexpected error, cannot define variable");
return NULL;
}
return get_nrv_symbol();
}
static object* eval_variable(object *exp, object *env) {
object *obj;
obj = lookup_variable_val(exp, env);
if (obj == NULL) {
fprintf(stderr, "%s `%s\n",
"unbound variable", obj_iv(exp));
}
return obj;
}
/* if form functions */
static object* make_if(object *predicate,
object *consequence,
object *alternative) {
object *obj;
obj = cons(alternative, get_empty_list());
gc_protect(obj);
obj = cons(consequence, obj);
obj = cons(predicate, obj);
obj = cons(get_if_symbol(), obj);
gc_abandon();
return obj;
}
static int is_if(object *exp) {
return is_tagged_list(exp, get_if_symbol());
}
static object* if_predicate(object *exp) {
return cadr(exp);
}
static object* if_consequence(object *exp) {
return caddr(exp);
}
static object* if_alternative(object *exp) {
object *alter;
alter = cdddr(exp);
if (is_empty_list(alter)) {
return get_false_obj(); /* undefined */
} else {
return car(alter);
}
return NULL;
}
static int check_if_arity(object *exp) {
return is_empty_list(cdddr(exp)) ||
is_empty_list(cddddr(exp));
}
/* function application */
static object* make_application(object *operator, object *operands) {
return cons(operator, operands);
}
static int is_application(object *exp) {
return is_pair(exp);
}
static object* operator(object *exp) {
return car(exp);
}
static object* operands(object *exp) {
return cdr(exp);
}
static int is_no_operands(object *ops) {
return is_empty_list(ops);
}
static object* first_operand(object *ops) {
return car(ops);
}
static object* rest_operands(object *ops) {
return cdr(ops);
}
static object* list_of_values(object *ops, object *env) {
object *car_obj, *cdr_obj, *obj;
if (is_no_operands(ops)) {
return get_empty_list();
} else {
car_obj = sc_eval(first_operand(ops), env);
if (car_obj == NULL) {
return NULL;
}
gc_protect(car_obj);
cdr_obj = list_of_values(rest_operands(ops), env);
if (cdr_obj == NULL) {
gc_abandon();
return NULL;
}
gc_protect(cdr_obj);
obj = cons(car_obj, cdr_obj);
gc_abandon();
gc_abandon();
return obj;
}
}
/* cond form functions */
static object* cond_clauses(object *exp) {
return cdr(exp);
}
static int is_cond(object *exp) {
return is_tagged_list(exp, get_cond_symbol());
}
static object* cond_predicate(object *clause) {
return car(clause);
}
static object* cond_actions(object *clause) {
return cdr(clause);
}
static int is_cond_else_clause(object *clause) {
return cond_predicate(clause) == get_else_symbol();
}
static object* sequence_to_exp(object *seq) {
if (is_empty_list(seq)) {
return seq;
} else if (is_last_exp(seq)) {
return car(seq);
} else {
return make_begin(seq);
}
}
static object* expand_clauses(object *clauses) {
object *first, *rest;
if (is_empty_list(clauses)) {
return get_false_obj();
} else {
first = car(clauses);
rest = cdr(clauses);
if (is_cond_else_clause(first)) {
if (is_empty_list(rest)) {
return sequence_to_exp(cond_actions(first));
} else {
fprintf(stderr,
"else clause isn't last cond->if\n");
return NULL;
}
} else {
object *alter;
alter = expand_clauses(rest);
if (alter == NULL) {
return NULL;
} else {
object *exps, *if_obj;
gc_protect(alter);
exps = sequence_to_exp(cond_actions(first));
gc_protect(exps);
if_obj = make_if(cond_predicate(first),
exps,
alter);
gc_abandon();
gc_abandon();
return if_obj;
}
}
}
}
static object* cond_to_if(object *exp) {
object *clauses;
clauses = cond_clauses(exp);
if (is_empty_list(clauses)) {
fprintf(stderr, "no clauses in cond form\n");
return NULL;
}
return expand_clauses(clauses);
}
/* let form functions */
static int is_let(object *exp) {
return is_tagged_list(exp, get_let_symbol());
}
static object* let_bindings(object *exp) {
return cadr(exp);
}
static object* let_body(object *exp) {
return cddr(exp);
}
static object* binding_variable(object *binding) {
return car(binding);
}
static object* binding_value(object *binding) {
return cadr(binding);
}
static int is_valid_binding(object *binding) {
return is_empty_list(cddr(binding));
}
static object* bindings_variables(object *bindings) {
object *list;
if (is_empty_list(bindings)) {
return get_empty_list();
} else {
object *binding;
object *var, *rest;
binding = car(bindings);
if (!is_valid_binding(binding)) {
return NULL;
}
var = binding_variable(binding);
rest = bindings_variables(cdr(bindings));
if (rest == NULL) {
return NULL;
}
gc_protect(rest);
list = cons(var, rest);
gc_abandon();
return list;
}
}
static object* bindings_values(object *bindings) {
object *list;
if (is_empty_list(bindings)) {
return get_empty_list();
} else {
object *binding;
object *val, *rest;
binding = car(bindings);
if (!is_valid_binding(binding)) {
return NULL;
}
val = binding_value(binding);
rest = bindings_values(cdr(bindings));
if (rest == NULL) {
return NULL;
}
gc_protect(rest);
list = cons(val, rest);
gc_abandon();
return list;
}
}
static int is_valid_let_bindings(object *bindings) {
return is_pair(bindings);
}
static object* let_variables(object *exp) {
object *bindings;
bindings = let_bindings(exp);
if (!is_valid_let_bindings(bindings)) {
return NULL;
}
return bindings_variables(bindings);
}
static object* let_values(object *exp) {
object *bindings;
bindings = let_bindings(exp);
if (!is_valid_let_bindings(bindings)) {
return NULL;
}
return bindings_values(bindings);
}
static object* let_to_application(object *exp) {
object *vars, *vals;
object *body;
object *lambda_obj, *result;
vars = let_variables(exp);
if (vars == NULL) {
return NULL;
}
gc_protect(vars);
vals = let_values(exp);
if (vals == NULL) {
return NULL;
}
body = let_body(exp);
if (body == NULL || is_empty_list(body)) {
return NULL;
}
gc_protect(vals);
lambda_obj = make_lambda(vars, body);
gc_protect(lambda_obj);
result = make_application(lambda_obj, vals);
gc_abandon();
gc_abandon();
gc_abandon();
return result;
}
/* and, or form functions */
static int is_and(object *exp) {
return is_tagged_list(exp, get_and_symbol());
}
static int is_or(object *exp) {
return is_tagged_list(exp, get_or_symbol());
}
static object* and_tests(object *exp) {
return cdr(exp);
}
static object* or_tests(object *exp) {
return cdr(exp);
}
static object* apply_operator(object *args) {
return car(args);
}
/* apply form functions */
static object* normalize_apply_operands(object *args) {
if (is_empty_list(args)) {
return NULL;
}
if (is_empty_list(cdr(args))) {
object *obj;
obj = car(args);
if (is_empty_list(obj) || is_pair(obj)) {
return obj;
} else {
return cons(obj, get_empty_list());
}
} else {
object *obj, *result;
obj = normalize_apply_operands(cdr(args));
gc_protect(obj);
result = cons(car(args), obj);
gc_abandon();
return result;
}
/* never here */
return NULL;
}
static object* apply_operands(object *args) {
return normalize_apply_operands(cdr(args));
}
/* eval form functions */
static object* eval_exps(object *args) {
return car(args);
}
/* macro functions */
static int is_macro_definition(object *exp) {
return is_tagged_list(exp, get_definemacro_symbol());
}
static object *eval_macro_definition(object *exp, object *env) {
object *var, *val;
char msg[] = "wrong arity in `define-macro form\n";
int ret;
var = definition_variable(exp);
val = definition_value(exp);
if (val == NULL || var == NULL ||
(is_symbol(cadr(exp)) && !is_empty_list(cdddr(exp)))) {
fprintf(stderr, "%s", msg);
return NULL;
}
if (!is_variable(var)) {
fprintf(stderr, "%s\n", "variable must be symbol");
return NULL;
}
gc_protect(val); /* protect lambda form */
val = sc_eval(val, env);
if (val == NULL) {
return NULL;
}
val = make_macro(val);
ret = define_variable(var, val, env);
gc_abandon();
if (ret != 0) {
fprintf(stderr, "%s\n",
"unexpected error in define-macro");
return NULL;
}
return get_nrv_symbol();
}
static object* eval_env(object *args) {
object *env;
env = cadr(args);
if (env == NULL) {
fprintf(stderr, "%s\n",
"wrong arity in eval");
return NULL;
}
if (!is_valid_env(env)) {
fprintf(stderr, "%s\n",
"invalid environment");
return NULL;
}
return env;
}
static object* expand_macro(object *raw_exp, object *macro, object *args) {
object *texp, *tenv, *op, *exp, *params;
/* handle var-arg */
op = obj_mv(macro);
params = normalize_lambda_args(obj_lvargc(op), obj_lvvar(op), args);
if (params == NULL) {
fprintf(stderr, "wrong arity `");
sc_write(stderr, raw_exp);
fprintf(stderr, "\n");
return NULL;
}
/* do macro transform */
gc_protect(params);
tenv = extend_env(obj_lvp(op),
params,
obj_lve(op));
gc_protect(tenv);
texp = make_begin(obj_lvb(op));
gc_protect(texp);
exp = sc_eval(texp, tenv);
gc_abandon();
gc_abandon();
gc_abandon();
return exp;
}
object* sc_eval(object *exp, object *env) {
object *val = NULL;
gc_protect(exp);
gc_protect(env);
tailcall:
if (exp == NULL) {
sc_log("%s", "cannot eval NULL exp");
return NULL;
}
if (is_self_evaluate(exp)) {
val = exp;
} else if (is_variable(exp)) {
val = eval_variable(exp, env);
} else if (is_quoted(exp)) {
val = eval_quote(exp);
} else if (is_quasiquote(exp)) {
val = eval_quasiquote(exp, env);
} else if (is_assignment(exp)) {
val = eval_assignment(exp, env);
} else if (is_definition(exp)) {
val = eval_definition(exp, env);
} else if (is_macro_definition(exp)) {
val = eval_macro_definition(exp, env);
} else if (is_if(exp)) {
object *pred;
if (!check_if_arity(exp)) {
fprintf(stderr, "%s\n",
"wrong arity in `if form");
gc_abandon();
gc_abandon();
return NULL;
}
pred = sc_eval(if_predicate(exp), env);
exp = is_true(pred) ? if_consequence(exp) : if_alternative(exp);
goto tailcall;
} else if (is_lambda(exp)) {
val = make_compound_proc(lambda_parameters(exp),
lambda_body(exp),
env);
} else if (is_begin(exp)) {
exp = begin_actions(exp);
while (!is_last_exp(exp)) {
sc_eval(first_exp(exp), env);
exp = rest_exps(exp);
}
exp = first_exp(exp);
goto tailcall;
} else if (is_cond(exp)) {
exp = cond_to_if(exp);
if (exp == NULL) {
gc_abandon();
gc_abandon();
return NULL;
}
goto tailcall;
} else if (is_let(exp)) {
exp = let_to_application(exp);
if (exp == NULL) {
fprintf(stderr, "malformed let form\n");
gc_abandon();
gc_abandon();
return NULL;
}
goto tailcall;
} else if (is_and(exp)) {
object *result;
exp = and_tests(exp);
if (is_empty_list(exp)) {
gc_abandon();
gc_abandon();
return get_true_obj();
}
while (!is_last_exp(exp)) {
result = sc_eval(first_exp(exp), env);
if (is_false(result)) {
gc_abandon();
gc_abandon();
return result;
}
exp = rest_exps(exp);
}
exp = first_exp(exp);
goto tailcall;
} else if (is_or(exp)) {
object *result;
exp = or_tests(exp);
if (is_empty_list(exp)) {
gc_abandon();
gc_abandon();
return get_false_obj();
}
while (!is_last_exp(exp)) {
result = sc_eval(first_exp(exp), env);
if (is_true(result)) {
gc_abandon();
gc_abandon();
return result;
}
exp = rest_exps(exp);
}
exp = first_exp(exp);
goto tailcall;
} else if (is_application(exp)) {
object *op, *args;
prim_proc fn;
object *ret;
int err;
op = sc_eval(operator(exp), env);
if (is_macro(op)) {
args = cdr(exp);
gc_protect(op);
gc_protect(args);
exp = expand_macro(exp, op, args);
gc_abandon(); /* args */
gc_abandon(); /* op */
if (exp == NULL) {
gc_abandon();
gc_abandon();
return NULL;
}
goto tailcall;
}
/* normal application */
gc_protect(op);
args = list_of_values(operands(exp), env);
if (args == NULL) {
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
gc_protect(args);
/* handle apply specially for tailcall requirement */
if (is_apply(op)) {
char msg[] = "wrong arity in apply";
op = apply_operator(args);
if (op == NULL) {
fprintf(stderr, "%s\n", msg);
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
args = apply_operands(args);
if (args == NULL) {
fprintf(stderr, "%s\n", msg);
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
}
/* handle eval specially for tailcall requirement */
if (is_eval(op)) {
char msg[] = "wrong arity in eval";
exp = eval_exps(args);
if (exp == NULL) {
fprintf(stderr, "%s\n", msg);
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
env = eval_env(args);
if (env == NULL) {
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
gc_abandon();
gc_abandon();
goto tailcall;
}
/* handle macroexpand specially for args */
if (is_macroexpand(op)) {
if (!is_empty_list(cdr(args))) {
fprintf(stderr, "%s\n", "wrong arity in macroexpand");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
} else {
object *mexp = car(args);
object *macro = sc_eval(car(mexp), env);
if (!is_macro(macro)) {
sc_write(stderr, car(mexp));
fprintf(stderr, "%s\n", " not a macro");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
gc_protect(macro);
val = expand_macro(mexp, macro, cdr(mexp));
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return val;
}
}
if (is_callwcc(op)) {
object *c;
if (!is_empty_list(cdr(args))) {
fprintf(stderr, "wrong arity `");
sc_write(stderr, exp);
fprintf(stderr, "\n");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
c = save_cont();
if (c != NULL) {
/* continuation saved */
gc_protect(c);
c = cons(c, get_empty_list());
c = cons(car(args), c);
exp = c;
gc_abandon();
gc_abandon();
gc_abandon();
goto tailcall;
} else {
/* continuation returns */
val = get_escape_val();
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return val;
}
}
if (is_primitive_proc(op)) {
fn = obj_fv(op);
if (fn == NULL) {
sc_log("%s", "invalid primitive procedure");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
err = fn(args, &ret);
if (err != 0) {
fprintf(stderr, "%s `", error_str(err));
sc_write(stderr, exp);
fprintf(stderr, "\n");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
gc_abandon();
gc_abandon();
val = ret;
} else if (is_compound_proc(op)) {
/* handle var-arg */
args = normalize_lambda_args(obj_lvargc(op), obj_lvvar(op), args);
if (args == NULL) {
fprintf(stderr, "wrong arity `");
sc_write(stderr, exp);
fprintf(stderr, "\n");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
env = extend_env(obj_lvp(op),
args,
obj_lve(op));
exp = make_begin(obj_lvb(op));
gc_abandon();
gc_abandon();
goto tailcall;
} else if (is_cont(op)) {
if (!is_empty_list(cdr(args))) {
fprintf(stderr, "wrong arity `");
sc_write(stderr, exp);
fprintf(stderr, "\n");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
/* never return, stack root is automatically abandoned*/
restore_cont(obj_cont(op), car(args));
} else {
fprintf(stderr, "%s `", "object not applicable");
sc_write(stderr, exp);
fprintf(stderr, "\n");
gc_abandon();
gc_abandon();
gc_abandon();
gc_abandon();
return NULL;
}
} else {
val = NULL;
fprintf(stderr,
"cannot evaluate expression `");
sc_write(stderr, exp);
fprintf(stderr, "\n");
}
gc_abandon();
gc_abandon();
return val;
}
Something went wrong with that request. Please try again.