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)))))
|