4chan's sleep sort for mario-goulart pasted by C-Keen on Thu Jun 16 09:22:34 2011
(use miscmacros srfi-1 srfi-18 thread-utils) (define *threads* '()) (define *res* '()) (define (wait-for-all l) (while (any (lambda (t) (not (or (thread-terminated? t) (thread-dead? t)))) l) (thread-yield!))) (define (make-sleeper n) (lambda () (thread-sleep! n) (push! n *res*))) (define (sleep-sort lst) (for-each (lambda (n) (let ((t (make-thread (make-sleeper n)))) (push! t *threads*) (thread-start! t))) lst)) (sleep-sort '(5 4 6 3 1 2)) (wait-for-all *threads*) (display (reverse *res*)) (newline) (exit 0)
sleep-sort using mailbox-threads pasted by DerGuteMoritz on Thu Jun 16 10:13:34 2011
(use mailbox-threads) (define (make-result-collector count) (thread-start! (lambda () (let loop ((res '()) (remaining (- count 1))) (if (zero? remaining) '() (cons (thread-receive) (loop res (- remaining 1)))))))) (define (make-sleeper n rc) (lambda () (thread-sleep! n) (thread-send rc n))) (define (sleep-sort lst) (let ((rc (make-result-collector (length lst)))) (for-each (lambda (n) (thread-start! (make-sleeper n rc))) lst) (thread-join! rc))) (write (sleep-sort '(5 4 6 3 1 2))) (newline) (exit 0)
correct version of sleep-sort using mailbox-threads pasted by DerGuteMoritz on Thu Jun 16 10:14:53 2011
(use mailbox-threads) (define (make-result-collector count) (thread-start! (lambda () (let loop ((res '()) (remaining count)) (if (zero? remaining) '() (cons (thread-receive) (loop res (- remaining 1)))))))) (define (make-sleeper n rc) (lambda () (thread-sleep! n) (thread-send rc n))) (define (sleep-sort lst) (let ((rc (make-result-collector (length lst)))) (for-each (lambda (n) (thread-start! (make-sleeper n rc))) lst) (thread-join! rc))) (write (sleep-sort '(5 4 6 3 1 2))) (newline) (exit 0)
system FTW added by mario-goulart on Thu Jun 16 15:19:15 2011
(define (sleep-sort l) (for-each (lambda (item) (system (sprintf "(sleep ~A && echo ~A) &" item item))) l)) (sleep-sort '(1 2 5 9 8 5 3 9))