[Yap-commits] CVS: pl boot.yap, 1.190, 1.191 modules.yap, 1.84, 1.85 preds.yap, 1.80, 1.81

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/yap/pl
In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv12640/pl

Modified Files:
	boot.yap modules.yap preds.yap 
Log Message:
fixes to module expansion


Index: boot.yap
===================================================================
RCS file: /cvsroot/yap/pl/boot.yap,v
retrieving revision 1.190
retrieving revision 1.191
diff -u -r1.190 -r1.191

--- boot.yap	22 Jul 2008 23:34:50 -0000	1.190
+++ boot.yap	6 Aug 2008 00:56:11 -0000	1.191
@@ -304,8 +304,7 @@
 	   fail	
 	 ;
 	   '$execute_commands'(Cs,VL,Con,Source)
-	 ),
-	 fail.
+	 ).
  '$execute_commands'(C,VL,Con,Source) :-
 	 '$execute_command'(C,VL,Con,Source).
 
@@ -781,16 +780,16 @@
         '$call'(Y,CP,G0,M).
 '$call'((X->Y),CP,G0,M) :- !,
 	(
-	 '$execute'(X)
+	 '$call'(X,CP,G0,M)
           ->
 	 '$call'(Y,CP,G0,M)
 	).
 '$call'((X*->Y),CP,G0,M) :- !,
