This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/corout.yap
Vitor Santos Costa b41986ee3c documentation.
2018-10-15 13:47:36 +01:00

580 lines
16 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: corout.pl *
* Last rev: *
* mods: *
* comments: Coroutines implementation *
* *
*************************************************************************/
/**
* @file corout.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Mon Nov 16 22:47:27 2015
* *
*/
:- module('$coroutining',[
op(1150, fx, block)
%dif/2,
%when/2,
%block/1,
%wait/1,
%frozen/2
]).
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( attributes, [get_module_atts/2,
put_module_atts/2]).
/**
* @addtogroup AttributedVariables_Builtins
* @{
*
*
*/
/** @pred attr_unify_hook(+ _AttValue_,+ _VarValue_)
Hook that must be defined in the module an attributed variable refers
to. Is is called <em>after</em> the attributed variable has been
unified with a non-var term, possibly another attributed variable.
_AttValue_ is the attribute that was associated to the variable
in this module and _VarValue_ is the new value of the variable.
Normally this predicate fails to veto binding the variable to
_VarValue_, forcing backtracking to undo the binding. If
_VarValue_ is another attributed variable the hook often combines
the two attribute and associates the combined attribute with
_VarValue_ using put_attr/3.
*/
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) }, !,
{ remove_when_declarations(Goal, NoWGoal) },
[ prolog:freeze(V,NoWGoal) ].
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) --> [].
remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !,
remove_when_declarations(Goal, NoWGoal).
remove_when_declarations(Goal, Goal).
%
% operators defined in this module:
%
/**
@pred freeze(? _X_,: _G_)
Delay execution of goal _G_ until the variable _X_ is bound.
*/
prolog:freeze(V, G) :-
var(V), !,
freeze_goal(V,G).
prolog:freeze(_, G) :-
'$execute'(G).
freeze_goal(V,VG) :-
var(VG), !,
'$current_module'(M),
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),
internal_freeze(V, redo_freeze(_Done,V,M:G)).
/** @pred dif( _X_, _Y_)
Succeed if the two arguments do not unify. A call to dif/2 will
suspend if unification may still succeed or fail, and will fail if they
always unify.
Dif is tricky because we need to wake up on the two variables being
bound together, or on any variable of the term being bound to
another. Also, the day YAP fully supports infinite rational trees,
dif should work for them too. Hence, term comparison should not be
implemented in Prolog.
This is the way dif works. The '$can_unify' predicate does not know
anything about dif semantics, it just compares two terms for
equaility and is based on compare. If it succeeds without generating
a list of variables, the terms are equal and dif fails. If it fails,
dif succeeds.
If it succeeds but it creates a list of variables, dif creates
suspension records for all these variables on the '$redo_dif'(V,
X, Y) goal. V is a flag that says whether dif has completed or not,
X and Y are the original goals. Whenever one of these variables is
bound, it calls '$redo_dif' again. '$redo_dif' will then check whether V
was bound. If it was, dif has succeeded and redo_dif just
exits. Otherwise, '$redo_dif' will call dif again to see what happened.
Dif needs two extensions from the suspension engine:
First, it needs
for the engine to be careful when binding two suspended
variables. Basically, in this case the engine must be sure to wake
up one of the goals, as they may make dif fail. The way the engine
does so is by searching the list of suspended variables, and search
whether they share a common suspended goal. If they do, that
suspended goal is added to the WokenList.
Second, thanks to dif we may try to suspend on the same variable
several times. dif calls a special version of freeze that checks
whether that is in fact the case.
*/
prolog:dif(X, Y) :-
'$can_unify'(X, Y, LVars), !,
LVars = [_|_],
dif_suspend_on_lvars(LVars, redo_dif(_Done, X, Y)).
prolog:dif(_, _).
dif_suspend_on_lvars([], _).
dif_suspend_on_lvars([H|T], G) :-
internal_freeze(H, G),
dif_suspend_on_lvars(T, G).
%% @pred redo_dif(_Done_, _X_, _Y_)
%
% This predicate is called whenever a variable dif was suspended on is
% bound. Note that dif may have already executed successfully.
%
% Three possible cases: dif has executed and Done is bound; we redo
% dif and the two terms either unify, hence we fail, or may unify, and
% 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(Done, X, Y) :-
'$can_unify'(X, Y, LVars), !,
LVars = [_|_],
dif_suspend_on_lvars(LVars, redo_dif(Done, X, Y)).
redo_dif('$done', _, _).
redo_freeze(Done, V, G0) :-
% 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
%
(nonvar(Done) -> true ;
%
% We still have some more conditions: continue the analysis.
%
G0 = when(C, G, Done) -> when(C, G, Done) ;
%
% check if the variable was really bound
%
var(V) -> internal_freeze(V, redo_freeze(Done,V,G0)) ;
%
% 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.
%
Done = '$done', '$execute'(G0) ).
%
% eq is a combination of dif and freeze
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, _) :-
'$execute'(Goal).
%
% ground is similar to freeze
redo_ground(Done, _, _) :- nonvar(Done), !.
redo_ground(Done, X, Goal) :-
'$non_ground'(X, Var), !,
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
%
/** @pred when(+ _C_, 0:_G_)
Delay execution of goal _G_ until the conditions _C_ are
satisfied. The conditions are of the following form:
+ _C1_, _C2_
Delay until both conditions _C1_ and _C2_ are satisfied.
+ _C1_; _C2_
Delay until either condition _C1_ or condition _C2_ is satisfied.
+ ?=( _V1_, _C2_)
Delay until terms _V1_ and _V1_ have been unified.
+ nonvar( _V_)
Delay until variable _V_ is bound.
+ ground( _V_)
Delay until variable _V_ is ground.
Note that when/2 will fail if the conditions fail.
*/
prolog:when(Conds,Goal) :-
'$current_module'(Mod),
prepare_goal_for_when(Goal, Mod, ModG),
when(Conds, ModG, Done, [], LG), !,
%write(vsc:freezing(LG,Done)),nl,
suspend_when_goals(LG, Done).
prolog:when(_,Goal) :-
'$execute'(Goal).
%
% support for when/2 like declaration.
%
%
% when will block on a conjunction or disjunction of nonvar, ground,
% ?=, where ?= is both terms being bound together
%
%
'$declare_when'(Cond, G) :-
generate_code_for_when(Cond, G, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
'$declare_when'(_,_).
%
% use a meta interpreter for now
%
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).
%
% 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).
%
% now for the important bit
%
% Done is used to synchronise: when it is bound someone else did the
% goal and we can give up.
%
% when/5 and when_suspend succeds when there is need to suspend a goal
%
%
when(V, G, _Done, LG, LG) :- 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) :-
% leave it open to continue with when.
(
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((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) :-
nonvar(Done), !.
when(Cond, G, Done) :-
when(Cond, G, Done, [], LG),
!,
suspend_when_goals(LG, Done).
when(_, G, '$done') :-
'$execute'(G).
%
% Do something depending on the condition!
%
% some one else did the work.
%
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).
try_freeze(V, G, Done, LG0, LGF) :-
var(V),
LGF = ['$coroutining':internal_freeze(V, redo_freeze(Done, V, G))|LG0].
try_eq(X, Y, G, Done, LG0, LGF) :-
'$can_unify'(X, Y, LVars), LVars = [_|_],
LGF = ['$coroutining':dif_suspend_on_lvars(LVars, redo_eq(Done, X, Y, G))|LG0].
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 = ['$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(['$coroutining':internal_freeze(V, G)|Ls], Done) :-
var(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([_|_], _).
%
% Support for wait declarations on goals.
% Or we also use the more powerful, SICStus like, "block" declarations.
%
% block or wait declarations must precede the first clause.
%
%
% I am using the simplest solution now: I'll add an extra clause at
% the beginning of the procedure to do this work. This creates a
% choicepoint and make things a bit slower, but it's probably not as
% significant as the remaining overheads.
%
prolog:'$block'(Conds) :-
generate_blocking_code(Conds, _, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
prolog:'$block'(_).
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),
recorda('$blocking_code','$code'(G,Conds),_),
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) :-
functor(C, Na, Ar),
functor(G, Na, Ar).
%
% If we suspend on the conditions, we should continue
% execution. If we don't suspend we should fail so that we can take
% the next clause. To
% know what we have to do we just test how many variables we suspended
% on ;-).
%
%
% We generate code as follows:
%
% block a(-,-,?)
%
% (var(A1), var(A2) -> true ; fail), !, when((nonvar(A1);nonvar(A2)),G).
%
% block a(-,-,?), a(?,-, -)
%
% (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_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).
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],
[GArg|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).
%
% The wait declaration is a simpler and more efficient version of block.
%
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.
prolog:'$wait'(_).
/** @pred frozen( _X_, _G_)
Unify _G_ with a conjunction of goals suspended on variable _X_,
or `true` if no goal has suspended.
*/
prolog:frozen(V, LG) :-
var(V), !,
'$attributes':attvars_residuals([V], Gs, []),
simplify_frozen( Gs, SGs ),
list_to_conj( SGs, LG ).
prolog:frozen(V, G) :-
'$do_error'(uninstantiation_error(V),frozen(V,G)).
simplify_frozen( [prolog:freeze(_, G)|Gs], [G|NGs] ) :-
simplify_frozen( Gs,NGs ).
simplify_frozen( [prolog:when(_, G)|Gs], [G|NGs] ) :-
simplify_frozen( Gs,NGs ).
simplify_frozen( [prolog:dif(_, _)|Gs], NGs ) :-
simplify_frozen( Gs,NGs ).
simplify_frozen( [], [] ).
list_to_conj([], true).
list_to_conj([El], El).
list_to_conj([E,E1|Els], (E,C) ) :-
list_to_conj([E1|Els], C).
%internal_freeze(V,G) :-
% attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail.
internal_freeze(V,G) :-
update_att(V, 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])).
not_vmember(_, []).
not_vmember(V, [V1|DonesSoFar]) :-
V \== V1,
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).
/**
@}
*/