REPL Server: Don't establish a SIGINT handler.

[bpt/guile.git] / libguile / list.c

diff --git a/libguile/list.c b/libguile/list.c
index 23ef404..d30f9e8 100644 (file)
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010
+/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010,2011
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -35,10 +35,10 @@
 \f
 /* creating lists */
 
-#define SCM_I_CONS(cell, x, y)                 \
-do {                                           \
-  cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y);                      \
-} while (0)
+#define SCM_I_CONS(cell, x, y)                          \
+  do {                                                  \
+    cell = scm_cell (SCM_UNPACK (x), SCM_UNPACK (y));   \
+  } while (0)
 
 SCM
 scm_list_1 (SCM e1)
@@ -267,7 +267,7 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
 
 
 SCM_DEFINE (scm_append_x, "append!", 0, 0, 1, 
-            (SCM lists),
+            (SCM args),
            "A destructive version of @code{append} (@pxref{Pairs and\n"
            "Lists,,,r5rs, The Revised^5 Report on Scheme}).  The cdr field\n"
            "of each list's final pair is changed to point to the head of\n"
@@ -276,26 +276,29 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
 #define FUNC_NAME s_scm_append_x
 {
   SCM ret, *loc;
-  SCM_VALIDATE_REST_ARGUMENT (lists);
+  int argnum = 1;
+  SCM_VALIDATE_REST_ARGUMENT (args);
 
-  if (scm_is_null (lists))
+  if (scm_is_null (args))
     return SCM_EOL;
 
   loc = &ret;
   for (;;)
     {
-      SCM arg = SCM_CAR (lists);
+      SCM arg = SCM_CAR (args);
       *loc = arg;
 
-      lists = SCM_CDR (lists);
-      if (scm_is_null (lists))
+      args = SCM_CDR (args);
+      if (scm_is_null (args))
         return ret;
 
       if (!SCM_NULL_OR_NIL_P (arg))
         {
-          SCM_VALIDATE_CONS (SCM_ARG1, arg);
+          SCM_VALIDATE_CONS (argnum, arg);
           loc = SCM_CDRLOC (scm_last_pair (arg));
+          SCM_VALIDATE_NULL_OR_NIL (argnum, *loc);
         }
+      argnum++;
     }
 }
 #undef FUNC_NAME
@@ -374,8 +377,6 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
   SCM_VALIDATE_LIST (1, lst);
   if (SCM_UNBNDP (new_tail))
     new_tail = SCM_EOL;
-  else
-    SCM_VALIDATE_LIST (2, new_tail);
 
   while (!SCM_NULL_OR_NIL_P (lst))
     {
@@ -617,8 +618,32 @@ SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
            "returned.")
 #define FUNC_NAME s_scm_memq
 {
-  SCM_VALIDATE_LIST (2, lst);
-  return scm_c_memq (x, lst);
+  SCM hare = lst, tortoise = lst;
+  
+  while (scm_is_pair (hare))
+    {
+      if (scm_is_eq (SCM_CAR (hare), x))
+       return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      if (!scm_is_pair (hare))
+        break;
+
+      if (scm_is_eq (SCM_CAR (hare), x))
+       return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      tortoise = SCM_CDR (tortoise);
+      if (SCM_UNLIKELY (scm_is_eq (hare, tortoise)))
+        break;
+    }
+
+  if (SCM_LIKELY (scm_is_null (hare)))
+    return SCM_BOOL_F;
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 2, lst, "list");
 }
 #undef FUNC_NAME
 
@@ -633,13 +658,32 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
            "returned.")
 #define FUNC_NAME s_scm_memv
 {
-  SCM_VALIDATE_LIST (2, lst);
-  for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst))
+  SCM hare = lst, tortoise = lst;
+  
+  while (scm_is_pair (hare))
     {
-      if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x)))
-       return lst;
+      if (scm_is_true (scm_eqv_p (SCM_CAR (hare), x)))
+       return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      if (!scm_is_pair (hare))
+        break;
+
+      if (scm_is_true (scm_eqv_p (SCM_CAR (hare), x)))
+       return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      tortoise = SCM_CDR (tortoise);
+      if (SCM_UNLIKELY (scm_is_eq (hare, tortoise)))
+        break;
     }
-  return SCM_BOOL_F;
+
+  if (SCM_LIKELY (scm_is_null (hare)))
+    return SCM_BOOL_F;
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 2, lst, "list");
 }
 #undef FUNC_NAME