-
Notifications
You must be signed in to change notification settings - Fork 0
/
multi-sort.scm
46 lines (37 loc) · 940 Bytes
/
multi-sort.scm
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
(define (multi-sort1 s . less)
(sort
s
(lambda (x y)
(let loop ((x x) (y y) (less less))
(if (or (null? x) (null? y) (null? less)) #f
(if ((car less) (car x) (car y)) #t
(if (not (equal? (car x) (car y))) #f
(loop (cdr x) (cdr y) (cdr less)))))))))
(define (multi-sort2 s . less)
(sort
s
(lambda (x y)
(call/cc
(lambda (return)
(fold (lambda (x y less res)
(if (less x y) (return #t)
(if (not (equal? x y)) (return #f)
res)))
#f
x y less))))))
(define multi-sort multi-sort2)
(define (ms-test)
(multi-sort
'((1 2 3)
(0 9 1)
(4 5 6 first)
(0 0 0)
(1 4 2)
(4 9 6)
(1 4 8)
(7 8 9)
(7 9 8)
(4 5 6 second)
(1 4 2))
< > <))
(define (print s) (for-each (curry format #t "~a~%") s))