From 1fe1b19534a7e79457d8b44d0bc5c040449a774a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 16 May 2009 12:00:56 -0700 Subject: [PATCH] cleanup handling of attributed variables: - try to make it clear when to call project - try to make it clear when to generate goals for attributed variables (get_goalist_from_attvars). - change call_residue to rely this infrastructure and then add extra variables. - change frozen never to call project. --- pl/boot.yap | 7 +- pl/corout.yap | 185 +++++++++++++++++++++++++++++++------------------- 2 files changed, 118 insertions(+), 74 deletions(-) diff --git a/pl/boot.yap b/pl/boot.yap index c0c2c4712..05362ee4f 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -524,12 +524,7 @@ true :- true. \+ '$undefined'(bindings_message(_,_,_), swi), swi:bindings_message(V, LGs, []), !. '$output_frozen'(G,V,LGs) :- - '$extract_goal_vars_for_dump'(V,LIV), - '$show_frozen'(G,LIV,LGs). - -'$extract_goal_vars_for_dump'([],[]). -'$extract_goal_vars_for_dump'([[_|V]|VL],[V|LIV]) :- - '$extract_goal_vars_for_dump'(VL,LIV). + '$project_and_delayed_goals'(G,LGs). % % present_answer has three components. First it flushes the streams, diff --git a/pl/corout.yap b/pl/corout.yap index 9a9ae5dcc..497b81ea8 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -36,23 +36,19 @@ :- assert((extensions_to_present_answer(Level) :- '$show_frozen_goals'(Level))). -'$show_frozen'(G,V,LGs) :- - \+ '$undefined'(all_attvars(LAV), attributes), +'$project_and_delayed_goals'(G,LGs) :- attributes:all_attvars(LAV), LAV = [_|_], !, - '$convert_to_list_of_frozen_goals'(V,LAV,G,LGs). -'$show_frozen'(_,_,[]). + % SICStus compatible step, + % just try to simplify store by projecting constraints + % over query variables. + '$project_attributes'(LAV, G), + % now get a list of frozen goals. + attributes:all_attvars(NLAV), + '$get_goalist_from_attvars'(NLAV, LGs). +'$project_and_delayed_goals'(_,[]). -'$convert_to_list_of_frozen_goals'(LIV,LAV,_,NLG) :- - '$project'(LAV,LIV,NLG). - - -'$get_rid_of_vls'((_-G),G). -'$get_rid_of_vls'((A,B),(NA,NB)) :- - '$get_rid_of_vls'(A,NA), - '$get_rid_of_vls'(B,NB). - % % wake_up_goal is called by the system whenever a suspended goal % resumes. @@ -502,12 +498,7 @@ when(_,Goal) :- frozen(V, G) :- nonvar(V), !, '$do_error'(type_error(variable,V),frozen(V,G)). frozen(V, LG) :- - '$project'([V],[V],Gs), - '$simplify_list_of_frozen_goals'(Gs,LG). - -'$simplify_list_of_frozen_goals'([],[]). -'$simplify_list_of_frozen_goals'([(_-G)|Gs],[G|NGs]) :- - '$simplify_list_of_frozen_goals'(Gs,NGs). + '$get_goalist_from_attvars'([V], LG). '$find_att_vars'([], []). '$find_att_vars'([V|LGs], [V|AttVars]) :- attvar(V), !, @@ -585,19 +576,9 @@ call_residue_vars(Goal,Residue) :- copy_term(Term, Copy, Goals) :- term_variables(Term, TVars), - '$pick_vars_for_project'(TVars,AttVars), - '$call_attribute_goals'(AttVars, Goals0, LDs), - '$fetch_delays_and_simplify'(AttVars, LDs, LGs), - '$convert_att_vars'(AttVars, LGs), + '$get_conj_from_attvars'(TVars, Goals0), copy_term_nat([Term|Goals0], [Copy|Goals]). -'$fetch_delays_and_simplify'(AttVars, LDs, LGs) :- - '$fetch_delays'(AttVars, LDs0, LGs), - '$fetch_delays_simplify'(LDs0, LDs). - -'$fetch_delays_simplify'(LDs0, LDs0) :- var(LDs0), !. -'$fetch_delays_simplify'([_-G|LDs0], [G|LDs0]) :- - '$fetch_delays_simplify'(LDs0, LDs0). call_residue(Goal,Residue) :- var(Goal), !, @@ -614,54 +595,48 @@ call_residue(Goal,Residue) :- copy_term_nat(Goal, NGoal), ( '$set_svar_list'(CurrentAttsList), '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)), - - '$call_residue_continuation'(NGoal,NResidue), - ( '$set_svar_list'(OldAttsList), - copy_term_nat(NGoal+NResidue, Goal+Residue) - ; - '$set_svar_list'(CurrentAttsList), fail - ) - ; + '$project_and_delayed_goals'(NGoal,Residue0), + '$add_vs_to_vlist'(Residue0, Residue), + ( '$set_svar_list'(OldAttsList), + copy_term_nat(NGoal+NResidue, Goal+Residue) + ; + '$set_svar_list'(CurrentAttsList), fail + ) + ; '$set_svar_list'(OldAttsList), fail ). +'$add_vs_to_vlist'([], []). +'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :- + term_variables(G, TVs), + '$pick_att_vars'(TVs, Vs), + '$add_vs_to_vlist'(Residue0, Residue). + + % make sure we set the suspended goal list to its previous state! '$residue_catch_trap'(Error,OldAttsList) :- '$set_svar_list'(OldAttsList), throw(Error). -% -% goal needs to be in a different procedure to catch suspended goals. -% -'$call_residue_continuation'(Goal,Residue) :- - '$variables_in_term'(Goal,[],LIV), - '$show_frozen'(Goal,LIV,Residue). - -'$project'([],_,[]). -'$project'(Vs,_,LGs) :- - % we don't have constraints yet, so we must be talking about delays. - '$undefined'(modules_with_attributes(_),attributes), !, - '$fetch_delays'(Vs, LGs, []). -'$project'([V|LAV], LIV, LDs) :- - attvar(V), !, +% make sure we have installed a SICStus like constraint solver. +'$project_attributes'(_, _) :- + '$undefined'(modules_with_attributes(_),attributes), !. +'$project_attributes'(AllVs, G) :- attributes:modules_with_attributes(LMods), - '$pick_vars_for_project'(LIV, NLIV), - '$project_module'(LMods, NLIV, [V|LAV]), - '$convert_att_vars'(NLIV, LGs), - attributes:all_attvars(NLAV), - '$call_attribute_goals'(NLAV, LGs1, LGs), - '$fetch_delays'([V|LAV], LDs, LGs1). + term_variables(G, InputVs), + '$pick_att_vars'(InputVs, AttIVs), + '$project_module'(LMods, AttIVs, AllVs). -'$pick_vars_for_project'([],[]). -'$pick_vars_for_project'([V|L],[V|NL]) :- attvar(V), !, - '$pick_vars_for_project'(L,NL). -'$pick_vars_for_project'([_|L],NL) :- - '$pick_vars_for_project'(L,NL). +'$pick_att_vars'([],[]). +'$pick_att_vars'([V|L],[V|NL]) :- attvar(V), !, + '$pick_att_vars'(L,NL). +'$pick_att_vars'([_|L],NL) :- + '$pick_att_vars'(L,NL). '$project_module'([], _, _). '$project_module'([Mod|LMods], LIV, LAV) :- - \+ '$undefined'(project_attributes(LIV, LAV), Mod), - '$execute'(Mod:project_attributes(LIV, LAV)), !, + current_predicate(Mod:project_attributes/2), + '$notrace'(Mod:project_attributes(LIV, LAV)), !, attributes:all_attvars(NLAV), '$project_module'(LMods,LIV,NLAV). '$project_module'([_|LMods], LIV, LAV) :- @@ -756,8 +731,8 @@ call_residue(Goal,Residue) :- '$update_att'(V, G). '$update_att'(V, G) :- - attributes:get_module_atts(V, prolog(_,Gs)), !, - attributes:put_module_atts(V, prolog(_,[G|Gs])). + attributes:get_module_atts(V, prolog(_,Gs)), !, + attributes:put_module_atts(V, prolog(_,[G|Gs])). '$update_att'(V, G) :- attributes:put_module_atts(V, prolog(_,[G])). @@ -769,7 +744,6 @@ call_residue(Goal,Residue) :- var(V), attributes:get_att(V, prolog, 2, Gs), nonvar(Gs). - '$call_attribute_goals'(NLIV, LGsF, LGs0) :- findall(Mod, ('$all_current_modules'(Mod),current_predicate(Mod:attribute_goals/3)), LMs), '$call_attribute_goals'(NLIV, LMs, LGsF, LGs0). @@ -785,3 +759,78 @@ call_residue(Goal,Residue) :- '$call_attribute_goals_for_module'(LMs, V, LGsI, LGs0). '$call_attribute_goals_for_module'([_|LMs], V, LGsF, LGs0) :- '$call_attribute_goals_for_module'(LMs, V, LGsF, LGs0). + +% +% given a list of attributed variables, generate a conjunction of goals. +% +'$get_conj_from_attvars'(TVars, Goals) :- + '$get_goalist_from_attvars'(TVars, [], GoalList, []), + '$list_to_conjunction'(GoalList, Goals). + +'$get_goalist_from_attvars'(TVars, GoalList) :- + '$get_goalist_from_attvars'(TVars, [], GoalList, []). + +'$get_goalist_from_attvars'([], _, GoalList, GoalList). +'$get_goalist_from_attvars'([V|TVars], DonesSoFar, GoalListF, GoalList0) :- + '$get_goalist_from_attvar'(V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalListI), + '$get_goalist_from_attvars'(TVars, MoreDonesSoFar, GoalListI, GoalList0). + +'$get_goalist_from_attvar'(V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- attvar(V), !, + attributes:get_all_atts(V, AllAtts), + '$all_atts_to_goals'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0). +'$get_goalist_from_attvar'(_, DonesSoFar, DonesSoFar, GoalList, GoalList). + +'$all_atts_to_goals'(AllAtts, _, DonesSoFar, DonesSoFar, GoalList, GoalList) :- var(AllAtts), !. +'$all_atts_to_goals'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- + functor(AllAtts, Mod, _), + arg(1, AllAtts, MoreAtts), + '$attgoals_for_module'(Mod, V, AllAtts, DonesSoFar, IDonesSoFar, GoalListF, GoalListI), + '$all_atts_to_goals'(MoreAtts, V, IDonesSoFar, MoreDonesSoFar, GoalListI, GoalList0). + +'$attgoals_for_module'(prolog, V, prolog(_,Gs), DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- !, + % dif, when, freeze + '$attgoals_for_prolog'(Gs, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0). +'$attgoals_for_module'(Mod, V, _Gs, DonesSoFar, DonesSoFar, GoalListF, GoalList0) :- + % SWI, HProlog + current_predicate(Mod:attribute_goals/3), !, + ( + '$notrace'(Mod:attribute_goals(V,GoalListF,GoalList0)) + -> + true + ; + GoalListF = GoalList0 + ). +'$attgoals_for_module'(Mod, V, _, DonesSoFar, DonesSoFar, GoalListF, GoalList0) :- + % SICStus + current_predicate(Mod:attribute_goal/2), !, + ( + '$notrace'(Mod:attribute_goal(V,G)) + -> + GoalListF = [G|GoalList0] + ; + GoalListF = GoalList0 + ). +'$attgoals_for_module'(Mod, V, _, DonesSoFar, DonesSoFar, GoalList, GoalList). + +'$attgoals_for_prolog'([], _, DonesSoFar, DonesSoFar, GoalList, GoalList). +'$attgoals_for_prolog'([G|AllAtts], V, DonesSoFar, MoreDonesSoFar, [AttGoal|GoalListI], GoalList0) :- + '$attgoal_for_prolog'(G, Done, AttGoal), + '$not_vmember'(Done, DonesSoFar), !, + '$attgoals_for_prolog'(AllAtts, V, [Done|DonesSoFar], MoreDonesSoFar, GoalListI, GoalList0). +'$attgoals_for_prolog'([_|AllAtts], V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0) :- + '$attgoals_for_prolog'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0). + +'$attgoal_for_prolog'('$redo_dif'(Done, X, Y), Done, prolog:dif(X,Y)). +'$attgoal_for_prolog'('$redo_freeze'(Done, V, Goal), Done, prolog:freeze(V,Goal)). +'$attgoal_for_prolog'('$redo_eq'(Done, X, Y, Goal), Done, prolog:when(X=Y,Goal)). +'$attgoal_for_prolog'('$redo_ground'(Done, X, Goal), Done, prolog:when(ground(X),Goal)). + +'$not_vmember'(_, []). +'$not_vmember'(V, [V1|DonesSoFar]) :- + V \== V1, + '$not_vmember'(V, DonesSoFar). + +'$list_to_conjunction'([], true). +'$list_to_conjunction'([G], G) :- !. +'$list_to_conjunction'([G|GoalList], (G,Goals0)) :- + '$list_to_conjunction'(GoalList, Goals0).