static int slot_list_delq( obj owner, UINT_32 slot, obj key )
{
obj p, prev = FALSE_OBJ;
p = gvec_ref( owner, slot );
while (PAIR_P( p )) {
if (EQ( pair_car( p ), key )) {
if (EQ( prev, FALSE_OBJ )) {
gvec_set( owner, slot, pair_cdr( p ) );
} else {
pair_set_cdr( prev, pair_cdr( p ) );
}
return 1;
}
prev = p;
p = pair_cdr( p );
}
return 0;
}
static obj_t *
expand_quasiquote(obj_t **frame, obj_t *content,
enum quasiquote_return_flag *flag)
{
if (!pairp(content)) {
return content;
}
// Manually compare each item with unquote/unquote-splicing
obj_t *qq = symbol_quasiquote;
obj_t *uq = symbol_unquote;
obj_t *spl = symbol_unquote_splicing;
if (pair_car(content) == qq) {
if (flag)
flag = QQ_DEFAULT;
return content;
// XXX: NESTED QQ...
/*
obj_t *body = pair_cadr(content);
frame = frame_extend(frame, 1, FR_SAVE_PREV | FR_CONTINUE_ENV);
*frame_ref(frame, 0) = content;
obj_t *res = expand_quasiquote(frame, body, NULL); // nested QQ
obj_t *wrap = pair_wrap(frame, res, nil_wrap());
return pair_wrap(frame, qq, wrap);
*/
}
else if (pair_car(content) == uq) {
obj_t *uq_body = pair_cadr(content);
frame = frame_extend(frame, 1, FR_SAVE_PREV | FR_CONTINUE_ENV);
*frame_ref(frame, 0) = uq_body;
if (flag)
*flag = QQ_UNQUOTE;
return eval_frame(frame);
}
else if (pair_car(content) == spl) {
obj_t *spl_body = pair_cadr(content);
obj_t *retval;
frame = frame_extend(frame, 1, FR_SAVE_PREV | FR_CONTINUE_ENV);
*frame_ref(frame, 0) = spl_body;
retval = eval_frame(frame);
if (flag)
*flag = QQ_SPLICING;
return retval;
}
else {
// Copy the pair content.
content = pair_copy_list(frame, content);
// Append a dummy header for unquote-splicing to use.
content = pair_wrap(frame, nil_wrap(), content);
// Mark the content.
frame = frame_extend(frame, 1, FR_SAVE_PREV | FR_CONTINUE_ENV);
*frame_ref(frame, 0) = content;
// For linking unquote-splicing, we look at the next item of
// the iterator. That's why we need a dummy header here.
obj_t *iter, *next, *got;
enum quasiquote_return_flag ret_flag;
for (iter = content; pairp(iter); iter = pair_cdr(iter)) {
// `next` will always be null or pair, since `content` is a list.
loop_begin:
next = pair_cdr(iter);
if (nullp(next)) // we are done.
break;
// XXX: this is strange. why do we need to initialize it?
ret_flag = QQ_DEFAULT;
got = expand_quasiquote(frame, pair_car(next), &ret_flag);
if (ret_flag & QQ_SPLICING) {
// Special handling for unquote-splicing
// WARNING: messy code below!
got = pair_copy_list(frame, got);
if (nullp(got)) {
pair_set_cdr(iter, pair_cdr(next));
}
else {
pair_set_cdr(iter, got); // iter -> got
while (pairp(pair_cdr(got))) {
got = pair_cdr(got);
}
pair_set_cdr(got, pair_cdr(next)); // got -> (next->next)
iter = got; // make sure the next iteration is correct
goto loop_begin; // And this...
}
}
else {
// Not unquote-splicing, easy...
pair_set_car(next, got);
}
}
if (flag)
*flag = QQ_DEFAULT;
return pair_cdr(content);
}
}
