(module main () (import (chicken base) scheme)
        (import matchable)
        (import srfi-18)
        (import (chicken process))

        (define guard (make-mutex))
        (define next-id 1)
        (define n-running-threads 1)
        (define dones '())
        ;; (module . #pre-reqs . successors)
        (define modules '((a 0 b d1)
                          (b 1 c)
                          (e 0 c)
                          (c 3)
                          (d1 1 d2)
                          (d2 1 d3)
                          (d3 1 c)))

        (define (runner-loop id)
          (mutex-lock! guard)
          (let loop ([ms modules]
                     [r '()])
            (match ms
              [()
               (set! n-running-threads (sub1 n-running-threads))
               (mutex-unlock! guard)
               (print id ": nothing to run")]
              [((m 0 . succs) . rest)
               (set! modules (append (reverse r) rest))

               ;; Add more parallelism
               (set! n-running-threads (add1 n-running-threads))
               (thread-start! (make-thread (lambda () (runner-loop next-id))))
               (set! next-id (add1 next-id))

               (mutex-unlock! guard)

               (print id ": running " m)
               (let [(pid (process-run "sleep 1"))]
                 (let loop ()
                   (receive (pid2 ok? status) (process-wait pid #t)
                     (when (= 0 pid2)
                       (thread-sleep! .1)
                       (loop)))))
               (print id ": ran " m)
               (mutex-lock! guard)
               (set! dones (cons m dones))
               ;; Decrement successor counters
               (for-each (lambda (succ)
                           (and-let* ([m2 (assq succ modules)])
                             (set-car! (cdr m2) (sub1 (cadr m2)))))
                         succs)
               (mutex-unlock! guard)

               (runner-loop id)]
              [(m . rest)
               (loop (cdr ms) (cons m r))])))


        (runner-loop 0)
        (let loop ()
          (mutex-lock! guard)
          (unless (= 0 n-running-threads)
            (mutex-unlock! guard)
            (print "primordial sleep")
            (thread-sleep! 1)
            (loop)))
        (print "primordial thread stopping")
        (print (reverse dones))
        )