#line 1 "/tmp/pkgbuild/lang/ecl/work/ecl-16.1.2/src/c/list.d"
/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */

/*
    list.d -- List manipulating routines.
*/
/*
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
    Copyright (c) 1990, Giuseppe Attardi.
    Copyright (c) 2001, Juan Jose Garcia Ripoll.

    ECL is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    See file '../Copyright' for full details.
*/

#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>

struct cl_test {
        bool (*test_c_function)(struct cl_test *, cl_object);
        cl_object (*key_c_function)(struct cl_test *, cl_object);
        cl_env_ptr env;
        cl_object key_function;
        cl_objectfn key_fn;
        cl_object test_function;
        cl_objectfn test_fn;
        cl_object item_compared;
};

static cl_object subst(struct cl_test *t, cl_object new_obj, cl_object tree);
static cl_object nsubst(struct cl_test *t, cl_object new_obj, cl_object tree);
static cl_object sublis(struct cl_test *t, cl_object alist, cl_object tree);
static cl_object nsublis(struct cl_test *t, cl_object alist, cl_object tree);
static cl_object do_assoc(struct cl_test *t, cl_object alist);

#define TEST(t,k) ((t)->test_c_function)((t),(k))
#define KEY(t,x) ((t)->key_c_function)((t),(x))
#define close_test(t) (void)0

static bool
test_compare(struct cl_test *t, cl_object x)
{
        x = KEY(t,x);
        t->env->function = t->test_function;
        return t->test_fn(2, t->item_compared, x) != ECL_NIL;
}

static bool
test_compare_not(struct cl_test *t, cl_object x)
{
        x = KEY(t,x);
        t->env->function = t->test_function;
        return t->test_fn(2, t->item_compared, x) == ECL_NIL;
}

static bool
test_eq(struct cl_test *t, cl_object x)
{
        return (t->item_compared == KEY(t,x));
}

static bool
test_eql(struct cl_test *t, cl_object x)
{
        return ecl_eql(t->item_compared, KEY(t,x));
}

static bool
test_equal(struct cl_test *t, cl_object x)
{
        return ecl_equal(t->item_compared, KEY(t,x));
}

static bool
test_equalp(struct cl_test *t, cl_object x)
{
        return ecl_equalp(t->item_compared, KEY(t,x));
}

static cl_object
key_function(struct cl_test *t, cl_object x)
{
        t->env->function = t->key_function;
        return t->key_fn(1,x);
}

static cl_object
key_identity(struct cl_test *t, cl_object x)
{
        return x;
}

static void
setup_test(struct cl_test *t, cl_object item, cl_object test,
           cl_object test_not, cl_object key)
{
        cl_env_ptr env = t->env = ecl_process_env();
        t->item_compared = item;
        if (test != ECL_NIL) {
                if (test_not != ECL_NIL)
                    FEerror("Both :TEST and :TEST-NOT are specified.", 0);
                t->test_function = test = si_coerce_to_function(test);
                if (test == ECL_SYM_FUN(ECL_SYM("EQ",333))) {
                        t->test_c_function = test_eq;
                } else if (test == ECL_SYM_FUN(ECL_SYM("EQL",334))) {
                        t->test_c_function = test_eql;
                } else if (test == ECL_SYM_FUN(ECL_SYM("EQUAL",335))) {
                        t->test_c_function = test_equal;
                } else if (test == ECL_SYM_FUN(ECL_SYM("EQUALP",336))) {
                        t->test_c_function = test_equalp;
                } else {
                        t->test_c_function = test_compare;
                        t->test_fn = ecl_function_dispatch(env, test);
                        t->test_function = env->function;
                }
        } else if (test_not != ECL_NIL) {
                t->test_c_function = test_compare_not;
                test_not = si_coerce_to_function(test_not);
                t->test_fn = ecl_function_dispatch(env, test_not);
                t->test_function = env->function;
        } else {
                t->test_c_function = test_eql;
        }
        if (key != ECL_NIL) {
                key = si_coerce_to_function(key);
                t->key_fn = ecl_function_dispatch(env, key);
                t->key_function = env->function;
                t->key_c_function = key_function;
        } else {
                t->key_c_function = key_identity;
        }
}

#line 138
cl_object cl_list(cl_narg narg, ...)
{
#line 138

        cl_object head = ECL_NIL;
#line 141
	const cl_env_ptr the_env = ecl_process_env();
#line 141
	ecl_va_list args;
	ecl_va_start(args, narg, narg, 0);
#line 141
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(481));
#line 141
        if (narg--) {
                cl_object tail = head = ecl_list1(ecl_va_arg(args));
                while (narg--) {
                        cl_object cons = ecl_list1(ecl_va_arg(args));
                        ECL_RPLACD(tail, cons);
                        tail = cons;
                }
        }
        {
#line 149
	#line 149
	cl_object __value0 = head;
#line 149
	the_env->nvalues = 1;
#line 149
	return __value0;
#line 149
}

}

#line 152
cl_object cl_listX(cl_narg narg, ...)
{
#line 152

        cl_object head;
#line 155
	const cl_env_ptr the_env = ecl_process_env();
#line 155
	ecl_va_list args;
	ecl_va_start(args, narg, narg, 0);
#line 155
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(482));
#line 155
        if (narg == 0)
                FEwrong_num_arguments(ecl_make_fixnum(/*LIST**/482));
        head = ecl_va_arg(args);
        if (--narg) {
                cl_object tail = head = ecl_list1(head);
                while (--narg) {
                        cl_object cons = ecl_list1(ecl_va_arg(args));
                        ECL_RPLACD(tail, cons);
                        tail = cons;
                }
                ECL_RPLACD(tail, ecl_va_arg(args));
        }
        {
#line 167
	#line 167
	cl_object __value0 = head;
#line 167
	the_env->nvalues = 1;
#line 167
	return __value0;
#line 167
}

}

static cl_object *
append_into(cl_object head, cl_object *tail, cl_object l)
{
        if (!Null(*tail)) {
                /* (APPEND '(1 . 2) 3) */
                FEtype_error_proper_list(head);
        }
        while (CONSP(l)) {
                cl_object cons = ecl_list1(ECL_CONS_CAR(l));
                *tail = cons;
                tail = &ECL_CONS_CDR(cons);
                l = ECL_CONS_CDR(l);
        }
        *tail = l;
        return tail;
}

