fix goal expansion problems

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),
+	'$yap_strip_module'(Mod:G, M1, G1),
-	( var(G1) -> M = M2, G1 = G2 ; G1 = M2:G2), !, 
+	var(G1), !,
-	do_c_built_metacall(G2, M2, OUT).
+	do_c_built_metacall(G1, M1, 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).
 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)).

pl/init.yap

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

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),
+       '$c_built_in'(G1, SM, G2).
-	Gi = 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) :- !,