#lang scheme/base
(require scheme/async-channel)

(define (report-memory msg)
  (printf "~a: ~a~n" msg (current-memory-use)))

(define-syntax-rule (run make get put)
  (let ()
    (define notif (make-channel))
    (define i 0)
    
    (define (server [msg (thread-receive)])
      (unless (eq? msg 'exit)
        (put msg #t)
        (set! i (add1 i))
        (server)))
    (define s-thd (thread server))
    
    (define (client)
      (for ([i (in-range 15000)])
        (let ([chn (make)])
          (thread-send s-thd chn)
          (get chn)))
      (printf "finished: ~s~n" i) (channel-put notif #t)
      (sync (current-thread)))
    
    (define c-thd (thread client))
    
    (values s-thd c-thd notif)))

(define-syntax-rule (test make get put)
  (begin
    (collect-garbage)
    (report-memory "before test")
    (let ()
      (define-values (s c notif)
        (run make get put))
      (time (channel-get notif))
      (report-memory "after test")
      (collect-garbage)
      (report-memory "after GC")
      (kill-thread s) (collect-garbage)
      (report-memory "after killing the server thread")
      (kill-thread c) (collect-garbage)
      (report-memory "after killing the client thread"))))

(printf "async:~n")
(time (test make-async-channel async-channel-get async-channel-put))
(sleep 5)
(printf "sync:~n")
(time (test make-channel channel-get channel-put))