#line 187
cl_object cl_append(cl_narg narg, ...)
{
#line 187

        cl_object head = ECL_NIL, *tail = &head;
#line 190
	const cl_env_ptr the_env = ecl_process_env();
#line 190
	ecl_va_list rest;
	ecl_va_start(rest, narg, narg, 0);
#line 190
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(88));
#line 190
        for (; narg > 1; narg--) {
                cl_object other = ecl_va_arg(rest);
                tail = append_into(head, tail, other);
        }
        if (narg) {
                if (!Null(*tail)) {
                        /* (APPEND '(1 . 2) 3) */
                        FEtype_error_proper_list(head);
                }
                *tail = ecl_va_arg(rest);
        }
        {
#line 201
	#line 201
	cl_object __value0 = head;
#line 201
	the_env->nvalues = 1;
#line 201
	return __value0;
#line 201
}

}

cl_object
ecl_append(cl_object x, cl_object y)
{
        cl_object head = ECL_NIL;
        cl_object *tail = &head;
        if (!Null(x)) {
                tail = append_into(head, tail, x);
        }
        if (!Null(*tail)) {
                /* (APPEND '(1 . 2) 3) */
                FEtype_error_proper_list(head);
        }
        *tail = y;
        return head;
}

#define LENTH(n) (cl_object x) {                                \
                const cl_env_ptr the_env = ecl_process_env();   \
                ecl_return1(the_env, ecl_nth(n, x));            \
        }
cl_object cl_fifth        LENTH(4)
cl_object cl_sixth        LENTH(5)
cl_object cl_seventh      LENTH(6)
cl_object cl_eighth       LENTH(7)
cl_object cl_ninth        LENTH(8)
cl_object cl_tenth        LENTH(9)
#undef LENTH

static bool
tree_equal(struct cl_test *t, cl_object x, cl_object y)
{
BEGIN:
        if (CONSP(x)) {
                if (CONSP(y)) {
                        if (tree_equal(t, ECL_CONS_CAR(x), ECL_CONS_CAR(y))) {
                                x = ECL_CONS_CDR(x);
                                y = ECL_CONS_CDR(y);
                                goto BEGIN;
                        } else {
                                return(FALSE);
                        }
                } else {
                        return(FALSE);
                }
        } else {
                t->item_compared = x;
                if (TEST(t, y))
                        return(TRUE);
                else
                        return(FALSE);
        }
}

#line 257
cl_object cl_tree_equal(cl_narg narg, cl_object x, cl_object y, ...)
{
#line 257

        struct cl_test t;
        cl_object output;
#line 261
	const cl_env_ptr the_env = ecl_process_env();
#line 261
	static cl_object KEYS[2] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322)};
	cl_object test;
	cl_object test_not;
#line 261
	cl_object KEY_VARS[4];
#line 261
	ecl_va_list ARGS;
	ecl_va_start(ARGS, y, narg, 2);
#line 261
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(863));
#line 261
	cl_parse_key(ARGS, 2, KEYS, KEY_VARS, NULL, 0);
#line 261
	if (KEY_VARS[2]==ECL_NIL) {
#line 261
	  test = ECL_NIL;
	} else {
#line 261
	  test = KEY_VARS[0];
	}
#line 261
	if (KEY_VARS[3]==ECL_NIL) {
#line 261
	  test_not = ECL_NIL;
	} else {
#line 261
	  test_not = KEY_VARS[1];
	}
#line 261
        setup_test(&t, ECL_NIL, test, test_not, ECL_NIL);
        output = tree_equal(&t, x, y)? ECL_T : ECL_NIL;
        close_test(&t);
        {
#line 264
	#line 264
	cl_object __value0 = output;
#line 264
	the_env->nvalues = 1;
#line 264
	return __value0;
#line 264
}

}

cl_object
cl_endp(cl_object x)
{
        cl_object output = ECL_NIL;
        if (Null(x)) {
                output = ECL_T;
        } else if (ecl_unlikely(!LISTP(x))) {
                FEwrong_type_only_arg(ecl_make_fixnum(/*ENDP*/330), x, ecl_make_fixnum(/*LIST*/481));
        }
        {
#line 276
	const cl_env_ptr the_env = ecl_process_env();
#line 276
	#line 276
	cl_object __value0 = output;
#line 276
	the_env->nvalues = 1;
#line 276
	return __value0;
#line 276
}
;
}

bool
ecl_endp(cl_object x)
{
        if (Null(x)) {
                return TRUE;
        } else if (ecl_unlikely(!LISTP(x))) {
                FEwrong_type_only_arg(ecl_make_fixnum(/*ENDP*/330), x, ecl_make_fixnum(/*LIST*/481));
        }
        return FALSE;
}

cl_object
cl_list_length(cl_object x)
{
        cl_fixnum n;
        cl_object fast, slow;
        /* INV: A list's length always fits in a fixnum */
        fast = slow = x;
        for (n = 0; !Null(fast); n++, fast = ECL_CONS_CDR(fast)) {
                if (ecl_unlikely(!LISTP(fast))) {
                        FEtype_error_list(fast);
                }
                if (n & 1) {
                        /* Circular list? */
                        if (slow == fast) {
#line 303
	const cl_env_ptr the_env = ecl_process_env();
#line 303
	#line 303
	cl_object __value0 = ECL_NIL;
#line 303
	the_env->nvalues = 1;
#line 303
	return __value0;
#line 303
}
;
                        slow = ECL_CONS_CDR(slow);
                }
        }
        {
#line 307
	const cl_env_ptr the_env = ecl_process_env();
#line 307
	#line 307
	cl_object __value0 = ecl_make_fixnum(n);
#line 307
	the_env->nvalues = 1;
#line 307
	return __value0;
#line 307
}
;
}

cl_object
si_proper_list_p(cl_object x)
{
        cl_fixnum n;
        cl_object fast, slow, test = ECL_T;
        /* INV: A list's length always fits in a fixnum */
        fast = slow = x;
        for (n = 0; !Null(fast); n++, fast = ECL_CONS_CDR(fast)) {
                if (!LISTP(fast)) {
                        test = ECL_NIL;
                        break;
                }
                if (n & 1) {
                        /* Circular list? */
                        if (slow == fast) {
                                test = ECL_NIL;
                                break;
                        }
                        slow = ECL_CONS_CDR(slow);
                }
        }
        {
#line 331
	const cl_env_ptr the_env = ecl_process_env();
#line 331
	#line 331
	cl_object __value0 = test;
#line 331
	the_env->nvalues = 1;
#line 331
	return __value0;
#line 331
}
;
}