-	'$execute'(X),
+	'$call'(X,CP,G0,M),
 	'$call'(Y,CP,G0,M).
 '$call'((X->Y; Z),CP,G0,M) :- !,
 	(
-	    '$execute'(X)
+	    '$call'(X,CP,G0,M)
          ->
 	    '$call'(Y,CP,G0,M)
         ;
@@ -799,7 +798,7 @@
 '$call'((X*->Y; Z),CP,G0,M) :- !,
 	(
 	 yap_hacks:current_choicepoint(DCP),
-	 '$execute'(X),
+	 '$call'(X,CP,G0,M),
 	 yap_hacks:cut_at(DCP),
 	 '$call'(Y,CP,G0,M)
         ;
@@ -813,16 +812,16 @@
 	).
 '$call'((X->Y| Z),CP,G0,M) :- !,
 	(
-	    '$execute'(X)
+	    '$call'(X,CP,G0,M)
          ->
-	    '$call'(Y,CP,G0,M)
+	 '$call'(Y,CP,G0,M)
         ;
-	    '$call'(Z,CP,G0,M)
+	'$call'(Z,CP,G0,M)
 	).
 '$call'((X*->Y| Z),CP,G0,M) :- !,
 	(
 	 yap_hacks:current_choicepoint(DCP),
-	 '$execute'(X),
+	 '$call'(X,CP,G0,M),
 	 yap_hacks:cut_at(DCP),
 	 '$call'(Y,CP,G0,M)
         ;
@@ -835,9 +834,9 @@
 	    '$call'(B,CP,G0,M)
 	).
 '$call'(\+ X, _CP, _G0, M) :- !,
-	\+ '$execute'(M:X).
+	\+  '$call'(X,CP,G0,M).
 '$call'(not(X), _CP, _G0, M) :- !,
-	\+ '$execute'(M:X).
+	\+  '$call'(X,CP,G0,M).
 '$call'(!, CP, _,_) :- !,
 	'$$cut_by'(CP).
 '$call'([A|B], _, _, M) :- !,

Index: modules.yap
===================================================================
RCS file: /cvsroot/yap/pl/modules.yap,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- modules.yap	22 Jul 2008 23:34:50 -0000	1.84
+++ modules.yap	6 Aug 2008 00:56:11 -0000	1.85
@@ -190,6 +190,7 @@
 % A5: context module (this is the current context
 % A6: head module (this is the one used in compiling and accessing).
 %
+%
 '$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !,
 	'$is_mt'(M, H, B, IB, MM),
 	'$module_u_vars'(H,UVars,M),	 % collect head variables in

Index: preds.yap
===================================================================
RCS file: /cvsroot/yap/pl/preds.yap,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- preds.yap	22 Jul 2008 23:34:50 -0000	1.80
+++ preds.yap	6 Aug 2008 00:56:11 -0000	1.81
@@ -45,7 +45,8 @@
 '$assert'((H:-G),M1,Where,R,P) :- !,
 	'$assert_clause'(H, G, M1, Where, R, P).
 '$assert'(H,M1,Where,R,_) :-
-	'$assert_fact'(H, M1, Where, R).
+	strip_module(M1:H, HM, H1),
+	'$assert_fact'(H1, HM, Where, R).
 
 '$assert_clause'(H, _, _, _, _, P) :-
 	var(H), !, '$do_error'(instantiation_error,P).
@@ -75,8 +76,8 @@
 
 
 '$assert_clause2'(HI,BI,Mod,Where,R,P) :-
-	'$expand_clause'((HI :- BI),C0,C,Mod),
-	'$assert_clause3'(C0,C,Mod,Where,R,P).
+	'$expand_clause'((HI :- BI),C0,C,Mod,HM),
+	'$assert_clause3'(C0,C,HM,Where,R,P).
 
 '$assert_clause3'(C0,C,Mod,Where,R,P) :-
 	'$check_head_and_body'(C,H,B,P),
@@ -106,8 +107,8 @@
 '$assert_dynamic'((H:-G),M1,Where,R,P) :-
         var(H), !, '$do_error'(instantiation_error,P).
 '$assert_dynamic'(CI,Mod,Where,R,P) :-
-	'$expand_clause'(CI,C0,C,Mod),
-	'$assert_dynamic2'(C0,C,Mod,Where,R,P).
+	'$expand_clause'(CI,C0,C,Mod,HM),
+	'$assert_dynamic2'(C0,C,HM,Where,R,P).
 
 '$assert_dynamic2'(C0,C,Mod,Where,R,P) :-
 	'$check_head_and_body'(C,H,B,P),
@@ -151,15 +152,15 @@
 '$assert_static'((H:-G),M1,Where,R,P) :-
 	var(H), !, '$do_error'(instantiation_error,P).
 '$assert_static'(CI,Mod,Where,R,P) :-
-	'$expand_clause'(CI,C0,C,Mod),
+	'$expand_clause'(CI,C0,C,Mod, HM),
 	'$check_head_and_body'(C,H,B,P),
-	( '$is_dynamic'(H, Mod) ->
-	    '$do_error'(permission_error(modify,dynamic_procedure,Na/Ar),P)
+	( '$is_dynamic'(H, HM) ->
+	    '$do_error'(permission_error(modify,dynamic_procedure,HM:Na/Ar),P)
 	;
-	  '$undefined'(H,Mod), get_value('$full_iso',true) ->
-	    functor(H,Na,Ar), '$dynamic'(Na/Ar, Mod), '$assertat_d'(Where,H,B,C0,Mod,R)
+	  '$undefined'(H,HM), get_value('$full_iso',true) ->
+	    functor(H,Na,Ar), '$dynamic'(Na/Ar, HM), '$assertat_d'(Where,H,B,C0,HM,R)
 	;
-	    '$assert1'(Where,C,C0,Mod,H)
+	'$assert1'(Where,C,C0,HM,H)
         ).
 
 
@@ -736,13 +737,16 @@
 	'$do_error'(domain_error(semantics_indicator,Sem),Goal).
 
 
-'$expand_clause'(C0,C1,C2,Mod) :-
-	'$module_expansion'(C0, C1, C2, Mod, Mod),
+'$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
+	strip_module(Mod:H, HM, H1),
+	'$module_expansion'((H1:-B), C1, C2, Mod, HM),
 	( get_value('$strict_iso',on) ->
 	    '$check_iso_strict_clause'(C1)
         ;
            true
         ).
+'$expand_clause'(H,H1,H1,Mod,HM) :-
+	strip_module(Mod:H, HM, H1).
 
 '$public'(X, _) :- var(X), !,
 	'$do_error'(instantiation_error,public(X)).



