diff options
author | Kevin Ryde <user42@zip.com.au> | 2006-06-17 22:47:50 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2006-06-17 22:47:50 +0000 |
commit | 9a9931719ddc6d1a7ed2e6597257e336114a69a9 (patch) | |
tree | 32ae67af7c73e28aae82a879a0c6d7434cfab39d | |
parent | 42be21d82afbede08c86bcde8203d1c94fdbd56e (diff) | |
download | guile-9a9931719ddc6d1a7ed2e6597257e336114a69a9.tar.gz |
merge 1.8 branch
-rw-r--r-- | srfi/ChangeLog | 10 | ||||
-rw-r--r-- | srfi/srfi-1.c | 61 | ||||
-rw-r--r-- | srfi/srfi-1.h | 2 | ||||
-rw-r--r-- | srfi/srfi-1.scm | 9 |
4 files changed, 72 insertions, 10 deletions
diff --git a/srfi/ChangeLog b/srfi/ChangeLog index f089bed5b..1d77d7747 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,13 @@ +2006-05-28 Kevin Ryde <user42@zip.com.au> + + * srfi-1.scm, srfi-1.c, srfi-1.h (append-reverse, append-reverse!): + Rewrite in C. + +2006-05-20 Kevin Ryde <user42@zip.com.au> + + * srfi-1.c (scm_srfi1_assoc): Correction to comparison procedure + argument order, SRFI-1 specifies given key is first. + 2006-02-06 Marius Vollmer <mvo@zagadka.de> * srfi-1.scm, srfi-60.scm: Updated versions in library name to diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index a300abfda..8e27ab4e6 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -124,6 +124,65 @@ SCM_DEFINE (scm_srfi1_alist_copy, "alist-copy", 1, 0, 0, #undef FUNC_NAME + +SCM_DEFINE (scm_srfi1_append_reverse, "append-reverse", 2, 0, 0, + (SCM revhead, SCM tail), + "Reverse @var{rev-head}, append @var{tail} to it, and return the\n" + "result. This is equivalent to @code{(append (reverse\n" + "@var{rev-head}) @var{tail})}, but its implementation is more\n" + "efficient.\n" + "\n" + "@example\n" + "(append-reverse '(1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)\n" + "@end example") +#define FUNC_NAME s_scm_srfi1_append_reverse +{ + while (scm_is_pair (revhead)) + { + /* copy first element of revhead onto front of tail */ + tail = scm_cons (SCM_CAR (revhead), tail); + revhead = SCM_CDR (revhead); + } + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (revhead), revhead, SCM_ARG1, FUNC_NAME, + "list"); + return tail; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 2, 0, 0, + (SCM revhead, SCM tail), + "Reverse @var{rev-head}, append @var{tail} to it, and return the\n" + "result. This is equivalent to @code{(append! (reverse!\n" + "@var{rev-head}) @var{tail})}, but its implementation is more\n" + "efficient.\n" + "\n" + "@example\n" + "(append-reverse! (list 1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)\n" + "@end example\n" + "\n" + "@var{rev-head} may be modified in order to produce the result.") +#define FUNC_NAME s_scm_srfi1_append_reverse_x +{ + SCM newtail; + + while (scm_is_pair (revhead)) + { + /* take the first cons cell from revhead */ + newtail = revhead; + revhead = SCM_CDR (revhead); + + /* make it the new start of tail, appending the previous */ + SCM_SETCDR (newtail, tail); + tail = newtail; + } + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (revhead), revhead, SCM_ARG1, FUNC_NAME, + "list"); + return tail; +} +#undef FUNC_NAME + + SCM_DEFINE (scm_srfi1_break, "break", 2, 0, 0, (SCM pred, SCM lst), "Return two values, the longest initial prefix of @var{lst}\n" @@ -1557,7 +1616,7 @@ SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (scm_is_true (equal_p (pred, SCM_CAR (tmp), key))) + if (scm_is_true (equal_p (pred, key, SCM_CAR (tmp)))) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, diff --git a/srfi/srfi-1.h b/srfi/srfi-1.h index 810f1046d..936586697 100644 --- a/srfi/srfi-1.h +++ b/srfi/srfi-1.h @@ -33,6 +33,8 @@ #endif SCM_SRFI1_API SCM scm_srfi1_alist_copy (SCM alist); +SCM_SRFI1_API SCM scm_srfi1_append_reverse (SCM revhead, SCM tail); +SCM_SRFI1_API SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail); SCM_SRFI1_API SCM scm_srfi1_break (SCM pred, SCM lst); SCM_SRFI1_API SCM scm_srfi1_break_x (SCM pred, SCM lst); SCM_SRFI1_API SCM scm_srfi1_car_plus_cdr (SCM pair); diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index 252e9b312..7c55d9923 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -324,15 +324,6 @@ ;;; Miscelleneous: length, append, concatenate, reverse, zip & count -(define (append-reverse rev-head tail) - (let lp ((l rev-head) (acc tail)) - (if (null? l) - acc - (lp (cdr l) (cons (car l) acc))))) - -(define (append-reverse! rev-head tail) - (append-reverse rev-head tail)) ; XXX:optimize - (define (zip clist1 . rest) (let lp ((l (cons clist1 rest)) (acc '())) (if (any null? l) |