cl_object
cl_nth(cl_object n, cl_object x)
{
        {
#line 337
	const cl_env_ptr the_env = ecl_process_env();
#line 337
	#line 337
	cl_object __value0 = ecl_nth(ecl_to_size(n), x);
#line 337
	the_env->nvalues = 1;
#line 337
	return __value0;
#line 337
}

}

cl_object
ecl_nth(cl_fixnum n, cl_object x)
{
        if (n < 0)
                FEtype_error_index(x, n);
        /* INV: No need to check for circularity since we visit
           at most `n' conses */
        for (; n > 0 && CONSP(x); n--)
                x = ECL_CONS_CDR(x);
        if (Null(x))
                return ECL_NIL;
        if (!LISTP(x))
                FEtype_error_list(x);
        return ECL_CONS_CAR(x);
}

cl_object
cl_nthcdr(cl_object n, cl_object x)
{
        {
#line 359
	const cl_env_ptr the_env = ecl_process_env();
#line 359
	#line 359
	cl_object __value0 = ecl_nthcdr(ecl_to_size(n), x);
#line 359
	the_env->nvalues = 1;
#line 359
	return __value0;
#line 359
}

}

cl_object
ecl_nthcdr(cl_fixnum n, cl_object x)
{
        if (n < 0)
                FEtype_error_index(x, n);
        while (n-- > 0 && !Null(x)) {
                if (LISTP(x)) {
                        x = ECL_CONS_CDR(x);
                } else {
                        FEtype_error_list(x);
                }
        }
        return x;
}

cl_object
ecl_last(cl_object l, cl_index n)
{
        /* The algorithm is very simple. We run over the list with
         * two pointers, "l" and "r". The separation between both
         * must be "n", so that when "l" finds no more conses, "r"
         * contains the output. */
        cl_object r;
        for (r = l; n && CONSP(r); n--, r = ECL_CONS_CDR(r))
                ;
        /* If "l" has not moved, we have to ensure that it is a list */
        if (r == l) {
                if (!LISTP(r)) FEtype_error_list(l);
                while (CONSP(r)) {
                        r = ECL_CONS_CDR(r);
                }
                return r;
        } else if (n == 0) {
                while (CONSP(r)) {
                        r = ECL_CONS_CDR(r);
                        l = ECL_CONS_CDR(l);
                }
                return l;
        } else {
                return l;
        }
}

#line 405
cl_object cl_last(cl_narg narg, cl_object l, ...)
{
#line 405

#line 407
	const cl_env_ptr the_env = ecl_process_env();
#line 407
	cl_object k;
#line 407
	va_list ARGS;
	va_start(ARGS, l);
#line 407
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(455));
#line 407
	if (narg > 1) {
#line 407
		k = va_arg(ARGS,cl_object);
#line 407
	} else {
#line 407
		k = ecl_make_fixnum(1);
#line 407
	}
#line 407
        if (ecl_t_of(k) == t_bignum)
                {
#line 408
	#line 408
	cl_object __value0 = l;
#line 408
	the_env->nvalues = 1;
#line 408
	return __value0;
#line 408
}

        {
#line 409
	#line 409
	cl_object __value0 = ecl_last(l, ecl_to_size(k));
#line 409
	the_env->nvalues = 1;
#line 409
	return __value0;
#line 409
}

}

#line 412
cl_object cl_make_list(cl_narg narg, cl_object size, ...)
{
#line 412

        cl_fixnum i;
#line 415
	const cl_env_ptr the_env = ecl_process_env();
#line 415
	static cl_object KEYS[1] = {(cl_object)(cl_symbols+1256)};
	cl_object initial_element;
#line 415
	cl_object x;
#line 415
	cl_object KEY_VARS[2];
#line 415
	ecl_va_list ARGS;
	ecl_va_start(ARGS, size, narg, 1);
#line 415
	if (ecl_unlikely(narg < 1)) FEwrong_num_arguments(ecl_make_fixnum(529));
#line 415
	cl_parse_key(ARGS, 1, KEYS, KEY_VARS, NULL, 0);
#line 415
	if (KEY_VARS[1]==ECL_NIL) {
#line 415
	  initial_element = ECL_NIL;
	} else {
#line 415
	  initial_element = KEY_VARS[0];
	}
#line 415
	x = ECL_NIL;
#line 415
        /* INV: ecl_to_size() signals a type-error if SIZE is not a integer >=0 */
        i = ecl_to_size(size);
        while (i-- > 0)
                x = CONS(initial_element, x);
        {
#line 419
	#line 419
	cl_object __value0 = x;
#line 419
	the_env->nvalues = 1;
#line 419
	return __value0;
#line 419
}

}

cl_object
cl_copy_list(cl_object x)
{
        cl_object copy;
        if (ecl_unlikely(!LISTP(x))) {
                FEwrong_type_only_arg(ecl_make_fixnum(/*COPY-LIST*/257), x, ecl_make_fixnum(/*LIST*/481));
        }
        copy = ECL_NIL;
        if (!Null(x)) {
                cl_object tail = copy = ecl_list1(CAR(x));
                while (x = ECL_CONS_CDR(x), CONSP(x)) {
                        cl_object cons = ecl_list1(ECL_CONS_CAR(x));
                        ECL_RPLACD(tail, cons);
                        tail = cons;
                }
                ECL_RPLACD(tail, x);
        }
        {
#line 439
	const cl_env_ptr the_env = ecl_process_env();
#line 439
	#line 439
	cl_object __value0 = copy;
#line 439
	the_env->nvalues = 1;
#line 439
	return __value0;
#line 439
}
;
}

static cl_object
duplicate_pairs(cl_object x)
{
        cl_object p = ECL_CONS_CAR(x);
        if (CONSP(p))
                p = CONS(ECL_CONS_CAR(p), ECL_CONS_CDR(p));
        return ecl_list1(p);
}

