summaryrefslogtreecommitdiff
path: root/benchmarks/chain.scm
diff options
context:
space:
mode:
Diffstat (limited to 'benchmarks/chain.scm')
-rw-r--r--benchmarks/chain.scm52
1 files changed, 52 insertions, 0 deletions
diff --git a/benchmarks/chain.scm b/benchmarks/chain.scm
new file mode 100644
index 0000000..441cebf
--- /dev/null
+++ b/benchmarks/chain.scm
@@ -0,0 +1,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)))