From 1461f441845f091c4e9436e992afa5124ed0cfad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sat, 11 Oct 2014 12:45:54 +0100 Subject: [PATCH] fix goal expansion problems --- pl/arith.yap | 59 +++++--------------------------------------------- pl/init.yap | 4 ++-- pl/modules.yap | 59 +++++++++++++++++++++++++++++++++++++++++++------- 3 files changed, 58 insertions(+), 64 deletions(-) diff --git a/pl/arith.yap b/pl/arith.yap index 4dba7616c..855fbf676 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -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), !, @@ -225,13 +180,9 @@ do_c_built_in(Comp0, _, R) :- % now, do it for comparisons do_c_built_in(P, _M, P). do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :- - var(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), !. + atom(Mod), !. do_c_built_metacall(G1, Mod, call(Mod:G1)). '$do_and'(true, P, P) :- !. diff --git a/pl/init.yap b/pl/init.yap index a7d93bc7b..9aa98d115 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -127,12 +127,12 @@ otherwise. 'flags.yap' ]. -:- compile_expressions. - :- [ 'preds.yap', 'modules.yap' ]. +:- compile_expressions. + :- [ % lists is often used. 'yio.yap', diff --git a/pl/modules.yap b/pl/modules.yap index 4af76d0b0..e5a96edb0 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -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. + '$match_mod'(G, HM, BM0, SM, G1), + '$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) :- !,