1/* Part of SWI-Prolog 2 3 Author: Tom Schrijvers, K.U.Leuven 4 E-mail: Tom.Schrijvers@cs.kuleuven.ac.be 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2004-2016, K.U.Leuven 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(when, 36 [ when/2 % +Condition, :Goal 37 ]). 38:- set_prolog_flag(generate_debug_info, false). 39 40:- meta_predicate 41 when(, ), 42 suspend_list(, ), 43 trigger(, ), 44 trigger_disj(, ), 45 trigger_conj(, , ). 46 47/** <module> Conditional coroutining 48 49This library implements the when/2 constraint, delaying a goal until its 50arguments are sufficiently instantiated. For example, the following 51delayes the execution of =:=/2 until the expression is instantiated. 52 53 == 54 ... 55 when(ground(Expr), 0 =:= Expr), 56 == 57 58@author Tom Schrijvers (initial implementation) 59@author Jan Wielemaker 60*/ 61 62%! when(+Condition, :Goal) 63% 64% Execute Goal when Condition is satisfied. I.e., Goal is executed 65% as by call/1 if Condition is true when when/2 is called. 66% Otherwise Goal is _delayed_ until Condition becomes true. 67% Condition is one of the following: 68% 69% * nonvar(X) 70% * ground(X) 71% * ?=(X,Y) 72% * (Cond1,Cond2) 73% * (Cond2;Cond2) 74% 75% For example (note the order =a= and =b= are written): 76% 77% == 78% ?- when(nonvar(X), writeln(a)), writeln(b), X = x. 79% b 80% a 81% X = x 82% == 83 84when(Condition, Goal) :- 85 '$eval_when_condition'(Condition, Optimised), 86 trigger_first(Optimised, Goal). 87 88%! '$eval_when_condition'(+Condition, -Optimised) 89% 90% C-building block defined in pl-attvar.c. It pre-processes the 91% when-condition, checks it for errors (instantiation errors, 92% domain-errors and cyclic terms) and simplifies it. Notably, it 93% removes already satisfied conditions from Condition, unifying 94% Optimised to =true= if there is no need to suspend. Nested 95% disjunctions are reported as or(List). 96 97 98trigger_first(true, Goal) :- 99 !, 100 call(Goal). 101trigger_first(nonvar(X), Goal) :- 102 !, 103 '$suspend'(X, when, trigger_nonvar(X, Goal)). 104trigger_first(Cond, Goal) :- 105 trigger(Cond, Goal). 106 107trigger(nonvar(X),Goal) :- 108 trigger_nonvar(X,Goal). 109trigger(ground(X),Goal) :- 110 trigger_ground(X,Goal). 111trigger(?=(X,Y),Goal) :- 112 trigger_determined(X,Y,Goal). 113trigger((G1,G2),Goal) :- 114 trigger_conj(G1,G2,Goal). 115trigger(or(GL),Goal) :- 116 trigger_disj(GL, check_disj(_DisjID,GL,Goal)). 117 118trigger_nonvar(X, Goal) :- 119 ( nonvar(X) 120 -> call(Goal) 121 ; '$suspend'(X, when, trigger_nonvar(X, Goal)) 122 ). 123 124%! trigger_ground(@Term, :Goal) 125% 126% Trigger Goal when Term becomes ground. The current implementation 127% uses nonground/2, waiting for an arbitrary variable and re-check 128% Term when this variable is bound. Previous version used 129% term_variables and suspended on a term constructed from these 130% variables. It is clear that either approach performs better on 131% certain types of terms. The term_variables/2 based approach wins on 132% large terms that are almost ground. Possibly we need a nonground 133% that also returns the number of tests performed and switch to the 134% term_variables/2 based approach if this becomes large. 135 136trigger_ground(X, Goal) :- 137 ( nonground(X, V) 138 -> '$suspend'(V, when, trigger_ground(X, Goal)) 139 ; call(Goal) 140 ). 141 142trigger_determined(X, Y, Goal) :- 143 unifiable(X, Y, Unifier), 144 !, 145 ( Unifier == [] 146 -> call(Goal) 147 ; put_attr(Det, when, det(trigger_determined(X,Y,Goal))), 148 suspend_list(Unifier, wake_det(Det)) 149 ). 150trigger_determined(_, _, Goal) :- 151 call(Goal). 152 153 154wake_det(Det) :- 155 ( var(Det) -> 156 get_attr(Det,when,Attr), 157 del_attr(Det,when), 158 Det = (-), 159 Attr = det(Goal), 160 call(Goal) 161 ; 162 true 163 ). 164 165trigger_conj(G1,G2,Goal) :- 166 trigger(G1, trigger(G2,Goal)). 167 168trigger_disj([],_). 169trigger_disj([H|T], G) :- 170 trigger(H, G), 171 trigger_disj(T, G). 172 173 174%! check_disj(DisjVar, Disj, Goal) 175% 176% If there is a disjunctive condition, we share a variable between the 177% disjunctions. If the goal is fired due to one of the conditions, the 178% shared variable is bound to (-). Note that this implies that the 179% attributed variable is left in place. The predicate when_goal//1 180% skips such goals on behalf of copy_term/3. 181 182check_disj(Disj,_,Goal) :- 183 ( Disj == (-) 184 -> true 185 ; Disj = (-), 186 call(Goal) 187 ). 188 189suspend_list([],_Goal). 190suspend_list([V=W|Unifier],Goal) :- 191 '$suspend'(V, when, Goal), 192 ( var(W) 193 -> '$suspend'(W, when, Goal) 194 ; true 195 ), 196 suspend_list(Unifier,Goal). 197 198attr_unify_hook(call(Goal), Other) :- 199 ( get_attr(Other, when, call(GOTher)) 200 -> del_attr(Other, when), 201 , 202 ; 203 ). 204 205 206%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 207attribute_goals(V) --> 208 { get_attr(V, when, Attr) }, 209 when_goals(Attr). 210 211when_goals(det(trigger_determined(X, Y, G))) --> 212 when_trigger_goal(?=(X,Y), G). 213when_goals(call(Conj)) --> 214 when_conj_goals(Conj). 215 216when_conj_goals((A,B)) --> 217 !, 218 when_conj_goals(A), 219 when_conj_goals(B). 220when_conj_goals(when:G) --> 221 when_goal(G). 222 223when_goal(trigger_nonvar(X, G)) --> 224 when_trigger_goal(nonvar(X), G). 225when_goal(trigger_ground(X, G)) --> 226 when_trigger_goal(ground(X), G). 227when_goal(wake_det(_)) --> 228 []. 229 230when_trigger_goal(Cond, when:trigger(InnerCond, InnerGoal)) --> 231 !, 232 when_trigger_goal((Cond, InnerCond), InnerGoal). 233when_trigger_goal(_, when:check_disj(Disj, _, _)) --> 234 { Disj == (-) }, 235 !, 236 []. 237when_trigger_goal(_, when:check_disj(-, OrList, InnerGoal)) --> 238 { OrList \== [] }, 239 !, 240 { or_list(OrList, OrCond) }, 241 when_trigger_goal(OrCond, InnerGoal). 242when_trigger_goal(Cond, Goal) --> 243 [ when(Cond, Goal) ]. 244 245or_list([H], HCond) :- 246 !, 247 or_list_member(H, HCond). 248or_list([H|T], (HCond;OT)) :- 249 or_list_member(H, HCond), 250 or_list(T, OT). 251 252or_list_member(or(OrList), OrCond) :- 253 !, 254 or_list(OrList, OrCond). 255or_list_member((L, R), (LCond, RCond)) :- 256 !, 257 or_list_member(L, LCond), 258 or_list_member(R, RCond). 259or_list_member(Cond, Cond). 260 261:- multifile sandbox:safe_meta_predicate/1. 262 263sandbox:safe_meta_predicate(when:when/2)