blob: a3d2f3ee58ab90f123e4c2778edf67fc79d0b7a1 (
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
60
61
62
63
64
|
#lang racket
(define (make-mutex)
(let ((the-mutex (make-semaphore 1)))
(define (dispatch m)
(cond ((eq? m 'acquire)
(semaphore-wait the-mutex))
((eq? m 'release)
(semaphore-post the-mutex))))
dispatch))
(define (make-serializer)
(let ((mutex (make-mutex)))
(lambda (p)
(define (serialized-p . args)
(mutex 'acquire)
(let ((val (apply p args)))
(mutex 'release)
val))
serialized-p)))
(define (make-numbered-accounts n)
(let ((global-serializer (make-serializer)))
(global-serializer
(lambda (balance)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(let ((number (begin (set! n (+ n 1))
n))
(balance-serializer (make-serializer)))
(lambda (m)
(cond ((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
((eq? m 'balance) balance)
((eq? m 'serializer) balance-serializer)
((eq? m 'number) number))))))))
(define account (make-numbered-accounts 0))
(define a1 (account 100))
(define a2 (account 50))
(println (a1 'number))
(println (a2 'number))
(define (exchange a1 a2)
(let ((delta (- (a1 'balance)
(a2 'balance))))
((a1 'withdraw) delta)
((a2 'deposit) delta)))
(define (serialized-exchange a1 a2)
(let ((s1 (a1 'serializer))
(s2 (a2 'serializer)))
(let ((s (if (< (a1 'number)
(a2 'number))
(lambda (f) (s1 (s2 f)))
(lambda (f) (s2 (s1 f))))))
((s exchange) a1 a2))))
(serialized-exchange a1 a2)
(println (a1 'balance))
(println (a2 'balance))
|
