From 69b33e06e74c312cb4e97fa8fb588bd9e7caae35 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 28 Mar 2000 02:06:12 +0000 Subject: [PATCH] . original commit: 6eb66746b48e7e4ec70be28561a7cec9c43e70c9 --- collects/mzlib/functior.ss | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/collects/mzlib/functior.ss b/collects/mzlib/functior.ss index 9785672..ed28824 100644 --- a/collects/mzlib/functior.ss +++ b/collects/mzlib/functior.ss @@ -59,7 +59,34 @@ (loop min pivot) (loop pivot max)))))))) (vector->list v))))) - + + (define mergesort + (polymorphic + (lambda (alox less-than) + (letrec ([split (lambda (alox r) + (cond + [(null? alox) r] + [(null? (cdr alox)) (cons alox r)] + [else (split (cdr alox) (cons (list (car alox)) r))]))] + [merge (lambda (l1 l2 r) + (cond + [(null? l1) (append! (reverse! r) l2)] + [(null? l2) (append! (reverse! r) l1)] + [(less-than (car l1) (car l2)) + (merge (cdr l1) l2 (cons (car l1) r))] + [else (merge (cdr l2) l1 (cons (car l2) r))]))] + [map2 (lambda (l) + (cond + [(null? l) '()] + [(null? (cdr l)) l] + [else (cons (merge (car l) (cadr l) null) + (map2 (cddr l)))]))] + [until (lambda (l) + (if (null? (cdr l)) + (car l) + (until (map2 l))))]) + (until (split alox null)))))) + (define ignore-errors (polymorphic (lambda (thunk)