aboutsummaryrefslogtreecommitdiffstats
path: root/csc/list.csc
blob: b1c2298054853b9a9ac0442502d449645496eb16 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
(define-library (csc list)
  (export
    all
    enumerate
    filter
    intercalate
    revappend
    split-at
    take
    unzip)
  (import (scheme base)
          (only (csc loop)
            loop
            return)
          (only (csc match)
            match))
  (begin


    (define (take n xs)
      (loop for x in xs
            for i from 1 to n
            collect x))


    (define (split-at n xs)
      (if (<= n 0)
        (values '() xs)
        (loop for i from 1 to n
              for x in xs
              for second-half = (cdr xs) then (cdr second-half)
              collect x into first-half
              finally (return (values first-half second-half)))))


    (define (revappend a b)
      (let loop ((xs a)
                 (acc b))
        (if (null? xs)
            acc
          (loop (cdr xs) (cons (car xs) acc)))))


    (define (intercalate x l)
      (match l
        ('() '())
        ((_) l)
        ((head . tail) (cons head (cons x (intercalate x tail))))))


    (define (enumerate l)
      (let loop ((i 0)
                 (l l))
        (match l
          ('() '())
          ((head . tail) (cons (cons i head) (loop (+ 1 i) tail))))))


    (define (filter p l)
      (let loop ((l l)
                 (acc '()))
        (match l
          ('() (reverse acc))
          ((x . xs)
           (if (p x)
             (loop xs (cons x acc))
             (loop xs acc))))))


    (define (unzip l)
      (loop for x in l
            collect (car x) into xs
            collect (cdr x) into ys
            finally (return (values xs ys))))


    (define (all pred . ls)
      (loop for ls = ls then (map cdr ls)
            while (loop for l in ls
                        if (null? l)
                          return #f
                        finally (return #t))
            unless (apply pred (map car ls))
              return #f
            finally (return #t)))))