diff --git a/gash/compat.scm b/gash/compat.scm index 22b793f..3f77e3b 100644 --- a/gash/compat.scm +++ b/gash/compat.scm @@ -107,7 +107,8 @@ thunk? EXIT_SUCCESS EXIT_FAILURE - exact-integer?) + exact-integer? + sort) (define-macro (define-inlinable . rest) `(define ,@rest)) @@ -241,4 +242,33 @@ (define EXIT_FAILURE 1) ;; 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)))))))