mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-29 08:20:20 +02:00
(alist-copy): Rewrite in C.
This commit is contained in:
parent
0b5adedd31
commit
b1fff4e793
3 changed files with 35 additions and 7 deletions
|
@ -63,6 +63,40 @@ equal_trampoline (SCM proc, SCM arg1, SCM arg2)
|
|||
}
|
||||
|
||||
|
||||
SCM_DEFINE (scm_srfi1_alist_copy, "alist-copy", 1, 0, 0,
|
||||
(SCM alist),
|
||||
"Return a copy of @var{alist}, copying both the pairs comprising\n"
|
||||
"the list and those making the associations.")
|
||||
#define FUNC_NAME s_scm_srfi1_alist_copy
|
||||
{
|
||||
SCM ret, *p, elem, c;
|
||||
|
||||
/* ret is the list to return. p is where to append to it, initially &ret
|
||||
then SCM_CDRLOC of the last pair. */
|
||||
ret = SCM_EOL;
|
||||
p = &ret;
|
||||
|
||||
for ( ; scm_is_pair (alist); alist = SCM_CDR (alist))
|
||||
{
|
||||
elem = SCM_CAR (alist);
|
||||
|
||||
/* each element of alist must be a pair */
|
||||
SCM_ASSERT_TYPE (scm_is_pair (elem), alist, SCM_ARG1, FUNC_NAME,
|
||||
"association list");
|
||||
|
||||
c = scm_cons (scm_cons (SCM_CAR (elem), SCM_CDR (elem)), SCM_EOL);
|
||||
*p = c;
|
||||
p = SCM_CDRLOC (c);
|
||||
}
|
||||
|
||||
/* alist must be a proper list */
|
||||
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (alist), alist, SCM_ARG1, FUNC_NAME,
|
||||
"association list");
|
||||
return ret;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
/* scm_append and scm_append_x don't modify their list argument (only the
|
||||
lists within that list in the case of scm_append_x), hence making them
|
||||
suitable for direct use for concatentate. */
|
||||
|
|
|
@ -32,6 +32,7 @@
|
|||
# define SCM_SRFI1_API extern
|
||||
#endif
|
||||
|
||||
SCM_SRFI1_API SCM scm_srfi1_alist_copy (SCM alist);
|
||||
SCM_SRFI1_API SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
|
||||
SCM_SRFI1_API SCM scm_srfi1_delete (SCM x, SCM lst, SCM pred);
|
||||
SCM_SRFI1_API SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM pred);
|
||||
|
|
|
@ -618,13 +618,6 @@
|
|||
|
||||
(define alist-cons acons)
|
||||
|
||||
(define (alist-copy alist)
|
||||
(let lp ((a alist)
|
||||
(rl '()))
|
||||
(if (null? a)
|
||||
(reverse! rl)
|
||||
(lp (cdr a) (acons (caar a) (cdar a) rl)))))
|
||||
|
||||
(define (alist-delete key alist . rest)
|
||||
(let ((k= (if (pair? rest) (car rest) equal?)))
|
||||
(let lp ((a alist) (rl '()))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue