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 \f
  42 #include <stdio.h>
  43 #include "_scm.h"
  44 #include "eq.h"
  45
  46 #include "list.h"
  47
  48 #ifdef __STDC__
  49 #include <stdarg.h>
  50 #define var_start(x, y) va_start(x, y)
  51 #else
  52 #include <varargs.h>
  53 #define var_start(x, y) va_start(x)
  54 #endif
  55
  56 \f
  57 /* creating lists */
  58
  59 /* SCM_P won't help us deal with varargs here.  */
  60 #ifdef __STDC__
  61 SCM
  62 scm_listify (SCM elt, ...)
  63 #else
  64 SCM
  65 scm_listify (elt, va_alist)
  66      SCM elt;
  67      va_dcl
  68 #endif
  69 {
  70   va_list foo;
  71   SCM answer;
  72   SCM *pos;
  73
  74   var_start (foo, elt);
  75   answer = SCM_EOL;
  76   pos = &answer;
  77   while (elt != SCM_UNDEFINED)
  78     {
  79       *pos = scm_cons (elt, SCM_EOL);
  80       pos = SCM_CDRLOC (*pos);
  81       elt = va_arg (foo, SCM);
  82     }
  83   return answer;
  84 }
  85
  86
  87 SCM_PROC(s_list, "list", 0, 0, 1, scm_list);
  88 SCM
  89 scm_list(objs)
  90      SCM objs;
  91 {
  92   return objs;
  93 }
  94
  95
  96 SCM_PROC (s_list_star, "list*", 1, 0, 1, scm_list_star);
  97
  98 SCM
  99 scm_list_star (SCM arg, SCM rest)
 100 {
 101   if (SCM_NIMP (rest))
 102     {
 103       SCM prev = arg = scm_cons (arg, rest);
 104       while (SCM_NIMP (SCM_CDR (rest)))
 105         {
 106           prev = rest;
 107           rest = SCM_CDR (rest);
 108         }
 109       SCM_SETCDR (prev, SCM_CAR (rest));
 110     }
 111   return arg;
 112 }
 113
 114
 115
 116 \f
 117 /* general questions about lists --- null?, list?, length, etc.  */
 118
 119 SCM_PROC(s_null_p, "null?", 1, 0, 0, scm_null_p);
 120 SCM
 121 scm_null_p(x)
 122      SCM x;
 123 {
 124  return SCM_NULLP(x) ? SCM_BOOL_T : SCM_BOOL_F;
 125 }
 126
 127 SCM_PROC(s_list_p, "list?", 1, 0, 0, scm_list_p);
 128 SCM
 129 scm_list_p(x)
 130      SCM x;
 131 {
 132   if (scm_ilength(x)<0)
 133     return SCM_BOOL_F;
 134   else
 135     return SCM_BOOL_T;
 136 }
 137
 138
 139 /* Return the length of SX, or -1 if it's not a proper list.
 140    This uses the "tortoise and hare" algorithm to detect "infinitely
 141    long" lists (i.e. lists with cycles in their cdrs), and returns -1
 142    if it does find one.  */
 143 long
 144 scm_ilength(sx)
 145      SCM sx;
 146 {
 147   register long i = 0;
 148   register SCM tortoise = sx;
 149   register SCM hare = sx;
 150
 151   do {
 152     if SCM_IMP(hare) return SCM_NULLP(hare) ? i : -1;
 153     if SCM_NCONSP(hare) return -1;
 154     hare = SCM_CDR(hare);
 155     i++;
 156     if SCM_IMP(hare) return SCM_NULLP(hare) ? i : -1;
 157     if SCM_NCONSP(hare) return -1;
 158     hare = SCM_CDR(hare);
 159     i++;
 160     /* For every two steps the hare takes, the tortoise takes one.  */
 161     tortoise = SCM_CDR(tortoise);
 162   }
 163   while (hare != tortoise);
 164
 165   /* If the tortoise ever catches the hare, then the list must contain
 166      a cycle.  */
 167   return -1;
 168 }
 169
 170 SCM_PROC(s_length, "length", 1, 0, 0, scm_length);
 171 SCM
 172 scm_length(x)
 173      SCM x;
 174 {
 175   int i;
 176   i = scm_ilength(x);
 177   SCM_ASSERT(i >= 0, x, SCM_ARG1, s_length);
 178   return SCM_MAKINUM (i);
 179 }
 180
 181
 182 \f
 183 /* appending lists */
 184
 185 SCM_PROC (s_append, "append", 0, 0, 1, scm_append);
 186 SCM
 187 scm_append(args)
 188      SCM args;
 189 {
 190   SCM res = SCM_EOL;
 191   SCM *lloc = &res, arg;
 192   if SCM_IMP(args) {
 193     SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_append);
 194     return res;
 195   }
 196   SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_append);
 197   while (1) {
 198     arg = SCM_CAR(args);
 199     args = SCM_CDR(args);
 200     if SCM_IMP(args) {
 201       *lloc = arg;
 202       SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_append);
 203       return res;
 204     }
 205     SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_append);
 206     for(;SCM_NIMP(arg);arg = SCM_CDR(arg)) {
 207       SCM_ASSERT(SCM_CONSP(arg), arg, SCM_ARGn, s_append);
 208       *lloc = scm_cons(SCM_CAR(arg), SCM_EOL);
 209       lloc = SCM_CDRLOC(*lloc);
 210     }
 211     SCM_ASSERT(SCM_NULLP(arg), arg, SCM_ARGn, s_append);
 212   }
 213 }
 214
 215
 216 SCM_PROC (s_append_x, "append!", 0, 0, 1, scm_append_x);
 217 SCM
 218 scm_append_x(args)
 219      SCM args;
 220 {
 221   SCM arg;
 222  tail:
 223   if SCM_NULLP(args) return SCM_EOL;
 224   arg = SCM_CAR(args);
 225   args = SCM_CDR(args);
 226   if SCM_NULLP(args) return arg;
 227   if SCM_NULLP(arg) goto tail;
 228   SCM_ASSERT(SCM_NIMP(arg) && SCM_CONSP(arg), arg, SCM_ARG1, s_append_x);
 229   SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
 230   return arg;
 231 }
 232
 233
 234 SCM_PROC(s_last_pair, "last-pair", 1, 0, 0, scm_last_pair);
 235 SCM
 236 scm_last_pair(sx)
 237      SCM sx;
 238 {
 239   register SCM res = sx;
 240   register SCM x;
 241
 242   if (SCM_NULLP (sx))
 243     return SCM_EOL;
 244
 245   SCM_ASSERT(SCM_NIMP(res) && SCM_CONSP(res), res, SCM_ARG1, s_last_pair);
 246   while (!0) {
 247     x = SCM_CDR(res);
 248     if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
 249     res = x;
 250     x = SCM_CDR(res);
 251     if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
 252     res = x;
 253     sx = SCM_CDR(sx);
 254     SCM_ASSERT(x != sx, sx, SCM_ARG1, s_last_pair);
 255   }
 256 }
 257
 258 \f
 259 /* reversing lists */
 260
 261 SCM_PROC (s_reverse, "reverse", 1, 0, 0, scm_reverse);
 262
 263 SCM
 264 scm_reverse (SCM ls)
 265 {
 266   SCM res = SCM_EOL;
 267   SCM p = ls, t = ls;
 268   while (SCM_NIMP (p))
 269     {
 270       SCM_ASSERT (SCM_CONSP (p), ls, SCM_ARG1, s_reverse);
 271       res = scm_cons (SCM_CAR (p), res);
 272       p = SCM_CDR (p);
 273       if (SCM_IMP (p))
 274         break;
 275       SCM_ASSERT (SCM_CONSP (p), ls, SCM_ARG1, s_reverse);
 276       res = scm_cons (SCM_CAR (p), res);
 277       p = SCM_CDR (p);
 278       t = SCM_CDR (t);
 279       if (t == p)
 280         scm_misc_error (s_reverse, "Circular structure: %S", SCM_LIST1 (ls));
 281     }
 282   SCM_ASSERT (SCM_NULLP (p), ls, SCM_ARG1, s_reverse);
 283   return res;
 284 }
 285
 286 SCM_PROC (s_reverse_x, "reverse!", 1, 1, 0, scm_reverse_x);
 287 SCM
 288 scm_reverse_x (ls, new_tail)
 289      SCM ls;
 290      SCM new_tail;
 291 {
 292   SCM old_tail;
 293   SCM_ASSERT (scm_ilength (ls) >= 0, ls, SCM_ARG1, s_reverse_x);
 294   if (SCM_UNBNDP (new_tail))
 295     new_tail = SCM_EOL;
 296   else
 297     SCM_ASSERT (scm_ilength (new_tail) >= 0, new_tail, SCM_ARG2, s_reverse_x);
 298
 299   while (SCM_NIMP (ls))
 300     {
 301       old_tail = SCM_CDR (ls);
 302       SCM_SETCDR (ls, new_tail);
 303       new_tail = ls;
 304       ls = old_tail;
 305     }
 306   return new_tail;
 307 }
 308
 309
 310 \f
 311 /* indexing lists by element number */
 312
 313 SCM_PROC(s_list_ref, "list-ref", 2, 0, 0, scm_list_ref);
 314 SCM
 315 scm_list_ref(lst, k)
 316      SCM lst;
 317      SCM k;
 318 {
 319         register long i;
 320         SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_ref);
 321         i = SCM_INUM(k);
 322         SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_ref);
 323         while (i-- > 0) {
 324                 SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
 325                 lst = SCM_CDR(lst);
 326         }
 327 erout:  SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
 328                SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_ref);
 329         return SCM_CAR(lst);
 330 }
 331
 332 SCM_PROC(s_list_set_x, "list-set!", 3, 0, 0, scm_list_set_x);
 333 SCM
 334 scm_list_set_x(lst, k, val)
 335      SCM lst;
 336      SCM k;
 337      SCM val;
 338 {
 339         register long i;
 340         SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_set_x);
 341         i = SCM_INUM(k);
 342         SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_set_x);
 343         while (i-- > 0) {
 344                 SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
 345                 lst = SCM_CDR(lst);
 346         }
 347 erout:  SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
 348                SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_set_x);
 349         SCM_SETCAR (lst, val);
 350         return val;
 351 }
 352
 353
 354 SCM_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail);
 355 SCM_PROC(s_list_tail, "list-tail", 2, 0, 0, scm_list_tail);
 356 SCM
 357 scm_list_tail(lst, k)
 358      SCM lst;
 359      SCM k;
 360 {
 361   register long i;
 362   SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_tail);
 363   i = SCM_INUM(k);
 364   while (i-- > 0) {
 365     SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_tail);
 366     lst = SCM_CDR(lst);
 367   }
 368   return lst;
 369 }
 370
 371
 372 SCM_PROC(s_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, scm_list_cdr_set_x);
 373 SCM
 374 scm_list_cdr_set_x(lst, k, val)
 375      SCM lst;
 376      SCM k;
 377      SCM val;
 378 {
 379         register long i;
 380         SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_cdr_set_x);
 381         i = SCM_INUM(k);
 382         SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_cdr_set_x);
 383         while (i-- > 0) {
 384                 SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
 385                 lst = SCM_CDR(lst);
 386         }
 387 erout:  SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
 388                SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_cdr_set_x);
 389         SCM_SETCDR (lst, val);
 390         return val;
 391 }
 392
 393
 394 \f
 395 /* copying lists, perhaps partially */
 396
 397 SCM_PROC(s_list_head, "list-head", 2, 0, 0, scm_list_head);
 398 SCM
 399 scm_list_head(lst, k)
 400      SCM lst;
 401      SCM k;
 402 {
 403   SCM answer;
 404   SCM * pos;
 405   register long i;
 406
 407   SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_head);
 408   answer = SCM_EOL;
 409   pos = &answer;
 410   i = SCM_INUM(k);
 411   while (i-- > 0)
 412     {
 413       SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_head);
 414       *pos = scm_cons (SCM_CAR (lst), SCM_EOL);
 415       pos = SCM_CDRLOC (*pos);
 416       lst = SCM_CDR(lst);
 417     }
 418   return answer;
 419 }
 420
 421
 422 SCM_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy);
 423 SCM
 424 scm_list_copy (lst)
 425      SCM lst;
 426 {
 427   SCM newlst;
 428   SCM * fill_here;
 429   SCM from_here;
 430
 431   newlst = SCM_EOL;
 432   fill_here = &newlst;
 433   from_here = lst;
 434
 435   while (SCM_NIMP (from_here) && SCM_CONSP (from_here))
 436     {
 437       SCM c;
 438       c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
 439       *fill_here = c;
 440       fill_here = SCM_CDRLOC (c);
 441       from_here = SCM_CDR (from_here);
 442     }
 443   return newlst;
 444 }
 445
 446 \f
 447 /* membership tests (memq, memv, etc.) */
 448
 449 SCM_PROC (s_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_sloppy_memq);
 450 SCM
 451 scm_sloppy_memq(x, lst)
 452      SCM x;
 453      SCM lst;
 454 {
 455   for(;  SCM_NIMP(lst) && SCM_CONSP (lst);  lst = SCM_CDR(lst))
 456     {
 457       if (SCM_CAR(lst)==x)
 458         return lst;
 459     }
 460   return lst;
 461 }
 462
 463
 464 SCM_PROC (s_sloppy_memv, "sloppy-memv", 2, 0, 0, scm_sloppy_memv);
 465 SCM
 466 scm_sloppy_memv(x, lst)
 467      SCM x;
 468      SCM lst;
 469 {
 470   for(;  SCM_NIMP(lst) && SCM_CONSP (lst);  lst = SCM_CDR(lst))
 471     {
 472       if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x))
 473         return lst;
 474     }
 475   return lst;
 476 }
 477
 478
 479 SCM_PROC (s_sloppy_member, "sloppy-member", 2, 0, 0, scm_sloppy_member);
 480 SCM
 481 scm_sloppy_member (x, lst)
 482      SCM x;
 483      SCM lst;
 484 {
 485   for(;  SCM_NIMP(lst) && SCM_CONSP (lst);  lst = SCM_CDR(lst))
 486     {
 487       if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x))
 488         return lst;
 489     }
 490   return lst;
 491 }
 492
 493
 494
 495 SCM_PROC(s_memq, "memq", 2, 0, 0, scm_memq);
 496 SCM
 497 scm_memq(x, lst)
 498      SCM x;
 499      SCM lst;
 500 {
 501   SCM answer;
 502   SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memq);
 503   answer = scm_sloppy_memq (x, lst);
 504   return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
 505 }
 506
 507
 508
 509 SCM_PROC(s_memv, "memv", 2, 0, 0, scm_memv);
 510 SCM
 511 scm_memv(x, lst)
 512      SCM x;
 513      SCM lst;
 514 {
 515   SCM answer;
 516   SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memv);
 517   answer = scm_sloppy_memv (x, lst);
 518   return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
 519 }
 520
 521
 522 SCM_PROC(s_member, "member", 2, 0, 0, scm_member);
 523 SCM
 524 scm_member(x, lst)
 525      SCM x;
 526      SCM lst;
 527 {
 528   SCM answer;
 529   SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_member);
 530   answer = scm_sloppy_member (x, lst);
 531   return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
 532 }
 533
 534
 535 \f
 536 /* deleting elements from a list (delq, etc.) */
 537
 538 SCM_PROC(s_delq_x, "delq!", 2, 0, 0, scm_delq_x);
 539 SCM
 540 scm_delq_x (item, lst)
 541      SCM item;
 542      SCM lst;
 543 {
 544   SCM walk;
 545   SCM *prev;
 546
 547   for (prev = &lst, walk = lst;
 548        SCM_NIMP (walk) && SCM_CONSP (walk);
 549        walk = SCM_CDR (walk))
 550     {
 551       if (SCM_CAR (walk) == item)
 552         *prev = SCM_CDR (walk);
 553       else
 554         prev = SCM_CDRLOC (walk);
 555     }
 556
 557   return lst;
 558 }
 559
 560
 561 SCM_PROC(s_delv_x, "delv!", 2, 0, 0, scm_delv_x);
 562 SCM
 563 scm_delv_x (item, lst)
 564      SCM item;
 565      SCM lst;
 566 {
 567   SCM walk;
 568   SCM *prev;
 569
 570   for (prev = &lst, walk = lst;
 571        SCM_NIMP (walk) && SCM_CONSP (walk);
 572        walk = SCM_CDR (walk))
 573     {
 574       if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
 575         *prev = SCM_CDR (walk);
 576       else
 577         prev = SCM_CDRLOC (walk);
 578     }
 579
 580   return lst;
 581 }
 582
 583
 584
 585 SCM_PROC(s_delete_x, "delete!", 2, 0, 0, scm_delete_x);
 586 SCM
 587 scm_delete_x (item, lst)
 588      SCM item;
 589      SCM lst;
 590 {
 591   SCM walk;
 592   SCM *prev;
 593
 594   for (prev = &lst, walk = lst;
 595        SCM_NIMP (walk) && SCM_CONSP (walk);
 596        walk = SCM_CDR (walk))
 597     {
 598       if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
 599         *prev = SCM_CDR (walk);
 600       else
 601         prev = SCM_CDRLOC (walk);
 602     }
 603
 604   return lst;
 605 }
 606
 607
 608 \f
 609
 610
 611 SCM_PROC (s_delq, "delq", 2, 0, 0, scm_delq);
 612 SCM
 613 scm_delq (item, lst)
 614      SCM item;
 615      SCM lst;
 616 {
 617   SCM copy;
 618
 619   copy = scm_list_copy (lst);
 620   return scm_delq_x (item, copy);
 621 }
 622
 623 SCM_PROC (s_delv, "delv", 2, 0, 0, scm_delv);
 624 SCM
 625 scm_delv (item, lst)
 626      SCM item;
 627      SCM lst;
 628 {
 629   SCM copy;
 630
 631   copy = scm_list_copy (lst);
 632   return scm_delv_x (item, copy);
 633 }
 634
 635 SCM_PROC (s_delete, "delete", 2, 0, 0, scm_delete);
 636 SCM
 637 scm_delete (item, lst)
 638      SCM item;
 639      SCM lst;
 640 {
 641   SCM copy;
 642
 643   copy = scm_list_copy (lst);
 644   return scm_delete_x (item, copy);
 645 }
 646
 647
 648 SCM_PROC(s_delq1_x, "delq1!", 2, 0, 0, scm_delq1_x);
 649 SCM
 650 scm_delq1_x (item, lst)
 651      SCM item;
 652      SCM lst;
 653 {
 654   SCM walk;
 655   SCM *prev;
 656
 657   for (prev = &lst, walk = lst;
 658        SCM_NIMP (walk) && SCM_CONSP (walk);
 659        walk = SCM_CDR (walk))
 660     {
 661       if (SCM_CAR (walk) == item)
 662         {
 663           *prev = SCM_CDR (walk);
 664           break;
 665         }
 666       else
 667         prev = SCM_CDRLOC (walk);
 668     }
 669
 670   return lst;
 671 }
 672
 673
 674 SCM_PROC(s_delv1_x, "delv1!", 2, 0, 0, scm_delv1_x);
 675 SCM
 676 scm_delv1_x (item, lst)
 677      SCM item;
 678      SCM lst;
 679 {
 680   SCM walk;
 681   SCM *prev;
 682
 683   for (prev = &lst, walk = lst;
 684        SCM_NIMP (walk) && SCM_CONSP (walk);
 685        walk = SCM_CDR (walk))
 686     {
 687       if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
 688         {
 689           *prev = SCM_CDR (walk);
 690           break;
 691         }
 692       else
 693         prev = SCM_CDRLOC (walk);
 694     }
 695
 696   return lst;
 697 }
 698
 699
 700 SCM_PROC(s_delete1_x, "delete1!", 2, 0, 0, scm_delete1_x);
 701 SCM
 702 scm_delete1_x (item, lst)
 703      SCM item;
 704      SCM lst;
 705 {
 706   SCM walk;
 707   SCM *prev;
 708
 709   for (prev = &lst, walk = lst;
 710        SCM_NIMP (walk) && SCM_CONSP (walk);
 711        walk = SCM_CDR (walk))
 712     {
 713       if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
 714         {
 715           *prev = SCM_CDR (walk);
 716           break;
 717         }
 718       else
 719         prev = SCM_CDRLOC (walk);
 720     }
 721
 722   return lst;
 723 }
 724
 725
 726 \f
 727 void
 728 scm_init_list ()
 729 {
 730 #include "list.x"
 731 }