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 ]).
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).
This predicate deals with reserved attribute names to avoid the meta-call overhead.
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).
freeze(X, (a, !, b)).98unfreeze('$and'(A,B)) :- 99 !, 100 unfreeze(A), 101 unfreeze(B). 102unfreeze(Goal) :- 103 .
109:- meta_predicate 110 freeze(, ). 111 112freeze(Var, Goal) :- 113 '$freeze'(Var, Goal), 114 !. % Succeeds if delayed 115freeze(_, Goal) :- 116 .
123frozen(Var, Goals) :- 124 get_attr(Var, freeze, Goals0), 125 !, 126 make_conjunction(Goals0, Goals). 127frozen(_, true). 128 129make_conjunction('$and'(A0, B0), (A, B)) :- 130 !, 131 make_conjunction(A0, A), 132 make_conjunction(B0, B). 133make_conjunction(G, G). 134 135 136 /******************************* 137 * PORTRAY * 138 *******************************/
attributes(portray) or
when the prolog flag write_attributes equals portray. Its task
is the write the attributes in a human readable format.146:- public 147 portray_attvar/1. 148 149portray_attvar(Var) :- 150 write('{'), 151 get_attrs(Var, Attr), 152 portray_attrs(Attr, Var), 153 write('}'). 154 155portray_attrs([], _). 156portray_attrs(att(Name, Value, Rest), Var) :- 157 portray_attr(Name, Value, Var), 158 ( Rest == [] 159 -> true 160 ; write(', '), 161 portray_attrs(Rest, Var) 162 ). 163 164portray_attr(freeze, Goal, Var) :- 165 !, 166 format('freeze(~w, ~W)', [ Var, Goal, 167 [ portray(true), 168 quoted(true), 169 attributes(ignore) 170 ] 171 ]). 172portray_attr(Name, Value, Var) :- 173 G = Name:attr_portray_hook(Value, Var), 174 ( '$c_current_predicate'(_, G), 175 176 -> true 177 ; format('~w = ...', [Name]) 178 ). 179 180 181 /******************************* 182 * CALL RESIDUE * 183 *******************************/
197:- meta_predicate 198 call_residue_vars(, ). 199 200call_residue_vars(Goal, Vars) :- 201 prolog_current_choice(Chp), 202 setup_call_cleanup( 203 '$call_residue_vars_start', 204 run_crv(Goal, Chp, Vars, Det), 205 '$call_residue_vars_end'), 206 ( Det == true 207 -> ! 208 ; true 209 ). 210call_residue_vars(_, _) :- 211 fail. 212 213run_crv(Goal, Chp, Vars, Det) :- 214 call(), 215 deterministic(Det), 216 '$attvars_after_choicepoint'(Chp, Vars).
226copy_term(Term, Copy, Gs) :- 227 term_attvars(Term, Vs), 228 ( Vs == [] 229 -> Gs = [], 230 copy_term(Term, Copy) 231 ; findall(Term-Gs, 232 ( phrase(attvars_residuals(Vs), Gs), 233 delete_attributes(Term) 234 ), 235 [Copy-Gs]) 236 ). 237 238attvars_residuals([]) --> []. 239attvars_residuals([V|Vs]) --> 240 ( { get_attrs(V, As) } 241 -> attvar_residuals(As, V) 242 ; [] 243 ), 244 attvars_residuals(Vs). 245 246attvar_residuals([], _) --> []. 247attvar_residuals(att(Module,Value,As), V) --> 248 ( { nonvar(V) } 249 -> % a previous projection predicate could have instantiated 250 % this variable, for example, to avoid redundant goals 251 [] 252 ; ( { Module == freeze } 253 -> frozen_residuals(Value, V) 254 ; { current_predicate(Module:attribute_goals//1), 255 phrase(Module:attribute_goals(V), Goals) 256 } 257 -> list(Goals) 258 ; [put_attr(V, Module, Value)] 259 ) 260 ), 261 attvar_residuals(As, V). 262 263list([]) --> []. 264list([L|Ls]) --> [L], list(Ls). 265 266delete_attributes(Term) :- 267 term_attvars(Term, Vs), 268 delete_attributes_(Vs). 269 270delete_attributes_([]). 271delete_attributes_([V|Vs]) :- 272 del_attrs(V), 273 delete_attributes_(Vs).
freeze(X, a), freeze(X, !) would create freeze(X,
(a,!)), which is fundamentally different. We could create
freeze(X, (call(a), call(!))) or preform a more eleborate
analysis to validate the semantics are not changed.285frozen_residuals('$and'(X,Y), V) --> 286 !, 287 frozen_residuals(X, V), 288 frozen_residuals(Y, V). 289frozen_residuals(X, V) --> 290 [ freeze(V, X) ]
Attributed variable handling
Attributed variable and coroutining support based on attributed variables. This module is complemented with C-defined predicates defined in pl-attvar.c */