(define thread-proc (lambda (x) #t))

(define (new-thread name)
  (let
    ((thread
       (make-thread
         (lambda ()
           (letrec*
             ((runner
                (lambda ()
                  (when (list? (thread-specific (current-thread)))
                    (for-each
                      (lambda (job)
                          (let ((lst (list-ref job 0))
                                (index (list-ref job 1))
                                (proc (list-ref job 2))
                                (result (list-ref job 3))
                                (getter (list-ref job 4))
                                (setter (list-ref job 5)))
                            (guard (condition
                                     (else
                                       (display "Error in thread: ")
                                       (write (thread-name (current-thread)))
                                       (display ", error: ")
                                       (write condition)
                                       (newline)
                                       (list-set! threads
                                                  (string->number (thread-name (current-thread)))
                                                  (new-thread (thread-name (current-thread))))))
                              (setter result
                                         index
                                         (apply proc
                                                (list (getter lst index)))))))
                      (thread-specific (current-thread)))
                    (thread-specific-set! (current-thread) #f))
                  (runner))))
             (runner)))
         name)))
    (thread-specific-set! thread #f)
    (thread-start! thread)
    thread))

(define threads
  (letrec*
    ((looper
       (lambda (count result)
         (if (>= count thread-count)
           result
           (looper (+ count 1)
                   (append result (list (new-thread (number->string count)))))))))
    (looper 0 '())))

(define-syntax parallel-map
  (syntax-rules ()
    ((_ env (l args body ...) lst)
     (letrec*
       ((result (make-list (length lst) #f))
        (lst-length (length lst))
        (loop-length (- (length lst) 2))
        (proc (eval `(lambda args body ...) (apply environment env)))
        (job-queues (make-vector thread-count '()))
        (index 0)
        (waited? #f)
        (waiter (lambda ()
                  (for-each
                    (lambda (thread)
                      (if (not (thread-specific thread))
                        (set! waited? #t)
                        (set! waited? #f)))
                    threads)
                  (if (not waited?) (waiter))))
        (queu-builder
          (lambda (index)
            (when (< index lst-length)
              (for-each
                (lambda (thread)
                  (when (< index lst-length)
                    (let ((thread-index (string->number (thread-name thread))))
                      (vector-set! job-queues
                                   thread-index
                                   (append (vector-ref job-queues thread-index)
                                           (list (list lst
                                                       index
                                                       proc
                                                       result
                                                       list-ref
                                                       list-set!)))))
                    (set! index (+ index 1))))
                threads)
              (queu-builder index)))))
       (queu-builder 0)
       (for-each
         (lambda (thread)
           (thread-specific-set!
             thread
             (vector-ref job-queues
                         (string->number (thread-name thread)))))
         threads)
       (waiter)
       result))))