summaryrefslogtreecommitdiff
path: root/module/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2024-07-20 14:56:27 -0500
committerRob Browning <rlb@defaultvalue.org>2024-07-30 18:54:45 -0500
commitaa44035ee883fd675a0e58343ad2172701f364b5 (patch)
tree2d22beea08147835ea7e4c5736e11f7d985d7423 /module/srfi/srfi-1.scm
parent6bd70136d96e73542e6725bc490199e17f56ee92 (diff)
downloadguile-aa44035ee883fd675a0e58343ad2172701f364b5.tar.gz
srfi-1 list-copy: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_list_copy): delete. * libguile/srfi-1.h (scm_srfi1_list_copy): delete. * module/srfi/srfi-1.scm: add list-copy. * test-suite/tests/srfi-1.test: ensure copied spine is independent.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r--module/srfi/srfi-1.scm18
1 files changed, 18 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 57f9058b6..89090af89 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -262,6 +262,24 @@ INIT-PROC is applied to the indices is not specified."
acc
(lp (- n 1) (cons (init-proc (- n 1)) acc)))))
+(define (list-copy lst)
+ "Return a copy of the given list @var{lst}.
+@var{lst} can be a proper or improper list. And if @var{lst} is not a
+pair then it's treated as the final tail of an improper list and simply
+returned."
+ ;; This routine differs from the core list-copy in allowing improper
+ ;; lists. Maybe the core could allow them too.
+ (if (not (pair? lst))
+ lst
+ (let ((result (cons (car lst) (cdr lst))))
+ (let lp ((tail result))
+ (let ((next (cdr tail)))
+ (if (pair? next)
+ (begin
+ (set-cdr! tail (cons (car next) (cdr next)))
+ (lp next))
+ result))))))
+
(define (circular-list elt1 . elts)
(set! elts (cons elt1 elts))
(set-cdr! (last-pair elts) elts)