From 4c04f1faa3e4ac14e755c78cc4c0e6d9f5bd9122 Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Wed, 8 Feb 2023 10:49:45 -0600 Subject: [PATCH] compat: Add 'sort' for Mes. * gash/compat.scm [mes] (sort): New procedure. --- gash/compat.scm | 34 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) 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)))))))