fixes to module expansion

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2295 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-08-06 00:56:11 +00:00
parent a3983fa820
commit 2c829f8e5c
3 changed files with 29 additions and 25 deletions

View File

@ -304,8 +304,7 @@ true :- true.
fail fail
; ;
'$execute_commands'(Cs,VL,Con,Source) '$execute_commands'(Cs,VL,Con,Source)
), ).
fail.
'$execute_commands'(C,VL,Con,Source) :- '$execute_commands'(C,VL,Con,Source) :-
'$execute_command'(C,VL,Con,Source). '$execute_command'(C,VL,Con,Source).
@ -781,16 +780,16 @@ not(G) :- \+ '$execute'(G).
'$call'(Y,CP,G0,M). '$call'(Y,CP,G0,M).
'$call'((X->Y),CP,G0,M) :- !, '$call'((X->Y),CP,G0,M) :- !,
( (
'$execute'(X) '$call'(X,CP,G0,M)
-> ->
'$call'(Y,CP,G0,M) '$call'(Y,CP,G0,M)
). ).
'$call'((X*->Y),CP,G0,M) :- !, '$call'((X*->Y),CP,G0,M) :- !,
'$execute'(X), '$call'(X,CP,G0,M),
'$call'(Y,CP,G0,M). '$call'(Y,CP,G0,M).
'$call'((X->Y; Z),CP,G0,M) :- !, '$call'((X->Y; Z),CP,G0,M) :- !,
( (
'$execute'(X) '$call'(X,CP,G0,M)
-> ->
'$call'(Y,CP,G0,M) '$call'(Y,CP,G0,M)
; ;
@ -799,7 +798,7 @@ not(G) :- \+ '$execute'(G).
'$call'((X*->Y; Z),CP,G0,M) :- !, '$call'((X*->Y; Z),CP,G0,M) :- !,
( (
yap_hacks:current_choicepoint(DCP), yap_hacks:current_choicepoint(DCP),
'$execute'(X), '$call'(X,CP,G0,M),
yap_hacks:cut_at(DCP), yap_hacks:cut_at(DCP),
'$call'(Y,CP,G0,M) '$call'(Y,CP,G0,M)
; ;
@ -813,7 +812,7 @@ not(G) :- \+ '$execute'(G).
). ).
'$call'((X->Y| Z),CP,G0,M) :- !, '$call'((X->Y| Z),CP,G0,M) :- !,
( (
'$execute'(X) '$call'(X,CP,G0,M)
-> ->
'$call'(Y,CP,G0,M) '$call'(Y,CP,G0,M)
; ;
@ -822,7 +821,7 @@ not(G) :- \+ '$execute'(G).
'$call'((X*->Y| Z),CP,G0,M) :- !, '$call'((X*->Y| Z),CP,G0,M) :- !,
( (
yap_hacks:current_choicepoint(DCP), yap_hacks:current_choicepoint(DCP),
'$execute'(X), '$call'(X,CP,G0,M),
yap_hacks:cut_at(DCP), yap_hacks:cut_at(DCP),
'$call'(Y,CP,G0,M) '$call'(Y,CP,G0,M)
; ;
@ -835,9 +834,9 @@ not(G) :- \+ '$execute'(G).
'$call'(B,CP,G0,M) '$call'(B,CP,G0,M)
). ).
'$call'(\+ X, _CP, _G0, M) :- !, '$call'(\+ X, _CP, _G0, M) :- !,
\+ '$execute'(M:X). \+ '$call'(X,CP,G0,M).
'$call'(not(X), _CP, _G0, M) :- !, '$call'(not(X), _CP, _G0, M) :- !,
\+ '$execute'(M:X). \+ '$call'(X,CP,G0,M).
'$call'(!, CP, _,_) :- !, '$call'(!, CP, _,_) :- !,
'$$cut_by'(CP). '$$cut_by'(CP).
'$call'([A|B], _, _, M) :- !, '$call'([A|B], _, _, M) :- !,

View File

@ -190,6 +190,7 @@ module(N) :-
% A5: context module (this is the current context % A5: context module (this is the current context
% A6: head module (this is the one used in compiling and accessing). % A6: head module (this is the one used in compiling and accessing).
% %
%
'$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !, '$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !,
'$is_mt'(M, H, B, IB, MM), '$is_mt'(M, H, B, IB, MM),
'$module_u_vars'(H,UVars,M), % collect head variables in '$module_u_vars'(H,UVars,M), % collect head variables in

View File

@ -45,7 +45,8 @@ assert(C) :-
'$assert'((H:-G),M1,Where,R,P) :- !, '$assert'((H:-G),M1,Where,R,P) :- !,
'$assert_clause'(H, G, M1, Where, R, P). '$assert_clause'(H, G, M1, Where, R, P).
'$assert'(H,M1,Where,R,_) :- '$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) :- '$assert_clause'(H, _, _, _, _, P) :-
var(H), !, '$do_error'(instantiation_error,P). var(H), !, '$do_error'(instantiation_error,P).
@ -75,8 +76,8 @@ assert(C) :-
'$assert_clause2'(HI,BI,Mod,Where,R,P) :- '$assert_clause2'(HI,BI,Mod,Where,R,P) :-
'$expand_clause'((HI :- BI),C0,C,Mod), '$expand_clause'((HI :- BI),C0,C,Mod,HM),
'$assert_clause3'(C0,C,Mod,Where,R,P). '$assert_clause3'(C0,C,HM,Where,R,P).
'$assert_clause3'(C0,C,Mod,Where,R,P) :- '$assert_clause3'(C0,C,Mod,Where,R,P) :-
'$check_head_and_body'(C,H,B,P), '$check_head_and_body'(C,H,B,P),
@ -106,8 +107,8 @@ assert(C) :-
'$assert_dynamic'((H:-G),M1,Where,R,P) :- '$assert_dynamic'((H:-G),M1,Where,R,P) :-
var(H), !, '$do_error'(instantiation_error,P). var(H), !, '$do_error'(instantiation_error,P).
'$assert_dynamic'(CI,Mod,Where,R,P) :- '$assert_dynamic'(CI,Mod,Where,R,P) :-
'$expand_clause'(CI,C0,C,Mod), '$expand_clause'(CI,C0,C,Mod,HM),
'$assert_dynamic2'(C0,C,Mod,Where,R,P). '$assert_dynamic2'(C0,C,HM,Where,R,P).
'$assert_dynamic2'(C0,C,Mod,Where,R,P) :- '$assert_dynamic2'(C0,C,Mod,Where,R,P) :-
'$check_head_and_body'(C,H,B,P), '$check_head_and_body'(C,H,B,P),
@ -151,15 +152,15 @@ assertz_static(C) :-
'$assert_static'((H:-G),M1,Where,R,P) :- '$assert_static'((H:-G),M1,Where,R,P) :-
var(H), !, '$do_error'(instantiation_error,P). var(H), !, '$do_error'(instantiation_error,P).
'$assert_static'(CI,Mod,Where,R,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), '$check_head_and_body'(C,H,B,P),
( '$is_dynamic'(H, Mod) -> ( '$is_dynamic'(H, HM) ->
'$do_error'(permission_error(modify,dynamic_procedure,Na/Ar),P) '$do_error'(permission_error(modify,dynamic_procedure,HM:Na/Ar),P)
; ;
'$undefined'(H,Mod), get_value('$full_iso',true) -> '$undefined'(H,HM), get_value('$full_iso',true) ->
functor(H,Na,Ar), '$dynamic'(Na/Ar, Mod), '$assertat_d'(Where,H,B,C0,Mod,R) 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 @@ dynamic_predicate(P,Sem) :-
'$do_error'(domain_error(semantics_indicator,Sem),Goal). '$do_error'(domain_error(semantics_indicator,Sem),Goal).
'$expand_clause'(C0,C1,C2,Mod) :- '$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
'$module_expansion'(C0, C1, C2, Mod, Mod), strip_module(Mod:H, HM, H1),
'$module_expansion'((H1:-B), C1, C2, Mod, HM),
( get_value('$strict_iso',on) -> ( get_value('$strict_iso',on) ->
'$check_iso_strict_clause'(C1) '$check_iso_strict_clause'(C1)
; ;
true true
). ).
'$expand_clause'(H,H1,H1,Mod,HM) :-
strip_module(Mod:H, HM, H1).
'$public'(X, _) :- var(X), !, '$public'(X, _) :- var(X), !,
'$do_error'(instantiation_error,public(X)). '$do_error'(instantiation_error,public(X)).