Racket/Multitråd

#lang racket


;;;;;
;; Multitrådad demo
;; Täpp-Anders Sikvall, anders@sikvall.se, 2006-04-04
;; Racketkurs.

;; Simulerar tidsödande arbete genom att pausa tråden en slumpmässig tid
(define (random-sleep min-sec max-sec)
  (sleep (+ min-sec (* (random) (- max-sec min-sec)))))

;; En arbetare körs i en egen tråd och lyssnar på work-channel
(define (start-worker id work-channel result-channel)
  (thread
   (λ ()
     (let loop ()
       ;; Vänta på att få ett meddelande från arbetskön
       (match (channel-get work-channel)
         ;; Om meddelandet är 'done', avsluta loopen och därmed tråden
         ['done
          (printf "Arbetare ~a: Avslutar.\n" id)]
         
         ;; Om meddelandet är ett tal, utför beräkningen
         [n
          (printf "Arbetare ~a: Bearbetar värde ~a...\n" id n)
          (random-sleep 0.1 0.4)
          
          ;; Skicka tillbaka resultatet. 
          ;; OBS: Detta blockerar arbetaren tills huvudtråden läser från result-channel.
          (channel-put result-channel (list id (* n n)))
          (loop)])))))

;; --- Huvudprogram ---

(define (main)
  (define num-workers 4)
  (define num-tasks   10)

  ;; Skapa kanaler för kommunikation
  ;; Dessa är synkrona (blockerande) i Racket
  (define work-channel   (make-channel))
  (define result-channel (make-channel))

  (printf "System: Startar ~a arbetstrådar.\n" num-workers)
  
  ;; Starta arbetartrådarna och spara deras referenser i en lista
  (define workers
    (for/list ([i (in-range num-workers)])
      (start-worker i work-channel result-channel)))

  ;; 1. Skicka uppgifter till arbetskön.
  ;; Vi gör detta i en separat tråd för att säkerställa att huvudtråden 
  ;; kan börja tömma resultat-kanalen omedelbart.
  (thread
   (λ ()
     (for ([task (in-range 1 (add1 num-tasks))])
       (channel-put work-channel task))
     
     ;; Skicka en 'done'-signal per arbetare för att stänga ner dem snyggt
     (for ([_ (in-range num-workers)])
       (channel-put work-channel 'done))))

  ;; Samla in resultaten.
  (printf "System: Samlar in resultat.\n")
  (for ([_ (in-range num-tasks)])
    (match (channel-get result-channel)
      [(list id result)
       (printf "Resultat: Arbetare ~a levererade ~a\n" id result)]))

  ;; Vänta på att trådarna faktiskt har stängt ner.
  (printf "System: Väntar på att trådar stängs ner...\n")
  (for-each thread-wait workers)

  (printf "System: Programmet är klart.\n"))

;; Kör programmet
(main)