summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2005-04-02 00:19:35 +0000
committerKevin Ryde <user42@zip.com.au>2005-04-02 00:19:35 +0000
commitb1fff4e793619b20342cba0015b9367680d3a0bd (patch)
tree29f35617ff07a9a2f67051e6a3b2bde8c4be1a1b
parent0b5adedd31897f75e69d6b122305a767be370321 (diff)
downloadguile-b1fff4e793619b20342cba0015b9367680d3a0bd.tar.gz
(alist-copy): Rewrite in C.
-rw-r--r--srfi/srfi-1.c34
-rw-r--r--srfi/srfi-1.h1
-rw-r--r--srfi/srfi-1.scm7
3 files changed, 35 insertions, 7 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index 79701b0b5..74df5a96e 100644
--- a/srfi/srfi-1.c
+++ b/srfi/srfi-1.c
@@ -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. */
diff --git a/srfi/srfi-1.h b/srfi/srfi-1.h
index 467e0251f..fff493552 100644
--- a/srfi/srfi-1.h
+++ b/srfi/srfi-1.h
@@ -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);
diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index d6625c136..7bbf2cb64 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -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 '()))