blob: 441cebf825c97640b09dd39d4774d1e5029fa0c5 (
about) (
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
|
#!/usr/bin/env guile
# -*- scheme -*-
!#
(use-modules (ice-9 match)
(fibers)
(fibers channels))
(define (make-chain link-count make-head make-link make-tail)
(let lp ((link-count link-count) (ch (make-head)))
(if (zero? link-count)
(make-tail ch)
(lp (1- link-count) (make-link ch)))))
(define (test link-count message-count)
(get-message
(make-chain
link-count
(lambda ()
(let ((out (make-channel)))
(spawn-fiber (lambda ()
(let lp ((n 0))
(put-message out n)
(lp (1+ n))))
#:parallel? #t)
out))
(lambda (in)
(let ((out (make-channel)))
(spawn-fiber (lambda ()
(let lp ()
(put-message out (get-message in))
(lp)))
#:parallel? #t)
out))
(lambda (in)
(let ((out (make-channel)))
(spawn-fiber (lambda ()
(let lp ()
(if (< (get-message in) message-count)
(lp)
(put-message out 'done))))
#:parallel? #t)
out)))))
(define (main args)
(match args
((_ link-count message-count)
(let ((link-count (string->number link-count))
(message-count (string->number message-count)))
(run-fibers (lambda () (test link-count message-count)))))))
(when (batch-mode?) (main (program-arguments)))
|
