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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199 | with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
with Ada.Task_Identification;
package body Task_Coroutines.Generator is
-----------
-- Yield --
-----------
procedure Yield (This : in out Inner_Control; Val : T) is
begin
This.Val := Val;
Set_False (This.Suspend);
This.State := Yielding;
-- Wake up the outer task
Set_True (This.Outer.Suspend);
-- Wait until the outer task wakes us up
Suspend_Until_True (This.Suspend);
end Yield;
-----------
-- Start --
-----------
procedure Start (This : aliased in out Instance;
Proc : not null Generator_Proc)
is
begin
Set_False (This.Suspend);
This.Inner.Outer := This'Unchecked_Access;
This.T.Start (This.Inner'Unchecked_Access, Proc);
Suspend_Until_True (This.Suspend);
end Start;
----------
-- Stop --
----------
procedure Stop (This : in out Instance) is
begin
Ada.Task_Identification.Abort_Task (This.T'Identity);
This.Inner.State := Done;
end Stop;
----------
-- Done --
----------
function Done (This : Instance) return Boolean is
begin
return This.Inner.State = Done;
end Done;
--------------
-- Has_Next --
--------------
function Has_Next (This : in out Instance) return Boolean is
begin
case This.Inner.State is
when Waiting =>
null;
when Yielding =>
return True;
when Done =>
return False;
end case;
Set_False (This.Suspend);
Set_True (This.Inner.Suspend);
Suspend_Until_True (This.Suspend);
case This.Inner.State is
when Waiting =>
raise Program_Error with "Unreachable state";
when Yielding =>
return True;
when Done =>
return False;
end case;
end Has_Next;
----------
-- Next --
----------
function Next (This : in out Instance) return T is
begin
case This.Inner.State is
when Waiting | Done =>
raise Program_Error with "Unreachable state";
when Yielding =>
This.Inner.State := Waiting;
return This.Inner.Val;
end case;
end Next;
-----------
-- First --
-----------
function First (This : Instance) return Cursor_Type is
pragma Unreferenced (This);
begin
return (null record);
end First;
----------
-- Next --
----------
function Next (This : in out Instance; C : Cursor_Type)
return Cursor_Type
is
begin
case This.Inner.State is
when Waiting =>
null;
when Yielding =>
This.Inner.State := Waiting;
when Done =>
raise Program_Error with "Unreachable state";
end case;
return This.First;
end Next;
-----------------
-- Has_Element --
-----------------
function Has_Element (This : in out Instance; C : Cursor_Type)
return Boolean
is
begin
return This.Has_Next;
end Has_Element;
-------------
-- Element --
-------------
function Element (This : in out Instance; C : Cursor_Type) return T is
begin
case This.Inner.State is
when Waiting | Yielding =>
This.Inner.State := Waiting;
return This.Inner.Val;
when Done =>
raise Program_Error with "Unreachable state";
end case;
end Element;
---------------
-- Coro_Task --
---------------
task body Coro_Task is
Ctrl : Inner_Acc;
Proc : Generator_Proc;
begin
loop
Ctrl := null;
Proc := null;
select
accept Start (Inner : not null Inner_Acc;
Proc : not null Generator_Proc) do
Ctrl := Inner;
Coro_Task.Proc := Start.Proc;
end Start;
or
terminate;
end select;
declare
begin
Proc (Ctrl.all);
exception
when others =>
null;
end;
Ctrl.State := Done;
Set_True (Ctrl.Outer.Suspend);
end loop;
end Coro_Task;
end Task_Coroutines.Generator;
|