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

fixes to module expansion

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pl/boot.yap
View File

@ -304,8 +304,7 @@ true :- true.
fail
;
'$execute_commands'(Cs,VL,Con,Source)
),
fail.
).
'$execute_commands'(C,VL,Con,Source) :-
'$execute_command'(C,VL,Con,Source).
@ -781,16 +780,16 @@ not(G) :- \+ '$execute'(G).
'$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 @@ not(G) :- \+ '$execute'(G).
'$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 @@ not(G) :- \+ '$execute'(G).
).
'$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 @@ not(G) :- \+ '$execute'(G).
'$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) :- !,

1
pl/modules.yap
View File

@ -190,6 +190,7 @@ module(N) :-
% 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

30
pl/preds.yap
View File

@ -45,7 +45,8 @@ assert(C) :-
'$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(C) :-
'$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(C) :-
'$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 @@ assertz_static(C) :-
'$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 @@ dynamic_predicate(P,Sem) :-
'$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)).