diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-10-08 13:48:02 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-10-08 15:25:56 +0200 |
commit | 7f593bc7f9ab9ebf4e64ce7e28f85bdcbbe8906f (patch) | |
tree | 8464c3ccb093d4ed4f7851d7ba131ea94e75e8f9 /module/srfi/srfi-1.scm | |
parent | 58ee1beabec22eaad41eecf6fdd4c0032b6608e3 (diff) | |
download | guile-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.scm | 28 |
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))) |