-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
async.lisp
82 lines (67 loc) · 3.03 KB
/
async.lisp
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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
(in-package #:org.shirakumo.fraf.trial)
(defclass task-thread (simple-tasks:queued-runner)
((thread :initform NIL :accessor thread)))
(defmethod start ((runner task-thread))
(unless (and (thread runner)
(bt:thread-alive-p (thread runner)))
(setf (thread runner)
(with-thread ("task-thread")
(simple-tasks:start-runner runner)))
(loop until (eql :running (simple-tasks:status runner))
do (sleep 0.0001))))
(defmethod stop ((runner task-thread))
(handler-case (simple-tasks:stop-runner runner)
(simple-tasks:runner-not-stopped ()
(bt:destroy-thread (thread runner)))))
(defmethod simple-tasks:start-runner ((runner task-thread))
(handler-bind (#+trial-release (error (lambda (e)
(v:warn :trial.async "Ignoring failure in task thread: ~a" e)
(v:debug :trial.async e)
(invoke-restart 'simple-tasks:skip))))
(call-next-method)))
(defmethod simple-tasks:schedule-task ((function function) (main task-thread))
(simple-tasks:schedule-task
(make-instance 'promise-task :promise (promise:make) :func function)
main))
(defclass task-runner ()
((task-thread :initform (make-instance 'task-thread) :accessor task-thread)))
(defmethod initialize-instance ((runner task-runner) &key)
(call-next-method)
(start (task-thread runner)))
(defmethod finalize :after ((runner task-runner))
(stop (task-thread runner)))
(defmethod simple-tasks:schedule-task (task (runner task-runner))
(simple-tasks:schedule-task task (task-thread runner)))
(defclass task-runner-main (task-runner main)
())
(defmethod update :before ((main task-runner-main) tt dt fc)
(handler-bind (#+trial-release (error #'abort))
(promise:tick-all dt)))
(defmethod simple-tasks:schedule-task (task (default (eql T)))
(simple-tasks:schedule-task task +main+))
(defclass promise-task (simple-tasks:task)
((promise :initarg :promise :accessor promise :reader promise:ensure-promise)
(func :initarg :func :accessor func)))
(defmethod simple-tasks:run-task ((task promise-task))
(let ((ok NIL))
(unwind-protect
(restart-case
(progn (promise:succeed (promise task) (funcall (func task)))
(setf ok T))
(use-value (value)
:report "Succeed the promise using the provided value"
(promise:succeed (promise task) value)
(setf ok T))
(continue ()
:report "Continue, failing the promise.")
(abort ()
:report "Abort, timing the promise out."
(promise:timeout (promise task))))
(unless ok
(promise:fail (promise task))))))
(defmacro with-eval-in-task-thread ((&key (runner '(task-thread +main+)) (task-type ''promise-task) lifetime) &body body)
`(flet ((thunk () ,@body))
(simple-tasks:schedule-task
(make-instance ,task-type :promise (promise:make NIL :lifetime ,lifetime)
:func #'thunk)
,runner)))