#lang racket

(provide scheduler-init)
(provide scheduler-start)
(provide create-thread)
(provide yield)


; yield-cc is the continuation that returns to the scheduler and starts the next
; thread.  It's argument is used to control the behaviour of the scheduler.

(define yield-cc #f)

; interface to the queue that is local to the scheduler. 

(define queue-add #f)
(define queue-head #f)
(define queue-remove #f)
(define queue-empty #f)
(define queue-get #f)

; when the scheduler has no more threads to schedule, it invokes this continuation to
; return to the point after the scheduler-start invocation.  scheduler-start sets up
; this, so strange things will happen if scheduler-start isn't called.

(define scheduler-return #f)  

(define scheduler-init
  (lambda ()
    (call/cc 
     (lambda (return-from-init) 
       
       (let ( (queue '()) )
         (begin
           (set! queue-empty (lambda () (null? queue)))
           (set! queue-head (lambda () (first queue)))
           (set! queue-add (lambda (item) (set! queue (append queue (list item)))))
           (set! queue-remove (lambda () (let ( (head (first queue)) ) (set! queue (rest queue)) head)) )
           (set! queue-get (lambda () queue))
           
           ; define yield point
           (let ( 
                 (thread-cc
                  (call/cc (lambda (c) (set! yield-cc c) (return-from-init "scheduler-initialized") ) ) )
                 )
             
             ; yield returns to this point with the continuation for the thread just yielding
             ; queue up this thread, if it returned a continuation, otherwise the thread is 
             ; finished.
             (if (continuation? thread-cc) (queue-add thread-cc) 
                 #f
                 ;(display (list "thread terminates with " thread-cc)) 
                 )
             ;(display (list "thread yields" thread-cc queue) )(newline)

             ; invoke new thread if any on queue
             (if (queue-empty) 
                 (begin (display "scheduler done") (newline) (scheduler-return) ) 
                 ((queue-remove) #f)) 
             )
           )))
     )))

(define scheduler-start
  (lambda () (call/cc 
      (lambda (c) (set! scheduler-return c) (yield-cc #f)))
    ))

; we should also have a termination function that is called when the thread finally 
; completes (if ever)

(define create-thread
  (lambda (p) (queue-add (lambda (c) (display (list "thread returns" (p) ) (yield-cc #f) ))) )
  )

(define-syntax-rule (yield) 
  (call/cc (lambda (c) (yield-cc c)))
  )