-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
scheduler.rkt
29 lines (23 loc) · 938 Bytes
/
scheduler.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
#lang racket/base
(require racket/async-channel
racket/match)
(define incoming-jobs-ch (make-async-channel))
;; new incoming task will replace the old task immediately
;; no matter if the old one is running or completed
(define (schedule)
(define open-doc (make-hash))
(let loop ()
(sync (handle-evt incoming-jobs-ch
(λ (data)
(match-define (cons path task) data)
(when (hash-has-key? open-doc path)
(define th (hash-ref open-doc path))
(unless (thread-dead? th)
(kill-thread th)))
(hash-set! open-doc path
(thread task)))))
(loop)))
(define _scheduler (thread schedule))
(define (scheduler-push-task! path task)
(async-channel-put incoming-jobs-ch (cons path task)))
(provide scheduler-push-task!)