File: gnatcoll-promises.ads

package info (click to toggle)
libgnatcoll 18-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 5,068 kB
  • sloc: ada: 40,393; python: 354; ansic: 310; makefile: 245; sh: 31
file content (484 lines) | stat: -rw-r--r-- 19,941 bytes parent folder | download
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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
------------------------------------------------------------------------------
--                             G N A T C O L L                              --
--                                                                          --
--                     Copyright (C) 2017, AdaCore                          --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

--   A promise (also known sometimes as a future or deferred) is a
--   a synchronization mechanism between asynchronous routines.
--
--   Such routines could be implemented as tasks, but also be handled
--   via the system's asynchronous I/O primitives, or an event loop in a
--   GUI program for instance.
--
--   A promise is a value that such a routine can return immediately to the
--   caller, before it even starts its processing or the actual value is
--   available. The caller can then subscribe to the promise, so that when
--   the value becomes actually known, it gets notified and a callback is
--   executed.
--
--   Here is a simple example:
--
--       package Str_Promises is new Promises (String);
--
--       type Process_Page is new Str_Promises.Callback with null record;
--       overriding procedure On_Next
--          (Self : in out Process_Page; Page : String)
--       is
--       begin
--          Put_Line ("Page contents is known: " & Page);
--       end On_Next;
--
--       P : Str_Promises.Promise;
--
--       P := Fetch_URL_Asynchronously ("http://...");
--       P.Subscribe (new Process_Page);
--
--   Where Fetch_URL_Asynchronously could run in a task, connect to a
--   web server and query a document.
--
--   But promises are more interesting when they are chained, i.e. the
--   action executed when the first promise is resolved will itself
--   return a promise. Here is an example:
--
--       package Str_Promises is new Promises (String);
--       package Int_Promises is new Promises (Integer);
--       package Str_To_Int is new Chains (Str_Promises, Int_Promises);
--       use Str_To_Int, Int_Promises;
--
--       type Count_Elements is new Str_To_Int.Callback with null record;
--       overriding procedure On_Next
--          (Self   : in out Process_Page;
--           Page   : String;
--           Output : in out Int_Promises.Promise);
--       --  For instance, count the number of elements in the XML, and
--       --  would call Output.Set_Value
--
--       type Report_Count is new Int_Promises.Callback with null record;
--       overriding procedure On_Next
--          (Self  : in out Report_Count;
--           Count : Integer);
--       --  For instance display the number of elements in a GUI
--
--       Subscribe
--          (Fetch_URL_Asynchronously ("http://...")
--           and new Count_Elements
--           and new Report_Count);
--
--   The code above returns immediately, even though the URL will be fetched
--   in the background (which could take a few seconds), then parsed to count
--   the number of elements (which could be done in a separate task and take
--   a few milliseconds), and finally this count will be displayed in a GUI.
--
--   The advantage of this code is that it is composed of small, independent
--   building blocks that are executed when data becomes available. The caller
--   does not have to take care of the synchronization, since the promises
--   handle that.
--
--   Behavior
--   ========
--
--   A Promise is a concept that has been adopted by multiple programming
--   languages, starting with javascript and C++ (promises and futures).
--
--   There are some standard behaviors associated with promises, which this
--   package tries to conform with:
--
--   * A promise can be in one of three states:
--     - Pending: the promise has no associated value yet. Some subprogram is
--                still running in the background to fetch that value.
--     - Resolved: the routine has successfully finished running, and given
--                an actual value to the promise (via a call to Set_Value)
--     - Failed: the routine failed, and no value will ever be provided to the
--                routine. A reason for the failure is provided via a call
--                to Set_Error)
--
--   * Any number of callbacks can be set on a routine. They will all be
--     executed once when the promise is resolved or failed. They are never
--     executed again afterwards.
--
--   * A promise can be resolved at any time. Whenever it is resolved, all
--     callbacks currently set on the promise are executed and then
--     disconnected. It is an error to resolve a promise more than once.
--
--   * A callback can be added to a promise at any time. If the promise has
--     already been resolved, the callback is executed immediately with the
--     value set on that promise.
--
--  Tasks
--  =====
--
--  Promises are task safe. They can be used from multiple threads (and, as
--  always, a single call to Set_Value or Set_Error can be done), subscribed
--  to from multiple threads,...
--  However, the value itself is under your control. Although the promise
--  will only execute one callback at a time, to which is passes the value,
--  you should ensure that the value is not used from another thread in
--  parallel, or provide appropriate locking.
--  Using simple types like Integers or Strings should be safe.
--
--  Chaining and callbacks
--  ======================
--
--  Promises can be chained, so that the callback for the first promise will
--  itself return a promise, whose callback might in turn return a promise,
--  and so on.
--
--  The syntax to chain promises is:
--
--       Subscribe (P and new A and new B and new C;
--
--  Let's take the following chain:
--
--      P and new A     --  A is the callback on P
--        and new B     --  B is the callback on the promise returned by A
--        and new C;    --  C is the callback on the promise returned by C
--
--  The following callbacks might occur (where *.P is the promise output
--  by the routine, *.V is the value of that promise, and *.R is the reason
--  for the failure of that promise, which defaults to the reason received
--  from the previous release unless overridden):
--
--       promises                                    calls
--  If P is resolved:           A.On_Next (P.V)
--     If A.P is resolved:         B.On_Next (A.V)
--        if B.P is resolved:        C.On_Next (B.V)
--        else B.P failed:           C.On_Error (B.R)
--     else A.P failed:            B.On_Error (A.R), C.On_Error (B.R)
--  else P failed:              A.On_Error (P.R), B.On_Error (A.R),
--                                 C.On_Error (B.R)
--
--  Q: What if I want multiple callbacks on the same promise ?
--  A: You need to use intermediate variables, as in:
--       Q := P and new A;
--       Subscribe (Q and new B);
--       Subscribe (Q and new C);
--     Where both B and C are callbacks on A's return promise (and not
--     chained together).
--
--     A more convenient syntax exists, as in the following example:
--
--         P and (new A & new B)        --  A.P is passed on to the next step
--           and (new C & new D)        --  C.P is passed on to the next step
--           and new E;
--
--         If P is resolved:            A.On_Next (P.V), B.On_Next (P.V)
--            if A.P is resolved:         C.On_Next (A.V), D.On_Next (A.V)
--               if C.P is resolved:        E.On_Next (C.V)
--               else C.P failed:           E.On_Error (C.R)
--            else A.P failed:            C.On_Error (A.R), D.On_Error (A.R),
--                                          E.On_Error (C.R)
--         else P failed:               A.On_Error (P.R), B.On_Error (P.R),
--                                      C.On_Error (A.R), D.On_Error (A.R),
--                                      E.On_Error (C.R)
--
--      Note that there is no guaranteed order in which the callbacks are
--      executed, so for instance it is possible that C.On_Next and
--      E.On_Next are called before B.On_Next.
--
--  Q: What if I want different success and failure callbacks ?
--  A: A callback is an object with both a On_Next and a On_Error primitive
--     operations. So you could set two different callbacks on the same
--     promise (as we did above in the first question)

