diff options
author | Kevin Ryde <user42@zip.com.au> | 2005-05-06 23:59:35 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2005-05-06 23:59:35 +0000 |
commit | e556f8c3c6b74ee6596e8dcbe829109d7745da2c (patch) | |
tree | 2bc3871e187dfd5a52016deb21b868081236cd95 /srfi/srfi-1.scm | |
parent | 6017642112daa7a14145e0c36ff3862e5d9f8d06 (diff) | |
download | guile-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.scm | 46 |
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) |