From c4b39d3ab9e54e80707335ee27accf338c55934b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 14:26:35 +0000 Subject: [PATCH] update Prolog code: do a cleanup and make delays use SWI interface. --- Makefile.in | 5 +- library/atts.yap | 70 +--- library/dialect/swi.yap | 2 - pl/attributes.yap | 283 +++++++++++++++- pl/boot.yap | 2 +- pl/corout.yap | 704 +++++++++++----------------------------- pl/init.yap | 8 +- 7 files changed, 467 insertions(+), 607 deletions(-) diff --git a/Makefile.in b/Makefile.in index 14c2d951e..c5d24b221 100755 --- a/Makefile.in +++ b/Makefile.in @@ -210,7 +210,10 @@ C_SOURCES= \ $(srcdir)/MYDDAS/myddas_wkb2prolog.c PL_SOURCES= \ - $(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \ + $(srcdir)/pl/arith.yap \ + $(srcdir)/pl/arrays.yap \ + $(srcdir)/pl/attributes.yap \ + $(srcdir)/pl/boot.yap \ $(srcdir)/pl/callcount.yap\ $(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \ $(srcdir)/pl/consult.yap \ diff --git a/library/atts.yap b/library/atts.yap index e76d91b57..86f8380f4 100644 --- a/library/atts.yap +++ b/library/atts.yap @@ -156,21 +156,12 @@ expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) : expand_put_attributes(Att,Mod,Var,Goal) :- expand_put_attributes([Att],Mod,Var,Goal). -woken_att_do(AttVar, Binding) :- - get_all_swi_atts(AttVar,SWIAtts), +woken_att_do(AttVar, Binding, NGoals, DoNotBind) :- modules_with_attributes(AttVar,Mods0), modules_with_attributes(Mods), find_used(Mods,Mods0,[],ModsI), do_verify_attributes(ModsI, AttVar, Binding, Goals), - process_goals(Goals, NGoals, DoNotBind), - ( DoNotBind == true - -> - unbind_attvar(AttVar) - ; - bind_attvar(AttVar) - ), - do_hook_attributes(SWIAtts, Binding), - lcall(NGoals). + process_goals(Goals, NGoals, DoNotBind). % dirty trick to be able to unbind a variable that has been constrained. process_goals([], [], _). @@ -198,62 +189,5 @@ do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :- do_verify_attributes([_|Mods], AttVar, Binding, Goals) :- do_verify_attributes(Mods, AttVar, Binding, Goals). -do_hook_attributes([], _). -do_hook_attributes(att(Mod,Att,Atts), Binding) :- - current_predicate(attr_unify_hook,Mod:attr_unify_hook(_,_)), - !, - Mod:attr_unify_hook(Att, Binding), - do_hook_attributes(Atts, Binding). -do_hook_attributes(att(_,_,Atts), Binding) :- - do_hook_attributes(Atts, Binding). - -lcall([]). -lcall([Mod:Gls|Goals]) :- - lcall2(Gls,Mod), - lcall(Goals). - -lcall2([], _). -lcall2([Goal|Goals], Mod) :- - call(Mod:Goal), - lcall2(Goals, Mod). - -convert_att_var(V, Gs) :- - modules_with_attributes(V,LMods), - fetch_att_goals(LMods,V,Gs0), !, - simplify_trues(Gs0, Gs). -convert_att_var(_, true). - -fetch_att_goals([Mod], Att, G1) :- - call_module_attributes(Mod, Att, G1), !. -fetch_att_goals([_], _, true) :- !. -fetch_att_goals([Mod|LMods], Att, (G1,LGoal)) :- - call_module_attributes(Mod, Att, G1), !, - fetch_att_goals(LMods, Att, LGoal). -fetch_att_goals([_|LMods], Att, LGoal) :- - fetch_att_goals(LMods, Att, LGoal). - -% -% if there is an active attribute for this module call attribute_goal. -% -call_module_attributes(Mod, AttV, G1) :- - current_predicate(attribute_goal, Mod:attribute_goal(AttV,G1)), - Mod:attribute_goal(AttV, G1). - -simplify_trues((A,B), NG) :- !, - simplify_trues(A, NA), - simplify_trues(B, NB), - simplify_true(NA, NB, NG). -simplify_trues(G, G). - -simplify_true(true, G, G) :- !. -simplify_true(G, true, G) :- !. -simplify_true(A, B, (A,B)). - - -convert_to_goals([G],G) :- !. -convert_to_goals([A|G],(A,Gs)) :- - convert_to_goals(G,Gs). - - \ No newline at end of file diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 38952e273..497d052b9 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -15,8 +15,6 @@ :- set_prolog_flag(user_flags,silent). -:- ensure_loaded(library(atts)). - :- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]). :- use_module(library(lists),[append/2, diff --git a/pl/attributes.yap b/pl/attributes.yap index 1cefa0c45..4d08ec6ab 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -15,37 +15,32 @@ * * *************************************************************************/ -:- module('$attributes', [get_attr/3, - put_attr/3, - del_attr/2, - del_attrs/1, - get_attrs/2, - put_attrs/2 +:- module('$attributes', [ + project_delayed_goals/2 ]). - -get_attr(Var, Mod, Att) :- +prolog:get_attr(Var, Mod, Att) :- functor(AttTerm, Mod, 2), arg(2, AttTerm, Att), attributes:get_module_atts(Var, AttTerm). -put_attr(Var, Mod, Att) :- +prolog:put_attr(Var, Mod, Att) :- functor(AttTerm, Mod, 2), arg(2, AttTerm, Att), attributes:put_module_atts(Var, AttTerm). -del_attr(Var, Mod) :- +prolog:del_attr(Var, Mod) :- functor(AttTerm, Mod, 2), attributes:del_all_module_atts(Var, AttTerm). -del_attrs(Var) :- +prolog:del_attrs(Var) :- attributes:del_all_atts(Var). -get_attrs(AttVar, SWIAtts) :- +prolog:get_attrs(AttVar, SWIAtts) :- attributes:get_all_swi_atts(AttVar,SWIAtts). -put_attrs(_, []). -put_attrs(V, Atts) :- +prolog:put_attrs(_, []). +prolog:put_attrs(V, Atts) :- cvt_to_swi_atts(Atts, YapAtts), attributes:put_att_term(V, YapAtts). @@ -54,3 +49,263 @@ cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :- ModAttribute =.. [Mod, YapAtts, Attribute], cvt_to_swi_atts(Atts, YapAtts). +% +% wake_up_goal is called by the system whenever a suspended goal +% resumes. +% + +/* The first case may happen if this variable was used for dif. + In this case, we need a way to keep the original + suspended goal around +*/ +%'$wake_up_goal'([Module1|Continuation],G) :- +% '$write'(4,vsc_woke:G+[Module1|Continuation]:' +%'), fail. +prolog:'$wake_up_goal'([Module1|Continuation], LG) :- + execute_woken_system_goals(LG), + do_continuation(Continuation, Module1). + + +% +% in the first two cases restore register immediately and proceed +% to continuation. In the last case take care with modules, but do +% not act as if a meta-call. +% +% +do_continuation('$cut_by'(X), _) :- !, + '$$cut_by'(X). +do_continuation('$restore_regs'(X), _) :- !, + '$restore_regs'(X). +do_continuation('$restore_regs'(X,Y), _) :- !, + '$restore_regs'(X,Y). +do_continuation(Continuation, Module1) :- + execute_continuation(Continuation,Module1). + +execute_continuation(Continuation, Module1) :- + '$undefined'(Continuation, Module1), !, + '$undefp'([Module1|Continuation]). +execute_continuation(Continuation, Mod) :- + % do not do meta-expansion nor any fancy stuff. + '$execute0'(Continuation, Mod). + + +execute_woken_system_goals([]). +execute_woken_system_goals([G|LG]) :- + execute_woken_system_goals(LG), + execute_woken_system_goal(G). + +% +% X surely was bound, otherwise we would not be awaken. +% +execute_woken_system_goal('$att_do'(V,New)) :- + call_atts(V,New). + +% +% what to do when an attribute gets bound +% +call_atts(V,_) :- + nonvar(V), !. +call_atts(V,_) :- + '$att_bound'(V), !. +call_atts(V,New) :- + attributes:get_all_swi_atts(V,SWIAtts), + ( + '$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes) + -> + LGoals = [], + DoNotBind = false + ; + attributes:woken_att_do(V, New, LGoals, DoNotBind) + ), + ( DoNotBind == true + -> + attributes:unbind_attvar(V) + ; + attributes:bind_attvar(V) + ), + do_hook_attributes(SWIAtts, New), + lcall(LGoals). + +do_hook_attributes([], _). +do_hook_attributes(att(Mod,Att,Atts), Binding) :- + ('$undefined'(attr_unify_hook(Att,Binding), Mod) + -> + true + ; + Mod:attr_unify_hook(Att, Binding) + ), + do_hook_attributes(Atts, Binding). + + +lcall([]). +lcall([Mod:Gls|Goals]) :- + lcall2(Gls,Mod), + lcall(Goals). + +lcall2([], _). +lcall2([Goal|Goals], Mod) :- + call(Mod:Goal), + lcall2(Goals, Mod). + + + +prolog:call_residue_vars(Goal,Residue) :- + attributes:all_attvars(Vs0), + call(Goal), + attributes:all_attvars(Vs), + % this should not be actually strictly necessary right now. + % but it makes it a safe bet. + sort(Vs, Vss), + sort(Vs0, Vs0s), + '$ord_remove'(Vss, Vs0s, Residue). + +'$ord_remove'([], _, []). +'$ord_remove'([V|Vs], [], [V|Vs]). +'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :- + ( V1 == V2 -> + '$ord_remove'(Vss, Vs0s, Residue) + ; + V1 @< V2 -> + Residue = [V1|ResidueF], + '$ord_remove'(Vss, [V2|Vs0s], ResidueF) + ; + '$ord_remove'([V1|Vss], Vs0s, Residue) + ). + +prolog:copy_term(Term, Copy, Goals) :- + term_variables(Term, TVars), + '$get_goalist_from_attvars'(TVars, Goals0), + copy_term_nat([Term|Goals0], [Copy|Goals]). + +prolog:call_residue(Goal,Residue) :- + var(Goal), !, + '$do_error'(instantiation_error,call_residue(Goal,Residue)). +prolog:call_residue(Module:Goal,Residue) :- + atom(Module), !, + call_residue(Goal,Module,Residue). +prolog:call_residue(Goal,Residue) :- + '$current_module'(Module), + call_residue(Goal,Module,Residue). + +call_residue(Goal,Module,Residue) :- + call(Module:Goal). + +% called by top_level to find out about delayed goals +project_delayed_goals(G,LGs) :- + % SICStus compatible step, + % just try to simplify store by projecting constraints + % over query variables. + ( + current_predicate(attributes:modules_with_attributes/1), false + -> + attributes:all_attvars(LAV), + LAV = [_|_], + !, + project_attributes(LAV, G), + % now get a list of frozen goals. + attributes:all_attvars(NLAV) + ; + attributed(G, NLAV), + NLAV = [_|_] + ), + !, + get_goalist_from_attvars(NLAV, LGs). +project_delayed_goals(_,[]). + + +attributed(G, Vs) :- + term_variables(G, LAV), + att_vars(LAV, Vs). + +att_vars([], []). +att_vars([V|LGs], [V|AttVars]) :- attvar(V), !, + att_vars(LGs, AttVars). +att_vars([_|LGs], AttVars) :- + att_vars(LGs, AttVars). + +% make sure we set the suspended goal list to its previous state! +% 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), + term_variables(G, InputVs), + pick_att_vars(InputVs, AttIVs), + project_module(LMods, AttIVs, AllVs). + +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) :- + '$pred_exists'(project_attributes(LIV, LAV),Mod), + '$notrace'(Mod:project_attributes(LIV, LAV)), !, + attributes:all_attvars(NLAV), + project_module(LMods,LIV,NLAV). +project_module([_|LMods], LIV, LAV) :- + project_module(LMods,LIV,LAV). + +% 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). + +% +% same, but generate list +% +get_goalist_from_attvars(TVars, GoalList) :- + get_goalist_from_attvars(TVars, GoalList, []). + +get_goalist_from_attvars([]) --> []. +get_goalist_from_attvars([V|TVars]) --> + get_goalist_from_attvar(V), + get_goalist_from_attvars(TVars). + +get_goalist_from_attvar(V) --> { attvar(V) }, !, + { attributes:get_all_atts(V, AllAtts) }, + all_atts_to_goals(AllAtts, V). +get_goalist_from_attvar(_) --> []. + +all_atts_to_goals(AllAtts, _) --> { var(AllAtts) }, !. +all_atts_to_goals(AllAtts, V) --> + { + functor(AllAtts, Mod, _), + arg(1, AllAtts, MoreAtts) + }, + attgoals_for_module(Mod, V, AllAtts), + all_atts_to_goals(MoreAtts, V). + +% +% check constraints for variable +% +attgoals_for_module(Mod, V, _Gs, GoalListF, GoalList0) :- + % SWI, HProlog + '$pred_exists'(attribute_goals(V,GoalListF,GoalList0), Mod), !, + ( + '$notrace'(Mod:attribute_goals(V,GoalListF,GoalList0)) + -> + true + ; + GoalListF = GoalList0 + ). +attgoals_for_module(Mod, V, _, GoalListF, GoalList0) :- + % SICStus + '$pred_exists'(attribute_goal(V,G),Mod), !, + ( + '$notrace'(Mod:attribute_goal(V,G)) + -> + GoalListF = [G|GoalList0] + ; + GoalListF = GoalList0 + ). +attgoals_for_module(Mod, V, _, GoalList, GoalList). + +list_to_conjunction([], true). +list_to_conjunction([G], G) :- !. +list_to_conjunction([G|GoalList], (G,Goals0)) :- + list_to_conjunction(GoalList, Goals0). + diff --git a/pl/boot.yap b/pl/boot.yap index 96c0aa5aa..209d14973 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -567,7 +567,7 @@ true :- true. \+ '$undefined'(bindings_message(_,_,_), swi), swi:bindings_message(V, LGs, []), !. '$output_frozen'(G,V,LGs) :- - '$project_and_delayed_goals'(G,LGs). + '$attributes':project_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 0681d31f9..8fd3c7be3 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -16,152 +16,69 @@ *************************************************************************/ -%:- module(coroutining,[ -%dif/2, -%when/2, -%block/1, -%wait/1, -%frozen/2 -%]). + %dif/2, + %when/2, + %block/1, + %wait/1, + %frozen/2 +:- module('$coroutining',[]). + + +attr_unify_hook(DelayList, _) :- + wake_delays(DelayList). + +wake_delays([]). +wake_delays(Delay.List) :- + wake_delay(Delay), + wake_delays(List). % +% Interface to attributed variables. +% +wake_delay(redo_dif(Done, X, Y)) :- + redo_dif(Done, X, Y). +wake_delay(redo_freeze(Done, V, Goal)) :- + redo_freeze(Done, V, Goal). +wake_delay(redo_eq(Done, X, Y, Goal)) :- + redo_eq(Done, X, Y, Goal, G). +wake_delay(redo_ground(Done, X, Goal)) :- + redo_ground(Done, X, Goal). + +attribute_goals(Var) --> + { get_attr(Var, '$coroutining', Delays) }, + attgoal_for_delays(Delays, Var). + +attgoal_for_delays([], V) --> []. +attgoal_for_delays([G|AllAtts], V) --> + attgoal_for_delay(G, V), + attgoal_for_delays(AllAtts, V). + +attgoal_for_delay(redo_dif(Done, X, Y), V) --> { var(Done), first_att(dif(X,Y), V) }, !, [prolog:dif(X,Y)]. +attgoal_for_delay(redo_freeze(Done, V, Goal), V) --> { var(Done) }, !, [prolog:freeze(V,Goal)]. +attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) --> { var(Done), first_att(Goal, V) }, !, [prolog:when(X=Y,Goal)]. +attgoal_for_delay(redo_ground(Done, X, Goal), V) --> { var(Done) }, !, [prolog:when(ground(X),Goal)]. +attgoal_for_delay(_, V) --> []. + + % % operators defined in this module: % :- op(1150, fx, block). -% -% Tell the system how to present frozen goals. -% - -:- assert((extensions_to_present_answer(Level) :- - '$show_frozen_goals'(Level))). - -'$project_and_delayed_goals'(G,LGs) :- - '$attributed'(G, LAV), -% attributes:all_attvars(LAV), - LAV = [_|_], !, - % 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. - '$attributed'(G, NLAV), -% attributes:all_attvars(NLAV), - '$get_goalist_from_attvars'(NLAV, LGs). -'$project_and_delayed_goals'(_,[]). - - -'$attributed'(G, Vs) :- - term_variables(G, LAV), - '$find_att_vars'(LAV, Vs). - -'$check_atts'([], []). -'$check_atts'(V.LAV, V.Vs) :- - attvar(V), !, - '$check_atts'(LAV, Vs). -'$check_atts'(_.LAV, Vs) :- - '$check_atts'(LAV, Vs). - - -% -% wake_up_goal is called by the system whenever a suspended goal -% resumes. -% - -/* The first case may happen if this variable was used for dif. - In this case, we need a way to keep the original - suspended goal around -*/ -%'$wake_up_goal'([Module1|Continuation],G) :- -% '$write'(4,vsc_woke:G+[Module1|Continuation]:' -%'), fail. -'$wake_up_goal'([Module1|Continuation], LG) :- -%write(waking:LG),nl, - '$execute_woken_system_goals'(LG), - '$do_continuation'(Continuation, Module1). - - -% -% in the first two cases restore register immediately and proceed -% to continuation. In the last case take care with modules, but do -% not act as if a meta-call. -% -% -'$do_continuation'('$cut_by'(X), _) :- !, - '$$cut_by'(X). -'$do_continuation'('$restore_regs'(X), _) :- !, - '$restore_regs'(X). -'$do_continuation'('$restore_regs'(X,Y), _) :- !, - '$restore_regs'(X,Y). -'$do_continuation'(Continuation, Module1) :- - '$execute_continuation'(Continuation,Module1). - -'$execute_continuation'(Continuation, Module1) :- - '$undefined'(Continuation, Module1), !, - '$undefp'([Module1|Continuation]). -'$execute_continuation'(Continuation, Mod) :- - % do not do meta-expansion nor any fancy stuff. - '$execute0'(Continuation, Mod). - - -'$execute_woken_system_goals'([]). -'$execute_woken_system_goals'([G|LG]) :- - '$execute_woken_system_goals'(LG), - '$execute_woken_system_goal'(G). - -% -% X surely was bound, otherwise we would not be awaken. -% -'$execute_woken_system_goal'('$att_do'(V,New)) :- - ( '$frozen_goals'(V, Goals) -> - '$call_atts'(V,New), - '$execute_frozen_goals'(Goals) - ; - '$call_atts'(V,New) - ). - -'$call_atts'(V,_) :- - nonvar(V), !. -'$call_atts'(V,_) :- - '$undefined'(woken_att_do(_,_), attributes), !, - attributes:bind_attvar(V). -'$call_atts'(V,_) :- - '$att_bound'(V), !. -'$call_atts'(V,New) :- - attributes:woken_att_do(V,New). - -'$execute_frozen_goals'([]). -'$execute_frozen_goals'([G0|Gs]) :- - '$execute_frozen_goal'(G0,G0), - '$execute_frozen_goals'(Gs). - -% -% X and Y may not be bound (multiple suspensions on the same goal). -% -'$execute_frozen_goal'('$redo_dif'(Done, X, Y), G) :- - '$redo_dif'(Done, X, Y, G). -'$execute_frozen_goal'('$redo_freeze'(Done, V, Goal), _) :- - '$redo_freeze'(Done, V, Goal). -'$execute_frozen_goal'('$redo_eq'(Done, X, Y, Goal), G) :- - '$redo_eq'(Done, X, Y, Goal, G). -'$execute_frozen_goal'('$redo_ground'(Done, X, Goal), _) :- - '$redo_ground'(Done, X, Goal). - -freeze(V, G) :- +prolog:freeze(V, G) :- var(V), !, - '$freeze_goal'(V,G). -freeze(_, G) :- + freeze_goal(V,G). +prolog:freeze(_, G) :- '$execute'(G). -'$freeze_goal'(V,VG) :- +freeze_goal(V,VG) :- var(VG), !, '$current_module'(M), - '$freeze'(V, '$redo_freeze'(_Done,V,M:VG)). -'$freeze_goal'(V,M:G) :- !, - '$freeze'(V, '$redo_freeze'(_Done,V,M:G)). -'$freeze_goal'(V,G) :- + internal_freeze(V, redo_freeze(_Done,V,M:VG)). +freeze_goal(V,M:G) :- !, + internal_freeze(V, redo_freeze(_Done,V,M:G)). +freeze_goal(V,G) :- '$current_module'(M), - '$freeze'(V, '$redo_freeze'(_Done,V,M:G)). + internal_freeze(V, redo_freeze(_Done,V,M:G)). % % @@ -199,16 +116,17 @@ freeze(_, G) :- % several times. dif calls a special version of freeze that checks % whether that is in fact the case. % -dif(X, Y) :- '$can_unify'(X, Y, LVars), !, +prolog:dif(X, Y) :- + '$can_unify'(X, Y, LVars), !, LVars = [_|_], - '$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)). -dif(_, _). + dif_suspend_on_lvars(LVars, redo_dif(_Done, X, Y)). +prolog:dif(_, _). -'$dif_suspend_on_lvars'([], _). -'$dif_suspend_on_lvars'([H|T], G) :- - '$freeze'(H, G), - '$dif_suspend_on_lvars'(T, G). +dif_suspend_on_lvars([], _). +dif_suspend_on_lvars([H|T], G) :- + internal_freeze(H, G), + dif_suspend_on_lvars(T, G). % % This predicate is called whenever a variable dif was suspended on is @@ -219,72 +137,72 @@ dif(_, _). % we try to increase the number of suspensions; last, the two terms % did not unify, we are done, so we succeed and bind the Done variable. % -'$redo_dif'(Done, _, _, _) :- nonvar(Done), !. -'$redo_dif'(_, X, Y, G) :- +redo_dif(Done, _, _) :- nonvar(Done), !. +redo_dif(Done, X, Y) :- '$can_unify'(X, Y, LVars), !, LVars = [_|_], - '$dif_suspend_on_lvars'(LVars, G). -'$redo_dif'('$done', _, _, _). + dif_suspend_on_lvars(LVars, redo_dif(Done, X, Y)). +redo_dif('$done', _, _). % If you called nonvar as condition for when, then you may find yourself % here. % % someone else (that is Cond had ;) did the work, do nothing % -'$redo_freeze'(Done, _, _) :- nonvar(Done), !. +redo_freeze(Done, _, _) :- nonvar(Done), !. % % We still have some more conditions: continue the analysis. % -'$redo_freeze'(Done, _, '$when'(C, G, Done)) :- !, +redo_freeze(Done, _, '$when'(C, G, Done)) :- !, '$when'(C, G, Done). % % check if the variable was really bound % -'$redo_freeze'(Done, V, G) :- var(V), !, - '$freeze'(V, '$redo_freeze'(Done,V,G)). +redo_freeze(Done, V, G) :- var(V), !, + internal_freeze(V, redo_freeze(Done,V,G)). % % I can't believe it: we're done and can actually execute our % goal. Notice we have to say we are done, otherwise someone else in % the disjunction might decide to wake up the goal themselves. % -'$redo_freeze'('$done', _, G) :- +redo_freeze('$done', _, G) :- '$execute'(G). % % eq is a combination of dif and freeze -'$redo_eq'(Done, _, _, _, _) :- nonvar(Done), !. -'$redo_eq'(_, X, Y, _, G) :- +redo_eq(Done, _, _, _, _) :- nonvar(Done), !. +redo_eq(_, X, Y, _, G) :- '$can_unify'(X, Y, LVars), LVars = [_|_], !, - '$dif_suspend_on_lvars'(LVars, G). -'$redo_eq'(Done, _, _, '$when'(C, G, Done), _) :- !, - '$when'(C, G, Done). -'$redo_eq'('$done', _ ,_ , Goal, _) :- + dif_suspend_on_lvars(LVars, G). +redo_eq(Done, _, _, when(C, G, Done), _) :- !, + when(C, G, Done). +redo_eq('$done', _ ,_ , Goal, _) :- '$execute'(Goal). % % ground is similar to freeze -'$redo_ground'(Done, _, _) :- nonvar(Done), !. -'$redo_ground'(Done, X, Goal) :- +redo_ground(Done, _, _) :- nonvar(Done), !. +redo_ground(Done, X, Goal) :- '$non_ground'(X, Var), !, - '$freeze'(Var, '$redo_ground'(Done, X, Goal)). -'$redo_ground'(Done, _, '$when'(C, G, Done)) :- !, - '$when'(C, G, Done). -'$redo_ground'('$done', _, Goal) :- + internal_freeze(Var, redo_ground(Done, X, Goal)). +redo_ground(Done, _, when(C, G, Done)) :- !, + when(C, G, Done). +redo_ground('$done', _, Goal) :- '$execute'(Goal). % % support for when/2 built-in % -when(Conds,Goal) :- +prolog:when(Conds,Goal) :- '$current_module'(Mod), - '$prepare_goal_for_when'(Goal, Mod, ModG), - '$when'(Conds, ModG, Done, [], LG), !, + prepare_goal_for_when(Goal, Mod, ModG), + when(Conds, ModG, Done, [], LG), !, %write(vsc:freezing(LG,Done)),nl, - '$suspend_when_goals'(LG, Done). -when(_,Goal) :- + suspend_when_goals(LG, Done). +prolog:when(_,Goal) :- '$execute'(Goal). % @@ -296,7 +214,7 @@ when(_,Goal) :- % % '$declare_when'(Cond, G) :- - '$generate_code_for_when'(Cond, G, Code), + generate_code_for_when(Cond, G, Code), '$current_module'(Module), '$$compile'(Code, Code, 5, Module), fail. '$declare_when'(_,_). @@ -304,19 +222,19 @@ when(_,Goal) :- % % use a meta interpreter for now % -'$generate_code_for_when'(Conds, G, - ( G :- '$when'(Conds, ModG, Done, [], LG), !, - '$suspend_when_goals'(LG, Done)) ) :- +generate_code_for_when(Conds, G, + ( G :- when(Conds, ModG, Done, [], LG), !, + suspend_when_goals(LG, Done)) ) :- '$current_module'(Mod), - '$prepare_goal_for_when'(G, Mod, ModG). + prepare_goal_for_when(G, Mod, ModG). % % make sure we have module info for G! % -'$prepare_goal_for_when'(G, Mod, Mod:call(G)) :- var(G), !. -'$prepare_goal_for_when'(M:G, _, M:G) :- !. -'$prepare_goal_for_when'(G, Mod, Mod:G). +prepare_goal_for_when(G, Mod, Mod:call(G)) :- var(G), !. +prepare_goal_for_when(M:G, _, M:G) :- !. +prepare_goal_for_when(G, Mod, Mod:G). % @@ -329,39 +247,39 @@ when(_,Goal) :- % $when/5 and $when_suspend succeds when there is need to suspend a goal % % -'$when'(V, G, Done, LG0, LGF) :- var(V), !, +when(V, G, Done, LG0, LGF) :- var(V), !, '$do_error'(instantiation_error,when(V,G)). -'$when'(nonvar(V), G, Done, LG0, LGF) :- - '$when_suspend'(nonvar(V), G, Done, LG0, LGF). -'$when'(?=(X,Y), G, Done, LG0, LGF) :- - '$when_suspend'(?=(X,Y), G, Done, LG0, LGF). -'$when'(ground(T), G, Done, LG0, LGF) :- - '$when_suspend'(ground(T), G, Done, LG0, LGF). -'$when'((C1, C2), G, Done, LG0, LGF) :- +when(nonvar(V), G, Done, LG0, LGF) :- + when_suspend(nonvar(V), G, Done, LG0, LGF). +when(?=(X,Y), G, Done, LG0, LGF) :- + when_suspend(?=(X,Y), G, Done, LG0, LGF). +when(ground(T), G, Done, LG0, LGF) :- + when_suspend(ground(T), G, Done, LG0, LGF). +when((C1, C2), G, Done, LG0, LGF) :- % leave it open to continue with when. ( - '$when'(C1, '$when'(C2, G, Done), Done, LG0, LGI) + when(C1, when(C2, G, Done), Done, LG0, LGI) -> LGI = LGF ; % we solved C1, great, now we just have to solve C2! - '$when'(C2, G, Done, LG0, LGF) + when(C2, G, Done, LG0, LGF) ). -'$when'((G1 ; G2), G, Done, LG0, LGF) :- - '$when'(G1, G, Done, LG0, LGI), - '$when'(G2, G, Done, LGI, LGF). +when((G1 ; G2), G, Done, LG0, LGF) :- + when(G1, G, Done, LG0, LGI), + when(G2, G, Done, LGI, LGF). % % Auxiliary predicate called from within a conjunction. % Repeat basic code for when, as inserted in first clause for predicate. % -'$when'(_, _, Done) :- +when(_, _, Done) :- nonvar(Done), !. -'$when'(Cond, G, Done) :- - '$when'(Cond, G, Done, [], LG), +when(Cond, G, Done) :- + when(Cond, G, Done, [], LG), !, - '$suspend_when_goals'(LG, Done). -'$when'(_, G, '$done') :- + suspend_when_goals(LG, Done). +when(_, G, '$done') :- '$execute'(G). % @@ -369,47 +287,47 @@ when(_,Goal) :- % % some one else did the work. % -'$when_suspend'(_, _, Done, _, []) :- nonvar(Done), !. +when_suspend(_, _, Done, _, []) :- nonvar(Done), !. % % now for the serious stuff. % -'$when_suspend'(nonvar(V), G, Done, LG0, LGF) :- - '$try_freeze'(V, G, Done, LG0, LGF). -'$when_suspend'(?=(X,Y), G, Done, LG0, LGF) :- - '$try_eq'(X, Y, G, Done, LG0, LGF). -'$when_suspend'(ground(X), G, Done, LG0, LGF) :- - '$try_ground'(X, G, Done, LG0, LGF). +when_suspend(nonvar(V), G, Done, LG0, LGF) :- + try_freeze(V, G, Done, LG0, LGF). +when_suspend(?=(X,Y), G, Done, LG0, LGF) :- + try_eq(X, Y, G, Done, LG0, LGF). +when_suspend(ground(X), G, Done, LG0, LGF) :- + try_ground(X, G, Done, LG0, LGF). -'$try_freeze'(V, G, Done, LG0, LGF) :- +try_freeze(V, G, Done, LG0, LGF) :- var(V), - LGF = ['$freeze'(V, '$redo_freeze'(Done, V, G))|LG0]. + LGF = ['$coroutining':internal_freeze(V, redo_freeze(Done, V, G))|LG0]. -'$try_eq'(X, Y, G, Done, LG0, LGF) :- +try_eq(X, Y, G, Done, LG0, LGF) :- '$can_unify'(X, Y, LVars), LVars = [_|_], - LGF = ['$dif_suspend_on_lvars'(LVars, '$redo_eq'(Done, X, Y, G))|LG0]. + LGF = ['$coroutining':dif_suspend_on_lvars(LVars, redo_eq(Done, X, Y, G))|LG0]. -'$try_ground'(X, G, Done, LG0, LGF) :- +try_ground(X, G, Done, LG0, LGF) :- '$non_ground'(X, Var), % the C predicate that succeds if % finding out the term is nonground % and gives the first variable it % finds. Notice that this predicate % must know about svars. - LGF = ['$freeze'(Var, '$redo_ground'(Done, X, G))| LG0]. + LGF = ['$coroutining':internal_freeze(Var, redo_ground(Done, X, G))| LG0]. % % When executing a when, if nobody succeeded, we need to create suspensions. % -'$suspend_when_goals'([], _). -'$suspend_when_goals'(['$freeze'(V, G)|Ls], Done) :- +suspend_when_goals([], _). +suspend_when_goals(['$coroutining':internal_freeze(V, G)|Ls], Done) :- var(Done), !, - '$freeze'(V, G), - '$suspend_when_goals'(Ls, Done). -'$suspend_when_goals'(['$dif_suspend_on_lvars'(LVars, G)|LG], Done) :- + internal_freeze(V, G), + suspend_when_goals(Ls, Done). +suspend_when_goals([dif_suspend_on_lvars(LVars, G)|LG], Done) :- var(Done), !, - '$dif_suspend_on_lvars'(LVars, G), - '$suspend_when_goals'(LG, Done). -'$suspend_when_goals'([_|_], _). + dif_suspend_on_lvars(LVars, G), + suspend_when_goals(LG, Done). +suspend_when_goals([_|_], _). % % Support for wait declarations on goals. @@ -424,31 +342,31 @@ when(_,Goal) :- % choicepoint and make things a bit slower, but it's probably not as % significant as the remaining overheads. % -'$block'(Conds) :- - '$generate_blocking_code'(Conds, _, Code), +prolog:'$block'(Conds) :- + generate_blocking_code(Conds, _, Code), '$current_module'(Module), '$$compile'(Code, Code, 5, Module), fail. -'$block'(_). +prolog:'$block'(_). -'$generate_blocking_code'(Conds, G, Code) :- +generate_blocking_code(Conds, G, Code) :- '$extract_head_for_block'(Conds, G), '$recorded'('$blocking_code','$code'(G,OldConds),R), !, erase(R), functor(G, Na, Ar), '$current_module'(M), abolish(M:Na, Ar), - '$generate_blocking_code'((Conds,OldConds), G, Code). -'$generate_blocking_code'(Conds, G, (G :- (If, !, when(When, G)))) :- - '$extract_head_for_block'(Conds, G), + generate_blocking_code((Conds,OldConds), G, Code). +generate_blocking_code(Conds, G, (G :- (If, !, when(When, G)))) :- + extract_head_for_block(Conds, G), recorda('$blocking_code','$code'(G,Conds),_), - '$generate_body_for_block'(Conds, G, If, When). + generate_body_for_block(Conds, G, If, When). % % find out what we are blocking on. % -'$extract_head_for_block'((C1, _), G) :- !, - '$extract_head_for_block'(C1, G). -'$extract_head_for_block'(C, G) :- +extract_head_for_block((C1, _), G) :- !, + extract_head_for_block(C1, G). +extract_head_for_block(C, G) :- functor(C, Na, Ar), functor(G, Na, Ar). @@ -472,323 +390,73 @@ when(_,Goal) :- % (var(A1), var(A2) -> true ; (var(A2), var(A3) -> true ; fail)), !, % when(((nonvar(A1);nonvar(A2)),(nonvar(A2);nonvar(A3))),G). -'$generate_body_for_block'((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !, - '$generate_for_cond_in_block'(C1, G, Code1, WhenConds), - '$generate_body_for_block'(C2, G, Code2, OtherWhenConds). -'$generate_body_for_block'(C, G, (Code -> true ; fail), WhenConds) :- - '$generate_for_cond_in_block'(C, G, Code, WhenConds). +generate_body_for_block((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !, + generate_for_cond_in_block(C1, G, Code1, WhenConds), + generate_body_for_block(C2, G, Code2, OtherWhenConds). +generate_body_for_block(C, G, (Code -> true ; fail), WhenConds) :- + generate_for_cond_in_block(C, G, Code, WhenConds). -'$generate_for_cond_in_block'(C, G, Code, Whens) :- +generate_for_cond_in_block(C, G, Code, Whens) :- C =.. [_|Args], G =.. [_|GArgs], - '$fetch_out_variables_for_block'(Args,GArgs,L0Vars), - '$add_blocking_vars'(L0Vars, LVars), - '$generate_for_each_arg_in_block'(LVars, Code, Whens). + fetch_out_variables_for_block(Args,GArgs,L0Vars), + add_blocking_vars(L0Vars, LVars), + generate_for_each_arg_in_block(LVars, Code, Whens). -'$add_blocking_vars'([], [_]) :- !. -'$add_blocking_vars'(LV, LV). +add_blocking_vars([], [_]) :- !. +add_blocking_vars(LV, LV). -'$fetch_out_variables_for_block'([], [], []). -'$fetch_out_variables_for_block'(['?'|Args], [_|GArgs], LV) :- - '$fetch_out_variables_for_block'(Args, GArgs, LV). -'$fetch_out_variables_for_block'(['-'|Args], [GArg|GArgs], +fetch_out_variables_for_block([], [], []). +fetch_out_variables_for_block(['?'|Args], [_|GArgs], LV) :- + fetch_out_variables_for_block(Args, GArgs, LV). +fetch_out_variables_for_block(['-'|Args], [GArg|GArgs], [GArg|LV]) :- - '$fetch_out_variables_for_block'(Args, GArgs, LV). + fetch_out_variables_for_block(Args, GArgs, LV). -'$generate_for_each_arg_in_block'([], false, true). -'$generate_for_each_arg_in_block'([V], var(V), nonvar(V)) :- !. -'$generate_for_each_arg_in_block'([V|L], (var(V),If), (nonvar(V);Whens)) :- - '$generate_for_each_arg_in_block'(L, If, Whens). +generate_for_each_arg_in_block([], false, true). +generate_for_each_arg_in_block([V], var(V), nonvar(V)) :- !. +generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :- + generate_for_each_arg_in_block(L, If, Whens). % % The wait declaration is a simpler and more efficient version of block. % -'$wait'(Na/Ar) :- +prolog:'$wait'(Na/Ar) :- functor(S, Na, Ar), arg(1, S, A), '$current_module'(M), '$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail. -'$wait'(_). +prolog:'$wait'(_). frozen(V, G) :- nonvar(V), !, '$do_error'(type_error(variable,V),frozen(V,G)). frozen(V, LG) :- - '$get_conj_from_attvars'([V], LG). + '$attributes':get_conj_from_attvars([V], LG). -'$find_att_vars'([], []). -'$find_att_vars'([V|LGs], [V|AttVars]) :- attvar(V), !, - '$find_att_vars'(LGs, AttVars). -'$find_att_vars'([_|LGs], AttVars) :- - '$find_att_vars'(LGs, AttVars). - -'$purge_done_goals'([], []). -'$purge_done_goals'([V|G0], GF) :- attvar(V), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_dif'(Done, _ , _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_freeze'(Done, _, _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_freeze'(_Done, _, CallCleanup)|G0], GF) :- - nonvar(CallCleanup), - % be careful about possibly adding extra binding at this point. - CallCleanup = _:T, nonvar(T), T = '$clean_call'(_,_), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_eq'(Done, _, _, _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_ground'(Done, _, _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'([G|G0], [G|GF]) :- - '$purge_done_goals'(G0, GF). - - -'$convert_frozen_goal'(V, _, _, V, _) :- attvar(V), !. -'$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)). -'$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G). -'$convert_frozen_goal'('$redo_eq'(Done, X, Y, G), LV, Done, [X,Y|LV], G). -'$convert_frozen_goal'('$redo_ground'(Done, V, G), LV, Done, [V|LV], G). - -'$fetch_same_done_goals'([], _, [], []). -'$fetch_same_done_goals'([V|G0], Done, NL, GF) :- attvar(V), !, - '$fetch_same_done_goals'(G0, Done, NL, GF). -'$fetch_same_done_goals'(['$redo_dif'(Done, X , Y)|G0], D0, [X,Y|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'(['$redo_freeze'(Done, V, _)|G0], D0, [V|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'(['$redo_eq'(Done, X, Y, _)|G0], D0, [X,Y|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'(['$redo_ground'(Done, G, _)|G0], D0, [G|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'([G|G0], D0, LV, [G|GF]) :- - '$fetch_same_done_goals'(G0, D0, LV, GF). - - -call_residue_vars(Goal,Residue) :- - attributes:all_attvars(Vs0), - call(Goal), - attributes:all_attvars(Vs), - % this should not be actually strictly necessary right now. - % but it makes it a safe bet. - sort(Vs, Vss), - sort(Vs0, Vs0s), - '$ord_remove'(Vss, Vs0s, Residue). - -'$ord_remove'([], _, []). -'$ord_remove'([V|Vs], [], [V|Vs]). -'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :- - ( V1 == V2 -> - '$ord_remove'(Vss, Vs0s, Residue) - ; - V1 @< V2 -> - Residue = [V1|ResidueF], - '$ord_remove'(Vss, [V2|Vs0s], ResidueF) - ; - '$ord_remove'([V1|Vss], Vs0s, Residue) - ). - -copy_term(Term, Copy, Goals) :- - term_variables(Term, TVars), - '$get_goalist_from_attvars'(TVars, Goals0), - copy_term_nat([Term|Goals0], [Copy|Goals]). - -call_residue(Goal,Residue) :- - var(Goal), !, - '$do_error'(instantiation_error,call_residue(Goal,Residue)). -call_residue(Module:Goal,Residue) :- - atom(Module), !, - '$call_residue'(Goal,Module,Residue). -call_residue(Goal,Residue) :- - '$current_module'(Module), - '$call_residue'(Goal,Module,Residue). - -'$call_residue'(Goal,Module,Residue) :- - '$read_svar_list'(OldAttsList), - copy_term_nat(Goal, NGoal), - ( '$set_svar_list'(CurrentAttsList), - '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)), - '$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). - -% 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), - term_variables(G, InputVs), - '$pick_att_vars'(InputVs, AttIVs), - '$project_module'(LMods, AttIVs, AllVs). - -'$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) :- - '$pred_exists'(project_attributes(LIV, LAV),Mod), - '$notrace'(Mod:project_attributes(LIV, LAV)), !, - attributes:all_attvars(NLAV), - '$project_module'(LMods,LIV,NLAV). -'$project_module'([_|LMods], LIV, LAV) :- - '$project_module'(LMods,LIV,LAV). - - -'$convert_att_vars'(_, []) :- - % do nothing - '$undefined'(convert_att_var(Vs,LIV),attributes), !. -'$convert_att_vars'(Vs0, LGs) :- - '$sort'(Vs0, Vs), - '$do_convert_att_vars'(Vs0, LGs). - -'$do_convert_att_vars'([],[]). -'$do_convert_att_vars'([V|LAV], NGs) :- - attvar(V), - attributes:convert_att_var(V,G), - G \= true, - !, - '$split_goals_for_catv'(G,V,NGs,IGs), - '$do_convert_att_vars'(LAV, IGs). -'$do_convert_att_vars'([_|LAV], Gs) :- - '$do_convert_att_vars'(LAV, Gs). - -'$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !, - '$split_goals_for_catv'(NG,V,Gs,Gs0). -'$split_goals_for_catv'(NG,V,[V-NG|Gs],Gs). - -'$vars_interset_for_constr'([V1|_],[V2|_]) :- - V1 == V2, !. -'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :- - V1 @< V2, !, - '$vars_interset_for_constr'(GV,[V2|LIV]). -'$vars_interset_for_constr'([V1|GV],[_|LIV]) :- - '$vars_interset_for_constr'([V1|GV],LIV). - -'$process_when'('$when'(_,G,_), NG) :- !, - '$process_when'(G, NG). -'$process_when'(G, G). - -%'$freeze'(V,G) :- +%internal_freeze(V,G) :- % attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail. -'$freeze'(V,G) :- - '$update_att'(V, G). +internal_freeze(V,G) :- + update_att(V, G). -'$update_att'(V, G) :- - 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])). +update_att(V, G) :- + attributes:get_module_atts(V, '$coroutining'(_,Gs)), + not_vmember(G, Gs), !, + attributes:put_module_atts(V, '$coroutining'(_,[G|Gs])). +update_att(V, G) :- + attributes:put_module_atts(V, '$coroutining'(_,[G])). -'$goal_in'(G,[G1|_]) :- G == G1, !. -'$goal_in'(G,[_|Gs]) :- - '$goal_in'(G,Gs). -'$frozen_goals'(V,Gs) :- - var(V), - attributes:get_att(V, prolog, 2, Gs), nonvar(Gs). - -% -% 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). - -% -% same, but generate list -% -'$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). - -% -% check constraints for variable -% -'$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'(_, _, _:'$clean_call'(_,_)), _, _) :- !, fail. -'$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]) :- +not_vmember(_, []). +not_vmember(V, [V1|DonesSoFar]) :- V \== V1, - '$not_vmember'(V, DonesSoFar). + not_vmember(V, DonesSoFar). + +first_att(T, V) :- + term_variables(T, Vs), + check_first_attvar(Vs, V). + +check_first_attvar(V.Vs, V0) :- attvar(V), !, V == V0. +check_first_attvar(_.Vs, V0) :- + check_first_attvar(Vs, V0). -'$list_to_conjunction'([], true). -'$list_to_conjunction'([G], G) :- !. -'$list_to_conjunction'([G|GoalList], (G,Goals0)) :- - '$list_to_conjunction'(GoalList, Goals0). diff --git a/pl/init.yap b/pl/init.yap index c473c61f3..88f3fe32a 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -83,7 +83,6 @@ lists:append([H|T], L, [H|R]) :- 'eam.yap', 'chtypes.yap', 'yapor.yap', - 'attributes.yap', 'udi.yap']. :- dynamic prolog:'$user_defined_flag'/4. @@ -126,14 +125,17 @@ system_mode(verbose,off) :- set_value('$verbose',off). :- dynamic 'extensions_to_present_answer'/1. -:- ['corout.yap', - 'arrays.yap']. +:- ['arrays.yap']. :- use_module('messages.yap'). :- use_module('hacks.yap'). +:- use_module('attributes.yap'). +:- use_module('corout.yap'). '$system_module'('$messages'). '$system_module'('$hacks'). +'$system_module'('$attributes'). +'$system_module'('$coroutining'). yap_hacks:cut_by(CP) :- '$$cut_by'(CP).