compat: Add 'sort' for Mes.
* gash/compat.scm [mes] (sort): New procedure.
This commit is contained in:
parent
a087816b90
commit
4c04f1faa3
|
@ -107,7 +107,8 @@
|
||||||
thunk?
|
thunk?
|
||||||
EXIT_SUCCESS
|
EXIT_SUCCESS
|
||||||
EXIT_FAILURE
|
EXIT_FAILURE
|
||||||
exact-integer?)
|
exact-integer?
|
||||||
|
sort)
|
||||||
|
|
||||||
(define-macro (define-inlinable . rest)
|
(define-macro (define-inlinable . rest)
|
||||||
`(define ,@rest))
|
`(define ,@rest))
|
||||||
|
@ -241,4 +242,33 @@
|
||||||
(define EXIT_FAILURE 1)
|
(define EXIT_FAILURE 1)
|
||||||
|
|
||||||
;; Mes only has exact integers.
|
;; Mes only has exact integers.
|
||||||
(define exact-integer? integer?))
|
(define exact-integer? integer?)
|
||||||
|
|
||||||
|
;; A simple (slow!) sort procedure. It's needed for globbing.
|
||||||
|
(define (sort items less)
|
||||||
|
(define (split-reverse lst)
|
||||||
|
(let loop ((lst lst) (acc1 '()) (acc2 '()))
|
||||||
|
(cond
|
||||||
|
((null? lst) (values acc1 acc2))
|
||||||
|
((null? (cdr lst)) (values (cons (car lst) acc1) acc2))
|
||||||
|
(else (loop (cddr lst)
|
||||||
|
(cons (car lst) acc1)
|
||||||
|
(cons (cadr lst) acc2))))))
|
||||||
|
|
||||||
|
(define (merge alist blist less)
|
||||||
|
(let loop ((alist alist) (blist blist) (acc '()))
|
||||||
|
(cond
|
||||||
|
((null? alist) (reverse (append-reverse blist acc)))
|
||||||
|
((null? blist) (reverse (append-reverse alist acc)))
|
||||||
|
(else (let ((a (car alist))
|
||||||
|
(b (car blist)))
|
||||||
|
(if (less a b)
|
||||||
|
(loop (cdr alist) blist (cons a acc))
|
||||||
|
(loop alist (cdr blist) (cons b acc))))))))
|
||||||
|
|
||||||
|
(cond
|
||||||
|
((null? items) items)
|
||||||
|
((null? (cdr items)) items)
|
||||||
|
(else (call-with-values (lambda () (split-reverse items))
|
||||||
|
(lambda (alist blist)
|
||||||
|
(merge (sort alist less) (sort blist less) less)))))))
|
||||||
|
|
Loading…
Reference in New Issue