static Expr* eqv(Expr* args) {
assert(args);
if(scm_list_len(args) != 2) return scm_mk_error("eqv? expects 2 args");
Expr* fst = scm_car(args);
Expr* snd = scm_cadr(args);
if(fst == snd) return TRUE;
if(scm_is_pair(fst) || scm_is_pair(snd)) return FALSE;
if(scm_is_closure(fst) || scm_is_closure(snd)) return FALSE;
if(scm_is_num(fst) && scm_is_num(snd)) return num_eq(args);
if(scm_is_string(fst) && scm_is_string(snd) && strcmp(scm_sval(fst), scm_sval(snd)) == 0) return TRUE;
return FALSE;
}
static void conv_highlight_keywords(struct conv *conv)
{
int key_index = 0;
scheme *sc = conv->proc->sc;
pointer sym = conv->proc->code;
assert(sc);
assert(sym);
if (sym == sc->NIL) {
warn("%s: conv proc not a symbol", __FUNCTION__);
return;
}
pointer ifc = sc->vptr->find_slot_in_env(sc, sc->envir, sym, 1);
if (! scm_is_pair(sc, ifc)) {
warn("%s: conv '%s' has no value", __FUNCTION__, scm_sym_val(sc, sym));
return;
}
pointer clos = scm_cdr(sc, ifc);
if (! scm_is_closure(sc, clos)) {
warn("%s: conv '%s' not a closure", __FUNCTION__, scm_sym_val(sc, sym));
return;
}
pointer env = scm_cdr(sc, clos);
pointer vtable = scm_cdr(sc, scm_car(sc, scm_car(sc, env)));
conv->n_keywords = scm_len(sc, vtable);
if (!(conv->keywords = (char**)calloc(conv->n_keywords, sizeof(char*)))) {
warn("%s: failed to allocate keyword array size %d", __FUNCTION__, conv->n_keywords);
return;
}
if (!(conv->marked = bitset_alloc(conv->n_keywords))) {
warn("%s: failed to allocate bitset array size %d", __FUNCTION__, conv->n_keywords);
return;
}
while (scm_is_pair(sc, vtable)) {
pointer binding = scm_car(sc, vtable);
vtable = scm_cdr(sc, vtable);
pointer var = scm_car(sc, binding);
if (conv_add_keyword(conv, scm_sym_val(sc, var), key_index)) {
return;
}
key_index++;
}
conv_sort_keywords(conv);
}
/**
* Evaluate a Scheme procedure with Scheme args. This is an internal helper
* function.
*
* @param closure The closure to invoke.
* @param args A scheme list of parameters.
* @returns The result of evaluating the closure.
*/
static pointer closure_exec_with_scheme_args(closure_t *closure, pointer args)
{
pointer result;
/* Lock the closure against deletion while it is being called. */
closure_ref(closure);
/* Straight procedure call? */
if (scm_is_closure(closure->sc, closure->code)) {
result = scheme_call(closure->sc, closure->code, args);
}
/* Need to lookup it up first? */
else if (scm_is_sym(closure->sc, closure->code)) {
pointer pair;
pointer proc;
/* The 'code' pointer is a pointer to a scheme symbol. Looking
* it up in the scheme environment will return a (symbol,
* value) pair. We then take the cdr of the pair to get the
* actual procedure we want to call. */
pair = closure->sc->vptr->find_slot_in_env(closure->sc,
closure->sc->envir,
closure->code,
1);
assert(scm_is_pair(closure->sc, pair));
proc = closure->sc->vptr->pair_cdr(pair);
result = scheme_call(closure->sc, proc, args);
}
/* Invalid or garbage-collected closure? */
else {
/* There's a bug somewhere. Happy hunting. */
assert(false);
}
closure_unref(closure);
return result;
}
