/* libsizzle/list.c - list operations
 
  Copyright (C) 1999, 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to the
  Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#include <stdlib.h>

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "node.h"
#include "eval.h"
#include "vector.h"
#include "capi.h"
#include "values.h"
#include "port.h"
#include "srfi-1.h"
#include "validate.h"
#include "list.h"

/*:doc
  list?
  (list? obj) => boolean
  Return @code{#t}, if @var{obj} is a proper list, return @code{#f}
  otherwise. 
  doc:*/
#define FUNC_NAME "list?"
static result_t
list_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  if (zzz_list_length (obj) >= 0)
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  null?
  (null? obj) => boolean
  Return @code{#t}, if @var{obj} is a the empty list, return @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "null?"
static result_t
null_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  if (null_p (obj))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  pair?
  (pair? obj) => boolean
  Return @code{#t}, if @var{obj} is a the cons pair, return @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "pair?"
static result_t
pair_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  if (cons_p (obj))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cons
  (cons obj0 obj1) => pair
  Construct a new pair with the car initialized to @var{obj0} and the
  cdr initialized to @var{obj1}.
  doc:*/
#define FUNC_NAME "cons"
static result_t
cons_func (zzz_scm_t env, zzz_scm_t obj1, zzz_scm_t obj2, zzz_scm_t * result)
{
  *result = zzz_cons (obj1, obj2);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  list
  (list obj ...) => list
  Create a list of all arguments.
  doc:*/
#define FUNC_NAME "list"
static result_t
list_func (zzz_scm_t env, zzz_scm_t param, zzz_scm_t * result)
{
  *result = param;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  car
  (car pair) => object
  Return the car of @var{pair}.
  doc:*/
#define FUNC_NAME "car"
static result_t
car_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  *result = car (pair);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdr
  (cdr pair) => object
  Return the cdr of @var{pair}.
  doc:*/
#define FUNC_NAME "cdr"
static result_t
cdr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  *result = cdr (pair);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*
  ====================================================================
  Beginning of the C**R mess.
  ==================================================================== */

/*:doc
  caar
  (caar pair) => object
  Equivalent to (car (car pair)).
  doc:*/
#define FUNC_NAME "caar"
static result_t
caar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  *result = car (car (pair));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cadr
  (cadr pair) => object
  Equivalent to (car (cdr pair)).
  doc:*/
#define FUNC_NAME "cadr"
static result_t
cadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  *result = car (cdr (pair));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdar
  (cdar pair) => object
  Equivalent to (cdr (car pair)).
  doc:*/
#define FUNC_NAME "cdar"
static result_t
cdar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  *result = cdr (car (pair));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cddr
  (cddr pair) => object
  Equivalent to (cdr (cdr pair)).
  doc:*/
#define FUNC_NAME "cddr"
static result_t
cddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  *result = cdr (cdr (pair));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caaar
  (caaar pair) => object
  Equivalent to (car (car (car pair))).
  doc:*/
#define FUNC_NAME "caaar"
static result_t
caaar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (pair))), zzz_pair_type_name);
  *result = car (car (car (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caadr
  (caadr pair) => object
  Equivalent to (car (car (cdr pair))).
  doc:*/
#define FUNC_NAME "caadr"
static result_t
caadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (pair))), zzz_pair_type_name);
  *result = car (car (cdr (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cadar
  (cadar pair) => object
  Equivalent to (car (cdr (car pair))).
  doc:*/
#define FUNC_NAME "cadar"
static result_t
cadar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (pair))), zzz_pair_type_name);
  *result = car (cdr (car (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caddr
  (caddr pair) => object
  Equivalent to (car (cdr (cdr pair))).
  doc:*/
#define FUNC_NAME "caddr"
static result_t
caddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (pair))), zzz_pair_type_name);
  *result = car (cdr (cdr (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdaar
  (cdaar pair) => object
  Equivalent to (cdr (car (car pair))).
  doc:*/
#define FUNC_NAME "cdaar"
static result_t
cdaar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (pair))), zzz_pair_type_name);
  *result = cdr (car (car (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdadr
  (cdadr pair) => object
  Equivalent to (cdr (car (cdr pair))).
  doc:*/
#define FUNC_NAME "cdadr"
static result_t
cdadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (pair))), zzz_pair_type_name);
  *result = cdr (car (cdr (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cddar
  (cddar pair) => object
  Equivalent to (cdr (cdr (car pair))).
  doc:*/
#define FUNC_NAME "cddar"
static result_t
cddar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (pair))), zzz_pair_type_name);
  *result = cdr (cdr (car (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdddr
  (cdddr pair) => object
  Equivalent to (cdr (cdr (cdr pair))).
  doc:*/
#define FUNC_NAME "cdddr"
static result_t
cdddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (pair))), zzz_pair_type_name);
  *result = cdr (cdr (cdr (pair)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caaaar
  (caaaar pair) => object
  Equivalent to (car (car (car (car pair)))).
  doc:*/
#define FUNC_NAME "caaaar"
static result_t
caaaar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (car (pair)))), zzz_pair_type_name);
  *result = car (car (car (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caaadr
  (caaadr pair) => object
  Equivalent to (car (car (car (cdr pair)))).
  doc:*/
#define FUNC_NAME "caaadr"
static result_t
caaadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (cdr (pair)))), zzz_pair_type_name);
  *result = car (car (car (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caadar
  (caadar pair) => object
  Equivalent to (car (car (cdr (car pair)))).
  doc:*/
#define FUNC_NAME "caadar"
static result_t
caadar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (car (pair)))), zzz_pair_type_name);
  *result = car (car (cdr (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caaddr
  (caaddr pair) => object
  Equivalent to (car (car (cdr (cdr pair)))).
  doc:*/
#define FUNC_NAME "caaddr"
static result_t
caaddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (cdr (pair)))), zzz_pair_type_name);
  *result = car (car (cdr (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cadaar
  (cadaar pair) => object
  Equivalent to (car (cdr (car (car pair)))).
  doc:*/
#define FUNC_NAME "cadaar"
static result_t
cadaar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (car (pair)))), zzz_pair_type_name);
  *result = car (cdr (car (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cadadr
  (cadadr pair) => object
  Equivalent to (car (cdr (car (cdr pair)))).
  doc:*/
#define FUNC_NAME "cadadr"
static result_t
cadadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (cdr (pair)))), zzz_pair_type_name);
  *result = car (cdr (car (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  caddar
  (caddar pair) => object
  Equivalent to (car (cdr (cdr (car pair)))).
  doc:*/
#define FUNC_NAME "caddar"
static result_t
caddar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (car (pair)))), zzz_pair_type_name);
  *result = car (cdr (cdr (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cadddr
  (cadddr pair) => object
  Equivalent to (car (cdr (cdr (cdr pair)))).
  doc:*/
#define FUNC_NAME "cadddr"
static result_t
cadddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (cdr (pair)))), zzz_pair_type_name);
  *result = car (cdr (cdr (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdaaar
  (cdaaar pair) => object
  Equivalent to (cdr (car (car (car pair)))).
  doc:*/
#define FUNC_NAME "cdaaar"
static result_t
cdaaar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (car (pair)))), zzz_pair_type_name);
  *result = cdr (car (car (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdaadr
  (cdaadr pair) => object
  Equivalent to (cdr (car (car (cdr pair)))).
  doc:*/
#define FUNC_NAME "cdaadr"
static result_t
cdaadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (cdr (pair)))), zzz_pair_type_name);
  *result = cdr (car (car (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdadar
  (cdadar pair) => object
  Equivalent to (cdr (car (cdr (car pair)))).
  doc:*/
#define FUNC_NAME "cdadar"
static result_t
cdadar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (car (pair)))), zzz_pair_type_name);
  *result = cdr (car (cdr (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdaddr
  (cdaddr pair) => object
  Equivalent to (cdr (car (cdr (cdr pair)))).
  doc:*/
#define FUNC_NAME "cdaddr"
static result_t
cdaddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (cdr (pair)))), zzz_pair_type_name);
  *result = cdr (car (cdr (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cddaar
  (cddaar pair) => object
  Equivalent to (cdr (cdr (car (car pair)))).
  doc:*/
#define FUNC_NAME "cddaar"
static result_t
cddaar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (car (pair)))), zzz_pair_type_name);
  *result = cdr (cdr (car (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cddadr
  (cddadr pair) => object
  Equivalent to (cdr (cdr (car (cdr pair)))).
  doc:*/
#define FUNC_NAME "cddadr"
static result_t
cddadr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (cdr (pair)))), zzz_pair_type_name);
  *result = cdr (cdr (car (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cdddar
  (cdddar pair) => object
  Equivalent to (cdr (cdr (cdr (car pair)))).
  doc:*/
#define FUNC_NAME "cdddar"
static result_t
cdddar_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (car (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (car (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (car (pair)))), zzz_pair_type_name);
  *result = cdr (cdr (cdr (car (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  cddddr
  (cddddr pair) => object
  Equivalent to (cdr (cdr (cdr (cdr pair)))).
  doc:*/
#define FUNC_NAME "cddddr"
static result_t
cddddr_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (pair)), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (pair))), zzz_pair_type_name);
  CHECK_TYPE (1, cons_p (cdr (cdr (cdr (pair)))), zzz_pair_type_name);
  *result = cdr (cdr (cdr (cdr (pair))));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*
  ====================================================================
  End of the C**R mess.
  ==================================================================== */

/*:doc
  set-car!
  (set-car! pair obj) => *unspecified*
  Modify @var{pair} so that @var{obj} is the new car of @var{pair}.
  doc:*/
#define FUNC_NAME "set-car!"
static result_t
set_car_x_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t obj,
		zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  set_car (pair, obj);
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-cdr!
  (set-cdr! pair obj) => *unspecified*
  Modify @var{pair} so that @var{obj} is the new cdr of @var{pair}.
  doc:*/
#define FUNC_NAME "set-cdr!"
static result_t
set_cdr_x_func (zzz_scm_t env, zzz_scm_t pair, zzz_scm_t obj,
		zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, cons_p (pair), zzz_pair_type_name);
  set_cdr (pair, obj);
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  append
  (append list ...) => list
  Append all argument @var{list}s to one list.
  doc:*/
#define FUNC_NAME "append"
static result_t
append_func (zzz_scm_t env, zzz_scm_t param, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t exp = NULL, res = NULL, last = NULL, temp = NULL;
  zzz_scm_t * resp = &res;

  while (cons_p (param) && cons_p (cdr (param)))
    {
      exp = car (param);
      param = cdr (param);

      /* Only proper lists are allowed to be appended. */
      if (zzz_list_length (exp) < 0)
	{
	  *result = zzz_make_wta_exception
	    (zzz_make_list
	     (zzz_make_string (_("arguments to "), -1),
	      zzz_make_string (FUNC_NAME, -1),
	      zzz_make_string (_(" must be proper lists"), -1),
	      NULL));
	  return RESULT_EXCEPTION;
	}
      while (cons_p (exp))
	{
	  ZZZ_TICK ();
	  temp = car (exp);
	  *resp = zzz_cons (temp, NULL);
	  resp = cdr_addr (*resp);
	  exp = cdr (exp);
	}
    }
  if (cons_p (param))
    {
      *resp = car (param);
      param = cdr (param);
    }
  *result = res;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  append!
  (append! list ...) => list
  Append all argument @var{list}s to one list.  The argument lists are
  modified to produce the resulting list.
  doc:*/
#define FUNC_NAME "append!"
static result_t
append_x_func (zzz_scm_t env, zzz_scm_t param, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t exp = NULL, res = NULL;
  zzz_scm_t * resp = &res;

  if (cons_p (param) && cons_p (cdr (param)))
    {
      NEXT_ARG (exp);
      if (zzz_list_length (exp) < 0)
	{
	  *result = zzz_make_wta_exception
	    (zzz_make_list
	     (zzz_make_string (_("arguments to "), -1),
	      zzz_make_string (FUNC_NAME, -1),
	      zzz_make_string (_(" must be proper lists"), -1),
	      NULL));
	  return RESULT_EXCEPTION;
	}
      res = exp;
      while (cons_p (exp))
	{
	  ZZZ_TICK ();
	  resp = cdr_addr (exp);
	  exp = cdr (exp);
	}
      while (cons_p (cdr (param)))
	{
	  ZZZ_TICK ();
	  NEXT_ARG (exp);
	  if (zzz_list_length (exp) < 0)
	    {
	      *result = zzz_make_wta_exception
		(zzz_make_list
		 (zzz_make_string (_("arguments to "), -1),
		  zzz_make_string (FUNC_NAME, -1),
		  zzz_make_string (_(" must be proper lists"), -1),
		  NULL));
	      return RESULT_EXCEPTION;
	    }
	  *resp = exp;
	  while (cons_p (exp))
	    {
	      ZZZ_TICK ();
	      resp = cdr_addr (exp);
	      exp = cdr (exp);
	    }
	}
    }
  if (cons_p (param))
    {
      *resp = car (param);
      param = cdr (param);
    }
  *result = res;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  reverse
  (reverse list) => list
  Return a list containing the elements of @var{list} in reverse order.
  doc:*/
#define FUNC_NAME "reverse"
static result_t
reverse_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL;

  CHECK_TYPE (1, zzz_list_length (list) >= 0, zzz_proper_list_type_name);
  while (cons_p (list))
    {
      res = zzz_cons (car (list), res);
      list = cdr (list);
    }
  *result = res;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  reverse!
  (reverse! list) => list
  Return a list containing the elements of @var{list} in reverse order.  The
  pairs of which @var{list} is constructed are modified to produce the result
  list.
  doc:*/
#define FUNC_NAME "reverse!"
static result_t
reverse_x_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL, prev = NULL, tail;

  CHECK_TYPE (1, zzz_list_length (list) >= 0, zzz_proper_list_type_name);
  while (cons_p (list))
    {
      tail = cdr (list);
      set_cdr (list, prev);
      prev = list;
      list = tail;
    }
  *result = prev;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  last
  (last list) => object
  Return the last element of @var{list} and return the empty list, if
  @var{list} is empty.
  doc:*/
#define FUNC_NAME "last"
static result_t
last_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, zzz_list_length (list) >= 0, zzz_proper_list_type_name);
  while (cons_p (list) && cons_p (cdr (list)))
    list = cdr (list);
  if (cons_p (list))
    *result = car (list);
  else
    *result = NULL;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  last-pair
  (last-pair list) => pair | '()
  Return the last of the pairs from which @var{list} is constructed.
  doc:*/
#define FUNC_NAME "last-pair"
static result_t
last_pair_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, zzz_list_length (list) >= 0, zzz_proper_list_type_name);
  while (cons_p (list) && cons_p (cdr (list)))
    list = cdr (list);
  *result = list;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/* Generic list length calculation and error detection. Returns the
   length of @var{list} if @var{list} is a proper finite list, return
   -1 if the list is not a proper list and returns -2 if the list is
   circular.

   Kudos to the Guile people (or maybe Aubrey Jaffer for his SCM?)
   for this algorithm. */
int
zzz_list_length (zzz_scm_t list)
{
  int length = 0;
  zzz_scm_t tortoise, hare;

  tortoise = list;
  hare = list;
  do
    {
      if (!cons_p (hare)) 
	return null_p (hare) ? length : -1;
      hare = cdr (hare);
      length++;
      if (!cons_p (hare)) 
	return null_p (hare) ? length : -1;
      hare = cdr (hare);
      length++;
      /* For every two steps the hare takes, the tortoise takes one.  */
      tortoise = cdr (tortoise);
    }
  while (!zzz_eq (hare, tortoise));
  /* If the tortoise ever catches the hare, then the list must contain
     a cycle.  */
  return -2;
}

/*:doc
  length
  (length list) => integer
  Return the length of @var{list}.  @var{list} must be a proper list, or 
  an error will be signalled.
  doc:*/
#define FUNC_NAME "length"
static result_t
length_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int length;

  length = zzz_list_length (list);
  if (length < 0)
    {
      if (length == -1)
	*result = zzz_make_wta_exception
	  (zzz_make_list
	   (zzz_make_string (_("not a proper list in call to `"), -1),
	    zzz_make_string (s_func_name, -1),
	    zzz_make_string ("'", -1),
	    NULL));
      else
	*result = zzz_make_wta_exception
	  (zzz_make_list
	   (zzz_make_string (_("circular list detected in call to `"), -1),
	    zzz_make_string (s_func_name, -1),
	    zzz_make_string ("'", -1),
	    NULL));
      return RESULT_EXCEPTION;
    }
  *result = zzz_make_integer (length);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  map
  (map proc list1 list2...) => list
  Apply the procedure @var{proc} to the elements of the @var{list}s
  and return a list of the results of the procedure applications.
  @var{proc} must take as many arguments as there are @var{list}s.
  doc:*/
#define FUNC_NAME "map"
static result_t
map_func (zzz_scm_t env, zzz_scm_t proc, zzz_scm_t param, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t arg_list = NULL, list = NULL, res_list = NULL;
  int list_count = 0, i;
  zzz_scm_t * cellp, *resp;

  CHECK_TYPE (1, procedure_p (proc), zzz_procedure_type_name);
  arg_list = param;
  do
    {
      ZZZ_TICK ();
      NEXT_ARG (list);
      CHECK_TYPE (list_count + 2, list_p (list), zzz_list_type_name);
      list_count++;
    }
  while (cons_p (param));
  list = zzz_make_vector (list_count);
  i = 0;
  while (cons_p (arg_list))
    {
      ZZZ_TICK ();
      zzz_vector_put (list, i, car (arg_list));
      arg_list = cdr (arg_list);
      i++;
    }
  res_list = NULL;
  resp = &res_list;
  for (;;)
    {
      int err;

      /* No ZZZ_TICK() necessary here, because zzz_apply() will do it.  */
      arg_list = NULL;
      cellp = &arg_list;
      for (i = 0; i < list_count; i++)
	{
	  if (!cons_p (zzz_vector_get (list, i)))
	    {
	      *result = res_list;
	      return RESULT_SUCCESS;
	    }
	  *cellp = zzz_cons (car (zzz_vector_get (list, i)), NULL);
	  cellp = cdr_addr (*cellp);
	  zzz_vector_put (list, i, cdr (zzz_vector_get (list, i)));
	}
      if ((err = zzz_apply (env, proc, arg_list, &arg_list)) !=
	  RESULT_SUCCESS)
	{
	  *result = arg_list;
	  return err;
	}
      *resp = zzz_cons (arg_list, NULL);
      resp = cdr_addr (*resp);
    }
  abort ();			/* Should never reach this. */
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  for-each
  (for-each proc list1 list2 ...) => *unspecified*
  Apply the procedure @var{proc} to the elements of the @var{list}s,
  in order.  @var{proc} must take as many arguments as there are
  lists.  The return value is unspecified.
  doc:*/
#define FUNC_NAME "for-each"
static result_t
for_each_func (zzz_scm_t env, zzz_scm_t proc, zzz_scm_t param,
	       zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t arg_list = NULL, list = NULL;
  int list_count = 0, i;
  zzz_scm_t * cellp;

  CHECK_TYPE (1, procedure_p (proc), zzz_procedure_type_name);
  arg_list = param;
  do
    {
      ZZZ_TICK ();
      NEXT_ARG (list);
      CHECK_TYPE (list_count + 2, list_p (list), zzz_list_type_name);
      list_count++;
    }
  while (cons_p (param));
  list = zzz_make_vector (list_count);
  i = 0;
  while (cons_p (arg_list))
    {
      ZZZ_TICK ();
      zzz_vector_put (list, i, car (arg_list));
      arg_list = cdr (arg_list);
      i++;
    }
  for (;;)
    {
      int err;

      /* No ZZZ_TICK() necessary here, because zzz_apply() will do it.  */
      arg_list = NULL;
      cellp = &arg_list;
      for (i = 0; i < list_count; i++)
	{
	  if (!cons_p (zzz_vector_get (list, i)))
	    {
	      *result = zzz_unspecified;
	      return RESULT_SUCCESS;
	    }
	  *cellp = zzz_cons (car (zzz_vector_get (list, i)), NULL);
	  cellp = cdr_addr (*cellp);
	  zzz_vector_put (list, i, cdr (zzz_vector_get (list, i)));
	}
      if ((err = zzz_apply (env, proc, arg_list, result)) != RESULT_SUCCESS)
	return err;
    }
  abort ();			/* Should never reach this. */
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  list-tail
  (list-tail list k) => list
  Return the tail of @var{list} after index @var{k}.
  doc:*/
#define FUNC_NAME "list-tail"
static result_t
list_tail_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t k, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL;
  int value;

  CHECK_TYPE (1, list_p (list), zzz_list_type_name);
  CHECK_TYPE (2, integer_p (k), zzz_integer_type_name);
  value = integer_val (k);
  while (cons_p (list) && value-- > 0)
    list = cdr (list);
  *result = list;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  list-ref
  (list-ref list k) => object
  Return the element at index @var{k} in the list @var{list}.
  doc:*/
#define FUNC_NAME "list-ref"
static result_t
list_ref_func (zzz_scm_t env, zzz_scm_t list, zzz_scm_t k, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL;
  int value;

  CHECK_TYPE (1, list_p (list), zzz_list_type_name);
  CHECK_TYPE (2, integer_p (k), zzz_integer_type_name);
  value = integer_val (k);
  while (cons_p (list) && value-- > 0)
    list = cdr (list);
  if (cons_p (list))
    *result = car (list);
  else
    *result = zzz_make_error
      (zzz_make_list
       (zzz_make_string (_("index out of range in call to `"), -1),
	zzz_make_string (s_func_name, -1),
	zzz_make_string ("'", -1),
	NULL),
       NULL);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  memq
  (memq obj list) => list | #f
  Return the first sublist of @var{list} whose car is
  @var{obj}. @code{memq} uses @code{eq?} for comparing the values.  If
  @var{obj} does not occur in @var{list}, @code{#f} is returned.
  doc:*/
#define FUNC_NAME "memq"
static result_t
memq_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list) && !zzz_eq (car (list), obj))
    {
      ZZZ_TICK ();
      list = cdr (list);
    }
  if (cons_p (list))
    *result = list;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  memv
  (memv obj list) => list | #f
  Return the first sublist of @var{list} whose car is
  @var{obj}. @code{memv} uses @code{eqv?} for comparing the values.  If
  @var{obj} does not occur in @var{list}, @code{#f} is returned.
  doc:*/
#define FUNC_NAME "memv"
static result_t
memv_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list) && !zzz_eqv (car (list), obj))
    {
      ZZZ_TICK ();
      list = cdr (list);
    }
  if (cons_p (list))
    *result = list;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  member
  (member obj list [=]) => list | #f
  Return the first sublist of @var{list} whose car is
  @var{obj}. @code{member} uses @code{equql?} for comparing the
  values.  If @var{obj} does not occur in @var{list}, @code{#f} is
  returned.
  @code{member} is extended from R5RS to allow the client to pass an
  optional equality procedure @var{=} used to compare keys.
  doc:*/
#define FUNC_NAME "member"
static result_t
member_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t pred,
	     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  if (pred != zzz_undefined)
    CHECK_TYPE (3, procedure_p (pred), zzz_procedure_type_name);
  if (zzz_eq (pred, zzz_undefined))
    {
      while (cons_p (list) && !zzz_equal (car (list), obj))
	{
	  ZZZ_TICK ();
	  list = cdr (list);
	}
    }
  else
    {
      while (cons_p (list))
	{ 
	  /* No ZZZ_TICK() necessary here, because zzz_apply() will do
             it.  */
	  if ((err = zzz_apply (env, pred,
				zzz_make_n_list (2, obj, car (list)),
				result)) != RESULT_SUCCESS)
	    return err;
	  if (!zzz_eq (*result, zzz_false_value))
	    break;
	  list = cdr (list);
	}
    }
  if (cons_p (list))
    *result = list;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  assq
  (assq obj list) => pair | #f
  @var{alist} (for association list) must be a list of pairs.  Return
  the first pair in @var{alist} whose car field is @var{obj}. If no
  pair in @var{alist} has @var{obj} as its car, then @code{#f} is
  returned. @code{assq} uses @code{eq?} for comparing the values.
  doc:*/
#define FUNC_NAME "assq"
static result_t
assq_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list))
    {
      ZZZ_TICK ();
      if (!cons_p (car (list)))
	{
	  *result = zzz_make_wta_exception
	    (zzz_make_list
	     (zzz_make_string (_("no association list in call to `"), -1),
	      zzz_make_string (s_func_name, -1),
	      zzz_make_string ("'", -1),
	      NULL));
	  return RESULT_EXCEPTION;
	}
      if (zzz_eq (car (car (list)), obj))
	{
	  *result = car (list);
	  return RESULT_SUCCESS;
	}
      list = cdr (list);
    }
  *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  assv
  (assv obj list) => pair | #f
  @var{alist} (for association list) must be a list of pairs.  Return
  the first pair in @var{alist} whose car field is @var{obj}. If no
  pair in @var{alist} has @var{obj} as its car, then @code{#f} is
  returned. @code{assv} uses @code{eqv?} for comparing the values.
  doc:*/
#define FUNC_NAME "assv"
static result_t
assv_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list))
    {
      ZZZ_TICK ();
      if (!cons_p (car (list)))
	{
	  *result = zzz_make_wta_exception
	    (zzz_make_list
	     (zzz_make_string (_("no association list in call to `"), -1),
	      zzz_make_string (s_func_name, -1),
	      zzz_make_string ("'", -1),
	      NULL));
	  return RESULT_EXCEPTION;
	}
      if (zzz_eqv (car (car (list)), obj))
	{
	  *result = car (list);
	  return RESULT_SUCCESS;
	}
      list = cdr (list);
    }
  *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  assoc
  (assoc obj list [=]) => pair | #f
  @var{alist} (for association list) must be a list of pairs.  Return
  the first pair in @var{alist} whose car field is @var{obj}. If no
  pair in @var{alist} has @var{obj} as its car, then @code{#f} is
  returned. @code{assv} uses @code{eqv?} for comparing the values.
  @code{assoc} is extended from R5RS to allow the client to pass in an
  optional equality procedure @var{=} to compare keys.
  doc:*/
#define FUNC_NAME "assoc"
static result_t
assoc_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t pred,
	    zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  if (pred != zzz_undefined)
    CHECK_TYPE (3, procedure_p (pred), zzz_procedure_type_name);
  if (zzz_eq (pred, zzz_undefined))
    {
      while (cons_p (list))
	{
	  ZZZ_TICK ();
	  if (!cons_p (car (list)))
	    {
	      *result = zzz_make_wta_exception
		(zzz_make_list
		 (zzz_make_string (_("no association list in call to `"), -1),
		  zzz_make_string (s_func_name, -1),
		  zzz_make_string ("'", -1),
		  NULL));
	      return RESULT_EXCEPTION;
	    }
	  if (zzz_equal (car (car (list)), obj))
	    {
	      *result = car (list);
	      return RESULT_SUCCESS;
	    }
	  list = cdr (list);
	}
    }
  else
    {
      while (cons_p (list))
	{
	  /* No ZZZ_TICK() necessary here, because zzz_apply() will do
             it.  */
	  if (!cons_p (car (list)))
	    {
	      *result = zzz_make_wta_exception
		(zzz_make_list
		 (zzz_make_string (_("no association list in call to `"), -1),
		  zzz_make_string (s_func_name, -1),
		  zzz_make_string ("'", -1),
		  NULL));
	      return RESULT_EXCEPTION;
	    }
	  if ((err = zzz_apply (env, pred,
				zzz_make_n_list (2, obj, car (car (list))),
				result)) != RESULT_SUCCESS)
	    return err;
	  if (!zzz_eq (*result, zzz_false_value))
	    {
	      *result = car (list);
	      return RESULT_SUCCESS;
	    }
	  list = cdr (list);
	}
    }
  *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  remq
  (remq obj list) => list
  Return a list which is identical to the parameter @var{list}, but
  from which all occurences of @var{obj} are removed. @code{remq} uses
  @code{eq?} for comparing the list elements with @var{obj}.
  doc:*/
#define FUNC_NAME "remq"
static result_t
remq_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL;
  zzz_scm_t * resp = &res;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list))
    {
      ZZZ_TICK ();
      if (!zzz_eq (car (list), obj))
	{
	  *resp = zzz_cons (car (list), NULL);
	  resp = cdr_addr (*resp);
	}
      list = cdr (list);
    }
  *result = res;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  remv
  (remv obj list) => list
  Return a list which is identical to the parameter @var{list}, but
  from which all occurences of @var{obj} are removed. @code{remv} uses
  @code{eqv?} for comparing the list elements with @var{obj}.
  doc:*/
#define FUNC_NAME "remv"
static result_t
remv_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL;
  zzz_scm_t * resp = &res;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list))
    {
      ZZZ_TICK ();
      if (!zzz_eqv (car (list), obj))
	{
	  *resp = zzz_cons (car (list), NULL);
	  resp = cdr_addr (*resp);
	}
      list = cdr (list);
    }
  *result = res;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  remove
  (remove obj list) => list
  Return a list which is identical to the parameter @var{list}, but
  from which all occurences of @var{obj} are removed. @code{remove} uses
  @code{equal?} for comparing the list elements with @var{obj}.
  doc:*/
#define FUNC_NAME "remove"
static result_t
remove_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t list, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res = NULL;
  zzz_scm_t * resp = &res;

  CHECK_TYPE (2, list_p (list), zzz_list_type_name);
  while (cons_p (list))
    {
      ZZZ_TICK ();
      if (!zzz_equal (obj, car (list)))
	{
	  *resp = zzz_cons (car (list), NULL);
	  resp = cdr_addr (*resp);
	}
      list = cdr (list);
    }
  *result = res;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_list (void)
{
  zzz_define_function ("null?", (zzz_prim_t)  null_p_func, argv_1_0_0);
  zzz_define_function ("list?", (zzz_prim_t) list_p_func, argv_1_0_0);
  zzz_define_function ("pair?", (zzz_prim_t) pair_p_func, argv_1_0_0);
  zzz_define_function ("cons", (zzz_prim_t) cons_func, argv_2_0_0);
  zzz_define_function ("list", (zzz_prim_t) list_func, argv_0_0_1);
  zzz_define_function ("car", (zzz_prim_t) car_func, argv_1_0_0);
  zzz_define_function ("cdr", (zzz_prim_t) cdr_func, argv_1_0_0);
  zzz_define_function ("caar", (zzz_prim_t) caar_func, argv_1_0_0);
  zzz_define_function ("cadr", (zzz_prim_t) cadr_func, argv_1_0_0);
  zzz_define_function ("cdar", (zzz_prim_t) cdar_func, argv_1_0_0);
  zzz_define_function ("cddr", (zzz_prim_t) cddr_func, argv_1_0_0);
  zzz_define_function ("caaar", (zzz_prim_t) caaar_func, argv_1_0_0);
  zzz_define_function ("caadr", (zzz_prim_t) caadr_func, argv_1_0_0);
  zzz_define_function ("cadar", (zzz_prim_t) cadar_func, argv_1_0_0);
  zzz_define_function ("caddr", (zzz_prim_t) caddr_func, argv_1_0_0);
  zzz_define_function ("cdaar", (zzz_prim_t) cdaar_func, argv_1_0_0);
  zzz_define_function ("cdadr", (zzz_prim_t) cdadr_func, argv_1_0_0);
  zzz_define_function ("cddar", (zzz_prim_t) cddar_func, argv_1_0_0);
  zzz_define_function ("cdddr", (zzz_prim_t) cdddr_func, argv_1_0_0);
  zzz_define_function ("caaaar", (zzz_prim_t) caaaar_func, argv_1_0_0);
  zzz_define_function ("caaadr", (zzz_prim_t) caaadr_func, argv_1_0_0);
  zzz_define_function ("caadar", (zzz_prim_t) caadar_func, argv_1_0_0);
  zzz_define_function ("caaddr", (zzz_prim_t) caaddr_func, argv_1_0_0);
  zzz_define_function ("cadaar", (zzz_prim_t) cadaar_func, argv_1_0_0);
  zzz_define_function ("cadadr", (zzz_prim_t) cadadr_func, argv_1_0_0);
  zzz_define_function ("caddar", (zzz_prim_t) caddar_func, argv_1_0_0);
  zzz_define_function ("cadddr", (zzz_prim_t) cadddr_func, argv_1_0_0);
  zzz_define_function ("cdaaar", (zzz_prim_t) cdaaar_func, argv_1_0_0);
  zzz_define_function ("cdaadr", (zzz_prim_t) cdaadr_func, argv_1_0_0);
  zzz_define_function ("cdadar", (zzz_prim_t) cdadar_func, argv_1_0_0);
  zzz_define_function ("cdaddr", (zzz_prim_t) cdaddr_func, argv_1_0_0);
  zzz_define_function ("cddaar", (zzz_prim_t) cddaar_func, argv_1_0_0);
  zzz_define_function ("cddadr", (zzz_prim_t) cddadr_func, argv_1_0_0);
  zzz_define_function ("cdddar", (zzz_prim_t) cdddar_func, argv_1_0_0);
  zzz_define_function ("cddddr", (zzz_prim_t) cddddr_func, argv_1_0_0);
  zzz_define_function ("set-car!", (zzz_prim_t) set_car_x_func, argv_2_0_0);
  zzz_define_function ("set-cdr!", (zzz_prim_t) set_cdr_x_func, argv_2_0_0);
  zzz_define_function ("append", (zzz_prim_t) append_func, argv_0_0_1);
  zzz_define_function ("append!", (zzz_prim_t) append_x_func, argv_0_0_1);
  zzz_define_function ("reverse", (zzz_prim_t) reverse_func, argv_1_0_0);
  zzz_define_function ("reverse!", (zzz_prim_t) reverse_x_func, argv_1_0_0);
  zzz_define_function ("last", (zzz_prim_t) last_func, argv_1_0_0);
  zzz_define_function ("last-pair", (zzz_prim_t) last_pair_func, argv_1_0_0);
  zzz_define_function ("length", (zzz_prim_t) length_func, argv_1_0_0);
  zzz_define_function ("map", (zzz_prim_t) map_func, argv_1_0_1);
  zzz_define_function ("for-each", (zzz_prim_t) for_each_func, argv_1_0_1);
  zzz_define_function ("list-tail", (zzz_prim_t) list_tail_func, argv_2_0_0);
  zzz_define_function ("list-ref", (zzz_prim_t) list_ref_func, argv_2_0_0);
  zzz_define_function ("memq", (zzz_prim_t) memq_func, argv_2_0_0);
  zzz_define_function ("memv", (zzz_prim_t) memv_func, argv_2_0_0);
  zzz_define_function ("member", (zzz_prim_t) member_func, argv_2_1_0);
  zzz_define_function ("assq", (zzz_prim_t) assq_func, argv_2_0_0);
  zzz_define_function ("assv", (zzz_prim_t) assv_func, argv_2_0_0);
  zzz_define_function ("assoc", (zzz_prim_t) assoc_func, argv_2_1_0);
  zzz_define_function ("remq", (zzz_prim_t) remq_func, argv_2_0_0);
  zzz_define_function ("remv", (zzz_prim_t) remv_func, argv_2_0_0);
  zzz_define_function ("remove", (zzz_prim_t) remove_func, argv_2_0_0);

  /* Define more primitives defined in SRFI-1.  */
  zzz_init_srfi_1 ();

  return RESULT_SUCCESS;
}
