diff options
author | Rob Browning <rlb@defaultvalue.org> | 2024-07-20 14:56:27 -0500 |
---|---|---|
committer | Rob Browning <rlb@defaultvalue.org> | 2024-07-30 18:54:45 -0500 |
commit | aa44035ee883fd675a0e58343ad2172701f364b5 (patch) | |
tree | 2d22beea08147835ea7e4c5736e11f7d985d7423 /module/srfi/srfi-1.scm | |
parent | 6bd70136d96e73542e6725bc490199e17f56ee92 (diff) | |
download | guile-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.scm | 18 |
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) |