summaryrefslogtreecommitdiff
path: root/module/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-10-08 13:48:02 +0200
committerLudovic Courtès <ludo@gnu.org>2010-10-08 15:25:56 +0200
commit7f593bc7f9ab9ebf4e64ce7e28f85bdcbbe8906f (patch)
tree8464c3ccb093d4ed4f7851d7ba131ea94e75e8f9 /module/srfi/srfi-1.scm
parent58ee1beabec22eaad41eecf6fdd4c0032b6608e3 (diff)
downloadguile-7f593bc7f9ab9ebf4e64ce7e28f85bdcbbe8906f.tar.gz
SRFI-1: Rewrite `split-at' and `split-at!' in Scheme.
This partially reverts commit bb560b9c16893f762699ba5a3109c8367fff8dfc (Tue Mar 15 2005). * module/srfi/srfi-1.scm (out-of-range, split-at, split-at!): New procedures. * libguile/srfi-1.c (scm_srfi1_split_at, scm_srfi1_split_at_x): Remove. * libguile/srfi-1.h (scm_srfi1_split_at, scm_srfi1_split_at_x): Ditto.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r--module/srfi/srfi-1.scm28
1 files changed, 28 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 5bcc3611c..8ddf2714b 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -238,6 +238,10 @@ higher-order procedures."
(scm-error 'wrong-type-arg caller
"Wrong type argument: ~S" (list arg) '())))
+(define (out-of-range proc arg)
+ (scm-error 'out-of-range proc
+ "Value out of range: ~A" (list arg) (list arg)))
+
;; the srfi spec doesn't seem to forbid inexact integers.
(define (non-negative-integer? x) (and (integer? x) (>= x 0)))
@@ -375,6 +379,30 @@ end-of-list checking in contexts where dotted lists are allowed."
(loop (cdr prev)
(cdr tail)))))))
+(define (split-at lst i)
+ "Return two values, a list of the elements before index I in LST, and
+a list of those after."
+ (if (< i 0)
+ (out-of-range 'split-at i)
+ (let lp ((l lst) (n i) (acc '()))
+ (if (<= n 0)
+ (values (reverse! acc) l)
+ (lp (cdr l) (- n 1) (cons (car l) acc))))))
+
+(define (split-at! lst i)
+ "Linear-update variant of `split-at'."
+ (cond ((< i 0)
+ (out-of-range 'split-at! i))
+ ((= i 0)
+ (values '() lst))
+ (else
+ (let lp ((l lst) (n (- i 1)))
+ (if (<= n 0)
+ (let ((tmp (cdr l)))
+ (set-cdr! l '())
+ (values lst tmp))
+ (lp (cdr l) (- n 1)))))))
+
(define (last pair)
"Return the last element of the non-empty, finite list PAIR."
(car (last-pair pair)))