libguile/list.c

   1 /*      Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46 #include <stdio.h>
  47 #include "_scm.h"
  48 #include "eq.h"
  49
  50 #include "scm_validate.h"
  51 #include "list.h"
  52
  53 #ifdef __STDC__
  54 #include <stdarg.h>
  55 #define var_start(x, y) va_start(x, y)
  56 #else
  57 #include <varargs.h>
  58 #define var_start(x, y) va_start(x)
  59 #endif
  60
  61 \f
  62 /* creating lists */
  63
  64 SCM
  65 scm_listify (SCM elt, ...)
  66 {
  67   va_list foo;
  68   SCM answer = SCM_EOL;
  69   SCM *pos = &answer;
  70
  71   var_start (foo, elt);
  72   while (elt != SCM_UNDEFINED)
  73     {
  74       *pos = scm_cons (elt, SCM_EOL);
  75       pos = SCM_CDRLOC (*pos);
  76       elt = va_arg (foo, SCM);
  77     }
  78   return answer;
  79 }
  80
  81
  82 SCM_DEFINE (scm_list, "list", 0, 0, 1,
  83            (SCM objs),
  84 "")
  85 #define FUNC_NAME s_scm_list
  86 {
  87   return objs;
  88 }
  89 #undef FUNC_NAME
  90
  91
  92 SCM_DEFINE (scm_list_star, "list*", 1, 0, 1,
  93             (SCM arg, SCM rest),
  94             "Return an improper list of the arguments.")
  95 #define FUNC_NAME s_scm_list_star
  96 {
  97   if (SCM_NNULLP (rest))
  98     {
  99       SCM prev = arg = scm_cons (arg, rest);
 100       while (SCM_NNULLP (SCM_CDR (rest)))
 101         {
 102           prev = rest;
 103           rest = SCM_CDR (rest);
 104         }
 105       SCM_SETCDR (prev, SCM_CAR (rest));
 106     }
 107   return arg;
 108 }
 109 #undef FUNC_NAME
 110
 111
 112 \f
 113 /* general questions about lists --- null?, list?, length, etc.  */
 114
 115 SCM_DEFINE (scm_null_p, "null?", 1, 0, 0,
 116            (SCM x),
 117 "")
 118 #define FUNC_NAME s_scm_null_p
 119 {
 120   return SCM_BOOL (SCM_NULLP (x));
 121 }
 122 #undef FUNC_NAME
 123
 124
 125 SCM_DEFINE (scm_list_p, "list?", 1, 0, 0,
 126            (SCM x),
 127 "")
 128 #define FUNC_NAME s_scm_list_p
 129 {
 130   return SCM_BOOL (scm_ilength (x) >= 0);
 131 }
 132 #undef FUNC_NAME
 133
 134
 135 /* Return the length of SX, or -1 if it's not a proper list.
 136    This uses the "tortoise and hare" algorithm to detect "infinitely
 137    long" lists (i.e. lists with cycles in their cdrs), and returns -1
 138    if it does find one.  */
 139 long
 140 scm_ilength(SCM sx)
 141 {
 142   long i = 0;
 143   SCM tortoise = sx;
 144   SCM hare = sx;
 145
 146   do {
 147     if (SCM_NULLP(hare)) return i;
 148     if (SCM_NCONSP(hare)) return -1;
 149     hare = SCM_CDR(hare);
 150     i++;
 151     if (SCM_NULLP(hare)) return i;
 152     if (SCM_NCONSP(hare)) return -1;
 153     hare = SCM_CDR(hare);
 154     i++;
 155     /* For every two steps the hare takes, the tortoise takes one.  */
 156     tortoise = SCM_CDR(tortoise);
 157   }
 158   while (hare != tortoise);
 159
 160   /* If the tortoise ever catches the hare, then the list must contain
 161      a cycle.  */
 162   return -1;
 163 }
 164
 165
 166 SCM_DEFINE (scm_length, "length", 1, 0, 0,
 167            (SCM lst),
 168 "")
 169 #define FUNC_NAME s_scm_length
 170 {
 171   int i;
 172   SCM_VALIDATE_LIST_COPYLEN (1,lst,i);
 173   return SCM_MAKINUM (i);
 174 }
 175 #undef FUNC_NAME
 176
 177
 178 \f
 179 /* appending lists */
 180
 181 SCM_DEFINE (scm_append, "append", 0, 0, 1,
 182             (SCM args),
 183             "A destructive version of @code{append} (@pxref{Pairs and Lists,,,r4rs,\n"
 184             "The Revised^4 Report on Scheme}).  The cdr field of each list's final\n"
 185             "pair is changed to point to the head of the next list, so no consing is\n"
 186             "performed.  Return a pointer to the mutated list.")
 187 #define FUNC_NAME s_scm_append
 188 {
 189   SCM res = SCM_EOL;
 190   SCM *lloc = &res, arg;
 191   if (SCM_IMP(args)) {
 192     SCM_VALIDATE_NULL (SCM_ARGn, args);
 193     return res;
 194   }
 195   SCM_VALIDATE_CONS (SCM_ARGn, args);
 196   while (1) {
 197     arg = SCM_CAR(args);
 198     args = SCM_CDR(args);
 199     if (SCM_IMP(args)) {
 200       *lloc = arg;
 201       SCM_VALIDATE_NULL (SCM_ARGn, args);
 202       return res;
 203     }
 204     SCM_VALIDATE_CONS (SCM_ARGn, args);
 205     for (; SCM_CONSP(arg); arg = SCM_CDR(arg)) {
 206       *lloc = scm_cons(SCM_CAR(arg), SCM_EOL);
 207       lloc = SCM_CDRLOC(*lloc);
 208     }
 209     SCM_VALIDATE_NULL (SCM_ARGn, arg);
 210   }
 211 }
 212 #undef FUNC_NAME
 213
 214
 215 SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
 216             (SCM args),
 217 "")
 218 #define FUNC_NAME s_scm_append_x
 219 {
 220   SCM arg;
 221  tail:
 222   if (SCM_NULLP(args)) return SCM_EOL;
 223   arg = SCM_CAR(args);
 224   args = SCM_CDR(args);
 225   if (SCM_NULLP(args)) return arg;
 226   if (SCM_NULLP(arg)) goto tail;
 227   SCM_VALIDATE_CONS (SCM_ARG1,arg);
 228   SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
 229   return arg;
 230 }
 231 #undef FUNC_NAME
 232
 233
 234 SCM_DEFINE (scm_last_pair, "last-pair", 1, 0, 0,
 235            (SCM lst),
 236             "Return a pointer to the last pair in @var{lst}, signalling an error if\n"
 237             "@var{lst} is circular.")
 238 #define FUNC_NAME s_scm_last_pair
 239 {
 240   SCM tortoise = lst;
 241   SCM hare = lst;
 242
 243   if (SCM_NULLP (lst))
 244     return SCM_EOL;
 245
 246   SCM_VALIDATE_CONS (SCM_ARG1, lst);
 247   do {
 248     SCM ahead = SCM_CDR(hare);
 249     if (SCM_NCONSP(ahead)) return hare;
 250     hare = ahead;
 251     ahead = SCM_CDR(hare);
 252     if (SCM_NCONSP(ahead)) return hare;
 253     hare = ahead;
 254     tortoise = SCM_CDR(tortoise);
 255   }
 256   while (hare != tortoise);
 257   SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
 258 }
 259 #undef FUNC_NAME
 260
 261 \f
 262 /* reversing lists */
 263
 264 SCM_DEFINE (scm_reverse, "reverse", 1, 0, 0,
 265             (SCM lst),
 266             "")
 267 #define FUNC_NAME s_scm_reverse
 268 {
 269   SCM result = SCM_EOL;
 270   SCM tortoise = lst;
 271   SCM hare = lst;
 272
 273   do {
 274       if (SCM_NULLP(hare)) return result;
 275       SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME);
 276       result = scm_cons (SCM_CAR (hare), result);
 277       hare = SCM_CDR (hare);
 278       if (SCM_NULLP(hare)) return result;
 279       SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME);
 280       result = scm_cons (SCM_CAR (hare), result);
 281       hare = SCM_CDR (hare);
 282       tortoise = SCM_CDR (tortoise);
 283     }
 284   while (hare != tortoise);
 285   SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
 286 }
 287 #undef FUNC_NAME
 288
 289 SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
 290             (SCM lst, SCM new_tail),
 291             "A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r4rs,\n"
 292             "The Revised^4 Report on Scheme}).  The cdr of each cell in @var{lst} is\n"
 293             "modified to point to the previous list element.  Return a pointer to the\n"
 294             "head of the reversed list.\n\n"
 295             "Caveat: because the list is modified in place, the tail of the original\n"
 296             "list now becomes its head, and the head of the original list now becomes\n"
 297             "the tail.  Therefore, the @var{lst} symbol to which the head of the\n"
 298             "original list was bound now points to the tail.  To ensure that the head\n"
 299             "of the modified list is not lost, it is wise to save the return value of\n"
 300             "@code{reverse!}")
 301 #define FUNC_NAME s_scm_reverse_x
 302 {
 303   SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG1, FUNC_NAME);
 304   if (SCM_UNBNDP (new_tail))
 305     new_tail = SCM_EOL;
 306   else
 307     SCM_ASSERT (scm_ilength (new_tail) >= 0, new_tail, SCM_ARG2, FUNC_NAME);
 308
 309   while (SCM_NNULLP (lst))
 310     {
 311       SCM old_tail = SCM_CDR (lst);
 312       SCM_SETCDR (lst, new_tail);
 313       new_tail = lst;
 314       lst = old_tail;
 315     }
 316   return new_tail;
 317 }
 318 #undef FUNC_NAME
 319
 320
 321 \f
 322 /* indexing lists by element number */
 323
 324 SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
 325            (SCM lst, SCM k),
 326             "")
 327 #define FUNC_NAME s_scm_list_ref
 328 {
 329   register long i;
 330   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
 331   while (i-- > 0) {
 332     SCM_ASRTGO(SCM_CONSP(lst), erout);
 333     lst = SCM_CDR(lst);
 334   }
 335  erout:
 336   SCM_ASSERT(SCM_CONSP(lst),
 337              SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
 338   return SCM_CAR(lst);
 339 }
 340 #undef FUNC_NAME
 341
 342 SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0,
 343            (SCM lst, SCM k, SCM val),
 344             "Set the @var{k}th element of @var{lst} to @var{val}.")
 345 #define FUNC_NAME s_scm_list_set_x
 346 {
 347   register long i;
 348   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
 349   while (i-- > 0) {
 350     SCM_ASRTGO(SCM_CONSP(lst), erout);
 351     lst = SCM_CDR(lst);
 352   }
 353  erout:
 354   SCM_ASSERT(SCM_CONSP(lst),
 355              SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
 356   SCM_SETCAR (lst, val);
 357   return val;
 358 }
 359 #undef FUNC_NAME
 360
 361
 362 SCM_REGISTER_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail);
 363
 364 SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0,
 365            (SCM lst, SCM k),
 366             "Return the \"tail\" of @var{lst} beginning with its @var{k}th element.\n"
 367             "The first element of the list is considered to be element 0.\n\n"
 368             "@code{list-cdr-ref} and @code{list-tail} are identical.  It may help to\n"
 369             "think of @code{list-cdr-ref} as accessing the @var{k}th cdr of the list,\n"
 370             "or returning the results of cdring @var{k} times down @var{lst}.")
 371 #define FUNC_NAME s_scm_list_tail
 372 {
 373   register long i;
 374   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
 375   while (i-- > 0) {
 376     SCM_VALIDATE_CONS (1,lst);
 377     lst = SCM_CDR(lst);
 378   }
 379   return lst;
 380 }
 381 #undef FUNC_NAME
 382
 383
 384 SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
 385            (SCM lst, SCM k, SCM val),
 386             "Set the @var{k}th cdr of @var{lst} to @var{val}.")
 387 #define FUNC_NAME s_scm_list_cdr_set_x
 388 {
 389   register long i;
 390   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
 391   while (i-- > 0) {
 392     SCM_ASRTGO(SCM_CONSP(lst), erout);
 393     lst = SCM_CDR(lst);
 394   }
 395 erout:
 396   SCM_ASSERT(SCM_CONSP(lst),
 397              SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME);
 398   SCM_SETCDR (lst, val);
 399   return val;
 400 }
 401 #undef FUNC_NAME
 402
 403
 404 \f
 405 /* copying lists, perhaps partially */
 406
 407 SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0,
 408            (SCM lst, SCM k),
 409             "Copy the first @var{k} elements from @var{lst} into a new list, and\n"
 410             "return it.")
 411 #define FUNC_NAME s_scm_list_head
 412 {
 413   SCM answer;
 414   SCM * pos;
 415   register long i;
 416
 417   SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
 418   answer = SCM_EOL;
 419   pos = &answer;
 420   while (i-- > 0)
 421     {
 422       SCM_VALIDATE_CONS (1,lst);
 423       *pos = scm_cons (SCM_CAR (lst), SCM_EOL);
 424       pos = SCM_CDRLOC (*pos);
 425       lst = SCM_CDR(lst);
 426     }
 427   return answer;
 428 }
 429 #undef FUNC_NAME
 430
 431
 432 SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0,
 433             (SCM lst),
 434             "Return a (newly-created) copy of @var{lst}.")
 435 #define FUNC_NAME s_scm_list_copy
 436 {
 437   SCM newlst;
 438   SCM * fill_here;
 439   SCM from_here;
 440
 441   newlst = SCM_EOL;
 442   fill_here = &newlst;
 443   from_here = lst;
 444
 445   while (SCM_CONSP (from_here))
 446     {
 447       SCM c;
 448       c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
 449       *fill_here = c;
 450       fill_here = SCM_CDRLOC (c);
 451       from_here = SCM_CDR (from_here);
 452     }
 453   return newlst;
 454 }
 455 #undef FUNC_NAME
 456
 457 \f
 458 /* membership tests (memq, memv, etc.) */
 459
 460 SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0,
 461             (SCM x, SCM lst),
 462             "@deffnx primitive sloppy-memv\n"
 463             "@deffnx primitive sloppy-member\n"
 464             "These procedures behave like @code{memq}, @code{memv} and @code{member}\n"
 465             "(@pxref{Pairs and Lists,,,r4rs, The Revised^4 Report on Scheme}), but do\n"
 466             "not perform any type or error checking.  Their use is recommended only\n"
 467             "in writing Guile internals, not for high-level Scheme programs.")
 468 #define FUNC_NAME s_scm_sloppy_memq
 469 {
 470   for(;  SCM_CONSP (lst);  lst = SCM_CDR(lst))
 471     {
 472       if (SCM_CAR(lst)==x)
 473         return lst;
 474     }
 475   return lst;
 476 }
 477 #undef FUNC_NAME
 478
 479
 480 SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0,
 481             (SCM x, SCM lst),
 482             "")
 483 #define FUNC_NAME s_scm_sloppy_memv
 484 {
 485   for(;  SCM_CONSP (lst);  lst = SCM_CDR(lst))
 486     {
 487       if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x))
 488         return lst;
 489     }
 490   return lst;
 491 }
 492 #undef FUNC_NAME
 493
 494
 495 SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0,
 496             (SCM x, SCM lst),
 497             "")
 498 #define FUNC_NAME s_scm_sloppy_member
 499 {
 500   for(;  SCM_CONSP (lst);  lst = SCM_CDR(lst))
 501     {
 502       if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x))
 503         return lst;
 504     }
 505   return lst;
 506 }
 507 #undef FUNC_NAME
 508
 509
 510
 511 SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
 512            (SCM x, SCM lst),
 513             "")
 514 #define FUNC_NAME s_scm_memq
 515 {
 516   SCM answer;
 517   SCM_VALIDATE_LIST (2,lst);
 518   answer = scm_sloppy_memq (x, lst);
 519   return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
 520 }
 521 #undef FUNC_NAME
 522
 523
 524
 525 SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
 526            (SCM x, SCM lst),
 527             "")
 528 #define FUNC_NAME s_scm_memv
 529 {
 530   SCM answer;
 531   SCM_VALIDATE_LIST (2,lst);
 532   answer = scm_sloppy_memv (x, lst);
 533   return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
 534 }
 535 #undef FUNC_NAME
 536
 537
 538 SCM_DEFINE (scm_member, "member", 2, 0, 0,
 539            (SCM x, SCM lst),
 540             "")
 541 #define FUNC_NAME s_scm_member
 542 {
 543   SCM answer;
 544   SCM_VALIDATE_LIST (2,lst);
 545   answer = scm_sloppy_member (x, lst);
 546   return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
 547 }
 548 #undef FUNC_NAME
 549
 550
 551 \f
 552 /* deleting elements from a list (delq, etc.) */
 553
 554 SCM_DEFINE (scm_delq_x, "delq!", 2, 0, 0,
 555            (SCM item, SCM lst),
 556             "@deffnx primitive delv! item lst\n"
 557             "@deffnx primitive delete! item lst\n"
 558             "These procedures are destructive versions of @code{delq}, @code{delv}\n"
 559             "and @code{delete}: they modify the pointers in the existing @var{lst}\n"
 560             "rather than creating a new list.  Caveat evaluator: Like other\n"
 561             "destructive list functions, these functions cannot modify the binding of\n"
 562             "@var{lst}, and so cannot be used to delete the first element of\n"
 563             "@var{lst} destructively.")
 564 #define FUNC_NAME s_scm_delq_x
 565 {
 566   SCM walk;
 567   SCM *prev;
 568
 569   for (prev = &lst, walk = lst;
 570        SCM_CONSP (walk);
 571        walk = SCM_CDR (walk))
 572     {
 573       if (SCM_CAR (walk) == item)
 574         *prev = SCM_CDR (walk);
 575       else
 576         prev = SCM_CDRLOC (walk);
 577     }
 578
 579   return lst;
 580 }
 581 #undef FUNC_NAME
 582
 583
 584 SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0,
 585            (SCM item, SCM lst),
 586             "")
 587 #define FUNC_NAME s_scm_delv_x
 588 {
 589   SCM walk;
 590   SCM *prev;
 591
 592   for (prev = &lst, walk = lst;
 593        SCM_CONSP (walk);
 594        walk = SCM_CDR (walk))
 595     {
 596       if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
 597         *prev = SCM_CDR (walk);
 598       else
 599         prev = SCM_CDRLOC (walk);
 600     }
 601
 602   return lst;
 603 }
 604 #undef FUNC_NAME
 605
 606
 607
 608 SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0,
 609            (SCM item, SCM lst),
 610             "")
 611 #define FUNC_NAME s_scm_delete_x
 612 {
 613   SCM walk;
 614   SCM *prev;
 615
 616   for (prev = &lst, walk = lst;
 617        SCM_CONSP (walk);
 618        walk = SCM_CDR (walk))
 619     {
 620       if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
 621         *prev = SCM_CDR (walk);
 622       else
 623         prev = SCM_CDRLOC (walk);
 624     }
 625
 626   return lst;
 627 }
 628 #undef FUNC_NAME
 629
 630
 631 \f
 632
 633
 634 SCM_DEFINE (scm_delq, "delq", 2, 0, 0,
 635             (SCM item, SCM lst),
 636             "@deffnx primitive delv item lst\n"
 637             "@deffnx primitive delete item lst\n"
 638             "Return a newly-created copy of @var{lst} with @var{item} removed.  These\n"
 639             "procedures mirror @code{memq}, @code{memv} and @code{member}:\n"
 640             "@code{delq} compares elements of @var{lst} against @var{item} with\n"
 641             "@code{eq?}, @code{delv} uses @code{eqv?} and @code{delete} uses @code{equal?}")
 642 #define FUNC_NAME s_scm_delq
 643 {
 644   SCM copy = scm_list_copy (lst);
 645   return scm_delq_x (item, copy);
 646 }
 647 #undef FUNC_NAME
 648
 649 SCM_DEFINE (scm_delv, "delv", 2, 0, 0,
 650             (SCM item, SCM lst),
 651             "")
 652 #define FUNC_NAME s_scm_delv
 653 {
 654   SCM copy = scm_list_copy (lst);
 655   return scm_delv_x (item, copy);
 656 }
 657 #undef FUNC_NAME
 658
 659 SCM_DEFINE (scm_delete, "delete", 2, 0, 0,
 660             (SCM item, SCM lst),
 661             "")
 662 #define FUNC_NAME s_scm_delete
 663 {
 664   SCM copy = scm_list_copy (lst);
 665   return scm_delete_x (item, copy);
 666 }
 667 #undef FUNC_NAME
 668
 669
 670 SCM_DEFINE (scm_delq1_x, "delq1!", 2, 0, 0,
 671            (SCM item, SCM lst),
 672             "")
 673 #define FUNC_NAME s_scm_delq1_x
 674 {
 675   SCM walk;
 676   SCM *prev;
 677
 678   for (prev = &lst, walk = lst;
 679        SCM_CONSP (walk);
 680        walk = SCM_CDR (walk))
 681     {
 682       if (SCM_CAR (walk) == item)
 683         {
 684           *prev = SCM_CDR (walk);
 685           break;
 686         }
 687       else
 688         prev = SCM_CDRLOC (walk);
 689     }
 690
 691   return lst;
 692 }
 693 #undef FUNC_NAME
 694
 695
 696 SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0,
 697            (SCM item, SCM lst),
 698             "")
 699 #define FUNC_NAME s_scm_delv1_x
 700 {
 701   SCM walk;
 702   SCM *prev;
 703
 704   for (prev = &lst, walk = lst;
 705        SCM_CONSP (walk);
 706        walk = SCM_CDR (walk))
 707     {
 708       if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
 709         {
 710           *prev = SCM_CDR (walk);
 711           break;
 712         }
 713       else
 714         prev = SCM_CDRLOC (walk);
 715     }
 716
 717   return lst;
 718 }
 719 #undef FUNC_NAME
 720
 721
 722 SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0,
 723            (SCM item, SCM lst),
 724             "")
 725 #define FUNC_NAME s_scm_delete1_x
 726 {
 727   SCM walk;
 728   SCM *prev;
 729
 730   for (prev = &lst, walk = lst;
 731        SCM_CONSP (walk);
 732        walk = SCM_CDR (walk))
 733     {
 734       if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
 735         {
 736           *prev = SCM_CDR (walk);
 737           break;
 738         }
 739       else
 740         prev = SCM_CDRLOC (walk);
 741     }
 742
 743   return lst;
 744 }
 745 #undef FUNC_NAME
 746
 747
 748 \f
 749 void
 750 scm_init_list ()
 751 {
 752 #include "list.x"
 753 }