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); } }