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

fix goal expansion problems

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-10-11 12:45:54 +01:00
parent b2cd81f79a
commit 1461f44184
3 changed files with 58 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
pl/arith.yap
View File

@ -125,54 +125,9 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
do_c_built_in(G, M, OUT) :- var(G), !,
do_c_built_metacall(G, M, OUT).
do_c_built_in(Mod:G, _, OUT) :-
strip_module(Mod:G, M, G1),
( var(G1) -> M = M2, G1 = G2 ; G1 = M2:G2), !,
do_c_built_metacall(G2, M2, OUT).
do_c_built_in(\+ G, _, OUT) :-
nonvar(G),
G = (A = B),
!,
OUT = (A \= B).
do_c_built_in(call(G), _, OUT) :-
nonvar(G),
G = (Mod:G1), !,
do_c_built_metacall(G1, Mod, OUT).
do_c_built_in(call(G), Mod, OUT) :-
var(G), !,
do_c_built_metacall(G, Mod, OUT).
do_c_built_in(depth_bound_call(G,D), M, OUT) :- !,
do_c_built_in(G, M, NG),
% make sure we don't have something like (A,B) -> $depth_next(D), A, B.
( '$composed_built_in'(NG) ->
OUT = depth_bound_call(NG,D)
;
OUT = ('$set_depth_limit_for_next_call'(D),NG)
).
do_c_built_in(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP))) :- !,
do_c_built_in(G,M,NG0),
'$clean_cuts'(NG0, NG).
do_c_built_in(forall(Cond,Action), M, \+((NCond, \+(NAction)))) :- !,
do_c_built_in(Cond,M,ICond),
do_c_built_in(Action,M,IAction),
'$clean_cuts'(ICond, NCond),
'$clean_cuts'(IAction, NAction).
do_c_built_in(ignore(Goal), M, (NGoal -> true ; true)) :- !,
do_c_built_in(Goal,M,IGoal),
'$clean_cuts'(IGoal, NGoal).
do_c_built_in(if(G,A,B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
do_c_built_in(G,M,NG0),
'$clean_cuts'(NG0, NG),
do_c_built_in(A,M,NA),
do_c_built_in(B,M,NB).
do_c_built_in((G*->A;B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
do_c_built_in(G,M,NG0),
'$clean_cuts'(NG0, NG),
do_c_built_in(A,M,NA),
do_c_built_in(B,M,NB).
do_c_built_in((G*->A), M, (NG,NA)) :- !,
do_c_built_in(G,M,NG0),
'$clean_cuts'(NG0, NG),
do_c_built_in(A,M,NA).
'$yap_strip_module'(Mod:G, M1, G1),
var(G1), !,
do_c_built_metacall(G1, M1, OUT).
do_c_built_in('C'(A,B,C), _, (A=[B|C])) :- !.
do_c_built_in(X is Y, M, P) :-
primitive(X), !,
@ -226,10 +181,6 @@ do_c_built_in(P, _M, P).
do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-
var(Mod), !.
do_c_built_metacall(G1, Mod, '$execute_in_mod'(G1,Mod)) :-
var(G1), atom(Mod), !.
do_c_built_metacall(Mod:G1, _, OUT) :- !,
do_c_built_metacall(G1, Mod, OUT).
do_c_built_metacall(G1, Mod, '$execute_in_mod'(G1,Mod)) :-
atom(Mod), !.
do_c_built_metacall(G1, Mod, call(Mod:G1)).

4
pl/init.yap
View File

@ -127,12 +127,12 @@ otherwise.
'flags.yap'
].
:- compile_expressions.
:- [ 'preds.yap',
'modules.yap'
].
:- compile_expressions.
:- [
% lists is often used.
'yio.yap',

57
pl/modules.yap
View File

@ -642,15 +642,22 @@ source_module(Mod) :-
% A6: head module (this is the one used in compiling and accessing).
%
%
%'$expand_modules'(V,NG,NG,_,_,SM,HVars):- writeln(V), fail.
%'$expand_modules'(V,NG,NG,_,_,SM,HVars):-l writeln(V), fail.
'$expand_modules'(V,NG,NG,_,_,SM,HVars) :-
var(V), !,
( '$not_in_vars'(V,HVars)
->
NG = call(SM:V)
NG = call(SM:V),
( atom(SM) -> NGO = '$execute_in_mod'(V,SM) ; NGO = NG )
;
NG = call(V)
).
'$expand_modules'(depth_bound_call(G,D),
depth_bound_call(G1,D),
('$set_depth_limit_for_next_call'(D),GO),
HM,BM,SM,HVars) :-
'$expand_modules'(G,G1,GO,HM,BM,SM,HVars),
'$composed_built_in'(GO), !.
'$expand_modules'((A,B),(A1,B1),(AO,BO),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
@ -672,10 +679,43 @@ source_module(Mod) :-
'$expand_modules'(A,A1,AOO,HM,BM,SM,HVars),
'$clean_cuts'(AOO, AO),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
'$expand_modules'(\+A,\+A1,\+AO,HM,BM,SM,HVars) :- !,
'$expand_modules'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :-
nonvar(G),
G = (A = B),
!.
'$expand_modules'(\+A,\+A1,(AO-> false;true),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars).
'$expand_modules'(not(A),not(A1),not(AO),HM,BM,SM,HVars) :- !,
'$expand_modules'(once(A),once(A1),
(yap_hacks:current_choice_point(CP),AO,'$$cut_by'(CP)),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$clean_cuts'(AO0, CP, AO).
'$expand_modules'(ignore(A),ignore(A1),
(AO -> true ; true),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$clean_cuts'(AO0, AO).
'$expand_modules'(forall(A,B),forall(A1,B1),
((AO, ( BO-> false ; true)) -> false ; true),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$clean_cuts'(AO0, AO).
'$expand_modules'(not(A),not(A1),(AO -> fail; true),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars).
'$expand_modules'(if(A,B,C),if(A1,B1,C1),
(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO)),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$expand_modules'(C,C1,CO,HM,BM,SM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_modules'((A*->B;C),(A1*->B1;C1),
(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO)),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
'$expand_modules'(C,C1,CO,HM,BM,SM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_modules'((A*->B),(A1*->B1),
(yap_hacks:current_choicepoint(DCP),AO,BO)),HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AO0,HM,BM,SM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_modules'(true,true,true,_,_,_,_) :- !.
'$expand_modules'(fail,fail,fail,_,_,_,_) :- !.
'$expand_modules'(false,false,false,_,_,_,_) :- !.
@ -757,12 +797,11 @@ expand_goal(G, G).
'$do_expand'(G, HM, BM, SM, HVars, GI),
GI \== G, !,
'$expand_modules'(GI, G1, GO, HM, BM, SM, HVars).
'$complete_goal_expansion'(G, HM, BM, SM, G1, G2, _HVars) :-
'$complete_goal_expansion'(G, HM, BM, SM, G1, G2, HVars) :-
'$all_system_predicate'(G, BM, BM0), !,
% make built-in processing transparent.
'$match_mod'(G, HM, BM0, SM, G1),
'$c_built_in'(G1, BM0, Gi),
Gi = G2.
'$c_built_in'(G1, SM, G2).
'$complete_goal_expansion'(G, HM, BM, SM, NG, NG, _) :-
'$match_mod'(G, HM, BM, SM, NG).
@ -1400,6 +1439,10 @@ export_list(Module, List) :-
'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
'$clean_cuts'(G,G).
'$clean_cuts'(G,DCP,NG) :-
'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
'$clean_cuts'(G,_,G).
'$conj_has_cuts'(V,_,V, _) :- var(V), !.
'$conj_has_cuts'(!,DCP,'$$cut_by'(DCP), ok) :- !.
'$conj_has_cuts'((G1,G2),DCP,(NG1,NG2), OK) :- !,