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) 2004-2016, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module('$attvar', 37 [ '$wakeup'/1, % +Wakeup list 38 freeze/2, % +Var, :Goal 39 frozen/2, % @Var, -Goal 40 call_residue_vars/2, % :Goal, -Vars 41 copy_term/3 % +Term, -Copy, -Residue 42 ]). 43 44/** <module> Attributed variable handling 45 46Attributed variable and coroutining support based on attributed 47variables. This module is complemented with C-defined predicates defined 48in pl-attvar.c 49*/ 50 51%! '$wakeup'(+List) 52% 53% Called from the kernel if assignments have been made to 54% attributed variables. 55 56'$wakeup'([]). 57'$wakeup'(wakeup(Attribute, Value, Rest)) :- 58 call_all_attr_uhooks(Attribute, Value), 59 '$wakeup'(Rest). 60 61call_all_attr_uhooks([], _). 62call_all_attr_uhooks(att(Module, AttVal, Rest), Value) :- 63 uhook(Module, AttVal, Value), 64 call_all_attr_uhooks(Rest, Value). 65 66 67%! uhook(+AttributeName, +AttributeValue, +Value) 68% 69% Run the unify hook for attributed named AttributeName after 70% assigning an attvar with attribute AttributeValue the value 71% Value. 72% 73% This predicate deals with reserved attribute names to avoid 74% the meta-call overhead. 75 76uhook(freeze, Goal, Y) :- 77 !, 78 ( attvar(Y) 79 -> ( get_attr(Y, freeze, G2) 80 -> put_attr(Y, freeze, '$and'(G2, Goal)) 81 ; put_attr(Y, freeze, Goal) 82 ) 83 ; unfreeze(Goal) 84 ). 85uhook(Module, AttVal, Value) :- 86 Module:attr_unify_hook(AttVal, Value). 87 88 89%! unfreeze(+ConjunctionOrGoal) 90% 91% Handle unfreezing of conjunctions. As meta-calling control 92% structures is slower than meta-interpreting them we do this in 93% Prolog. Another advantage is that having unfreeze/1 in between 94% makes the stacktrace and profiling easier to intepret. Please 95% note that we cannot use a direct conjunction as this would break 96% freeze(X, (a, !, b)). 97 98unfreeze('$and'(A,B)) :- 99 !, 100 unfreeze(A), 101 unfreeze(B). 102unfreeze(Goal) :- 103 . 104 105%! freeze(@Var, :Goal) 106% 107% Suspend execution of Goal until Var is unbound. 108 109:- meta_predicate 110 freeze(, ). 111 112freeze(Var, Goal) :- 113 '$freeze'(Var, Goal), 114 !. % Succeeds if delayed 115freeze(_, Goal) :- 116 . 117 118%! frozen(@Term, -Goal) 119% 120% Unify Goals with the goals frozen on Var or true if no goals are 121% frozen on Var. 122% 123% Note that attribute_goals//1 may destructively update attributes, 124% often used to simplify the produced attributes. For frozen/2 however 125% we must keep the original variables. Ideally we would demand 126% attribute_goals//1 to not modify any attributes. As that is hard 127% given where we are we now copy the result and fail, restoring the 128% bindings. This is a simplified version of bagof/3. 129 130frozen(Term, Goal) :- 131 term_attvars(Term, AttVars), 132 ( AttVars == [] 133 -> Goal = true 134 ; sort(AttVars, AttVars2), 135 '$term_attvar_variables'(Term, KVars), 136 Keep =.. [v|KVars], 137 findall(Keep+Goal0, 138 frozen_residuals(AttVars2, Goal0), 139 [Kept+Goal]), 140 rebind_vars(Keep, Kept) 141 ). 142 143frozen_residuals(AttVars, Goal) :- 144 phrase(attvars_residuals(AttVars), GoalList0), 145 sort(GoalList0, GoalList), 146 make_conjunction(GoalList, Goal). 147 148 149%! rebind_vars(+Keep, +Kept) is det. 150% 151% Rebind the variables that have been copied and possibly instantiated 152% by attribute_goals//1. Note that library(clpfd) may bind internal 153% variables to e.g., `processed`. We do not rebind such variables as 154% that would trigger constraints. These variables should not appear in 155% the produced goal anyway. If both are attvars, unifying may also 156% re-trigger. Therefore, we remove the variables from the copy before 157% rebinding. This should be ok as all variable identifies are properly 158% restored. 159 160rebind_vars(Keep, Kept) :- 161 functor(Keep, _, Arity), 162 rebind_vars(1, Arity, Keep, Kept). 163 164rebind_vars(I, Arity, KeepT, KeptT) :- 165 I =< Arity, 166 !, 167 arg(I, KeepT, Keep), 168 arg(I, KeptT, Kept), 169 ( attvar(Keep), attvar(Kept) 170 -> del_attrs(Kept), 171 Keep = Kept 172 ; var(Kept) 173 -> Keep = Kept 174 ; true 175 ), 176 I2 is I+1, 177 rebind_vars(I2, Arity, KeepT, KeptT). 178rebind_vars(_, _, _, _). 179 180make_conjunction([], true). 181make_conjunction([H|T], Goal) :- 182 ( T == [] 183 -> Goal = H 184 ; Goal = (H,G), 185 make_conjunction(T, G) 186 ). 187 188 189 /******************************* 190 * PORTRAY * 191 *******************************/ 192 193%! portray_attvar(@Var) 194% 195% Called from write_term/3 using the option attributes(portray) or 196% when the prolog flag write_attributes equals portray. Its task 197% is the write the attributes in a human readable format. 198 199:- public 200 portray_attvar/1. 201 202portray_attvar(Var) :- 203 write('{'), 204 get_attrs(Var, Attr), 205 portray_attrs(Attr, Var), 206 write('}'). 207 208portray_attrs([], _). 209portray_attrs(att(Name, Value, Rest), Var) :- 210 portray_attr(Name, Value, Var), 211 ( Rest == [] 212 -> true 213 ; write(', '), 214 portray_attrs(Rest, Var) 215 ). 216 217portray_attr(freeze, Goal, Var) :- 218 !, 219 Options = [ portray(true), 220 quoted(true), 221 attributes(ignore) 222 ], 223 format('freeze(~W, ~W)', [ Var, Options, Goal, Options 224 ]). 225portray_attr(Name, Value, Var) :- 226 G = Name:attr_portray_hook(Value, Var), 227 ( '$c_current_predicate'(_, G), 228 229 -> true 230 ; format('~w = ...', [Name]) 231 ). 232 233 234 /******************************* 235 * CALL RESIDUE * 236 *******************************/ 237 238%! call_residue_vars(:Goal, -Vars) 239% 240% If Goal is true, Vars is the set of residual attributed 241% variables created by Goal. Goal is called as in call/1. This 242% predicate is for debugging constraint programs. Assume a 243% constraint program that creates conflicting constraints on a 244% variable that is not part of the result variables of Goal. If 245% the solver is powerful enough it will detect the conflict and 246% fail. If the solver is too weak however it will succeed and 247% residual attributed variables holding the conflicting constraint 248% form a witness of this problem. 249 250:- meta_predicate 251 call_residue_vars(, ). 252 253call_residue_vars(Goal, Vars) :- 254 prolog_current_choice(Chp), 255 setup_call_cleanup( 256 '$call_residue_vars_start', 257 run_crv(Goal, Chp, Vars, Det), 258 '$call_residue_vars_end'), 259 ( Det == true 260 -> ! 261 ; true 262 ). 263call_residue_vars(_, _) :- 264 fail. 265 266run_crv(Goal, Chp, Vars, Det) :- 267 call(Goal), 268 deterministic(Det), 269 '$attvars_after_choicepoint'(Chp, Vars). 270 271%! copy_term(+Term, -Copy, -Gs) is det. 272% 273% Creates a regular term Copy as a copy of Term (without any 274% attributes), and a list Gs of goals that when executed reinstate 275% all attributes onto Copy. The nonterminal attribute_goals//1, as 276% defined in the modules the attributes stem from, is used to 277% convert attributes to lists of goals. 278 279copy_term(Term, Copy, Gs) :- 280 term_attvars(Term, Vs), 281 ( Vs == [] 282 -> Gs = [], 283 copy_term(Term, Copy) 284 ; sort(Vs, Vs2), 285 findall(Term-Gs, 286 ( phrase(attvars_residuals(Vs2), Gs), 287 delete_attributes(Term) 288 ), 289 [Copy-Gs]) 290 ). 291 292attvars_residuals([]) --> []. 293attvars_residuals([V|Vs]) --> 294 ( { get_attrs(V, As) } 295 -> attvar_residuals(As, V) 296 ; [] 297 ), 298 attvars_residuals(Vs). 299 300attvar_residuals([], _) --> []. 301attvar_residuals(att(Module,Value,As), V) --> 302 ( { nonvar(V) } 303 -> % a previous projection predicate could have instantiated 304 % this variable, for example, to avoid redundant goals 305 [] 306 ; ( { Module == freeze } 307 -> frozen_residuals(Value, V) 308 ; { current_predicate(Module:attribute_goals//1), 309 phrase(Module:attribute_goals(V), Goals) 310 } 311 -> list(Goals) 312 ; [put_attr(V, Module, Value)] 313 ) 314 ), 315 attvar_residuals(As, V). 316 317list([]) --> []. 318list([L|Ls]) --> [L], list(Ls). 319 320delete_attributes(Term) :- 321 term_attvars(Term, Vs), 322 delete_attributes_(Vs). 323 324delete_attributes_([]). 325delete_attributes_([V|Vs]) :- 326 del_attrs(V), 327 delete_attributes_(Vs). 328 329 330%! frozen_residuals(+FreezeAttr, +Var)// is det. 331% 332% Instantiate a freeze goal for each member of the $and 333% conjunction. Note that we cannot map this into a conjunction 334% because freeze(X, a), freeze(X, !) would create freeze(X, 335% (a,!)), which is fundamentally different. We could create 336% freeze(X, (call(a), call(!))) or preform a more eleborate 337% analysis to validate the semantics are not changed. 338 339frozen_residuals('$and'(X,Y), V) --> 340 !, 341 frozen_residuals(X, V), 342 frozen_residuals(Y, V). 343frozen_residuals(X, V) --> 344 [ freeze(V, X) ]