cl_object
cl_copy_alist(cl_object x)
{
        cl_object copy;
        if (ecl_unlikely(!LISTP(x))) {
                FEwrong_type_only_arg(ecl_make_fixnum(/*COPY-ALIST*/256), x, ecl_make_fixnum(/*LIST*/481));
        }
        copy = ECL_NIL;
        if (!Null(x)) {
                cl_object tail = copy = duplicate_pairs(x);
                while (x = ECL_CONS_CDR(x), !Null(x)) {
                        if (!LISTP(x)) {
                                FEtype_error_list(x);
                        } else {
                                cl_object cons = duplicate_pairs(x);
                                tail = ECL_RPLACD(tail, cons);
                                tail = cons;
                        }
                }
        }
        {
#line 471
	const cl_env_ptr the_env = ecl_process_env();
#line 471
	#line 471
	cl_object __value0 = copy;
#line 471
	the_env->nvalues = 1;
#line 471
	return __value0;
#line 471
}
;
}

static cl_object
do_copy_tree(cl_object x)
{
        if (CONSP(x)) {
                x = CONS(do_copy_tree(ECL_CONS_CAR(x)),
                         do_copy_tree(ECL_CONS_CDR(x)));
        }
        return x;
}

cl_object
cl_copy_tree(cl_object x)
{
        {
#line 487
	const cl_env_ptr the_env = ecl_process_env();
#line 487
	#line 487
	cl_object __value0 = do_copy_tree(x);
#line 487
	the_env->nvalues = 1;
#line 487
	return __value0;
#line 487
}

}

cl_object
cl_revappend(cl_object x, cl_object y)
{
        loop_for_in(x) {
                y = CONS(ECL_CONS_CAR(x),y);
        } end_loop_for_in;
        {
#line 496
	const cl_env_ptr the_env = ecl_process_env();
#line 496
	#line 496
	cl_object __value0 = y;
#line 496
	the_env->nvalues = 1;
#line 496
	return __value0;
#line 496
}

}

#line 499
cl_object cl_nconc(cl_narg narg, ...)
{
#line 499

        cl_object head = ECL_NIL, tail = ECL_NIL;
#line 501
	const cl_env_ptr the_env = ecl_process_env();
#line 501
	ecl_va_list lists;
	ecl_va_start(lists, narg, narg, 0);
#line 501
	if (ecl_unlikely(narg < 0)) FEwrong_num_arguments(ecl_make_fixnum(581));
#line 501
      
        while (narg--) {
                cl_object new_tail, other = ecl_va_arg(lists);
                if (Null(other)) {
                        new_tail = tail;
                } else if (CONSP(other)) {
                        new_tail = ecl_last(other, 1);
                } else {
                        if (narg) FEtype_error_list(other);
                        new_tail = tail;
                }
                if (Null(head)) {
                        head = other;
                } else {
                        ECL_RPLACD(tail, other);
                }
                tail = new_tail;
        }
        {
#line 519
	#line 519
	cl_object __value0 = head;
#line 519
	the_env->nvalues = 1;
#line 519
	return __value0;
#line 519
}

}

cl_object
ecl_nconc(cl_object l, cl_object y)
{
        if (Null(l)) {
                return y;
        } else {
                ECL_RPLACD(ecl_last(l, 1), y);
                return l;
        }
}

cl_object
cl_nreconc(cl_object l, cl_object y)
{
        cl_object x, z;
        /* INV: when a circular list is "reconc'ed", the pointer ends
           up at the beginning of the original list, hence we need no
           slow pointer */
        for (x = l; !Null(x); ) {
                if (!LISTP(x)) FEtype_error_list(x);
                z = x;
                x = ECL_CONS_CDR(x);
                if (x == l) FEcircular_list(l);
                ECL_RPLACD(z, y);
                y = z;
        }
        {
#line 548
	const cl_env_ptr the_env = ecl_process_env();
#line 548
	#line 548
	cl_object __value0 = y;
#line 548
	the_env->nvalues = 1;
#line 548
	return __value0;
#line 548
}

}

cl_object
ecl_butlast(cl_object l, cl_index n)
{
        /* See LAST for details on this algorithm */
        cl_object r;
        for (r = l; n && CONSP(r); n--, r = ECL_CONS_CDR(r))
                ;
        if (Null(r)) {
                return ECL_NIL;
        } else if (!LISTP(r)) {
                /* We reach here either because l is shorter than n conses,
                 * or because it is not a list */
                if (r == l) FEtype_error_list(r);
                return ECL_NIL;
        } else {
                /* We reach here because l has at least n conses and
                 * thus we can take CAR(l) */
                cl_object head, tail;
                head = tail = ecl_list1(CAR(l));
                while (l = ECL_CONS_CDR(l), r = ECL_CONS_CDR(r), CONSP(r)) {
                        cl_object cons = ecl_list1(ECL_CONS_CAR(l));
                        ECL_RPLACD(tail, cons);
                        tail = cons;
                }
                return head;
        }
}

#line 579
cl_object cl_butlast(cl_narg narg, cl_object lis, ...)
{
#line 579

#line 581
	const cl_env_ptr the_env = ecl_process_env();
#line 581
	cl_object nn;
#line 581
	va_list ARGS;
	va_start(ARGS, lis);
#line 581
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(161));
#line 581
	if (narg > 1) {
#line 581
		nn = va_arg(ARGS,cl_object);
#line 581
	} else {
#line 581
		nn = ecl_make_fixnum(1);
#line 581
	}
#line 581
        /* INV: No list has more than MOST_POSITIVE_FIXNUM elements */
        if (ecl_t_of(nn) == t_bignum)
                {
#line 583
	#line 583
	cl_object __value0 = ECL_NIL;
#line 583
	the_env->nvalues = 1;
#line 583
	return __value0;
#line 583
}
;
        /* INV: ecl_to_size() signals a type-error if NN is not an integer >=0 */
        {
#line 585
	#line 585
	cl_object __value0 = ecl_butlast(lis, ecl_to_size(nn));
#line 585
	the_env->nvalues = 1;
#line 585
	return __value0;
#line 585
}

}

cl_object
ecl_nbutlast(cl_object l, cl_index n)
{
        cl_object r;
        if (ecl_unlikely(!LISTP(l)))
                FEwrong_type_only_arg(ecl_make_fixnum(/*NBUTLAST*/580), l, ecl_make_fixnum(/*LIST*/481));
        for (n++, r = l; n && CONSP(r); n--, r = ECL_CONS_CDR(r))
                ;
        if (n == 0) {
                cl_object tail = l;
                while (CONSP(r)) {
                        tail = ECL_CONS_CDR(tail);
                        r = ECL_CONS_CDR(r);
                }
                ECL_RPLACD(tail, ECL_NIL);
                return l;
        }
        return ECL_NIL;
}

