1/************************************************************************* 2* * 3* YAP Prolog * 4* * 5* Yap Prolog was developed at NCCUP - Universidade do Porto * 6* * 7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * 8* * 9************************************************************************** 10* * 11* File: atts.yap * 12* Last rev: 8/2/88 * 13* mods: * 14* comments: attribute support for Prolog * 15* * 16*************************************************************************/ 17 18:- module('$attributes', [ 19 delayed_goals/4 20 ]). 21 22:- dynamic attributes:attributed_module/3, attributes:modules_with_attributes/1. 23 24prolog:get_attr(Var, Mod, Att) :- 25 functor(AttTerm, Mod, 2), 26 arg(2, AttTerm, Att), 27 attributes:get_module_atts(Var, AttTerm). 28 29prolog:put_attr(Var, Mod, Att) :- 30 functor(AttTerm, Mod, 2), 31 arg(2, AttTerm, Att), 32 attributes:put_module_atts(Var, AttTerm). 33 34prolog:del_attr(Var, Mod) :- 35 functor(AttTerm, Mod, 2), 36 attributes:del_all_module_atts(Var, AttTerm). 37 38prolog:del_attrs(Var) :- 39 attributes:del_all_atts(Var). 40 41prolog:get_attrs(AttVar, SWIAtts) :- 42 attributes:get_all_swi_atts(AttVar,SWIAtts). 43 44prolog:put_attrs(_, []). 45prolog:put_attrs(V, Atts) :- 46 cvt_to_swi_atts(Atts, YapAtts), 47 attributes:put_att_term(V, YapAtts). 48 49cvt_to_swi_atts([], _). 50cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :- 51 ModAttribute =.. [Mod, YapAtts, Attribute], 52 cvt_to_swi_atts(Atts, YapAtts). 53 54% 55% wake_up_goal is called by the system whenever a suspended goal 56% resumes. 57% 58 59/* The first case may happen if this variable was used for dif. 60 In this case, we need a way to keep the original 61 suspended goal around 62*/ 63%'$wake_up_goal'([Module1|Continuation],G) :- 64% '$write'(4,vsc_woke:G+[Module1|Continuation]:' 65%'), fail. 66prolog:'$wake_up_goal'([Module1|Continuation], LG) :- 67 execute_woken_system_goals(LG), 68 do_continuation(Continuation, Module1). 69 70 71% 72% in the first two cases restore register immediately and proceed 73% to continuation. In the last case take care with modules, but do 74% not act as if a meta-call. 75% 76% 77do_continuation('$cut_by'(X), _) :- !, 78 '$$cut_by'(X). 79do_continuation('$restore_regs'(X), _) :- !, 80 '$restore_regs'(X). 81do_continuation('$restore_regs'(X,Y), _) :- !, 82 '$restore_regs'(X,Y). 83do_continuation(Continuation, Module1) :- 84 execute_continuation(Continuation,Module1). 85 86execute_continuation(Continuation, Module1) :- 87 '$undefined'(Continuation, Module1), !, 88 '$undefp'([Module1|Continuation]). 89execute_continuation(Continuation, Mod) :- 90 % do not do meta-expansion nor any fancy stuff. 91 '$execute0'(Continuation, Mod). 92 93 94execute_woken_system_goals([]). 95execute_woken_system_goals(['$att_do'(V,New)|LG]) :- 96 execute_woken_system_goals(LG), 97 call_atts(V,New). 98 99% 100% what to do when an attribute gets bound 101% 102call_atts(V,_) :- 103 nonvar(V), !. 104call_atts(V,_) :- 105 '$att_bound'(V), !. 106call_atts(V,New) :- 107 attributes:get_all_swi_atts(V,SWIAtts), 108 ( 109 '$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes) 110 -> 111 LGoals = [], 112 DoNotBind = false 113 ; 114 attributes:woken_att_do(V, New, LGoals, DoNotBind) 115 ), 116 ( DoNotBind == true 117 -> 118 attributes:unbind_attvar(V) 119 ; 120 attributes:bind_attvar(V) 121 ), 122 do_hook_attributes(SWIAtts, New), 123 lcall(LGoals). 124 125do_hook_attributes([], _). 126do_hook_attributes(att(Mod,Att,Atts), Binding) :- 127 ('$undefined'(attr_unify_hook(Att,Binding), Mod) 128 -> 129 true 130 ; 131 Mod:attr_unify_hook(Att, Binding) 132 ), 133 do_hook_attributes(Atts, Binding). 134 135 136lcall([]). 137lcall([Mod:Gls|Goals]) :- 138 lcall2(Gls,Mod), 139 lcall(Goals). 140 141lcall2([], _). 142lcall2([Goal|Goals], Mod) :- 143 call(Mod:Goal), 144 lcall2(Goals, Mod). 145 146 147 148prolog:call_residue_vars(Goal,Residue) :- 149 attributes:all_attvars(Vs0), 150 call(Goal), 151 attributes:all_attvars(Vs), 152 % this should not be actually strictly necessary right now. 153 % but it makes it a safe bet. 154 sort(Vs, Vss), 155 sort(Vs0, Vs0s), 156 '$ord_remove'(Vss, Vs0s, Residue). 157 158'$ord_remove'([], _, []). 159'$ord_remove'([V|Vs], [], [V|Vs]). 160'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :- 161 ( V1 == V2 -> 162 '$ord_remove'(Vss, Vs0s, Residue) 163 ; 164 V1 @< V2 -> 165 Residue = [V1|ResidueF], 166 '$ord_remove'(Vss, [V2|Vs0s], ResidueF) 167 ; 168 '$ord_remove'([V1|Vss], Vs0s, Residue) 169 ). 170 171%% from SWI 172%% copy_term(+Term, -Copy, -Gs) is det. 173% 174% Creates a regular term Copy as a copy of Term (without any 175% attributes), and a list Gs of goals that when executed reinstate 176% all attributes onto Copy. The nonterminal attribute_goals//1, as 177% defined in the modules the attributes stem from, is used to 178% convert attributes to lists of goals. 179 180prolog:copy_term(Term, Copy, Gs) :- 181 term_attvars(Term, Vs), 182 ( Vs == [] 183 -> Gs = [], 184 copy_term(Term, Copy) 185 ; findall(Term-Gs, 186 ( attvars_residuals(Vs, Gs, []), 187 delete_attributes(Term) 188 ), 189 [Copy-Gs]) 190 ). 191 192attvars_residuals([]) --> []. 193attvars_residuals([V|Vs]) --> 194 ( { get_attrs(V, As) } 195 -> attvar_residuals(As, V) 196 ; [] 197 ), 198 attvars_residuals(Vs). 199 200attvar_residuals([], _) --> []. 201attvar_residuals(att(Module,Value,As), V) --> 202 ( { nonvar(V) } 203 -> % a previous projection predicate could have instantiated 204 % this variable, for example, to avoid redundant goals 205 [] 206 ; { attributes:attributed_module(Module, _, _) } -> 207 % SICStus like run, put attributes back first 208 { Value =.. [Name,_|Vs], 209 NValue =.. [Name,_|Vs], 210 attributes:put_module_atts(V,NValue) 211 }, 212 attvar_residuals(As, V), 213 ( { '$undefined'(attribute_goal(V, Goal), Module) } 214 -> 215 [] 216 ; 217 { '$notrace'(Module:attribute_goal(V, Goal)) }, 218 dot_list(Goal) 219 ) 220 ; ( { current_predicate(Module:attribute_goals/3) } 221 -> { '$notrace'(Module:attribute_goals(V, Goals, [])) }, 222 list(Goals) 223 ; { current_predicate(Module:attribute_goal/2) } 224 -> { '$notrace'(Module:attribute_goal(V, Goal)) }, 225 dot_list(Goal) 226 ; [put_attr(V, Module, Value)] 227 ), 228 attvar_residuals(As, V) 229 ). 230 231list([]) --> []. 232list([L|Ls]) --> [L], list(Ls). 233 234dot_list((A,B)) --> !, dot_list(A), dot_list(B). 235dot_list(A) --> [A]. 236 237delete_attributes(Term) :- 238 term_attvars(Term, Vs), 239 delete_attributes_(Vs). 240 241delete_attributes_([]). 242delete_attributes_([V|Vs]) :- 243 del_attrs(V), 244 delete_attributes_(Vs). 245 246 247 248prolog:call_residue(Goal,Residue) :- 249 var(Goal), !, 250 '$do_error'(instantiation_error,call_residue(Goal,Residue)). 251prolog:call_residue(Module:Goal,Residue) :- 252 atom(Module), !, 253 call_residue(Goal,Module,Residue). 254prolog:call_residue(Goal,Residue) :- 255 '$current_module'(Module), 256 call_residue(Goal,Module,Residue). 257 258call_residue(Goal,Module,Residue) :- 259 prolog:call_residue_vars(Module:Goal,NewAttVars), 260 ( 261 attributes:modules_with_attributes([_|_]) 262 -> 263 project_attributes(NewAttVars, Module:Goal) 264 ; 265 true 266 ), 267 copy_term(Goal, Goal, Residue). 268 269delayed_goals(G, Vs, NVs, Gs) :- 270 project_delayed_goals(G), 271 copy_term(G.Vs, _.NVs, Gs). 272 273project_delayed_goals(G) :- 274% SICStus compatible step, 275% just try to simplify store by projecting constraints 276% over query variables. 277% called by top_level to find out about delayed goals 278 attributes:modules_with_attributes([_|_]), !, 279 attributes:all_attvars(LAV), 280 LAV = [_|_], 281 project_attributes(LAV, G), !. 282project_delayed_goals(_). 283 284 285attributed(G, Vs) :- 286 term_variables(G, LAV), 287 att_vars(LAV, Vs). 288 289att_vars([], []). 290att_vars([V|LGs], [V|AttVars]) :- attvar(V), !, 291 att_vars(LGs, AttVars). 292att_vars([_|LGs], AttVars) :- 293 att_vars(LGs, AttVars). 294 295% make sure we set the suspended goal list to its previous state! 296% make sure we have installed a SICStus like constraint solver. 297project_attributes(AllVs, G) :- 298 attributes:modules_with_attributes(LMods), 299 LMods = [_|_], 300 term_variables(G, InputVs), 301 pick_att_vars(InputVs, AttIVs), 302 project_module(LMods, AttIVs, AllVs). 303 304pick_att_vars([],[]). 305pick_att_vars([V|L],[V|NL]) :- attvar(V), !, 306 pick_att_vars(L,NL). 307pick_att_vars([_|L],NL) :- 308 pick_att_vars(L,NL). 309 310project_module([], _, _). 311project_module([Mod|LMods], LIV, LAV) :- 312 '$pred_exists'(project_attributes(LIV, LAV),Mod), 313 '$notrace'(Mod:project_attributes(LIV, LAV)), !, 314 attributes:all_attvars(NLAV), 315 project_module(LMods,LIV,NLAV). 316project_module([_|LMods], LIV, LAV) :- 317 project_module(LMods,LIV,LAV). 318 319