Permalink
Browse files

ch3

  • Loading branch information...
1 parent 2ffec6b commit 52de07a7b77a297f1b2b6d9da9acf60ddf5d9d48 @nslobodin committed Aug 18, 2012
Showing with 152 additions and 1 deletion.
  1. +7 −1 ch3/ex3-39.scm
  2. +13 −0 ch3/ex3-40.scm
  3. +28 −0 ch3/ex3-41.scm
  4. +24 −0 ch3/ex3-42.scm
  5. +3 −0 ch3/ex3-43.scm
  6. +5 −0 ch3/ex3-44.scm
  7. +3 −0 ch3/ex3-45.scm
  8. +4 −0 ch3/ex3-47.scm
  9. +35 −0 ch3/test_concurrency_2.scm
  10. +30 −0 ch3/test_streams.scm
View
@@ -3,4 +3,10 @@
(define x 10)
(define s (make-serializer))
(parallel-execute (lambda () (set! x ((s (lambda () (* x x))))))
- (s (lambda () (set! x (+ x 1)))))
+ (s (lambda () (set! x (+ x 1)))))
+
+x
+
+;; 121
+;; 101
+;; 11
View
@@ -0,0 +1,13 @@
+;; Example 3.40
+
+(define x 10)
+(parallel-execute (lambda () (set! x (* x x)))
+ (lambda () (set! x (* x x x))))
+
+;; 100
+;; 1000
+;; 1000000
+;; 10000
+;; 100000
+
+;; serialized: 1000000
View
@@ -0,0 +1,28 @@
+;; Example 3.41
+
+(define (make-account balance)
+ (define (withdraw amount)
+ (if (>= balance amount)
+ (begin (set! balance (- balance amount))
+ balance)
+ "Insufficient funds\n"))
+
+ (define (deposit amount)
+ (set! balance (+ balance amount))
+ balance)
+
+ (let ((protected (make-serializer)))
+ (define (dispatch m)
+ (cond ((eq? m 'withdraw) (protected withdraw))
+ ((eq? m 'deposit) (protected deposit))
+ ((eq? m 'balance) ((protected (lambda () balance))))
+ (else (error "Unknown request" m))))
+ dispatch))
+
+;; A = make-account
+
+;; parallel:
+;; balance = A.get-balance
+;; A.make-withdraw
+
+;; balance maybe wrong
View
@@ -0,0 +1,24 @@
+;; Example 3.42
+
+(define (make-account balance)
+ (define (withdraw amount)
+ (if (>= balance amount)
+ (begin (set! balance (- balance amount))
+ balance)
+ "Insufficient funds\n"))
+
+ (define (deposit amount)
+ (set! balance (+ balance amount))
+ balance)
+
+ (let ((protected (make-serializer)))
+ (let ((protected-withdraw (protected withdraw))
+ (protected-deposit (protected deposit)))
+ (define (dispatch m)
+ (cond ((eq? m 'withdraw) protected-withdraw)
+ ((eq? m 'deposit) protected-deposit)
+ ((eq? m 'balance) balance)
+ (else (error "Unknown request" m))))
+ dispatch)))
+
+;; it's okay, no difference
View
@@ -0,0 +1,3 @@
+;; Example 3.43
+
+;; on the paper
View
@@ -0,0 +1,5 @@
+(define (transfer from-account to-account amount)
+ ((from-account 'withdraw) amount)
+ ((to-account 'deposit) amount))
+
+;; no problem here
View
@@ -0,0 +1,3 @@
+;; Example 3.45
+
+;; withdraw and deposit serialized twice by the same serializer
View
@@ -0,0 +1,4 @@
+;; Example 3.47
+
+(define (make-semaphore n)
+
View
@@ -0,0 +1,35 @@
+;; test concurrency
+
+(require rnrs/mutable-pairs-6)
+
+(define (my-test-and-set! cell)
+ (if (car cell)
+ #t
+ (begin (set-car! cell #t)
+ #f)))
+
+(define (my-make-mutex)
+ (let ((cell (list #f)))
+ (define (the-mutex m)
+ (cond ((eq? m 'acquire)
+ (if (my-test-and-set! cell)
+ (the-mutex 'acquire)))
+ ((eq? m 'release) (clear! cell))))
+ the-mutex))
+
+(define (my-make-serializer)
+ (let ((mutex (my-make-mutex)))
+ (lambda (p)
+ (define (serialized-p . args)
+ (mutex 'acquire)
+ (let ((val (apply p args)))
+ (mutex 'release)
+ val))
+ serialized-p)))
+
+(define x 10)
+(define s (my-make-serializer))
+(parallel-execute (s (lambda () (set! x (* x x))))
+ (s (lambda () (set! x (+ x 1)))))
+
+x
View
@@ -0,0 +1,30 @@
+#lang racket
+
+(define (cons-stream a b)
+ (cons a (stream-delay b)))
+
+(define (stream-car stream)
+ (car stream))
+
+(define (stream-cdr stream)
+ (stream-force (cdr stream)))
+
+(define (stream-ref s n)
+ (if (= n 0)
+ (stream-car s)
+ (stream-ref (stream-cdr s) (- n 1))))
+
+(define (stream-map proc s)
+ (if (stream-null? s)
+ the-empty-stream
+ (cons-stream (proc (stream-car s))
+ (stream-map proc (stream-cdr s)))))
+
+(define (stream-for-each proc s)
+ (if (stream-null? s)
+ 'done
+ (begin (proc (stream-car s))
+ (stream-for-each proc (stream-cdr s)))))
+
+(define (display-stream s)
+ (stream-for-each (lambda (x) (newline) (display x)) s))

0 comments on commit 52de07a

Please sign in to comment.