#line 608
cl_object cl_nbutlast(cl_narg narg, cl_object lis, ...)
{
#line 608

#line 610
	const cl_env_ptr the_env = ecl_process_env();
#line 610
	cl_object nn;
#line 610
	va_list ARGS;
	va_start(ARGS, lis);
#line 610
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(580));
#line 610
	if (narg > 1) {
#line 610
		nn = va_arg(ARGS,cl_object);
#line 610
	} else {
#line 610
		nn = ecl_make_fixnum(1);
#line 610
	}
#line 610
        /* INV: No list has more than MOST_POSITIVE_FIXNUM elements */
        if (ecl_t_of(nn) == t_bignum)
                {
#line 612
	#line 612
	cl_object __value0 = ECL_NIL;
#line 612
	the_env->nvalues = 1;
#line 612
	return __value0;
#line 612
}

        /* INV: ecl_to_size() signas a type-error if NN is not an integer >=0 */
        {
#line 614
	#line 614
	cl_object __value0 = ecl_nbutlast(lis, ecl_to_size(nn));
#line 614
	the_env->nvalues = 1;
#line 614
	return __value0;
#line 614
}

}

cl_object
cl_ldiff(cl_object x, cl_object y)
{
        cl_object head = ECL_NIL;
        if (ecl_unlikely(!LISTP(x))) {
                FEwrong_type_only_arg(ecl_make_fixnum(/*LDIFF*/459), x, ecl_make_fixnum(/*LIST*/481));
        }
        /* Here we use that, if X or Y are CONS, then (EQL X Y)
         * only when X == Y */
        if (!Null(x) && (x != y)) {
                cl_object tail = head = ecl_list1(ECL_CONS_CAR(x));
                while (1) {
                        x = ECL_CONS_CDR(x);
                        if (!CONSP(x)) {
                                if (!ecl_eql(x, y)) {
                                        ECL_RPLACD(tail, x);
                                }
                                break;
                        } else if (x == y) {
                                break;
                        } else {
                                cl_object cons = ecl_list1(ECL_CONS_CAR(x));
                                ECL_RPLACD(tail, cons);
                                tail = cons;
                        }
                }
        }
        {
#line 644
	const cl_env_ptr the_env = ecl_process_env();
#line 644
	#line 644
	cl_object __value0 = head;
#line 644
	the_env->nvalues = 1;
#line 644
	return __value0;
#line 644
}

}

cl_object
cl_rplaca(cl_object x, cl_object v)
{
        if (ecl_unlikely(!CONSP(x)))
                FEwrong_type_nth_arg(ecl_make_fixnum(/*RPLACA*/732), 1, x, ecl_make_fixnum(/*CONS*/251));
        ECL_RPLACA(x, v);
        {
#line 653
	const cl_env_ptr the_env = ecl_process_env();
#line 653
	#line 653
	cl_object __value0 = x;
#line 653
	the_env->nvalues = 1;
#line 653
	return __value0;
#line 653
}

}

cl_object
cl_rplacd(cl_object x, cl_object v)
{
        if (ecl_unlikely(!CONSP(x)))
                FEwrong_type_nth_arg(ecl_make_fixnum(/*RPLACD*/733), 1, x, ecl_make_fixnum(/*CONS*/251));
        ECL_RPLACD(x, v);
        {
#line 662
	const cl_env_ptr the_env = ecl_process_env();
#line 662
	#line 662
	cl_object __value0 = x;
#line 662
	the_env->nvalues = 1;
#line 662
	return __value0;
#line 662
}

}

#line 665
cl_object cl_subst(cl_narg narg, cl_object new_obj, cl_object old_obj, cl_object tree, ...)
{
#line 665

        struct cl_test t;
        cl_object output;
#line 669
	const cl_env_ptr the_env = ecl_process_env();
#line 669
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 669
	cl_object KEY_VARS[6];
#line 669
	ecl_va_list ARGS;
	ecl_va_start(ARGS, tree, narg, 3);
#line 669
	if (ecl_unlikely(narg < 3)) FEwrong_num_arguments(ecl_make_fixnum(831));
#line 669
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 669
	if (KEY_VARS[3]==ECL_NIL) {
#line 669
	  test = ECL_NIL;
	} else {
#line 669
	  test = KEY_VARS[0];
	}
#line 669
	if (KEY_VARS[4]==ECL_NIL) {
#line 669
	  test_not = ECL_NIL;
	} else {
#line 669
	  test_not = KEY_VARS[1];
	}
#line 669
	if (KEY_VARS[5]==ECL_NIL) {
#line 669
	  key = ECL_NIL;
	} else {
#line 669
	  key = KEY_VARS[2];
	}
#line 669
        setup_test(&t, old_obj, test, test_not, key);
        output = subst(&t, new_obj, tree);
        close_test(&t);
        {
#line 672
	#line 672
	cl_object __value0 = output;
#line 672
	the_env->nvalues = 1;
#line 672
	return __value0;
#line 672
}

}


static cl_object
subst(struct cl_test *t, cl_object new_obj, cl_object tree)
{
        if (TEST(t, tree)) {
                return new_obj;
        } else if (ECL_ATOM(tree)) {
                return tree;
        } else {
                cl_object head, tail = ECL_NIL;
                do {
                        cl_object cons = subst(t, new_obj, ECL_CONS_CAR(tree));
                        cons = ecl_cons(cons, tree = ECL_CONS_CDR(tree));
                        if (Null(tail)) {
                                head = cons;
                        } else {
                                ECL_RPLACD(tail, cons);
                        }
                        tail = cons;
                        if (TEST(t, tree)) {
                                ECL_RPLACD(tail, new_obj);
                                return head;
                        }
                } while (CONSP(tree));
                return head;
        }
}

