mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

(scm_srfi1_count): Use scm_list_copy to make arg list,

Browse source 
instead of an inline loop.  Share final list check between all cases
to save some code.
This commit is contained in:
Kevin Ryde 2005-04-01 23:43:49 +00:00
parent 5e5999f9c3
commit 5fc743b48d
1 changed files with 15 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

32
srfi/srfi-1.c
View file

@ -87,6 +87,8 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
#define FUNC_NAME s_scm_srfi1_count #define FUNC_NAME s_scm_srfi1_count
{ {
long count; long count;
SCM lst;
int argnum;
SCM_VALIDATE_REST_ARGUMENT (rest); SCM_VALIDATE_REST_ARGUMENT (rest);
count = 0; count = 0;
@ -101,9 +103,10 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1)) for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
count += scm_is_true (pred_tramp (pred, SCM_CAR (list1))); count += scm_is_true (pred_tramp (pred, SCM_CAR (list1)));
end_lst1: /* check below that list1 is a proper list, and done */
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (list1), list1, SCM_ARG2, FUNC_NAME, end_list1:
"list"); lst = list1;
argnum = 2;
} }
else if (scm_is_pair (rest) && scm_is_null (SCM_CDR (rest))) else if (scm_is_pair (rest) && scm_is_null (SCM_CDR (rest)))
{ {
@ -118,11 +121,11 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
for (;;) for (;;)
{ {
if (! scm_is_pair (list1)) if (! scm_is_pair (list1))
goto end_lst1; goto end_list1;
if (! scm_is_pair (list2)) if (! scm_is_pair (list2))
{ {
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (list2), list2, SCM_ARG3, lst = list2;
FUNC_NAME, "list"); argnum = 3;
break; break;
} }
count += scm_is_true (pred_tramp count += scm_is_true (pred_tramp
@ -134,17 +137,14 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
else else
{ {
/* three or more lists */ /* three or more lists */
SCM lstlst, args, l, a, lst; SCM lstlst, args, l, a;
int argnum;
/* lstlst is a list of the list arguments */ /* lstlst is a list of the list arguments */
lstlst = scm_cons (list1, rest); lstlst = scm_cons (list1, rest);
/* args is the argument list to pass to pred, same length as lstlst, /* args is the argument list to pass to pred, same length as lstlst,
re-used for each call */ re-used for each call */
args = SCM_EOL; args = scm_list_copy (lstlst);
for (l = lstlst; scm_is_pair (l); l = SCM_CDR (l))
args = scm_cons (SCM_BOOL_F, args);
for (;;) for (;;)
{ {
@ -156,11 +156,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
{ {
lst = SCM_CAR (l); /* list argument */ lst = SCM_CAR (l); /* list argument */
if (! scm_is_pair (lst)) if (! scm_is_pair (lst))
{ goto check_lst_and_done;
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst,
argnum, FUNC_NAME, "list");
goto done;
}
SCM_SETCAR (a, SCM_CAR (lst)); /* arg for pred */ SCM_SETCAR (a, SCM_CAR (lst)); /* arg for pred */
SCM_SETCAR (l, SCM_CDR (lst)); /* keep rest of lst */ SCM_SETCAR (l, SCM_CDR (lst)); /* keep rest of lst */
} }
@ -168,7 +164,9 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
count += scm_is_true (scm_apply (pred, args, SCM_EOL)); count += scm_is_true (scm_apply (pred, args, SCM_EOL));
} }
} }
done:
check_lst_and_done:
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, argnum, FUNC_NAME, "list");
return scm_from_long (count); return scm_from_long (count);
} }
#undef FUNC_NAME #undef FUNC_NAME