;;; 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-exp thread-env thread-cont
           this-thread
           fork-thread! kill-thread! kill-all-threads!
           suspend! reschedule!)

  ;; make-thread : Exp * Env * Cont -> Thread

  (define (make-thread exp env cont)
    (vector 'thread exp env cont))

  ;; 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))

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

  (define the-active-threads '())

  (define (this-thread) (car the-active-threads))

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

  ;; th should not be the currently executing thread

  (define (kill-thread! th)
    (define (remq x y)
      (cond ((null? y) '())
            ((eq? x (car y))
             (remq x (cdr y)))
            (else
             (cons (car y) (remq x (cdr y))))))
    (let ((current-thread (car the-active-threads))
          (other-threads (remq th (cdr the-active-threads))))
      (set! the-active-threads
            (cons current-thread other-threads))))

  (define (kill-all-threads!)
    (set! 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!)
    (set! the-active-threads
          (append (cdr the-active-threads)
                  (list (car the-active-threads)))))

  )