#line 703
cl_object cl_nsubst(cl_narg narg, cl_object new_obj, cl_object old_obj, cl_object tree, ...)
{
#line 703

        struct cl_test t;
#line 706
	const cl_env_ptr the_env = ecl_process_env();
#line 706
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 706
	cl_object KEY_VARS[6];
#line 706
	ecl_va_list ARGS;
	ecl_va_start(ARGS, tree, narg, 3);
#line 706
	if (ecl_unlikely(narg < 3)) FEwrong_num_arguments(ecl_make_fixnum(596));
#line 706
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 706
	if (KEY_VARS[3]==ECL_NIL) {
#line 706
	  test = ECL_NIL;
	} else {
#line 706
	  test = KEY_VARS[0];
	}
#line 706
	if (KEY_VARS[4]==ECL_NIL) {
#line 706
	  test_not = ECL_NIL;
	} else {
#line 706
	  test_not = KEY_VARS[1];
	}
#line 706
	if (KEY_VARS[5]==ECL_NIL) {
#line 706
	  key = ECL_NIL;
	} else {
#line 706
	  key = KEY_VARS[2];
	}
#line 706
        setup_test(&t, old_obj, test, test_not, key);
        tree = nsubst(&t, new_obj, tree);
        close_test(&t);
        {
#line 709
	#line 709
	cl_object __value0 = tree;
#line 709
	the_env->nvalues = 1;
#line 709
	return __value0;
#line 709
}

}

static cl_object
nsubst_cons(struct cl_test *t, cl_object new_obj, cl_object tree)
{
        cl_object l = tree;
        do {
                cl_object o = ECL_CONS_CAR(l);
                if (TEST(t, o)) {
                        ECL_RPLACA(l, new_obj);
                } else if (CONSP(o)) {
                        nsubst_cons(t, new_obj, o);
                }
                o = ECL_CONS_CDR(l);
                if (TEST(t, o)) {
                        ECL_RPLACD(l, new_obj);
                        return tree;
                }
                l = o;
        } while (CONSP(l));
        return tree;
}

static cl_object
nsubst(struct cl_test *t, cl_object new_obj, cl_object tree)
{
        if (TEST(t, tree))
                return new_obj;
        if (CONSP(tree))
                return nsubst_cons(t, new_obj, tree);
        return tree;
}

#line 743
cl_object cl_sublis(cl_narg narg, cl_object alist, cl_object tree, ...)
{
#line 743

        /* t[0] is the test for the objects in the tree, configured
           with test, test_not and key. t[1] is the test for searching
           in the association list.
         */
        struct cl_test t[2];
#line 750
	const cl_env_ptr the_env = ecl_process_env();
#line 750
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 750
	cl_object KEY_VARS[6];
#line 750
	ecl_va_list ARGS;
	ecl_va_start(ARGS, tree, narg, 2);
#line 750
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(828));
#line 750
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 750
	if (KEY_VARS[3]==ECL_NIL) {
#line 750
	  test = ECL_NIL;
	} else {
#line 750
	  test = KEY_VARS[0];
	}
#line 750
	if (KEY_VARS[4]==ECL_NIL) {
#line 750
	  test_not = ECL_NIL;
	} else {
#line 750
	  test_not = KEY_VARS[1];
	}
#line 750
	if (KEY_VARS[5]==ECL_NIL) {
#line 750
	  key = ECL_NIL;
	} else {
#line 750
	  key = KEY_VARS[2];
	}
#line 750
        setup_test(t, ECL_NIL, ECL_NIL, ECL_NIL, key);
        setup_test(t+1, ECL_NIL, test, test_not, ECL_NIL);
        tree = sublis(t, alist, tree);
        close_test(t+1);
        close_test(t);
        {
#line 755
	#line 755
	cl_object __value0 = tree;
#line 755
	the_env->nvalues = 1;
#line 755
	return __value0;
#line 755
}

}

/*
        Sublis(alist, tree) returns
        result of substituting tree by alist.
*/
static cl_object
sublis(struct cl_test *t, cl_object alist, cl_object tree)
{
        cl_object node;
        t[1].item_compared = KEY(t, tree);
        node = do_assoc(t+1, alist);
        if (!Null(node)) {
                return ECL_CONS_CDR(node);
        }
        if (CONSP(tree)) {
                tree = CONS(sublis(t, alist, ECL_CONS_CAR(tree)),
                            sublis(t, alist, ECL_CONS_CDR(tree)));
        }
        return tree;
}

#line 778
cl_object cl_nsublis(cl_narg narg, cl_object alist, cl_object tree, ...)
{
#line 778

        /* t[0] is the test for the objects in the tree, configured
           with test, test_not and key. t[1] is the test for searching
           in the association list.
         */
        struct cl_test t[2];
#line 785
	const cl_env_ptr the_env = ecl_process_env();
#line 785
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 785
	cl_object KEY_VARS[6];
#line 785
	ecl_va_list ARGS;
	ecl_va_start(ARGS, tree, narg, 2);
#line 785
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(595));
#line 785
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 785
	if (KEY_VARS[3]==ECL_NIL) {
#line 785
	  test = ECL_NIL;
	} else {
#line 785
	  test = KEY_VARS[0];
	}
#line 785
	if (KEY_VARS[4]==ECL_NIL) {
#line 785
	  test_not = ECL_NIL;
	} else {
#line 785
	  test_not = KEY_VARS[1];
	}
#line 785
	if (KEY_VARS[5]==ECL_NIL) {
#line 785
	  key = ECL_NIL;
	} else {
#line 785
	  key = KEY_VARS[2];
	}
#line 785
        setup_test(t, ECL_NIL, ECL_NIL, ECL_NIL, key);
        setup_test(t+1, ECL_NIL, test, test_not, ECL_NIL);
        tree = nsublis(t, alist, tree);
        close_test(t+1);
        close_test(t);
        {
#line 790
	#line 790
	cl_object __value0 = tree;
#line 790
	the_env->nvalues = 1;
#line 790
	return __value0;
#line 790
}

}

/*
        Nsublis(alist, treep) stores
        the result of substiting *treep by alist
        to *treep.
*/
static cl_object
nsublis(struct cl_test *t, cl_object alist, cl_object tree)
{
        cl_object node;
        t[1].item_compared = KEY(t, tree);
        node = do_assoc(t+1, alist);
        if (!Null(node)) {
                return ECL_CONS_CDR(node);
        }
        if (CONSP(tree)) {
                ECL_RPLACA(tree, nsublis(t, alist, ECL_CONS_CAR(tree)));
                ECL_RPLACD(tree, nsublis(t, alist, ECL_CONS_CDR(tree)));
        }
        return tree;
}

#line 814
cl_object cl_member(cl_narg narg, cl_object item, cl_object list, ...)
{
#line 814

        struct cl_test t;
#line 817
	const cl_env_ptr the_env = ecl_process_env();
#line 817
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 817
	cl_object KEY_VARS[6];
#line 817
	ecl_va_list ARGS;
	ecl_va_start(ARGS, list, narg, 2);
#line 817
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(552));
#line 817
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 817
	if (KEY_VARS[3]==ECL_NIL) {
#line 817
	  test = ECL_NIL;
	} else {
#line 817
	  test = KEY_VARS[0];
	}
