Fix total pattern match verification
[scheme.git] / utils.scm
1 (define (drop n xs)
2   (case n
3     [(0) xs]
4     [else (drop (- n 1) (cdr xs))]))
5
6 (define (drop-end n xs)
7   (reverse (drop n (reverse xs))))
8
9 (define (range s n)
10   (if (= 0 n) '()
11       (append (range s (- n 1))
12               (list (+ s (- n 1))))))
13
14 (define (flat-map f . xs) (fold-left append '() (apply map (cons f xs))))
15 (define (repeat x n) (if (<= n 0) '()
16                          (cons x (repeat x (- n 1)))))
17
18
19 (define-syntax push!
20   (syntax-rules ()
21     ((_ s x) (set! s (cons x s)))))
22
23 (define-syntax pop!
24   (syntax-rules ()
25     ((_ s) (let ([x (car s)])
26              (set! s (cdr s))
27              x))))
28
29 (define (any p x)
30   (fold-left
31    (lambda (acc y) (if acc #t (p y)))
32    #f
33    x))
34
35 (define (all xs) (fold-left (lambda (acc x) (and acc x)) #t xs))
36
37                                         ; (combinations '(1 2) '(3)) => '((1 3) (2 3))
38 (define (combinations . lists)
39   (case (length lists)
40     [0 '()]
41     [1 (map (lambda (x) (list x)) (car lists))]
42     [else (flat-map (lambda (x)
43                       (map (lambda (y) (cons x y))
44                            (apply combinations (cdr lists)))) (car lists))]))