[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