diff options
Diffstat (limited to 'benchmarks/chain.scm')
| -rw-r--r-- | benchmarks/chain.scm | 52 |
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))) |
