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 121% goals are grozen on Var. 122 123frozen(Term, Goal) :- 124 term_attvars(Term, AttVars), 125 ( AttVars == [] 126 -> Goal = true 127 ; sort(AttVars, AttVars2), 128 phrase(attvars_residuals(AttVars2), GoalList0), 129 sort(GoalList0, GoalList), 130 make_conjunction(GoalList, Goal) 131 ). 132 133make_conjunction([], true). 134make_conjunction([H|T], Goal) :- 135 ( T == [] 136 -> Goal = H 137 ; Goal = (H,G), 138 make_conjunction(T, G) 139 ). 140 141 142 /******************************* 143 * PORTRAY * 144 *******************************/ 145 146%! portray_attvar(@Var) 147% 148% Called from write_term/3 using the option attributes(portray) or 149% when the prolog flag write_attributes equals portray. Its task 150% is the write the attributes in a human readable format. 151 152:- public 153 portray_attvar/1. 154 155portray_attvar(Var) :- 156 write('{'), 157 get_attrs(Var, Attr), 158 portray_attrs(Attr, Var), 159 write('}'). 160 161portray_attrs([], _). 162portray_attrs(att(Name, Value, Rest), Var) :- 163 portray_attr(Name, Value, Var), 164 ( Rest == [] 165 -> true 166 ; write(', '), 167 portray_attrs(Rest, Var) 168 ). 169 170portray_attr(freeze, Goal, Var) :- 171 !, 172 Options = [ portray(true), 173 quoted(true), 174 attributes(ignore) 175 ], 176 format('freeze(~W, ~W)', [ Var, Options, Goal, Options 177 ]). 178portray_attr(Name, Value, Var) :- 179 G = Name:attr_portray_hook(Value, Var), 180 ( '$c_current_predicate'(_, G), 181 182 -> true 183 ; format('~w = ...', [Name]) 184 ). 185 186 187 /******************************* 188 * CALL RESIDUE * 189 *******************************/ 190 191%! call_residue_vars(:Goal, -Vars) 192% 193% If Goal is true, Vars is the set of residual attributed 194% variables created by Goal. Goal is called as in call/1. This 195% predicate is for debugging constraint programs. Assume a 196% constraint program that creates conflicting constraints on a 197% variable that is not part of the result variables of Goal. If 198% the solver is powerful enough it will detect the conflict and 199% fail. If the solver is too weak however it will succeed and 200% residual attributed variables holding the conflicting constraint 201% form a witness of this problem. 202 203:- meta_predicate 204 call_residue_vars(, ). 205 206call_residue_vars(Goal, Vars) :- 207 prolog_current_choice(Chp), 208 setup_call_cleanup( 209 '$call_residue_vars_start', 210 run_crv(Goal, Chp, Vars, Det), 211 '$call_residue_vars_end'), 212 ( Det == true 213 -> ! 214 ; true 215 ). 216call_residue_vars(_, _) :- 217 fail. 218 219run_crv(Goal, Chp, Vars, Det) :- 220 call(Goal), 221 deterministic(Det), 222 '$attvars_after_choicepoint'(Chp, Vars). 223 224%! copy_term(+Term, -Copy, -Gs) is det. 225% 226% Creates a regular term Copy as a copy of Term (without any 227% attributes), and a list Gs of goals that when executed reinstate 228% all attributes onto Copy. The nonterminal attribute_goals//1, as 229% defined in the modules the attributes stem from, is used to 230% convert attributes to lists of goals. 231 232copy_term(Term, Copy, Gs) :- 233 term_attvars(Term, Vs), 234 ( Vs == [] 235 -> Gs = [], 236 copy_term(Term, Copy) 237 ; sort(Vs, Vs2), 238 findall(Term-Gs, 239 ( phrase(attvars_residuals(Vs2), Gs), 240 delete_attributes(Term) 241 ), 242 [Copy-Gs]) 243 ). 244 245attvars_residuals([]) --> []. 246attvars_residuals([V|Vs]) --> 247 ( { get_attrs(V, As) } 248 -> attvar_residuals(As, V) 249 ; [] 250 ), 251 attvars_residuals(Vs). 252 253attvar_residuals([], _) --> []. 254attvar_residuals(att(Module,Value,As), V) --> 255 ( { nonvar(V) } 256 -> % a previous projection predicate could have instantiated 257 % this variable, for example, to avoid redundant goals 258 [] 259 ; ( { Module == freeze } 260 -> frozen_residuals(Value, V) 261 ; { current_predicate(Module:attribute_goals//1), 262 phrase(Module:attribute_goals(V), Goals) 263 } 264 -> list(Goals) 265 ; [put_attr(V, Module, Value)] 266 ) 267 ), 268 attvar_residuals(As, V). 269 270list([]) --> []. 271list([L|Ls]) --> [L], list(Ls). 272 273delete_attributes(Term) :- 274 term_attvars(Term, Vs), 275 delete_attributes_(Vs). 276 277delete_attributes_([]). 278delete_attributes_([V|Vs]) :- 279 del_attrs(V), 280 delete_attributes_(Vs). 281 282 283%! frozen_residuals(+FreezeAttr, +Var)// is det. 284% 285% Instantiate a freeze goal for each member of the $and 286% conjunction. Note that we cannot map this into a conjunction 287% because freeze(X, a), freeze(X, !) would create freeze(X, 288% (a,!)), which is fundamentally different. We could create 289% freeze(X, (call(a), call(!))) or preform a more eleborate 290% analysis to validate the semantics are not changed. 291 292frozen_residuals('$and'(X,Y), V) --> 293 !, 294 frozen_residuals(X, V), 295 frozen_residuals(Y, V). 296frozen_residuals(X, V) --> 297 [ freeze(V, X) ]