fork download
copy 
  1. ;; ============================================================
  2. ;; Merge procedure
  3. ;; ============================================================
  4.  
  5. ;; Public entry point: merge two sorted lists with a comparator
  6. (define (merge comparator list1 list2)
  7.   ;; Start with an empty collector
  8.   (merge01 comparator list1 list2 '()))
  9.  
  10. ;; Internal merge with accumulator (collect)
  11. (define (merge01 comparator list1 list2 collect)
  12.   (cond
  13.     ;; Case 1: list2 exhausted → append reversed collect with list1
  14.     ((null? list2)
  15.      (append (reverse collect) list1))
  16.  
  17.     ;; Case 2: list1 exhausted → append reversed collect with list2
  18.     ((null? list1)
  19.      (append (reverse collect) list2))
  20.  
  21.     ;; Case 3: comparator prefers element from list2
  22.     ((comparator (car list2) (car list1))
  23.      (merge01 comparator
  24.               list1
  25.               (cdr list2)
  26.               (cons (car list2) collect)))
  27.  
  28.     ;; Case 4: otherwise take from list1 (stability priority)
  29.     (else
  30.      (merge01 comparator
  31.               (cdr list1)
  32.               list2
  33.               (cons (car list1) collect)))))
  34.  
  35.  
  36. ;; ============================================================
  37. ;; Sort procedure (merge sort)
  38. ;; ============================================================
  39.  
  40. ;; Public entry point: prepare jumble and perform merge passes
  41. (define (sort comparator jumble)
  42.   (sort03 comparator
  43.           (sort02 comparator
  44.                   (sort01 jumble))))
  45.  
  46. ;; Step 1: prepare jumble by wrapping each element in a list
  47. (define (sort01 jumble)
  48.   (map list jumble))
  49.  
  50. ;; Step 2: perform merge passes until only one list remains
  51. (define (sort02 comparator jumble)
  52.   (cond
  53.     ;; Empty jumble → return nil
  54.     ((null? jumble) '())
  55.  
  56.     ;; One list in jumble → return it
  57.     ((null? (cdr jumble)) jumble)
  58.  
  59.     ;; Otherwise merge first two lists, recurse on rest
  60.     (else
  61.      (cons (merge comparator (car jumble) (cadr jumble))
  62.             (sort02 comparator (cddr jumble))))))
  63.  
  64. ;; Step 3: repeat merge passes until fully sorted
  65. (define (sort03 comparator jumble)
  66.   (cond
  67.     ;; Empty jumble
  68.     ((null? jumble) '())
  69.  
  70.     ;; One list left → return it
  71.     ((null? (cdr jumble)) (car jumble))
  72.  
  73.     ;; Otherwise perform another merge pass
  74.     (else
  75.      (sort03 comparator (sort02 comparator jumble)))))
  76.  
  77.  
  78. ;; ============================================================
  79. ;; Main entry point
  80. ;; ============================================================
  81.  
  82. (define (main)
  83.   ;; Example: sort numbers with ">" comparator
  84.   (display (sort > (list 4 3 5 6 8 7 1 2 9)))
  85.   (newline))
  86.  
  87. ;; Run main
  88. (main)
Success #stdin #stdout 0.02s 10844KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(9 8 7 6 5 4 3 2 1)
https://ideone.com/zFC00M
language:
Scheme (guile 2.2.4)
created:
9 hours ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!