fork download 
  1. ;; ============================================================
  2. ;; Code as Statement on https://y...content-available-to-author-only...p.me/kasten/
  3. ;;
  4. ;; Each program here is more than its utility: it is both
  5. ;; an implementation and a declaration.
  6. ;;
  7. ;; Technical design:
  8. ;; - Write clearly. 
  9. ;; - Structure code for adaptability,
  10. ;;   experimentation, and reuse.
  11. ;;
  12. ;; Philosophical intent:
  13. ;; - Release into the public domain: free to use,
  14. ;;   remix, and preserve without restriction.
  15. ;; - Value permanence, openness, and freedom.
  16. ;; - A collaboration between human intent and machine creativity.
  17. ;; ============================================================
  18.  
  19.  
  20. ;; ============================================================
  21. ;; Basic wrappers for primitive operations
  22. ;; ============================================================
  23.  
  24. ;; Append two lists
  25. (define (append* list1 list2)
  26.   ;; Equivalent to built-in append
  27.   (append list1 list2))
  28.  
  29. ;; Car of a pair
  30. (define (car* list1)
  31.   ;; Equivalent to built-in car
  32.   (car list1))
  33.  
  34. ;; Cdr of a pair
  35. (define (cdr* list1)
  36.   ;; Equivalent to built-in cdr
  37.   (cdr list1))
  38.  
  39. ;; Cons an item onto a list
  40. (define (cons* item list)
  41.   ;; Equivalent to built-in cons
  42.   (cons item list))
  43.  
  44. ;; Map a function over a list
  45. (define (map* function list)
  46.   ;; Equivalent to built-in map
  47.   (map function list))
  48.  
  49. ;; Null? predicate
  50. (define (null?* value)
  51.   ;; Equivalent to built-in null?
  52.   (null? value))
  53.  
  54. ;; Reverse a list
  55. (define (reverse* list)
  56.   ;; Equivalent to built-in reverse
  57.   (reverse list))
  58.  
  59.  
  60. ;; ============================================================
  61. ;; Merge procedure
  62. ;; ============================================================
  63.  
  64. ;; Public entry point: merge two sorted lists with a comparator
  65. (define (merge comparator list1 list2)
  66.   ;; Start with an empty collector
  67.   (merge01 comparator list1 list2 '()))
  68.  
  69. ;; Internal merge with accumulator (collect)
  70. (define (merge01 comparator list1 list2 collect)
  71.   (cond
  72.     ;; Case 1: list2 exhausted → append reversed collect with list1
  73.     ((null?* list2)
  74.      (append* (reverse* collect) list1))
  75.  
  76.     ;; Case 2: list1 exhausted → append reversed collect with list2
  77.     ((null?* list1)
  78.      (append* (reverse* collect) list2))
  79.  
  80.     ;; Case 3: comparator prefers element from list2
  81.     ((comparator (car* list2) (car* list1))
  82.      (merge01 comparator
  83.               list1
  84.               (cdr* list2)
  85.               (cons* (car* list2) collect)))
  86.  
  87.     ;; Case 4: otherwise take from list1 (stability priority)
  88.     (else
  89.      (merge01 comparator
  90.               (cdr* list1)
  91.               list2
  92.               (cons* (car* list1) collect)))))
  93.  
  94.  
  95. ;; ============================================================
  96. ;; Sort procedure (merge sort)
  97. ;; ============================================================
  98.  
  99. ;; Public entry point: prepare jumble and perform merge passes
  100. (define (sort* comparator jumble)
  101.   (sort03 comparator
  102.           (sort02 comparator
  103.                   (sort01 jumble))))
  104.  
  105. ;; Step 1: prepare jumble by wrapping each element in a list
  106. (define (sort01 jumble)
  107.   (map* list jumble))
  108.  
  109. ;; Step 2: perform a single merge pass
  110. (define (sort02 comparator jumble)
  111.   (cond
  112.     ;; Empty jumble → return nil
  113.     ((null?* jumble) '())
  114.  
  115.     ;; One list in jumble → return it
  116.     ((null?* (cdr* jumble)) jumble)
  117.  
  118.     ;; Otherwise merge first two lists, recurse on rest
  119.     (else
  120.      (cons* (merge comparator (car* jumble) (car* (cdr* jumble)))
  121.             (sort02 comparator (cdr* (cdr* jumble)))))))
  122.  
  123. ;; Step 3: repeat merge passes until fully sorted
  124. (define (sort03 comparator jumble)
  125.   (cond
  126.     ;; Empty jumble
  127.     ((null?* jumble) '())
  128.  
  129.     ;; One list left → return it
  130.     ((null?* (cdr* jumble)) (car* jumble))
  131.  
  132.     ;; Otherwise perform another merge pass
  133.     (else
  134.      (sort03 comparator (sort02 comparator jumble)))))
  135.  
  136.  
  137. ;; ============================================================
  138. ;; Main entry point
  139. ;; ============================================================
  140.  
  141. (define (main)
  142.   ;; Example: sort numbers with ">" comparator
  143.   (display (sort* > (list 4 3 5 6 8 7 1 2 9)))
  144.   (newline))
  145.  
  146. ;; Run main
  147. (main)
Success #stdin #stdout 0.02s 10836KB
comments (?)
stdin 
Standard input is empty
stdout 
(9 8 7 6 5 4 3 2 1)
https://ideone.com/SOQwyY
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!