Convert emit-linear-dispatch to use match

[bpt/guile.git] / libguile / srfi-1.c

diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 37441f7..353a746 100644 (file)
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -1,7 +1,7 @@
 /* srfi-1.c --- SRFI-1 procedures for Guile
  *
- * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006,
- *   2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+ * Copyright (C) 1995-1997, 2000-2003, 2005, 2006, 2008-2011, 2013
+ *   2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -258,7 +258,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
               SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst));  /* rest of lst */
             }
 
-          count += scm_is_true (scm_apply (pred, args, SCM_EOL));
+          count += scm_is_true (scm_apply_0 (pred, args));
         }
     }
 
@@ -568,28 +568,6 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_srfi1_drop_right, "drop-right", 2, 0, 0,
-            (SCM lst, SCM n),
-           "Return a new list containing all except the last @var{n}\n"
-           "elements of @var{lst}.")
-#define FUNC_NAME s_scm_srfi1_drop_right
-{
-  SCM tail = scm_list_tail (lst, n);
-  SCM ret = SCM_EOL;
-  SCM *rend = &ret;
-  while (scm_is_pair (tail))
-    {
-      *rend = scm_cons (SCM_CAR (lst), SCM_EOL);
-      rend = SCM_CDRLOC (*rend);
-      
-      lst = SCM_CDR (lst);
-      tail = SCM_CDR (tail);
-    }
-  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(tail), tail, SCM_ARG1, FUNC_NAME, "list");
-  return ret;
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_srfi1_find, "find", 2, 0, 0,
             (SCM pred, SCM lst),
            "Return the first element of @var{lst} which satisfies the\n"
@@ -636,8 +614,40 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
            "circular.")
 #define FUNC_NAME s_scm_srfi1_length_plus
 {
-  long len = scm_ilength (lst);
-  return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F);
+  size_t i = 0;
+  SCM tortoise = lst;
+  SCM hare = lst;
+
+  do
+    {
+      if (!scm_is_pair (hare))
+        {
+          if (SCM_NULL_OR_NIL_P (hare))
+            return scm_from_size_t (i);
+          else
+            scm_wrong_type_arg_msg (FUNC_NAME, 1, lst,
+                                    "proper or circular list");
+        }
+      hare = SCM_CDR (hare);
+      i++;
+      if (!scm_is_pair (hare))
+        {
+          if (SCM_NULL_OR_NIL_P (hare))
+            return scm_from_size_t (i);
+          else
+            scm_wrong_type_arg_msg (FUNC_NAME, 1, lst,
+                                    "proper or circular list");
+        }
+      hare = SCM_CDR (hare);
+      i++;
+      /* For every two steps the hare takes, the tortoise takes one.  */
+      tortoise = SCM_CDR (tortoise);
+    }
+  while (!scm_is_eq (hare, tortoise));
+
+  /* If the tortoise ever catches the hare, then the list must contain
+     a cycle.  */
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -736,8 +746,8 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
 
 SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
            (SCM key, SCM alist, SCM pred),
-           "Behaves like @code{assq} but uses third argument @var{pred?}\n"
-           "for key comparison.  If @var{pred?} is not supplied,\n"
+           "Behaves like @code{assq} but uses third argument @var{pred}\n"
+           "for key comparison.  If @var{pred} is not supplied,\n"
            "@code{equal?} is used.  (Extended from R5RS.)\n")
 #define FUNC_NAME s_scm_srfi1_assoc
 {
@@ -866,9 +876,9 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
 
 SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
            (SCM pred, SCM list),
-           "Return a list containing all elements from @var{lst} which do\n"
+           "Return a list containing all elements from @var{list} which do\n"
            "not satisfy the predicate @var{pred}.  The elements in the\n"
-           "result list have the same order as in @var{lst}.  The order in\n"
+           "result list have the same order as in @var{list}.  The order in\n"
            "which @var{pred} is applied to the list elements is not\n"
            "specified.")
 #define FUNC_NAME s_scm_srfi1_remove
@@ -924,23 +934,6 @@ SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0,
-            (SCM lst, SCM n),
-           "Return a list containing the @var{n} last elements of\n"
-           "@var{lst}.")
-#define FUNC_NAME s_scm_srfi1_take_right
-{
-  SCM tail = scm_list_tail (lst, n);
-  while (scm_is_pair (tail))
-    {
-      lst = SCM_CDR (lst);
-      tail = SCM_CDR (tail);
-    }
-  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(tail), tail, SCM_ARG1, FUNC_NAME, "list");
-  return lst;
-}
-#undef FUNC_NAME
-
 \f
 void
 scm_register_srfi_1 (void)