[R6RS] SRFI-1 procedures
dyb at cs.indiana.edu
dyb at cs.indiana.edu
Tue May 30 11:51:03 EDT 2006
To help focus our discussion of SRFI-1 procedures, I've created brief
summaries of the possible candidates.
The first section covers the SRFI-1 procedures that one or more of
us have proposed to include. The second section covers generalized
versions of member, remove, and assoc. The third section covers specific
removal procedures: remq, remv, and remove, i.e., counterparts to
memq/memv/member and assq/assv/assoc.
The Scheme definitions shown are for illustration only; most lack adequate
error checking, and some are not as efficient as they could be.
Kent
-------- SRFI-1 procedures
(any pred list1 list2 ...)
- as in SRFI 1 except same constraints on argument lists as we've
agreed upon for map
(define any
(lambda (pred ls . ls*)
(and (not (null? ls))
(let loop ([ls ls] [ls* ls*])
(if (null? (cdr ls))
(apply pred (car ls) (map car ls*))
(or (apply pred (car ls) (map car ls*))
(loop (cdr ls) (map cdr ls*))))))))
(any < '(1 2 3) '(1 2 3)) ;=> #f
(any < '(1 2 3) '(3 2 1)) ;=> #t
(any car '((#f) (b) (#f))) ;=> b
(any car '((a) (b) (c))) ;=> a
(every pred list1 list2 ...)
- as in SRFI 1 except same constraints on argument lists as we've
agreed upon for map
(define every
(lambda (pred ls . ls*)
(or (null? ls)
(let loop ([ls ls] [ls* ls*])
(if (null? (cdr ls))
(apply pred (car ls) (map car ls*))
(and (apply pred (car ls) (map car ls*))
(loop (cdr ls) (map cdr ls*))))))))
(every <= '(1 2 3) '(1 2 3)) ;=> #t
(every <= '(1 2 3) '(3 2 1)) ;=> #f
(every car '((#f) (b) (#f))) ;=> #f
(every car '((a) (b) (c))) ;=> c
(concatenate list-of-lists)
- as in SRFI 1
- can last element of list-of-lists be a non-list?
- is (concatenate x) actually clearer than (apply append x)?
("concatenate" is one character shorter than "apply append")
(define concatenate
(lambda (list-of-lists)
(apply append list-of-lists)))
(concatenate '((1 2) (3 4 5))) ;=> (1 2 3 4 5)
(filter pred list)
- as in SRFI 1
(define filter
(lambda (pred ls)
(let f ([ls ls])
(if (null? ls)
'()
(if (pred (car ls))
(cons (car ls) (f (cdr ls)))
(f (cdr ls)))))))
(filter even? '(1 2 3 4 5)) ;=> (2 4)
(filter-map proc list1 list2 ...)
- as in SRFI 1 except same constraints on argument lists as we've
agreed upon for map
(define filter-map
(lambda (proc ls . ls*)
(filter values
(apply map proc ls ls*))))
(filter-map (lambda (x) (memq 'b x)) '((a b) (b c) (c d))) ;=> ((b) (b c))
(find pred ls)
- as in SRFI 1 except same constraints on argument list as we've
agreed upon for memq/memv/member
(define find
(lambda (pred ls)
(cond
[(generalized-member pred ls) => car]
[else #f])))
(find even? '(1 2 3 4 5)) ;=> 2
(find even? '(1 3 5 7 9)) ;=> #f
(fold cons nil list1 list2 ...)
- as in SRFI 1 except same constraints on argument lists as we've
agreed upon for map
(define fold
(lambda (cons nil ls . ls*)
(let f ([nil nil] [ls ls] [ls* ls*])
(if (null? ls)
nil
(f (apply cons (car ls) (append (map car ls*) (list nil)))
(cdr ls)
(map cdr ls*))))))
(fold cons '(q) '(a b c)) ;=> (c b a q)
(fold + 0 '(1 2 3) '(4 5 6)) ;=> 21
(fold-right kons knil list1 list2 ...)
- as in SRFI 1 except same constraints on argument lists as we've
agreed upon for map
(define fold-right
(lambda (cons nil ls . ls*)
(let f ([ls ls] [ls* ls*])
(if (null? ls)
nil
(apply cons (car ls)
(append (map car ls*) (list (f (cdr ls) (map cdr ls*)))))))))
(fold-right cons '(q) '(a b c)) ;=> (a b c q)
(fold-right + 0 '(1 2 3) '(4 5 6)) ;=> 21
(iota count [start [step]])
- as in SRFI 1 except that start can be specified even if step cannot.
(define iota
(rec iota
(case-lambda
[(count) (iota count 0 1)]
[(count start) (iota count start 1)]
[(count start step)
(if (= count 0)
'()
(cons start (iota (- count 1) (+ start step) step)))])))
(iota 5) ;=> (0 1 2 3 4)
(iota 5 1) ;=> (1 2 3 4 5)
(iota 5 1 -.25) ;=> (1 0.75 0.5 0.25 0.0)
(partition pred list)
- as in SRFI 1
(define partition
(lambda (pred ls)
(let f ([ls ls])
(if (null? ls)
(values '() '())
(let-values ([(ls1 ls2) (f (cdr ls))])
(if (pred (car ls))
(values (cons (car ls) ls1) ls2)
(values ls1 (cons (car ls) ls2))))))))
(partition even? '(1 2 3 4 5)) ;=> (2 4)
; (1 3 5)
-------- generalized member, remove, assoc
(generalized-member pred list)
- returns first pair of list whose car satisfies pred, if any,
otherwise #f
- same constraints on argument list as we've agreed upon for
memq/memv/member
- can we come up with a better name?
- SRFI 1 calls this find-tail.
- SRFI 1 also generalizes member with = argument
(define generalized-member
(lambda (pred ls)
(let f ([ls ls])
(and (not (null? ls))
(if (pred (car ls))
ls
(f (cdr ls)))))))
(generalized-member even? '(1 2 3 4 5)) ;=> (2 3 4 5)
(generalized-member even? '(1 3 5 7 9)) ;=> #f
(generalized-remove pred list)
- returns new list with elements satisfying pred removed
- raises exception if list is not a list
- can we come up with a better name?
- SRFI 1 calls this remove, but remove has a different meaning
in some Scheme systems and in Common Lisp
(define generalized-remove
(lambda (pred ls)
(filter (lambda (x) (not (pred x))) ls)))
(generalized-remove even? '(1 2 3 4 5)) ;=> (1 3 5)
(generalized-assoc pred alist)
- returns first pair of alist whose car satisfies pred, if any,
otherwise #f
- same constraints on argument list as we've agreed upon for
assq/assv/assoc
- can we come up with a better name?
- SRFI 1 generalizes assoc with = argument
(define generalized-assoc
(lambda (pred alist)
(find (lambda (x) (pred (car x))) alist)))
(generalized-assoc
(lambda (x) (not (= x x)))
'((0 . zero) (+nan.0 . #f) (+inf.0 . big))) ;=> (+inf.0 . big)
-------- specific removal procedures
(remq x list)
(define remq
(lambda (x list)
(generalized-remove (lambda (y) (eq? y x)) list)))
(remq 'b '(a b c b a)) ;=> (a c a)
(remv x list)
(define remv
(lambda (x list)
(generalized-remove (lambda (y) (eqv? y x)) list)))
(remv 3.14 '(pi 3.14 3.1416 #\x03C0)) ;=> (pi 3.1416 #\x03C0)
(remove x list)
(define remove
(lambda (x list)
(generalized-remove (lambda (y) (equal? y x)) list)))
(remove "a" '(a "a" #\a (a))) ;=> (a #\a (a))
More information about the R6RS
mailing list