#line 817
	if (KEY_VARS[4]==ECL_NIL) {
#line 817
	  test_not = ECL_NIL;
	} else {
#line 817
	  test_not = KEY_VARS[1];
	}
#line 817
	if (KEY_VARS[5]==ECL_NIL) {
#line 817
	  key = ECL_NIL;
	} else {
#line 817
	  key = KEY_VARS[2];
	}
#line 817
        setup_test(&t, item, test, test_not, key);
        loop_for_in(list) {
                if (TEST(&t, ECL_CONS_CAR(list)))
                        break;
        } end_loop_for_in;
        close_test(&t);
        {
#line 823
	#line 823
	cl_object __value0 = list;
#line 823
	the_env->nvalues = 1;
#line 823
	return __value0;
#line 823
}

}

bool
ecl_member_eq(cl_object x, cl_object l)
{
        loop_for_in(l) {
                if (x == ECL_CONS_CAR(l))
                        return(TRUE);
        } end_loop_for_in;
        return(FALSE);
}

cl_object
si_memq(cl_object x, cl_object l)
{
        loop_for_in(l) {
                if (x == ECL_CONS_CAR(l))
                        {
#line 841
	const cl_env_ptr the_env = ecl_process_env();
#line 841
	#line 841
	cl_object __value0 = l;
#line 841
	the_env->nvalues = 1;
#line 841
	return __value0;
#line 841
}

        } end_loop_for_in;
        {
#line 843
	const cl_env_ptr the_env = ecl_process_env();
#line 843
	#line 843
	cl_object __value0 = ECL_NIL;
#line 843
	the_env->nvalues = 1;
#line 843
	return __value0;
#line 843
}

}

/* Added for use by the compiler, instead of open coding them. Beppe */
cl_object
ecl_memql(cl_object x, cl_object l)
{
        loop_for_in(l) {
                if (ecl_eql(x, ECL_CONS_CAR(l)))
                        return(l);
        } end_loop_for_in;
        return(ECL_NIL);
}

cl_object
ecl_member(cl_object x, cl_object l)
{
        loop_for_in(l) {
                if (ecl_equal(x, ECL_CONS_CAR(l)))
                        return(l);
        } end_loop_for_in;
        return(ECL_NIL);
}
/* End of addition. Beppe */

cl_object
si_member1(cl_object item, cl_object list, cl_object test, cl_object test_not, cl_object key)
{
        struct cl_test t;

        if (key != ECL_NIL)
                item = funcall(2, key, item);
        setup_test(&t, item, test, test_not, key);
        loop_for_in(list) {
                if (TEST(&t, ECL_CONS_CAR(list)))
                        break;
        } end_loop_for_in;
        close_test(&t);
        {
#line 881
	const cl_env_ptr the_env = ecl_process_env();
#line 881
	#line 881
	cl_object __value0 = list;
#line 881
	the_env->nvalues = 1;
#line 881
	return __value0;
#line 881
}

}

cl_object
cl_tailp(cl_object y, cl_object x)
{
        loop_for_on(x) {
                if (ecl_eql(x, y)) {
#line 888
	const cl_env_ptr the_env = ecl_process_env();
#line 888
	#line 888
	cl_object __value0 = ECL_T;
#line 888
	the_env->nvalues = 1;
#line 888
	return __value0;
#line 888
}
;
        } end_loop_for_on(x);
        return cl_eql(x, y);
}

#line 893
cl_object cl_adjoin(cl_narg narg, cl_object item, cl_object list, ...)
{
#line 893

        cl_object output;
#line 896
	const cl_env_ptr the_env = ecl_process_env();
#line 896
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 896
	cl_object KEY_VARS[6];
#line 896
	ecl_va_list ARGS;
	ecl_va_start(ARGS, list, narg, 2);
#line 896
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(82));
#line 896
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 896
	if (KEY_VARS[3]==ECL_NIL) {
#line 896
	  test = ECL_NIL;
	} else {
#line 896
	  test = KEY_VARS[0];
	}
#line 896
	if (KEY_VARS[4]==ECL_NIL) {
#line 896
	  test_not = ECL_NIL;
	} else {
#line 896
	  test_not = KEY_VARS[1];
	}
#line 896
	if (KEY_VARS[5]==ECL_NIL) {
#line 896
	  key = ECL_NIL;
	} else {
#line 896
	  key = KEY_VARS[2];
	}
#line 896
        if (narg < 2)
                FEwrong_num_arguments(ecl_make_fixnum(/*ADJOIN*/82));
        output = si_member1(item, list, test, test_not, key);
        if (Null(output))
                output = CONS(item, list);
        else
                output = list;
        {
#line 903
	#line 903
	cl_object __value0 = output;
#line 903
	the_env->nvalues = 1;
#line 903
	return __value0;
#line 903
}

}

cl_object
cl_cons(cl_object x, cl_object y)
{
        {
#line 909
	const cl_env_ptr the_env = ecl_process_env();
#line 909
	#line 909
	cl_object __value0 = CONS(x, y);
#line 909
	the_env->nvalues = 1;
#line 909
	return __value0;
#line 909
}

}

cl_object
cl_acons(cl_object x, cl_object y, cl_object z)
{
        {
#line 915
	const cl_env_ptr the_env = ecl_process_env();
#line 915
	#line 915
	cl_object __value0 = CONS(CONS(x, y), z);
#line 915
	the_env->nvalues = 1;
#line 915
	return __value0;
#line 915
}

}

#line 918
cl_object cl_pairlis(cl_narg narg, cl_object keys, cl_object data, ...)
{
#line 918

        cl_object k, d;
#line 921
	const cl_env_ptr the_env = ecl_process_env();
#line 921
	cl_object a_list;
#line 921
	va_list ARGS;
	va_start(ARGS, data);
#line 921
	if (ecl_unlikely(narg < 2|| narg > 3)) FEwrong_num_arguments(ecl_make_fixnum(626));
#line 921
	if (narg > 2) {
#line 921
		a_list = va_arg(ARGS,cl_object);
#line 921
	} else {
#line 921
		a_list = ECL_NIL;
#line 921
	}
#line 921
        k = keys;
        d = data;
        loop_for_in(k) {
                if (ecl_endp(d))
                        goto error;
                a_list = CONS(CONS(ECL_CONS_CAR(k), ECL_CONS_CAR(d)), a_list);
                d = CDR(d);
        } end_loop_for_in;
        if (!ecl_endp(d))
error:      FEerror("The keys ~S and the data ~S are not of the same length",
                    2, keys, data);
        {
#line 932
	#line 932
	cl_object __value0 = a_list;
#line 932
	the_env->nvalues = 1;
#line 932
	return __value0;
#line 932
}

}


