mergesort
;; ============================================================
;; Basic wrappers for primitive operations
;; ============================================================
;; Append two lists
(define (append* list1 list2)
;; Equivalent to built-in append
(append list1 list2))
;; Cons an item onto a list
(define (cons* item list)
;; Equivalent to built-in cons
(cons item list))
;; Map a function over a list
(define (map* function list)
;; Equivalent to built-in map
(map function list))
;; Null? predicate
(define (null?* value)
(null? value))
;; Reverse a list
(define (reverse* list)
(reverse list))
;; ============================================================
;; Merge procedure
;; ============================================================
;; Public entry point: merge two sorted lists with a comparator
(define (merge comparator list1 list2)
;; Start with an empty collector
(merge01 comparator list1 list2 '()))
;; Internal merge with accumulator (collect)
(define (merge01 comparator list1 list2 collect)
(cond
;; Case 1: list2 exhausted → append reversed collect with list1
((null?* list2)
(append* (reverse* collect) list1))
;; Case 2: list1 exhausted → append reversed collect with list2
((null?* list1)
(append* (reverse* collect) list2))
;; Case 3: comparator prefers element from list2
((comparator (car list2) (car list1))
(merge01 comparator
list1
(cdr list2)
(cons* (car list2) collect)))
;; Case 4: otherwise take from list1 (stability priority)
(else
(merge01 comparator
(cdr list1)
list2
(cons* (car list1) collect)))))
;; ============================================================
;; Sort procedure (merge sort)
;; ============================================================
;; Public entry point: prepare jumble and perform merge passes
(define (sort* comparator jumble)
(sort03 comparator
(sort02 comparator
(sort01 jumble))))
;; Step 1: prepare jumble by wrapping each element in a list
(define (sort01 jumble)
(map* list jumble))
;; Step 2: perform a single merge pass
(define (sort02 comparator jumble)
(cond
;; Empty jumble → return nil
((null?* jumble) '())
;; One list in jumble → return it
((null?* (cdr jumble)) jumble)
;; Otherwise merge first two lists, recurse on rest
(else
(cons* (merge comparator (car jumble) (cadr jumble))
(sort02 comparator (cddr jumble))))))
;; Step 3: repeat merge passes until fully sorted
(define (sort03 comparator jumble)
(cond
;; Empty jumble
((null?* jumble) '())
;; One list left → return it
((null?* (cdr jumble)) (car jumble))
;; Otherwise perform another merge pass
(else
(sort03 comparator (sort02 comparator jumble)))))
;; ============================================================
;; Main entry point
;; ============================================================
(define (main)
;; Example: sort numbers with ">" comparator
(display (sort* > (list 4 3 5 6 8 7 1 2 9)))
(newline))
;; Run main
(main)