diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

move to SWI like interface.

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-03-08 09:24:24 +00:00
parent 53b4828000
commit dd3645b5c8
1 changed files with 15 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
pl/corout.yap
View File

@ -37,17 +37,27 @@
'$show_frozen_goals'(Level))). '$show_frozen_goals'(Level))).
'$project_and_delayed_goals'(G,LGs) :- '$project_and_delayed_goals'(G,LGs) :-
attributes:all_attvars(LAV), '$att_vars'(G, LAV),
LAV = [_|_], !, LAV = [_|_], !,
% SICStus compatible step, % SICStus compatible step,
% just try to simplify store by projecting constraints % just try to simplify store by projecting constraints
% over query variables. % over query variables.
'$project_attributes'(LAV, G), '$project_attributes'(LAV, G),
% now get a list of frozen goals. % now get a list of frozen goals.
attributes:all_attvars(NLAV), '$att_vars'(G, NLAV),
'$get_goalist_from_attvars'(NLAV, LGs). '$get_goalist_from_attvars'(NLAV, LGs).
'$project_and_delayed_goals'(_,[]). '$project_and_delayed_goals'(_,[]).
'$att_vars'(Term, LAV) :-
term_variables(Term, TVars),
'$select_atts'(TVars, LAV).
'$select_atts'([], []).
'$select_atts'(V.TVars, V.LAV) :-
attvar(V), !,
'$select_atts'(TVars, LAV).
'$select_atts'(V.TVars, LAV) :-
'$select_atts'(TVars, LAV).
% %
% wake_up_goal is called by the system whenever a suspended goal % wake_up_goal is called by the system whenever a suspended goal
@ -553,7 +563,8 @@ frozen(V, LG) :-
'$fetch_same_done_goals'(G0, D0, LV, GF). '$fetch_same_done_goals'(G0, D0, LV, GF).
call_residue_vars(Goal,Residue) :- /*
call_residue_vars(Goal,Vars) :-
attributes:all_attvars(Vs0), attributes:all_attvars(Vs0),
call(Goal), call(Goal),
attributes:all_attvars(Vs), attributes:all_attvars(Vs),
@ -575,50 +586,13 @@ call_residue_vars(Goal,Residue) :-
; ;
'$ord_remove'([V1|Vss], Vs0s, Residue) '$ord_remove'([V1|Vss], Vs0s, Residue)
). ).
*/
copy_term(Term, Copy, Goals) :- copy_term(Term, Copy, Goals) :-
term_variables(Term, TVars), term_variables(Term, TVars),
'$get_goalist_from_attvars'(TVars, Goals0), '$get_goalist_from_attvars'(TVars, Goals0),
copy_term_nat([Term|Goals0], [Copy|Goals]). 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. % make sure we have installed a SICStus like constraint solver.
'$project_attributes'(_, _) :- '$project_attributes'(_, _) :-
'$undefined'(modules_with_attributes(_),attributes), !. '$undefined'(modules_with_attributes(_),attributes), !.