|
|
|
|
@ -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).
|
|
|
|
|
|
Vitor Santos Costa