utilities.scm

   1 ;;; utilities
   2
   3 (define (interval n m) ; returns the list (n n+1 n+2 ... m)
   4   (if (<= n m) (cons n (interval (+ n 1) m)) '()))
   5
   6 (define (keep f lst)
   7   (cond ((null? lst)   '())
   8         ((f (car lst)) (cons (car lst) (keep f (cdr lst))))
   9         (else          (keep f (cdr lst)))))
  10
  11 (define (set-equal? s1 s2)
  12   (and (eq? (diff s1 s2) '())
  13        (eq? (diff s2 s1) '())))
  14
  15 (define (diff s1 s2)
  16   (cond ((null? s1)         '())
  17         ((memq (car s1) s2) (diff (cdr s1) s2))
  18         (else               (cons (car s1) (diff (cdr s1) s2)))))
  19
  20 (define (intersection s1 s2)
  21   (cond ((null? s1)         '())
  22         ((memq (car s1) s2) (cons (car s1) (intersection (cdr s1) s2)))
  23         (else               (intersection (cdr s1) s2))))
  24
  25 (define (union s1 s2)
  26   (cond ((null? s1)         s2)
  27         ((memq (car s1) s2) (union (cdr s1) s2))
  28         (else               (cons (car s1) (union (cdr s1) s2)))))
  29
  30 (define (union-multi sets) (foldl union '() sets))
  31
  32 (define (foldl f base lst)
  33   (if (null? lst)
  34       base
  35       (foldl f (f base (car lst)) (cdr lst))))
  36
  37 (define (pos-in-list x lst)
  38   (let loop ((lst lst) (i 0))
  39     (cond ((not (pair? lst)) #f)
  40           ((eq? (car lst) x) i)
  41           (else              (loop (cdr lst) (+ i 1))))))
  42
  43 (define (remove x lst)
  44   (cond ((null? lst)       '())
  45         ((eq? x (car lst)) (cdr lst))
  46         (else              (cons (car lst)
  47                                  (remove x (cdr lst))))))
  48
  49 (define (replace x y lst)
  50   (cond ((null? lst)       '())
  51         ((eq? x (car lst)) (cons y (cdr lst)))
  52         (else              (cons (car lst)
  53                                  (replace x y (cdr lst))))))
  54
  55 (define (last lst)
  56   (cond ((null? lst)       #f)
  57         ((null? (cdr lst)) (car lst))
  58         (else              (last (cdr lst)))))
  59
  60 (define (all-but-last lst)
  61   (let loop ((lst lst)
  62              (new '()))
  63     (cond ((null? lst)       #f)
  64           ((null? (cdr lst)) (reverse new))
  65           (else              (loop (cdr lst)
  66                                    (cons (car lst) new))))))
  67
  68 (define (memp p l)
  69   (cond ((null? l)   #f)
  70         ((p (car l)) l)
  71         (else        (memp p (cdr l)))))