mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

(car+cdr, fold, last, list-index,

Browse source 
list-tabulate, not-pair, xcons): Rewrite in C.
This commit is contained in:
Kevin Ryde 2005-05-06 23:59:35 +00:00
parent 6017642112
commit e556f8c3c6
3 changed files with 297 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

46
srfi/srfi-1.scm
View file

@ -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)