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 atribtrary 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 177% the disjunctions. If the goal is fired due to one of the 178% conditions, the shared variable is boud to (-). Note that this 179% implies that the attributed variable is left in place. The 180% predicate when_goal//1 skips such goals on behalfe of 181% copy_term/3. 182 183check_disj(Disj,_,Goal) :- 184 ( Disj == (-) 185 -> true 186 ; Disj = (-), 187 call(Goal) 188 ). 189 190suspend_list([],_Goal). 191suspend_list([V=W|Unifier],Goal) :- 192 '$suspend'(V, when, Goal), 193 ( var(W) 194 -> '$suspend'(W, when, Goal) 195 ; true 196 ), 197 suspend_list(Unifier,Goal). 198 199attr_unify_hook(call(Goal), Other) :- 200 ( get_attr(Other, when, call(GOTher)) 201 -> del_attr(Other, when), 202 , 203 ; 204 ). 205 206 207%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 208attribute_goals(V) --> 209 { get_attr(V, when, Attr) }, 210 when_goals(Attr). 211 212when_goals(det(trigger_determined(X, Y, G))) --> 213 !, 214 ( { disj_goal(G, Disj, DG) } 215 -> disj_or(Disj, DG) 216 ; { G = when:trigger(C, Goal) } 217 -> [ when((?=(X,Y),C), Goal) ] 218 ; [ when(?=(X,Y), G) ] 219 ). 220when_goals(call(Conj)) --> 221 when_conj_goals(Conj). 222 223when_conj_goals((A,B)) --> 224 !, 225 when_conj_goals(A), 226 when_conj_goals(B). 227when_conj_goals(when:G) --> 228 when_goal(G). 229 230when_goal(trigger_nonvar(X, G)) --> 231 ( { disj_goal(G, Disj, DG) } 232 -> disj_or(Disj, DG) 233 ; { G = when:trigger(C, Goal) } 234 -> [ when((nonvar(X),C), Goal) ] 235 ; [ when(nonvar(X),G) ] 236 ). 237when_goal(trigger_ground(X, G)) --> 238 ( { disj_goal(G, Disj, DG) } 239 -> disj_or(Disj, DG) 240 ; { G = when:trigger(C, Goal) } 241 -> [ when((ground(X),C), Goal) ] 242 ; [ when(ground(X),G) ] 243 ). 244when_goal(wake_det(_)) --> 245 []. 246 247disj_goal(when:check_disj(X, _, _), [], -) :- X == (-). 248disj_goal(when:check_disj(-, Or, DG), Or, DG). 249 250disj_or([], _) --> []. 251disj_or(List, DG) --> 252 { or_list(List, Or) }, 253 [when(Or, DG)]. 254 255or_list([H], H) :- !. 256or_list([H|T], (H;OT)) :- 257 or_list(T, OT). 258 259:- multifile sandbox:safe_meta_predicate/1. 260 261sandbox:safe_meta_predicate(when:when/2)