summaryrefslogtreecommitdiff
path: root/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2005-05-03 22:57:26 +0000
committerKevin Ryde <user42@zip.com.au>2005-05-03 22:57:26 +0000
commite9508fbb7df0b1ead007637f16d80cf831776307 (patch)
tree0e44c80e552c1a859a1ddca8771d501155d51d3d /srfi/srfi-1.scm
parent597dbd4eea8b6b4dddd72593a22590d4c322baa5 (diff)
downloadguile-e9508fbb7df0b1ead007637f16d80cf831776307.tar.gz
(drop-right!, drop-while,
lset-adjoin, reduce, reduce-right, span, span!, take!, take-while, take-while!): Rewrite in C.
Diffstat (limited to 'srfi/srfi-1.scm')
-rw-r--r--srfi/srfi-1.scm81
1 files changed, 0 insertions, 81 deletions
diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index 7bbf2cb64..24b0e0d5a 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -341,31 +341,6 @@
(define take list-head)
(define drop list-tail)
-(define (take! x i)
- (if (<= i 0)
- '()
- (let lp ((n (- i 1)) (l x))
- (if (<= n 0)
- (begin
- (set-cdr! l '())
- x)
- (lp (- n 1) (cdr l))))))
-
-(define (drop-right! flist i)
- (if (<= i 0)
- flist
- (let lp ((n (+ i 1)) (l flist))
- (if (<= n 0)
- (let lp0 ((s flist) (l l))
- (if (null? l)
- (begin
- (set-cdr! s '())
- flist)
- (lp0 (cdr s) (cdr l))))
- (if (null? l)
- '()
- (lp (- n 1) (cdr l)))))))
-
(define (last pair)
(car (last-pair pair)))
@@ -476,16 +451,6 @@
lis
(uf (g seed) (cons (f seed) lis))))))
-(define (reduce f ridentity lst)
- (if (null? lst)
- ridentity
- (fold f (car lst) (cdr lst))))
-
-(define (reduce-right f ridentity lst)
- (if (null? lst)
- ridentity
- (fold-right f (last lst) (drop-right lst 1))))
-
;; Internal helper procedure. Map `f' over the single list `ls'.
;;
@@ -517,38 +482,6 @@
;;; Searching
-(define (take-while pred ls)
- (cond ((null? ls) '())
- ((not (pred (car ls))) '())
- (else
- (let ((result (list (car ls))))
- (let lp ((ls (cdr ls)) (p result))
- (cond ((null? ls) result)
- ((not (pred (car ls))) result)
- (else
- (set-cdr! p (list (car ls)))
- (lp (cdr ls) (cdr p)))))))))
-
-(define (take-while! pred clist)
- (take-while pred clist)) ; XXX:optimize
-
-(define (drop-while pred clist)
- (if (null? clist)
- '()
- (if (pred (car clist))
- (drop-while pred (cdr clist))
- clist)))
-
-(define (span pred clist)
- (let lp ((clist clist) (rl '()))
- (if (and (not (null? clist))
- (pred (car clist)))
- (lp (cdr clist) (cons (car clist) rl))
- (values (reverse! rl) clist))))
-
-(define (span! pred list)
- (span pred list)) ; XXX:optimize
-
(define (break pred clist)
(let lp ((clist clist) (rl '()))
(if (or (null? clist)
@@ -650,20 +583,6 @@
(every (lambda (el) (member el f (lambda (x y) (= y x)))) (car r))
(lp (car r) (cdr r)))))))
-;; It's not quite clear if duplicates among the `rest' elements are meant to
-;; be cast out. The spec says `=' is called as (= lstelem restelem),
-;; suggesting perhaps not, but the reference implementation shows the "list"
-;; at each stage as including those elements already added. The latter
-;; corresponds to what's described for lset-union, so that's what's done.
-;;
-(define (lset-adjoin = list . rest)
- (let lp ((l rest) (acc list))
- (if (null? l)
- acc
- (if (member (car l) acc (lambda (x y) (= y x)))
- (lp (cdr l) acc)
- (lp (cdr l) (cons (car l) acc))))))
-
(define (lset-union = . rest)
(let ((acc '()))
(for-each (lambda (lst)