aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l15/kacp.rkt
blob: bd484f1fb93313bf478eac86d5a6c912b592e2c1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
#lang racket

(define (run-concurrent . thunks)
  (define threads (map thread thunks))
  (for-each thread-wait threads))

(define (random-sleep)
  (sleep (/ (random) 100)))

(define (with-random-sleep proc)
  (lambda args
    (random-sleep)
    (apply proc args)))

(define (make-serializer)
  (define sem (make-semaphore 1))
  (lambda (proc)
    (lambda args
      (semaphore-wait sem)
      (define ret (apply proc args))
      (semaphore-post sem)
      ret)))

(define (table)
  (random-sleep)
  (define forks (list (make-semaphore 1)
                      (make-semaphore 1)
                      (make-semaphore 1)
                      (make-semaphore 1)
                      (make-semaphore 1)))
  (define (pick-fork i)
    (random-sleep)
    (semaphore-wait (list-ref forks i)))
  (define (put-fork i)
    (random-sleep)
    (semaphore-post (list-ref forks i)))
  (define (dispatch m)
    (cond [(eq? m 'pick-fork) pick-fork]
          [(eq? m 'put-fork) put-fork]
          [else (error "Unknown request -- TABLE"
                       m)]))
  dispatch)

(define dtable (table))

(define (philosopher dining-table number)
  (define my-turn (make-serializer))
  (define (eat)
    (display "Zaczynam ")
    (display number)
    (newline)
    ((dining-table 'pick-fork) number)
    ((dining-table 'put-fork) number)
    ((dining-table 'pick-fork) (modulo (+ number 1) 5))
    ((dining-table 'put-fork) (modulo (+ number 1) 5))
    (display "Koncze ")
    (display number)
    (newline))
  (my-turn eat))