X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/0858753e829fd399b55700688b4b2cb9c3ea6908..3f4829e082c2fdd0553a6ce97fe173f8df327e7b:/libguile/srfi-1.c diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c index 54c7e2aa3..353a746f5 100644 --- 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)); } } @@ -614,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