Welcome to the CHICKEN Scheme pasting service

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))

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Which one-argument R5RS procedure returns 1 when given `'(1 2 3)' as input?
Visually impaired? Let me spell it for you (wav file) download WAV