YAP 7.1.0
c_alarms.yap
Go to the documentation of this file.
1%%% -*- Mode: Prolog; -*-
2/**
3 * @file c_alarms.yap
4 * @author Theofrastos Mantadelis
5 * @date Tue Nov 17 14:50:03 2015
6 *
7 * @brief Concurrent alarms
8 *
9*/
10
11%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
12%
13% Concurrent alarms was developed at Katholieke Universiteit Leuven
14%
15% Copyright 2010
16% Katholieke Universiteit Leuven
17%
18% Contributions to this file:
19% Author: Theofrastos Mantadelis
20% $Date: 2011-02-04 16:04:49 +0100 (Fri, 04 Feb 2011) $
21% $Revision: 11 $
22% Contributions: The timer implementation is inspired by Bernd Gutmann's timers
23%
24%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
25%
26% Artistic License 2.0
27%
28% Copyright (c) 2000-2006, The Perl Foundation.
29%
30% Everyone is permitted to copy and distribute verbatim copies of this
31% license document, but changing it is not allowed. Preamble
32%
33% This license establishes the terms under which a given free software
34% Package may be copied, modified, distributed, and/or
35% redistributed. The intent is that the Copyright Holder maintains some
36% artistic control over the development of that Package while still
37% keeping the Package available as open source and free software.
38%
39% You are always permitted to make arrangements wholly outside of this
40% license directly with the Copyright Holder of a given Package. If the
41% terms of this license do not permit the full use that you propose to
42% make of the Package, you should contact the Copyright Holder and seek
43% a different licensing arrangement. Definitions
44%
45% "Copyright Holder" means the individual(s) or organization(s) named in
46% the copyright notice for the entire Package.
47%
48% "Contributor" means any party that has contributed code or other
49% material to the Package, in accordance with the Copyright Holder's
50% procedures.
51%
52% "You" and "your" means any person who would like to copy, distribute,
53% or modify the Package.
54%
55% "Package" means the collection of files distributed by the Copyright
56% Holder, and derivatives of that collection and/or of those files. A
57% given Package may consist of either the Standard Version, or a
58% Modified Version.
59%
60% "Distribute" means providing a copy of the Package or making it
61% accessible to anyone else, or in the case of a company or
62% organization, to others outside of your company or organization.
63%
64% "Distributor Fee" means any fee that you charge for Distributing this
65% Package or providing support for this Package to another party. It
66% does not mean licensing fees.
67%
68% "Standard Version" refers to the Package if it has not been modified,
69% or has been modified only in ways explicitly requested by the
70% Copyright Holder.
71%
72% "Modified Version" means the Package, if it has been changed, and such
73% changes were not explicitly requested by the Copyright Holder.
74%
75% "Original License" means this Artistic License as Distributed with the
76% Standard Version of the Package, in its current version or as it may
77% be modified by The Perl Foundation in the future.
78%
79% "Source" form means the source code, documentation source, and
80% configuration files for the Package.
81%
82% "Compiled" form means the compiled bytecode, object code, binary, or
83% any other form resulting from mechanical transformation or translation
84% of the Source form.
85%
86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87%
88% Permission for Use and Modification Without Distribution
89%
90% (1) You are permitted to use the Standard Version and create and use
91% Modified Versions for any purpose without restriction, provided that
92% you do not Distribute the Modified Version.
93%
94% Permissions for Redistribution of the Standard Version
95%
96% (2) You may Distribute verbatim copies of the Source form of the
97% Standard Version of this Package in any medium without restriction,
98% either gratis or for a Distributor Fee, provided that you duplicate
99% all of the original copyright notices and associated disclaimers. At
100% your discretion, such verbatim copies may or may not include a
101% Compiled form of the Package.
102%
103% (3) You may apply any bug fixes, portability changes, and other
104% modifications made available from the Copyright Holder. The resulting
105% Package will still be considered the Standard Version, and as such
106% will be subject to the Original License.
107%
108% Distribution of Modified Versions of the Package as Source
109%
110% (4) You may Distribute your Modified Version as Source (either gratis
111% or for a Distributor Fee, and with or without a Compiled form of the
112% Modified Version) provided that you clearly document how it differs
113% from the Standard Version, including, but not limited to, documenting
114% any non-standard features, executables, or modules, and provided that
115% you do at least ONE of the following:
116%
117% (a) make the Modified Version available to the Copyright Holder of the
118% Standard Version, under the Original License, so that the Copyright
119% Holder may include your modifications in the Standard Version. (b)
120% ensure that installation of your Modified Version does not prevent the
121% user installing or running the Standard Version. In addition, the
122% modified Version must bear a name that is different from the name of
123% the Standard Version. (c) allow anyone who receives a copy of the
124% Modified Version to make the Source form of the Modified Version
125% available to others under (i) the Original License or (ii) a license
126% that permits the licensee to freely copy, modify and redistribute the
127% Modified Version using the same licensing terms that apply to the copy
128% that the licensee received, and requires that the Source form of the
129% Modified Version, and of any works derived from it, be made freely
130% available in that license fees are prohibited but Distributor Fees are
131% allowed.
132%
133% Distribution of Compiled Forms of the Standard Version or
134% Modified Versions without the Source
135%
136% (5) You may Distribute Compiled forms of the Standard Version without
137% the Source, provided that you include complete instructions on how to
138% get the Source of the Standard Version. Such instructions must be
139% valid at the time of your distribution. If these instructions, at any
140% time while you are carrying out such distribution, become invalid, you
141% must provide new instructions on demand or cease further
142% distribution. If you provide valid instructions or cease distribution
143% within thirty days after you become aware that the instructions are
144% invalid, then you do not forfeit any of your rights under this
145% license.
146%
147% (6) You may Distribute a Modified Version in Compiled form without the
148% Source, provided that you comply with Section 4 with respect to the
149% Source of the Modified Version.
150%
151% Aggregating or Linking the Package
152%
153% (7) You may aggregate the Package (either the Standard Version or
154% Modified Version) with other packages and Distribute the resulting
155% aggregation provided that you do not charge a licensing fee for the
156% Package. Distributor Fees are permitted, and licensing fees for other
157% components in the aggregation are permitted. The terms of this license
158% apply to the use and Distribution of the Standard or Modified Versions
159% as included in the aggregation.
160%
161% (8) You are permitted to link Modified and Standard Versions with
162% other works, to embed the Package in a larger work of your own, or to
163% build stand-alone binary or bytecode versions of applications that
164% include the Package, and Distribute the result without restriction,
165% provided the result does not expose a direct interface to the Package.
166%
167% Items That are Not Considered Part of a Modified Version
168%
169% (9) Works (including, but not limited to, modules and scripts) that
170% merely extend or make use of the Package, do not, by themselves, cause
171% the Package to be a Modified Version. In addition, such works are not
172% considered parts of the Package itself, and are not subject to the
173% terms of this license.
174%
175% General Provisions
176%
177% (10) Any use, modification, and distribution of the Standard or
178% Modified Versions is governed by this Artistic License. By using,
179% modifying or distributing the Package, you accept this license. Do not
180% use, modify, or distribute the Package, if you do not accept this
181% license.
182%
183% (11) If your Modified Version has been derived from a Modified Version
184% made by someone other than you, you are nevertheless required to
185% ensure that your Modified Version complies with the requirements of
186% this license.
187%
188% (12) This license does not grant you the right to use any trademark,
189% service mark, tradename, or logo of the Copyright Holder.
190%
191% (13) This license includes the non-exclusive, worldwide,
192% free-of-charge patent license to make, have made, use, offer to sell,
193% sell, import and otherwise transfer the Package with respect to any
194% patent claims licensable by the Copyright Holder that are necessarily
195% infringed by the Package. If you institute patent litigation
196% (including a cross-claim or counterclaim) against any party alleging
197% that the Package constitutes direct or contributory patent
198% infringement, then this Artistic License to you shall terminate on the
199% date that such litigation is filed.
200%
201% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
202% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
203% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
204% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
205% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
206% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
207% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
208% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
209%
210%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
211
212:- set_alarm/3unset_alarm/1time_out_call_once/3timer_start/1timer_restart/1timer_stop/2timer_elapsed/2timer_pause/2module(c_alarms, [,
213 ,
214 ,
215 ,
216 ,
217 ,
218 ,
219 ]).
220
221/** @defgroup c_alarms Concurrent Alarms
222@ingroup YAPLibrary
223@{
224
225This library provides a concurrent signals. To use it use:
226`:-use_module(library(c_alarms))`.
227*/
228
229
230:- member/2memberchk/2delete/3use_module(library(lists), [, , ]).
231:- ord_add_element/3use_module(library(ordsets), []).
232:- maplist/3use_module(library(apply_macros), []).
233
234:- '$timer'/3dynamic().
235
236:- meta_predicate(set_alarm(+, 0, -)).
237:- meta_predicate(time_out_call_once(+, 0, -)).
238:- meta_predicate(prove_once(0)).
239
240:- initialization(local_init).
241
242initialization:-
243 bb_put(alarms, []),
244 bb_put(identity, 0).
245
246get_next_identity(ID):-
247 bb_get(identity, ID),
248 NID is ID + 1,
249 bb_put(identity, NID).
250
251set_alarm(Seconds, Execute, ID):-
252 bb_get(alarms, []),
253 get_next_identity(ID), get_next_identity,
254 bb_put(alarms, [alarm(Seconds, ID, Execute)]),
255 alarm(Seconds, alarm_handler, _).
256
257%% @pred set_alarm(+Seconds, +Execute, -ID)
258%
259% calls Executes after a time interval of Seconds
260% ID is returned to be able to unset the alarm (the call will not be executed)
261% set_alarm/3 supports multiple & nested settings of alarms.
262% Known Bug: There is the case that an alarm might trigger +-1 second of the set time.
263%
264set_alarm(Seconds, Execute, ID):-
265 get_next_identity(ID), get_next_identity,
266 bb_get(alarms, [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms]),
267 alarm(0, true, Remaining),
268 Elapsed is CurrentSeconds - Remaining - 1,
269 maplist(subtract(Elapsed), [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms], RemainingAlarms),
270 ord_add_element(RemainingAlarms, alarm(Seconds, ID, Execute), [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]),
271 bb_put(alarms, [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]),
272 alarm(NewSeconds, alarm_handler, _).
273set_alarm(Seconds, Execute, ID):-
274 throw(error(permission_error(create, alarm, set_alarm(Seconds, Execute, ID)), 'Non permitted alarm identifier.')).
275
276subtract(Elapsed, alarm(Seconds, ID, Execute), alarm(NewSeconds, ID, Execute)):-
277 NewSeconds is Seconds - Elapsed.
278
279%% @pred unset_alarm(+ID)
280%
281% It will unschedule the alarm.
282% It will not affect other concurrent alarms.
283%
284unset_alarm(ID):-
285 \+ ground(ID),
286 throw(error(instantiation_error, 'Alarm ID needs to be instantiated.')).
287unset_alarm(ID):-
288 bb_get(alarms, Alarms),
289 \+ memberchk(alarm(_Seconds, ID, _Execute), Alarms),
290 throw(error(existence_error(alarm, unset_alarm(ID)), 'Alarm does not exist.')).
291unset_alarm(ID):-
292 alarm(0, true, Remaining),
293 bb_get(alarms, Alarms),
294 [alarm(Seconds, _, _)|_] = Alarms,
295 Elapsed is Seconds - Remaining - 1,
296 delete_alarm(Alarms, ID, NewAlarms),
297 bb_put(alarms, NewAlarms),
298 (NewAlarms = [alarm(NewSeconds, _, _)|_] ->
299 RemainingSeconds is NewSeconds - Elapsed,
300 alarm(RemainingSeconds, alarm_handler, _)
301 ;
302 alarm
303 ).
304
305delete_alarm(Alarms, ID, NewAlarms):-
306 memberchk(alarm(Seconds, ID, Execute), Alarms),
307 delete(Alarms, alarm(Seconds, ID, Execute), NewAlarms).
308
309delete:-
310 bb_get(alarms, [alarm(_, _, CurrentExecute)|[]]),
311 bb_put(alarms, []),
312 call(CurrentExecute).
313call:-
314 bb_get(alarms, [alarm(Elapsed, CurrentID, CurrentExecute)|Alarms]),
315 maplist(subtract(Elapsed), Alarms, NewAlarms),
316 find_zeros(NewAlarms, ZeroAlarms),
317 findall(alarm(S, ID, E), (member(alarm(S, ID, E), NewAlarms), S > 0), NonZeroAlarms),
318 bb_put(alarms, NonZeroAlarms),
319 (NonZeroAlarms = [alarm(NewSeconds, _, _)|_] ->
320 alarm(NewSeconds, alarm_handler, _)
321 ;
322 alarm
323 ),
324 execute([alarm(0, CurrentID, CurrentExecute)|ZeroAlarms]).
325
326find_zeros([], []).
327find_zeros([alarm(0, ID, E)|T], [alarm(0, ID, E)|R]):-
328 find_zeros(T, R).
329find_zeros([alarm(S, _, _)|T], R):-
330 S > 0,
331 find_zeros(T, R).
332
333execute([]).
334execute([alarm(_, _, Execute)|R]):-
335 call(Execute),
336 execute(R).
337
338%% time_out_call(+Seconds, +Goal, -Return)
339%
340% It will will execute the closure Goal and returns its success or failure at Return.
341% If the goal times out in Seconds then Return = timeout.
342time_out_call_once(Seconds, Goal, Return):-
343 bb_get(identity, ID),
344 set_alarm(Seconds, throw(timeout(ID)), ID),
345 catch((
346 prove_once(Goal, Return),
347 unset_alarm(ID))
348 , Exception, (
349 (Exception == timeout(ID) ->
350 Return = timeout
351 ;
352 unset_alarm(ID),
353 throw(Exception)
354 ))).
355
356prove_once(Goal, success):-
357 once(Goal), once.
358prove_once(_Goal, failure).
359
360timer_start(Name):-
361 \+ ground(Name),
362 throw(error(instantiation_error, 'Timer name needs to be instantiated.')).
363timer_start(Name):-
364 '$timer'(Name, _, _),
365 throw(error(permission_error(create, timer, timer_start(Name)), 'Timer already exists.')).
366timer_start(Name):-
367 statistics(walltime, [StartTime, _]),
368 assertz('$timer'(Name, running, StartTime)).
369
370timer_restart(Name):-
371 \+ ground(Name),
372 throw(error(instantiation_error, 'Timer name needs to be instantiated.')).
373timer_restart(Name):-
374 \+ '$timer'(Name, _, _), '$timer',
375 statistics(walltime, [StartTime, _]),
376 assertz('$timer'(Name, running, StartTime)).
377timer_restart(Name):-
378 retract('$timer'(Name, running, _)), retract,
379 statistics(walltime, [StartTime, _]),
380 assertz('$timer'(Name, running, StartTime)).
381timer_restart(Name):-
382 retract('$timer'(Name, paused, Duration)),
383 statistics(walltime, [StartTime, _]),
384 Elapsed is StartTime - Duration,
385 assertz('$timer'(Name, running, Elapsed)).
386
387timer_stop(Name, Elapsed):-
388 \+ '$timer'(Name, _, _),
389 throw(error(existence_error(timer, timer_stop(Name, Elapsed)), 'Timer does not exist.')).
390timer_stop(Name, Elapsed):-
391 retract('$timer'(Name, running, StartTime)), retract,
392 statistics(walltime, [EndTime, _]),
393 Elapsed is EndTime - StartTime.
394timer_stop(Name, Elapsed):-
395 retract('$timer'(Name, paused, Elapsed)).
396
397timer_elapsed(Name, Elapsed):-
398 \+ '$timer'(Name, _, _),
399 throw(error(existence_error(timer, timer_elapsed(Name, Elapsed)), 'Timer does not exist.')).
400timer_elapsed(Name, Elapsed):-
401 '$timer'(Name, running, StartTime), '$timer',
402 statistics(walltime, [EndTime, _]),
403 Elapsed is EndTime - StartTime.
404timer_elapsed(Name, Elapsed):-
405 '$timer'(Name, paused, Elapsed).
406
407timer_pause(Name, Elapsed):-
408 \+ '$timer'(Name, _, _),
409 throw(error(existence_error(timer, timer_pause(Name, Elapsed)), 'Timer does not exist.')).
410timer_pause(Name, Elapsed):-
411 '$timer'(Name, paused, _),
412 throw(error(permission_error(timer, timer_pause(Name, Elapsed)), 'Timer already paused.')).
413timer_pause(Name, Elapsed):-
414 retract('$timer'(Name, _, StartTime)),
415 statistics(walltime, [EndTime, _]),
416 Elapsed is EndTime - StartTime,
417 assertz('$timer'(Name, paused, Elapsed)).
418
419/**
420@}
421*/
422
alarm(+ Seconds,+ Callable,+ OldAlarm)
catch( : Goal,+ Exception,+ Action)
module(+M)
statistics(? Param,- Info)
Definition: statistics.yap:83
throw(+ Ball)
bb_get(+ Key,? Term)
bb_put(+ Key,? Term)
assertz(+ C)
retract(+ C)
use_module( +Files )
findall( T,+ G,- L)
Definition: setof.yap:70
initialization(+ G)
call( 0:P )
once( 0:G)
dynamic( + P )
ground( T)
set_alarm(+Seconds, +Execute, -ID)
unset_alarm(+ID)
delete(+ List, ? Element, ? Residue)
member(?Element, ?Set) is true when Set is a list, and Element occurs in it
memberchk(+ Element, + Set)
maplist( 2:Pred, + List1,+ List2)
ord_add_element(+ Set1, + Element, ? Set2)