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