#line 936
cl_object cl_assoc(cl_narg narg, cl_object item, cl_object a_list, ...)
{
#line 936

        struct cl_test t;
#line 939
	const cl_env_ptr the_env = ecl_process_env();
#line 939
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 939
	cl_object KEY_VARS[6];
#line 939
	ecl_va_list ARGS;
	ecl_va_start(ARGS, a_list, narg, 2);
#line 939
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(114));
#line 939
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 939
	if (KEY_VARS[3]==ECL_NIL) {
#line 939
	  test = ECL_NIL;
	} else {
#line 939
	  test = KEY_VARS[0];
	}
#line 939
	if (KEY_VARS[4]==ECL_NIL) {
#line 939
	  test_not = ECL_NIL;
	} else {
#line 939
	  test_not = KEY_VARS[1];
	}
#line 939
	if (KEY_VARS[5]==ECL_NIL) {
#line 939
	  key = ECL_NIL;
	} else {
#line 939
	  key = KEY_VARS[2];
	}
#line 939
        setup_test(&t, item, test, test_not, key);
        a_list = do_assoc(&t, a_list);
        close_test(&t);
        {
#line 942
	#line 942
	cl_object __value0 = a_list;
#line 942
	the_env->nvalues = 1;
#line 942
	return __value0;
#line 942
}

}

static cl_object
do_assoc(struct cl_test *t, cl_object a_list)
{
        loop_for_in(a_list) {
                cl_object pair = ECL_CONS_CAR(a_list);
                if (!Null(pair)) {
                        if (!LISTP(pair))
                                FEtype_error_list(pair);
                        if (TEST(t, ECL_CONS_CAR(pair)))
                                return pair;
                }
        } end_loop_for_in;
        return ECL_NIL;
}

#line 960
cl_object cl_rassoc(cl_narg narg, cl_object item, cl_object a_list, ...)
{
#line 960

        struct cl_test t;
#line 963
	const cl_env_ptr the_env = ecl_process_env();
#line 963
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1321), (cl_object)(cl_symbols+1322), (cl_object)(cl_symbols+1267)};
	cl_object test;
	cl_object test_not;
	cl_object key;
#line 963
	cl_object KEY_VARS[6];
#line 963
	ecl_va_list ARGS;
	ecl_va_start(ARGS, a_list, narg, 2);
#line 963
	if (ecl_unlikely(narg < 2)) FEwrong_num_arguments(ecl_make_fixnum(683));
#line 963
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 963
	if (KEY_VARS[3]==ECL_NIL) {
#line 963
	  test = ECL_NIL;
	} else {
#line 963
	  test = KEY_VARS[0];
	}
#line 963
	if (KEY_VARS[4]==ECL_NIL) {
#line 963
	  test_not = ECL_NIL;
	} else {
#line 963
	  test_not = KEY_VARS[1];
	}
#line 963
	if (KEY_VARS[5]==ECL_NIL) {
#line 963
	  key = ECL_NIL;
	} else {
#line 963
	  key = KEY_VARS[2];
	}
#line 963
        setup_test(&t, item, test, test_not, key);
        loop_for_in(a_list) {
                cl_object pair = ECL_CONS_CAR(a_list);
                if (!Null(pair)) {
                        if (!LISTP(pair))
                                FEtype_error_list(pair);
                        if (TEST(&t, ECL_CONS_CDR(pair))) {
                                a_list = pair;
                                break;
                        }
                }
        } end_loop_for_in;
        close_test(&t);
        {
#line 976
	#line 976
	cl_object __value0 = a_list;
#line 976
	the_env->nvalues = 1;
#line 976
	return __value0;
#line 976
}

}

cl_object
ecl_remove_eq(cl_object x, cl_object l)
{
        cl_object head = ECL_NIL, tail = ECL_NIL;
        loop_for_on_unsafe(l) {
                if (ECL_CONS_CAR(l) != x) {
                        cl_object cons = ecl_list1(ECL_CONS_CAR(l));
                        if (Null(tail)) {
                                head = tail = cons;
                        } else {
                                ECL_RPLACD(tail, cons);
                                tail = cons;
                        }
                }
        } end_loop_for_on_unsafe(l);
        return head;
}

cl_object
ecl_delete_eq(cl_object x, cl_object l)
{
        cl_object head = l;
        cl_object *p = &head;
        while (!ECL_ATOM(l)) {
                if (ECL_CONS_CAR(l) == x) {
                        *p = l = ECL_CONS_CDR(l);
                } else {
                        p = &ECL_CONS_CDR(l);
                        l = *p;
                }
        }
        return head;
}

/* Added for use by the compiler, instead of open coding them. Beppe */
cl_object
ecl_assq(cl_object x, cl_object l)
{
        loop_for_in(l) {
                cl_object pair = ECL_CONS_CAR(l);
                if (x == CAR(pair))
                        return pair;
        } end_loop_for_in;
        return(ECL_NIL);
}

cl_object
ecl_assql(cl_object x, cl_object l)
{
        loop_for_in(l) {
                cl_object pair = ECL_CONS_CAR(l);
                if (ecl_eql(x, CAR(pair)))
                        return pair;
        } end_loop_for_in;
        return(ECL_NIL);
}

cl_object
ecl_assoc(cl_object x, cl_object l)
{
        loop_for_in(l) {
                cl_object pair = ECL_CONS_CAR(l);
                if (ecl_equal(x, CAR(pair)))
                        return pair;
        } end_loop_for_in;
        return(ECL_NIL);
}

cl_object
ecl_assqlp(cl_object x, cl_object l)
{
        loop_for_in(l) {
                cl_object pair = ECL_CONS_CAR(l);
                if (ecl_equalp(x, CAR(pair)))
                        return pair;
        } end_loop_for_in;
        return(ECL_NIL);
}
/* End of addition. Beppe */