with GNATCOLL.Atomic;
with GNATCOLL.Refcount;

package GNATCOLL.Promises is

   use type GNATCOLL.Atomic.Atomic_Counter;

   subtype Promise_State is GNATCOLL.Atomic.Atomic_Counter;
   Pending     : constant Promise_State := 0;
   Resolved    : constant Promise_State := 1;
   Failed      : constant Promise_State := 2;
   Resolving   : constant Promise_State := 3;
   Failing     : constant Promise_State := 4;
   Subscribing : constant Promise_State := 5;
   subtype Actual_Promise_State is Promise_State range Pending .. Subscribing;
   --  The various states that a promise can have.
   --  We use atomic operations when possible to manipulate it, to make
   --  promises task safe.

   type Promise_Chain is tagged private;
   procedure Subscribe (Self : Promise_Chain) with Inline => True;
   --  A dummy type used when chaining promises with the "and"
   --  operator. See below for an example of code.
   --
   --  Do not mark this procedure as "is null", since otherwise GNAT
   --  does not even call the last "and" in the chain.

   --------------
   -- IFreeable --
   --------------

   type IFreeable is interface;
   type Freeable_Access is access all IFreeable'Class;
   --  a general interface for objects that have an explicit Free
   --  primitive operation.

   procedure Free (Self : in out IFreeable) is null;
   --  Free internal data of Self

   procedure Free (Self : in out Freeable_Access);
   --  Free self, via its primitive operation, and then free the pointer

   ----------
   -- Impl --
   ----------
   --  This package is for implementation details

   package Impl is

      type IPromise_Data is interface;
      procedure Free (Self : in out IPromise_Data) is null;
      procedure Dispatch_Free (Self : in out IPromise_Data'Class);

      type IAbstract_Promise is interface;

      package Promise_Pointers is new GNATCOLL.Refcount.Shared_Pointers
         (Element_Type           => IPromise_Data'Class,
          Release                => Dispatch_Free,
          Atomic_Counters        => True);   --  thread-safe
      type Root_Promise is
         new Promise_Pointers.Ref and IAbstract_Promise with null record;

      type IPromise_Callback is interface and IFreeable;
      type Promise_Callback_Access is access all IPromise_Callback'Class;

      procedure On_Error
         (Self : in out IPromise_Callback; Reason : String) is null;
      --  Called when a promise has failed and will never be resolved.

   end Impl;

   --------------
   -- Promises --
   --------------

   generic
      type T (<>) is private;
   package Promises is

      type Promise is new Impl.IAbstract_Promise with private;
      --  A promise is a smart pointer: it is a wrapper around shared
      --  data that is freed when no more reference to the promise
      --  exists.

      subtype Result_Type is T;

      ---------------
      -- Callbacks --
      ---------------

      type Callback is interface and Impl.IPromise_Callback;
      type Callback_Access is access all Callback'Class;

      procedure On_Next (Self : in out Callback; R : Result_Type) is null;
      --  Executed when a promise is resolved. It provides the real value
      --  associated with the promise.

      type Callback_List (<>) is private;
      --  Multiple callbacks, all subscribed to the same promise (or
      --  will be subscribed to the same promise).

      --------------
      -- Promises --
      --------------

      function Create return Promise
        with
          Post => Create'Result.Is_Created
             and Create'Result.Get_State = Pending;
      --  Create a new promise, with no associated value.

      procedure Set_Value (Self : in out Promise; R : T)
        with
          Pre => Self.Is_Created
             and Self.Get_State /= Resolved
             and Self.Get_State /= Failed,
          Post => Self.Get_State = Resolved;
      --  Give a result to the promise.
      --  The callbacks' On_Next methods are executed.
      --  This can only be called once on a promise.

      procedure Set_Error (Self : in out Promise; Reason : String)
        with
          Pre => Self.Is_Created
             and Self.Get_State /= Resolved
             and Self.Get_State /= Failed,
          Post => Self.Get_State = Failed;
      --  Mark the promise has failed. It will never be resolved.
      --  The callbacks' On_Error method are executed.

      procedure Subscribe
        (Self : Promise;
         Cb   : not null access Callback'Class)
        with Pre => Self.Is_Created;
      function "and"
        (Self  : Promise;
         Cb    : not null access Callback'Class) return Promise_Chain
        with Pre => Self.Is_Created;
      function "and"
        (Self : Promise; Cb : Callback_List) return Promise_Chain
        with Pre => Self.Is_Created;
      --  Will call Cb when Self is resolved or failed (or immediately if Self
      --  has already been resolved or failed).
      --  Any number of callbacks can be set on each promise.
      --  If you want to chain promises (i.e. your callback itself returns
      --  a promise), take a look at the Chains package below.
      --
      --  Cb must be allocated specifically for this call, and will be
      --  freed as needed. You must not reuse the same pointer for multiple
      --  calls to Subscribe.
      --  ??? This is unsafe
      --
      --  Self is modified, but does not need to be "in out" since a promise
      --  is a pointer. This means that Subscribe can be directly called on
      --  the result of a function call, for instance.

      function "&"
        (Cb    : not null access Callback'Class;
         Cb2   : not null access Callback'Class) return Callback_List;
      function "&"
        (List  : Callback_List;
         Cb2   : not null access Callback'Class) return Callback_List;
      --  Create a list of callbacks that will all be subscribed to the same
      --  promise.

      function Is_Created
         (Self : Promise'Class) return Boolean with Inline_Always;
      --  Whether the promise has been created

      function Get_State
        (Self : Promise'Class) return Actual_Promise_State with Inline_Always;
      --  Used for pre and post conditions

   private
      type Promise is new Impl.Root_Promise with null record;

      type Callback_List is
         array (Natural range <>) of not null access Callback'Class;

      function Is_Created (Self : Promise'Class) return Boolean
        is (not Self.Is_Null);
   end Promises;

   ------------
   -- Chains --
   ------------

   generic
      with package Input_Promises is new Promises (<>);
      with package Output_Promises is new Promises (<>);
   package Chains is

      type Callback is abstract new Input_Promises.Callback
         with private;
      procedure On_Next
        (Self   : in out Callback;
         Input  : Input_Promises.Result_Type;
         Output : in out Output_Promises.Promise)
        is abstract
        with
           Post'Class =>
              Output.Get_State = Resolved
              or Output.Get_State = Failed;
      --  This is the procedure that needs overriding, not the one inherited
      --  from Input_Promises. When chaining, a callback returns another
      --  promise, to which the user can attach further callbacks, and so on.
      --
      --  Failures in a promise are by default propagated to the output
      --  promise, unless you override the Failed primitive operation of
      --  Self.

      type Callback_List (<>) is private;

      function Is_Registered
        (Self : not null access Callback'Class) return Boolean
        with Inline;
      function Is_Registered (Self : Callback_List) return Boolean
        with Inline;
      --  Whether the callback has already been set on a promise. It is
      --  invalid to use the same callback on multiple promises (or even
      --  multiple times on the same promise).

      function "and"
        (Input : Input_Promises.Promise;
         Cb    : not null access Callback'Class)
        return Output_Promises.Promise
        with
          Pre  => not Is_Registered (Cb) and Input.Is_Created,
          Post => Is_Registered (Cb)
             and "and"'Result.Is_Created;
      --  Chains two properties.
      --  When Input is resolved, Cb is executed and will in turn resolve
      --  the output promise
      --  These functions return immediately a promise that will be resolved
      --  later.

      function "&"
        (Cb    : not null access Callback'Class;
         Cb2   : not null access Input_Promises.Callback'Class)
        return Callback_List
        with
           Pre => not Is_Registered (Cb);
           --  ??? Results in GNAT bug box
           --  Post => "and"'Result = Cb
           --     and not Is_Registered ("and"'Result);
      function "&"
        (List  : Callback_List;
         Cb2   : not null access Input_Promises.Callback'Class)
        return Callback_List;
      --  Used to set multiple callbacks on the same promise, as in:
      --      P & (new A and new B) & new C
      --  Only Cb is expected to output a promise, which will be
      --  forwarded to the next step (C in this example). Cb2 only
      --  gets notified via its On_Next and On_Error primitives.

      function "and"
        (Input : Input_Promises.Promise;
         Cb    : Callback_List)
        return Output_Promises.Promise
        with
          Pre  => not Is_Registered (Cb) and Input.Is_Created,
          Post => Is_Registered (Cb)
             and "and"'Result.Is_Created;
      --  Chaining multiple callbacks on the same promise

   private
      type Callback is abstract new Input_Promises.Callback with record
         Promise : aliased Output_Promises.Promise;
      end record;
      overriding procedure On_Next
         (Self : in out Callback; P : Input_Promises.Result_Type);
      overriding procedure On_Error (Self : in out Callback; Reason : String);

      type Callback_Array is array (Natural range <>)
         of not null access Input_Promises.Callback'Class;
      type Callback_List (N : Natural) is record
         Cb  : not null access Callback'Class;
         Cb2 : Callback_Array (1 .. N);
      end record;
   end Chains;

private
   type Promise_Chain is tagged null record;
end GNATCOLL.Promises;