thread-ring benchmark

threads.lua

-- The Computer Language Benchmarks Game
-- http://shootout.alioth.debian.org/

-- contributed by Toru Hisai

function make_thread (name, next)
   return coroutine.create (
      function (m)
         while m > 0 do
            m = coroutine.yield (next)
         end

         print (name)
      end
   )
end

local n = tonumber (arg[1])

local ring = {}
for i = 1, 503 do
   local next = i + 1
   if next > 503 then next = 1 end

   ring[i] = make_thread (i, next)
end

local index = 1
_, index = coroutine.resume (ring[index], n)
while index do
   n = n - 1
   _, index = coroutine.resume (ring[index], n)
end

threads.scm

;; http://shootout.alioth.debian.org/u64q/performance.php?test=threadring

(define m 0)

(define (make-thread name cont1)
  (let1 cont2 (call/cc
               (lambda (ret)
                 (cont1 ret)))
    (let loop ()
      (if (> m 1)
          (begin (dec! m)
                 (call/cc
                  (lambda (ret)
                    (cont2 ret)))
                 (loop))
          (begin (print name)
                 (cont2 #f))))))

(define (main args)
  (define threads
    (let loop ((n 503)
               (part ()))
      (if (> n 0)
          (loop (- n 1) (cons (call/cc
                               (lambda (ret)
                                 (make-thread n ret)))
                              part))
          part)))

  (set-cdr! (last-pair threads) threads)

  (set! m (+ (string->number (cadr args)) 1))

  (let loop ((p threads))
    (if (= m 0)
        'done
        (begin
          (let1 new-cont (call/cc
                          (lambda (cont)
                            ((car p) cont)))
            (set-car! p new-cont)
            (when new-cont
              (loop (cdr p))))
          ))))