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
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: David van Horn, Mike Sperber, Marcus Crestani
;;; "sort.scm" defines: sorted?, merge, merge!, sort, sort!
(define (sorted? seq less? . opt-key)
(define key (if (null? opt-key) (lambda (x) x) (car opt-key)))
(define less-key? (lambda (a b) (less? (key a) (key b))))
(cond
((array? seq)
(olin:vector-sorted? less-key? (array->vector seq)))
((vector? seq)
(olin:vector-sorted? less-key? seq))
(else
(olin:list-sorted? less-key? seq))))
(define (merge a b less? . opt-key)
(define key (if (null? opt-key) (lambda (x) x) (car opt-key)))
(define less-key? (lambda (a b) (less? (key a) (key b))))
(cond
((and (vector? a) (vector? b))
(olin:vector-merge less-key? a b))
(else
(olin:list-merge less-key? a b))))
(define (merge! a b less? . opt-key)
(define key (if (null? opt-key) (lambda (x) x) (car opt-key)))
(define less-key? (lambda (a b) (less? (key a) (key b))))
(cond
((and (vector? a) (vector? b))
(let ((v (make-vector (+ (vector-length a) (vector-length b)))))
(olin:vector-merge! less-key? v a b)
v))
(else
(olin:list-merge! less-key? a b))))
(define (sort seq less? . opt-key)
(define key (if (null? opt-key) (lambda (x) x) (car opt-key)))
(define less-key? (lambda (a b) (less? (key a) (key b))))
(cond
((vector? seq)
(olin:vector-sort less-key? seq))
((array? seq)
(apply vector->array
(olin:vector-sort less-key? (array->vector seq))
'#()
(array-dimensions seq)))
(else
(olin:list-sort less-key? seq))))
(define (sort! seq less? . opt-key)
(define key (if (null? opt-key) (lambda (x) x) (car opt-key)))
(define less-key? (lambda (a b) (less? (key a) (key b))))
(cond
((vector? seq)
(olin:vector-sort! less-key? seq)
seq)
((array? seq)
(let ((v (olin:vector-sort less-key? (array->vector seq))))
(apply vector->array v '#() (array-dimensions seq))))
(else
(olin:list-sort! less-key? seq))))
|
