-
Notifications
You must be signed in to change notification settings - Fork 9
/
management.lisp
136 lines (97 loc) · 3.84 KB
/
management.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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
(in-package :erlangen.management)
(defgeneric root (agent-tree)
(:documentation
"→ _agent_
*Arguments and Values:*
_agent-tree_—an _object_ of _type_ {agent-tree}.
_agent_—an _agent_.
*Description*:
{root} returns the _agent_ that is the root of _agent-tree_."))
(defgeneric linked (agent-tree)
(:documentation
"→ _list_
*Arguments and Values:*
_agent-tree_—an _object_ of _type_ {agent-tree}.
_list_—a _list_ of _agents_.
*Description*:
{linked} returns a _list_ of _agents_ that are linked to but not monitored
by the root _agent_ of _agent-tree_."))
(defgeneric monitored (agent-tree)
(:documentation
"→ _subtrees_
*Arguments and Values:*
_agent-tree_—an _object_ of _type_ {agent-tree}.
_subtrees_—a _list_ of _objects_ of _type_ {agent-tree}.
*Description*:
{monitored} returns a _list_ of the _subtrees_ whose root _agents_ are
monitored by the root _agent_ of _agent-tree_."))
(defclass agent-tree ()
((root :initarg :root :reader root)
(linked :initarg :linked :reader linked-to)
(monitored :initarg :monitored :reader monitored-by))
(:documentation
"*Description:*
Instances of class {agent-tree} denote views of the _agent_ graph at a
specific point in time. Their {print-object} method prints an elaborate
description of that view when {*print-readably*} is {nil}."))
(defun agent-tree (agent)
"→ _agent-tree_
*Arguments and Values:*
_agent_—an _agent_.
_agent-tree_—an _instance_ of _class_ {agent-tree}.
*Description:*
{agent-tree} returns the current _agent-tree_ whose root is _agent_."
(let (linked monitored)
(typecase agent
(erlangen.agent:agent ; stop at local edges
(loop for x in (agent-links agent)
if (and ; remote agents show up as links
(typep x 'erlangen.agent:agent)
(find agent (agent-monitors x)))
do
(push (agent-tree x) monitored)
else do
(push x linked))))
(make-instance 'agent-tree
:root agent
:linked linked
:monitored monitored)))
(defvar *print-agent-tree-indent* 0)
(defmethod print-object ((o agent-tree) stream)
(if *print-readably*
(call-next-method)
(with-slots (root linked monitored) o
(format stream "~v@{~A~:*~}~*~:[↳~;~]~a~@[ (linked: ~{~a~^ ~})~]~%"
#1=*print-agent-tree-indent* #\Space (= 0 #1#)
root linked)
(let ((#1# (+ #1# 4)))
(loop for m in monitored do (print-object m stream))))))
(defun process-agent (process &key (timeout 1))
"→ _agent_
*Arguments and Values:*
_process_—a _process_.
_timeout_—a non-negative _real_ denoting a time interval in seconds. The
default is 1.
_agent_—an _agent_ or {nil}.
*Description:*
{process-agent} interrupts _process_ to retrieve its associated _agent_. It
returns the respective _agent_ or {nil}. A return value of {nil} indicates
that _process_ could not be interrupted within the duration specified by
_timeout_."
(let (agent)
(process-interrupt
process (lambda () (setf agent (agent))))
(process-wait-with-timeout
"…management:process-agent" timeout (lambda () agent))))
(defun flush-messages (&key (print-p t) (stream *standard-output*))
"*Arguments and Values:*
_print-p_—a _generalized boolean_. The default is _true_.
_stream_—an _output stream_. The default is {*standard-output*}.
*Description:*
{flush-messages} dequeues messages from the mailbox of the _calling agent_
until there are no more pending messages. If _print-p_ is _true_ each
dequeued message is printed to _stream_."
(ignore-errors
(loop for message = (erlangen:receive :timeout 0)
when print-p do (print message stream)))
(values))