scheme language bottom up mergesort code

;; ============================================================
;; Basic wrappers for primitive operations
;; ============================================================

;; Append two lists
(define (append* list1 list2)
  ;; Equivalent to built-in append
  (append list1 list2))

;; Car of a pair
(define (car* list1)
  ;; Equivalent to built-in car
  (car list1))

;; Cdr of a pair
(define (cdr* list1)
  ;; Equivalent to built-in cdr
  (cdr list1))

;; Cons an item onto a list
(define (cons* item list1)
  ;; Equivalent to built-in cons
  (cons item list1))

;; singleton List
(define (list1* value)
  ;; Equivalent to built-in list
  (list value))

;; Map a function over a list
(define (map* function list1)
  ;; Equivalent to built-in map
  (map function list1))

;; Null? predicate
(define (null?* value)
  ;; Equivalent to built-in null?
  (null? value))

;; Reverse a list
(define (reverse* list1)
  ;; Equivalent to built-in reverse
  (reverse list1))


;; ============================================================
;; 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* list1* 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) (car* (cdr* jumble)))
            (sort02 comparator (cdr* (cdr* 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)