1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2019, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(timed_call, 36 [ timed_call/2 37 ]). 38:- use_module(library(time)). 39:- use_module(library(debug)). 40:- use_module(library(error)). 41 42/** <module> XSB timed call 43 44This module emulates the XSB built-in timed_call/2. As this is a 45built-in, this module is re-exported from library(dialect/xsb). It has 46been placed in a separete module to facilitate reuse and allow to not 47load this if the prerequisites (library(time) and multi-threading) are 48not satisfied. 49*/ 50 51%! timed_call(:Goal, :Options) 52% 53% Emulation for XSB timed_call/2. Runs Goal as once/1 with timed 54% interrupts. The interrupt goals are called as interrupts using the 55% semantics of ignore/1: possible choice points are cut and failure is 56% ignored. If the interrupt throws an exception this is propagated. 57% 58% Options is a list of the terms below. At least one of the terms 59% max/2 or repeating/2 must be present. 60% 61% - max(+MaxInterval, :MaxHandler) 62% Schedule a single interrupt calling MaxHandler at MaxInterval 63% __milliseconds__ from now. 64% - repeating(+RepInterval, :RepHandler) 65% Schedule a repeating interrupt calling RepHandler each 66% RepInterval __milliseconds__. 67% - nesting 68% Nested calls to timed_call/2 are transformed into calls to 69% once/1. Without `nesting`, a nested call raises a 70% `permission_error` exception. 71% 72% @see call_with_time_limit/2, alarm/4, thread_signal/2. 73% 74% @compat This predicate is a generalization of the SWI-Prolog 75% library(time) interface. It is left in the XSB emulation because it 76% uses non-standard option syntax and the time is in __milliseconds__ 77% where all SWI-Prolog time handling uses seconds. 78 79:- meta_predicate 80 timed_call(, ). 81 82timed_call(Goal, _Options) :- 83 ok_nested(Goal), 84 !, 85 debug(timed_call, 'Calling nested ~p', [Goal]), 86 once(Goal). 87timed_call(Goal, Options) :- 88 '$timed_call_nested'(Goal, Options), 89 no_lco. 90 91no_lco. 92 93ok_nested(Goal) :- 94 prolog_current_frame(Fr), 95 prolog_frame_attribute(Fr, parent, Fr2), 96 prolog_frame_attribute(Fr2, parent, Parent), 97 prolog_frame_attribute(Parent, parent_goal, 98 timed_call:timed_call(_,_:Options)), 99 !, 100 debug(timed_call, 'Nested ~p: found parent timed call with options ~p', 101 [Goal, Options]), 102 ( memberchk(nesting, Options) 103 -> true 104 ; permission_error(nest, timed_goal, Goal) 105 ). 106 107 108'$timed_call_nested'(Goal, M:Options) :- 109 memberchk(max(MaxInterval, MaxHandler), Options), 110 !, 111 run_max_goal(Goal, MaxInterval, MaxHandler, M:Options). 112'$timed_call_nested'(Goal, M:Options) :- 113 memberchk(repeating(RepInterval, RepHandler), Options), 114 !, 115 run_repeating_goal(Goal, RepInterval, RepHandler, M:Options). 116'$timed_call_nested'(_Goal, _M:Options) :- 117 domain_error(timed_call_options, Options). 118 119run_max_goal(Goal, MaxInterval, MaxHandler, M:Options) :- 120 ( MaxInterval > 0 121 -> Time is MaxInterval/1000, 122 setup_call_cleanup(alarm(Time, ignore(M:MaxHandler), 123 Id, [install(false)]), 124 run_opt_releating(Id, Goal, M:Options), 125 time:remove_alarm_notrace(Id)) 126 ; call(M:MaxHandler) 127 ). 128 129run_opt_releating(AlarmID, Goal, M:Options) :- 130 memberchk(repeating(RepInterval, RepHandler), Options), 131 !, 132 install_alarm(AlarmID), 133 run_repeating_goal(Goal, RepInterval, RepHandler, M:Options). 134run_opt_releating(AlarmID, Goal, _Options) :- 135 install_alarm(AlarmID), 136 call(Goal), 137 !. 138 139run_repeating_goal(Goal, RepInterval, RepHandler, M:_Options) :- 140 ( RepInterval > 0 141 -> Time is RepInterval/1000, 142 setup_call_cleanup(alarm(Time, repeat_handler(Id, Time, M:RepHandler), 143 Id, [install(false)]), 144 run_alarm_goal(Id, Goal), 145 time:remove_alarm_notrace(Id)) 146 ; domain_error(repeating_interval, RepInterval) 147 ). 148 149 150repeat_handler(Id, Time, M:RepHandler) :- 151 ignore(M:RepHandler), 152 uninstall_alarm(Id), 153 install_alarm(Id, Time). 154 155run_alarm_goal(AlarmID, Goal) :- 156 install_alarm(AlarmID), 157 call(Goal), 158 !