implement some of important list functions listed on srfi-1

This commit is contained in:
Yuichi Nishiwaki 2014-02-01 23:20:13 +09:00
parent 78d82e4d12
commit dd784c589b
1 changed files with 67 additions and 1 deletions

View File

@ -5,12 +5,20 @@
;; cons list
;; xcons cons* make-list list-tabulate
;; list-copy circular-list iota
(define (xcons a b)
(cons b a))
(export cons list xcons)
;; # Predicates
;; pair? null?
;; proper-list? cirtular-list? dotted-list?
;; not-pair? null-list?
;; list=
(define (not-pair? x)
(not (pair? x)))
(export pair? null? not-pair?)
;; # Selectors
;; car cdr ... cddadr cddddr list-ref
@ -21,6 +29,25 @@
;; take! drop-right!
;; split-at split-at!
;; last last-pair
(define (car+cdr pair)
(values (car pair) (cdr pair)))
(define (take x i)
(if (zero? i)
'()
(cons (car x)
(take (cdr x) (- i 1)))))
(define (drop x i)
(if (zero? i)
x
(drop (cdr x) (- i 1))))
(define (split-at x i)
(values (take x i) (drop x i)))
(export car cdr car+cdr
take drop)
;; # Miscellaneous
;; length length+
@ -29,6 +56,13 @@
;; append-reverse append-reverse!
;; zip unzip1 unzip2 unzip3 unzip4 unzip5
;; count
(define (concatenate lists)
(apply append lists))
(define (zip . lists)
(apply map list lists))
(export length append concatenate reverse zip)
;; # Fold, unfold & map
;; map for-each
@ -36,10 +70,27 @@
;; fold-right unfold-right pair-fold right reduce-right
;; append-map append-map!
;; map! pair-for-each filter-map map-in-order
(export map for-each)
;; # Filtering & partitioning
;; filter partition remove
;; filter! partition! remove!
(define (filter pred list)
(if (null? list)
'()
(if (pred (car list))
(cons (car list)
(filter pred (cdr list)))
(filter pred (cdr list)))))
(define (partition pred list)
(values (filter pred list)
(filter (lambda (x) (not (pred x))) list)))
(define (remove pred list)
(filter (lambda (x) (not (pred x))) list))
(export filter partition remove)
;; # Searching
;; member memq memv
@ -48,6 +99,20 @@
;; list-index
;; take-while drop-while take-while!
;; span break span! break!
(define (find-tail pred list)
(if (null? list)
#f
(if (pred (car list))
list
(find-tail pred (cdr list)))))
(define (find pred list)
(let ((tail (find-tail pred list)))
(if tail
(car tail)
#f)))
(export member memq memv find-tail find)
;; # Deleting
;; delete delete-duplicates
@ -57,6 +122,7 @@
;; assoc assq assv
;; alist-cons alist-copy
;; alist-delete alist-delete!
(export assoc assq assv)
;; # Set operations on lists
;; lset<= lset= lset-adjoin
@ -68,4 +134,4 @@
;; # Primitive side-effects
;; set-car! set-cdr!
)
(export set-car! set-cdr!))