fork download
copy 
  1. ;; ============================================================
  2. ;; Basic wrappers for primitive operations
  3. ;; ============================================================
  4.  
  5. ;; Append two lists
  6. (define (append* list1 list2)
  7.   ;; Equivalent to built-in append
  8.   (append list1 list2))
  9.  
  10. ;; Cons an item onto a list
  11. (define (cons* item list)
  12.   ;; Equivalent to built-in cons
  13.   (cons item list))
  14.  
  15. ;; Map a function over a list
  16. (define (map* function list)
  17.   ;; Equivalent to built-in map
  18.   (map function list))
  19.  
  20. ;; Null? predicate
  21. (define (null?* value)
  22.   (null? value))
  23.  
  24. ;; Reverse a list
  25. (define (reverse* list)
  26.   (reverse list))
  27.  
  28.  
  29. ;; ============================================================
  30. ;; Merge procedure
  31. ;; ============================================================
  32.  
  33. ;; Public entry point: merge two sorted lists with a comparator
  34. (define (merge comparator list1 list2)
  35.   ;; Start with an empty collector
  36.   (merge01 comparator list1 list2 '()))
  37.  
  38. ;; Internal merge with accumulator (collect)
  39. (define (merge01 comparator list1 list2 collect)
  40.   (cond
  41.     ;; Case 1: list2 exhausted → append reversed collect with list1
  42.     ((null?* list2)
  43.      (append* (reverse* collect) list1))
  44.  
  45.     ;; Case 2: list1 exhausted → append reversed collect with list2
  46.     ((null?* list1)
  47.      (append* (reverse* collect) list2))
  48.  
  49.     ;; Case 3: comparator prefers element from list2
  50.     ((comparator (car list2) (car list1))
  51.      (merge01 comparator
  52.               list1
  53.               (cdr list2)
  54.               (cons* (car list2) collect)))
  55.  
  56.     ;; Case 4: otherwise take from list1 (stability priority)
  57.     (else
  58.      (merge01 comparator
  59.               (cdr list1)
  60.               list2
  61.               (cons* (car list1) collect)))))
  62.  
  63.  
  64. ;; ============================================================
  65. ;; Sort procedure (merge sort)
  66. ;; ============================================================
  67.  
  68. ;; Public entry point: prepare jumble and perform merge passes
  69. (define (sort* comparator jumble)
  70.   (sort03 comparator
  71.           (sort02 comparator
  72.                   (sort01 jumble))))
  73.  
  74. ;; Step 1: prepare jumble by wrapping each element in a list
  75. (define (sort01 jumble)
  76.   (map* list jumble))
  77.  
  78. ;; Step 2: perform a single merge pass
  79. (define (sort02 comparator jumble)
  80.   (cond
  81.     ;; Empty jumble → return nil
  82.     ((null?* jumble) '())
  83.  
  84.     ;; One list in jumble → return it
  85.     ((null?* (cdr jumble)) jumble)
  86.  
  87.     ;; Otherwise merge first two lists, recurse on rest
  88.     (else
  89.      (cons* (merge comparator (car jumble) (cadr jumble))
  90.             (sort02 comparator (cddr jumble))))))
  91.  
  92. ;; Step 3: repeat merge passes until fully sorted
  93. (define (sort03 comparator jumble)
  94.   (cond
  95.     ;; Empty jumble
  96.     ((null?* jumble) '())
  97.  
  98.     ;; One list left → return it
  99.     ((null?* (cdr jumble)) (car jumble))
  100.  
  101.     ;; Otherwise perform another merge pass
  102.     (else
  103.      (sort03 comparator (sort02 comparator jumble)))))
  104.  
  105.  
  106. ;; ============================================================
  107. ;; Main entry point
  108. ;; ============================================================
  109.  
  110. (define (main)
  111.   ;; Example: sort numbers with ">" comparator
  112.   (display (sort* > (list 4 3 5 6 8 7 1 2 9)))
  113.   (newline))
  114.  
  115. ;; Run main
  116. (main)
Success #stdin #stdout 0.03s 10772KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(9 8 7 6 5 4 3 2 1)
https://ideone.com/m4ZyZD
language:
Scheme (guile 2.2.4)
created:
3 days 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!