mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

srfi-1 concatenate concatenate!: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_concatenate, scm_srfi1_concatenate_x): delete.
* libguile/srfi-1.h (scm_srfi1_concatenate, scm_srfi1_concatenate_x): delete.
* module/srfi/srfi-1.scm: add concatenate and concatenate!.
This commit is contained in:
Rob Browning 2024-07-16 23:30:05 -05:00
parent a816b2484b
commit c62d2962d4
4 changed files with 21 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

35
libguile/srfi-1.c
View file

@ -143,41 +143,6 @@ SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_srfi1_concatenate, "concatenate", 1, 0, 0,
(SCM lstlst),
"Construct a list by appending all lists in @var{lstlst}.\n"
"\n"
"@code{concatenate} is the same as @code{(apply append\n"
"@var{lstlst})}. It exists because some Scheme implementations\n"
"have a limit on the number of arguments a function takes, which\n"
"the @code{apply} might exceed. In Guile there is no such\n"
"limit.")
#define FUNC_NAME s_scm_srfi1_concatenate
{
SCM_VALIDATE_LIST (SCM_ARG1, lstlst);
return scm_append (lstlst);
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_concatenate_x, "concatenate!", 1, 0, 0,
(SCM lstlst),
"Construct a list by appending all lists in @var{lstlst}. Those\n"
"lists may be modified to produce the result.\n"
"\n"
"@code{concatenate!} is the same as @code{(apply append!\n"
"@var{lstlst})}. It exists because some Scheme implementations\n"
"have a limit on the number of arguments a function takes, which\n"
"the @code{apply} might exceed. In Guile there is no such\n"
"limit.")
#define FUNC_NAME s_scm_srfi1_concatenate_x
{
SCM_VALIDATE_LIST (SCM_ARG1, lstlst);
return scm_append_x (lstlst);
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
(SCM pred, SCM list1, SCM rest), (SCM pred, SCM list1, SCM rest),
"Return a count of the number of times @var{pred} returns true\n" "Return a count of the number of times @var{pred} returns true\n"

2
libguile/srfi-1.h
View file

@ -26,8 +26,6 @@
SCM_INTERNAL SCM scm_srfi1_append_reverse (SCM revhead, SCM tail); SCM_INTERNAL SCM scm_srfi1_append_reverse (SCM revhead, SCM tail);
SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail); SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail);
SCM_INTERNAL SCM scm_srfi1_concatenate (SCM lstlst);
SCM_INTERNAL SCM scm_srfi1_concatenate_x (SCM lstlst);
SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest); SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred); SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred);
SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred); SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);

19
module/srfi/srfi-1.scm
View file

@ -445,6 +445,25 @@ a list of those after."
;;; Miscelleneous: length, append, concatenate, reverse, zip & count ;;; Miscelleneous: length, append, concatenate, reverse, zip & count
(define (concatenate lists)
"Construct a list by appending all lists in @var{lists}.
@code{concatenate} is the same as @code{(apply append @var{lists})}.
It exists because some Scheme implementations have a limit on the number
of arguments a function takes, which the @code{apply} might exceed. In
Guile there is no such limit."
(apply append lists))
(define (concatenate! lists)
"Construct a list by appending all lists in @var{lists}. Those
lists may be modified to produce the result.
@code{concatenate!} is the same as @code{(apply append! @var{lists})}.
It exists because some Scheme implementations have a limit on the number
of arguments a function takes, which the @code{apply} might exceed. In
Guile there is no such limit."
(apply append! lists))
(define (zip clist1 . rest) (define (zip clist1 . rest)
(let lp ((l (cons clist1 rest)) (acc '())) (let lp ((l (cons clist1 rest)) (acc '()))
(if (any null? l) (if (any null? l)

4
test-suite/tests/srfi-1.test
View file

@ -463,10 +463,10 @@
(pass-if-exception "too many args" exception:wrong-num-args (pass-if-exception "too many args" exception:wrong-num-args
(concatenate-proc '() '())) (concatenate-proc '() '()))
(pass-if-exception "number" exception:wrong-type-arg (pass-if-exception "number" '(wrong-type-arg . "Apply to non-list")
(concatenate-proc 123)) (concatenate-proc 123))
(pass-if-exception "vector" exception:wrong-type-arg (pass-if-exception "vector" '(wrong-type-arg . "Apply to non-list")
(concatenate-proc #(1 2 3))) (concatenate-proc #(1 2 3)))
(pass-if "no lists" (pass-if "no lists"