;;; Thread scheduler.

(module threads (lib "eopl.ss" "eopl")
  
  (require "drscheme-init.scm")

  (require "lang.scm")
  (require "data-structures.scm")
  (require "environments.scm")

  (provide make-thread thread?
           thread-exp thread-env thread-cont thread-id
           this-thread
           fork-thread! kill-thread! kill-subthreads!
           kill-all-threads! kill-this-thread!
           suspend! reschedule!)

  ;; make-thread : Exp * Env * Cont * Maybe[Thread] -> Thread

  (define (make-thread exp env cont parent)
    (set! thread-counter (+ thread-counter 1))
    (vector 'thread exp env cont thread-counter
            (if parent
                (cons parent (thread-ancestors parent))
                '())))

  (define thread-counter 0)

  ;; thread? : Any -> Bool

  (define (thread? x)
    (and (vector? x)
         (= (vector-length x) 6)
         (eq? (vector-ref x 0) 'thread)))

  ;; thread-exp : Thread -> Exp

  (define (thread-exp th)
    (vector-ref th 1))

  ;; thread-env : Thread -> Env

  (define (thread-env th)
    (vector-ref th 2))

  ;; thread-cont : Thread -> Cont

  (define (thread-cont th)
    (vector-ref th 3))

  ;; thread-id : Thread -> Int

  (define (thread-id th)
    (vector-ref th 4))

  ;; thread-ancestors : Thread -> Listof[Thread]

  (define (thread-ancestors th)
    (vector-ref th 5))

  ;; the-active-threads : Listof[Thread]
  ;;
  ;; Invariant:  (car the-active-threads) is the currently
  ;; executing thread.

  (define the-active-threads '())

  (define (this-thread)
    (if (null? the-active-threads)
        (all-threads-failed!)
        (car the-active-threads)))

  (define (fork-thread! th)
    (set! the-active-threads
          (append the-active-threads
                  (list th))))

  ;; (kill-thread! th) kills th and all the threads th has created

  (define (kill-thread! th)
    (set! the-active-threads
          (filter (lambda (thread)
                    (and (not (eq? th thread))
                         (not (memq th (thread-ancestors thread)))))
                  the-active-threads)))

  ;; (kill-subthreads! th) kills all the threads th has created

  (define (kill-subthreads! th)
    (set! the-active-threads
          (filter (lambda (thread)
                    (not (memq th (thread-ancestors thread))))
                  the-active-threads)))

  (define (kill-all-threads!)
    (set! thread-counter 0)
    (set! the-active-threads '()))

  (define (kill-this-thread!)
    (if (null? the-active-threads)
        (all-threads-failed!)
        (set! the-active-threads
              (cdr the-active-threads))))

  (define (suspend! th exp env cont)
    (vector-set! th 1 exp)
    (vector-set! th 2 env)
    (vector-set! th 3 cont))
  
  (define (reschedule!)
    (if (null? the-active-threads)
        (all-threads-failed!)
        (set! the-active-threads
              (append (cdr the-active-threads)
                      (list (car the-active-threads))))))

  (define (all-threads-failed!)
    (eopl:error 'this-thread "All threads have failed."))

  (define (filter f x)
    (cond ((null? x) '())
          ((f (car x)) (cons (car x) (filter f (cdr x))))
          (else (filter f (cdr x)))))

  )