mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 08:40:19 +02:00
Code Activity

srfi-1 list-copy: move from C to Scheme

Browse source 
* 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.
This commit is contained in:
Rob Browning 2024-07-20 14:56:27 -05:00
parent 6bd70136d9
commit aa44035ee8
4 changed files with 26 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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)