summaryrefslogtreecommitdiff
path: root/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2005-05-06 23:59:35 +0000
committerKevin Ryde <user42@zip.com.au>2005-05-06 23:59:35 +0000
commite556f8c3c6b74ee6596e8dcbe829109d7745da2c (patch)
tree2bc3871e187dfd5a52016deb21b868081236cd95 /srfi/srfi-1.scm
parent6017642112daa7a14145e0c36ff3862e5d9f8d06 (diff)
downloadguile-e556f8c3c6b74ee6596e8dcbe829109d7745da2c.tar.gz
(car+cdr, fold, last, list-index,
list-tabulate, not-pair, xcons): Rewrite in C.
Diffstat (limited to 'srfi/srfi-1.scm')
-rw-r--r--srfi/srfi-1.scm46
1 files changed, 1 insertions, 45 deletions
diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index 36da13b75..7fd1b67c2 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -225,9 +225,6 @@
;;; Constructors
-(define (xcons d a)
- (cons a d))
-
;; internal helper, similar to (scsh utilities) check-arg.
(define (check-arg-type pred arg caller)
(if (pred arg)
@@ -238,12 +235,7 @@
;; the srfi spec doesn't seem to forbid inexact integers.
(define (non-negative-integer? x) (and (integer? x) (>= x 0)))
-(define (list-tabulate n init-proc)
- (check-arg-type non-negative-integer? n "list-tabulate")
- (let lp ((n n) (acc '()))
- (if (<= n 0)
- acc
- (lp (- n 1) (cons (init-proc (- n 1)) acc)))))
+
(define (circular-list elt1 . elts)
(set! elts (cons elt1 elts))
@@ -304,9 +296,6 @@
(else
(error "not a proper list in null-list?"))))
-(define (not-pair? x)
- (not (pair? x)))
-
(define (list= elt= . rest)
(define (lists-equal a b)
(let lp ((a a) (b b))
@@ -330,14 +319,9 @@
(define third caddr)
(define fourth cadddr)
-(define (car+cdr x) (values (car x) (cdr x)))
-
(define take list-head)
(define drop list-tail)
-(define (last pair)
- (car (last-pair pair)))
-
;;; Miscelleneous: length, append, concatenate, reverse, zip & count
(define (append-reverse rev-head tail)
@@ -370,19 +354,6 @@
;;; Fold, unfold & map
-(define (fold kons knil list1 . rest)
- (if (null? rest)
- (let f ((knil knil) (list1 list1))
- (if (null? list1)
- knil
- (f (kons (car list1) knil) (cdr list1))))
- (let f ((knil knil) (lists (cons list1 rest)))
- (if (any null? lists)
- knil
- (let ((cars (map1 car lists))
- (cdrs (map1 cdr lists)))
- (f (apply kons (append! cars (list knil))) cdrs))))))
-
(define (fold-right kons knil clist1 . rest)
(if (null? rest)
(let f ((list1 clist1))
@@ -516,21 +487,6 @@
(else
(and (pred (car ls)) (lp (cdr ls)))))))
-(define (list-index pred clist1 . rest)
- (if (null? rest)
- (let lp ((l clist1) (i 0))
- (if (null? l)
- #f
- (if (pred (car l))
- i
- (lp (cdr l) (+ i 1)))))
- (let lp ((lists (cons clist1 rest)) (i 0))
- (cond ((any1 null? lists)
- #f)
- ((apply pred (map1 car lists)) i)
- (else
- (lp (map1 cdr lists) (+ i 1)))))))
-
;;; Association lists
(define alist-cons acons)