diff --git a/pl/boot.yap b/pl/boot.yap
index 9079e2585..eb550dca7 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -185,31 +185,10 @@ list, since backtracking could not "pass through" the cut.
*/
-
-
-system_module(_init, _SysExps, _Decls) :- !.
-system_module(M, SysExps, Decls) :-
- '$current_module'(prolog, M),
- '$compile'( ('$system_module'(M) :- true), 0, assert_static('$system_module'(M)), M ),
- '$export_preds'(SysExps, prolog),
- '$export_preds'(Decls, M).
-
-'$export_preds'([], _).
-'$export_preds'([N/A|Decls], M) :-
- functor(S, N, A),
- '$sys_export'(S, M),
- '$export_preds'(Decls, M).
+system_module(Mod, _SysExps, _Decls) :- !,
+ system_module(Mod).
use_system_module(_init, _SysExps) :- !.
-use_system_module(M, SysExps) :-
- '$current_module'(M0, M0),
- '$import_system'(SysExps, M0, M).
-
-'$import_system'([], _, _).
-'$import_system'([N/A|Decls], M0, M) :-
- functor(S, N, A),
- '$compile'( (G :- M0:G) ,0, assert_static((M:G :- M0:G)), M ),
- '$import_system'(Decls, M0, M).
private(_).
@@ -287,6 +266,14 @@ private(_).
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
'$iso_check_goal'/2]).
+/*
+'$undefp'([M0|G0], Default) :-
+ G0 \= '$imported_predicate'(_,_,_,_),
+ G0 \= '$full_clause_optimisation'(_H, _M, _B0, _BF),
+ G0 \= '$expand_a_clause'(_,_,_,_),
+ G0 \= '$all_directives'(_),
+ format(user_error, 'ERROR: undefined ~a:~q.~n', [M0, G0]), fail.
+*/
'$prepare_goals'((A,B),(NA,NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
@@ -308,7 +295,6 @@ private(_).
'$prepare_goals'(A,NA,Any).
'$prepare_goals'('$do_error'(Error,Goal),
(clause_location(Call, Caller),
- writeln(Goal),
strip_module(M:Goal,M1,NGoal),
throw(error(Error, [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]]))
),
@@ -620,7 +606,7 @@ number of steps.
'$execute_commands'([],_,_,_,_) :- !.
'$execute_commands'([C|Cs],VL,Pos,Con,Source) :- !,
(
- '$system_catch'('$execute_command'(C,VL,Pos,Con,C),prolog,Error,(writeln(k),'$LoopError'(Error, Con))),
+ '$system_catch'('$execute_command'(C,VL,Pos,Con,C),prolog,Error,'$LoopError'(Error, Con)),
fail
;
'$execute_commands'(Cs,VL,Pos,Con,Source)
@@ -710,10 +696,11 @@ number of steps.
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
'$continue_with_command'(reconsult,V,Pos,G,Source) :-
- '$go_compile_clause'(G,V,Pos,5,Source),
+% writeln(G),
+ '$go_compile_clause'(G,V,Pos,reconsult,Source),
fail.
'$continue_with_command'(consult,V,Pos,G,Source) :-
- '$go_compile_clause'(G,V,Pos,13,Source),
+ '$go_compile_clause'(G,V,Pos,consult,Source),
fail.
'$continue_with_command'(top,V,_,G,_) :-
'$query'(G,V).
@@ -727,56 +714,46 @@ number of steps.
% Pos the source position
% N where to add first or last
% Source the original clause
- '$go_compile_clause'(G,Vs,Pos,N,Source) :-
- '$current_module'(Mod),
- '$go_compile_clause'(G,Vs,Pos,N,Mod,Mod,Mod,Source).
+ '$go_compile_clause'(G,Vs,Pos, Where, Source) :-
+ '$precompile_term'(G, G0, G1),
+ !,
+ '$$compile'(G1, Where, G0, _).
+ '$go_compile_clause'(G,Vs,Pos, Where, Source) :-
+ throw(error(system, compilation_failed(G))).
+
+'$$compile'(C, Where, C0, R) :-
+ '$head_and_body'( C, MH, B ),
+ strip_module( MH, Mod, H),
+ (
+ '$undefined'(H, Mod)
+ ->
+ '$init_pred'(H, Mod, Where)
+ ;
+ true
+ ),
-'$go_compile_clause'(G,_Vs,_Pos,_N,_HM,_BM,_SM,Source) :-
- var(G), !,
- '$do_error'(instantiation_error,assert(Source)).
-'$go_compile_clause'((G:-_),_Vs,_Pos,_N,_HM,_BM,_SM,Source) :-
- var(G), !,
- '$do_error'(instantiation_error,assert(Source)).
-'$go_compile_clause'(M:G,Vs,Pos,N,_,_,SourceMod,Source) :- !,
- '$go_compile_clause'(G,Vs,Pos,N,M,M,M,Source).
-'$go_compile_clause'((M:H :- B),Vs,Pos,N,_,BodyMod,SourceMod,Source) :- !,
- '$go_compile_clause'((H :- B),Vs,Pos,N,M,BodyMod,SourceMod,Source).
-'$go_compile_clause'(G,_Vs,Pos,N,HeadMod,BodyMod,SourceMod,_Source) :- !,
- '$precompile_term'(G, G0, G1, HeadMod, BodyMod, SourceMod),
- '$$compile'(G1, G0, N, HeadMod).
+% writeln(Mod:((H:-B))),
+ '$compile'((H:-B), Where, C0, Mod, R).
+'$init_pred'(H, Mod, _Where ) :-
+ recorded('$import','$import'(NM,Mod,NH,H,_,_),RI),
+% NM \= Mod,
+ functor(NH,N,Ar),
+ '$early_print'(warning,redefine_imported(Mod,NM,M:N/Ar)),
+ erase(RI),
+ fail.
+'$init_pred'(H, Mod, Where ) :-
+ '$init_as_dynamic'(Where),
+ !,
+ functor(H, Na, Ar),
+ '$dynamic'(Na/Ar, Mod).
+'$init_pred'(_H, _Mod, _Where ).
- % process an input clause
- '$$compile'(G, G0, L, Mod) :-
- '$head_and_body'(G,H,_),
- (
- '$is_dynamic'(H, Mod)
- ->
- '$assertz_dynamic'(L, G, G0, Mod)
- ;
- '$nb_getval'('$assert_all',on,fail)
- ->
- functor(H,N,A),
- '$dynamic'(N/A,Mod),
- '$assertz_dynamic'(L, G, G0, Mod)
- ;
- '$not_imported'(H, Mod),
- '$compile'(G, L, G0, Mod)
- ).
-
-%
-% check if current module redefines an imported predicate.
-% and remove import.
-%
-'$not_imported'(H, Mod) :-
- recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
- NM \= Mod,
- functor(NH,N,Ar),
- '$early_print'(warning,redefine_imported(Mod,NM,N/Ar)),
- erase(R),
- fail.
-'$not_imported'(_, _).
-
+'$init_as_dynamic'( asserta ).
+'$init_as_dynamic'( assertz ).
+'$init_as_dynamic'( consult ) :- '$nb_getval'('$assert_all',on,fail).
+'$init_as_dynamic'( reconsult ) :- '$nb_getval'('$assert_all',on,fail).
+
'$check_if_reconsulted'(N,A) :-
once(recorded('$reconsulted',N/A,_)),
@@ -1392,10 +1369,16 @@ bootstrap(F) :-
user:'$LoopError'(Error, Status)),
!.
-'$enter_command'(Stream,Mod,top) :- !,
- read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]),
- '$command'(Command,Vars,Pos,Status).
'$enter_command'(Stream,Mod,Status) :-
+ !,
+ read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]),
+ '$command'(Command,Vars,Pos, Status).
+'$enter_command'(_Stream, _Mod, _HeadMob).
+
+
+/** @pred expand_term( _T_,- _X_)
+
+This predicate is used by YAP for preprocessingStatus) :-
read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status).
@@ -1411,43 +1394,42 @@ bootstrap(F) :-
%
% split head and body, generate an error if body is unbound.
%
-'$check_head_and_body'((H:-B),H,B,P) :- !,
- '$check_head'(H,P).
-'$check_head_and_body'(H,H,true,P) :-
- '$check_head'(H,P).
-
-'$check_head'(H,P) :- var(H), !,
- '$do_error'(instantiation_error,P).
-'$check_head'(H,P) :- number(H), !,
- '$do_error'(type_error(callable,H),P).
-'$check_head'(H,P) :- db_reference(H), !,
- '$do_error'(type_error(callable,H),P).
-'$check_head'(_,_).
-
-% term expansion
+'$check_head_and_body'((M:H:-B),M,H,B,P) :-
+ !,
+ error:is_callable(M:H,P).
+'$check_head_and_body'(M:H, M, H, true, P) :-
+ error:is_callable(M:H,P).
+ % term expansion
%
% return two arguments: Expanded0 is the term after "USER" expansion.
% Expanded is the final expanded term.
%
-'$precompile_term'(Term, Expanded0, Expanded, HeadMod, BodyMod, SourceMod) :-
+'$precompile_term'(Term, Expanded0, Expanded) :-
%format('[ ~w~n',[Term]),
- '$module_expansion'(Term, Expanded0, ExpandedI, HeadMod, BodyMod, SourceMod), !,
+ '$expand_clause'(Term, Expanded0, ExpandedI), !,
%format(' -> ~w~n',[Expanded0]),
(
current_prolog_flag(strict_iso, true) /* strict_iso on */
- ->
+ ->
Expanded = ExpandedI,
'$check_iso_strict_clause'(Expanded0)
- ;
+ ;
'$expand_array_accesses_in_term'(ExpandedI,Expanded)
+ -> true
+ ;
+ Expanded = ExpandedI
).
-'$precompile_term'(Term, Term, Term, _, _, _).
+'$precompile_term'(Term, Term, Term).
+'$expand_clause'(InputCl, C1, CO) :-
+ source_module(SM),
+ '$yap_strip_module'(SM:InputCl, M, ICl),
+ '$expand_a_clause'( M:ICl, SM, C1, CO),
+ !.
+'$expand_clause'(Cl, Cl, Cl).
/** @pred expand_term( _T_,- _X_)
-
-
This predicate is used by YAP for preprocessing each top level
term read when consulting a file and before asserting or executing it.
It rewrites a term _T_ to a term _X_ according to the following
diff --git a/pl/meta.yap b/pl/meta.yap
new file mode 100644
index 000000000..4aa3bf615
--- /dev/null
+++ b/pl/meta.yap
@@ -0,0 +1,582 @@
+/**
+
+@{
+
+ @defgroup YAPMetaPredicates Using Meta-Calls with Modules
+ @ingroup YAPModules
+
+ @pred meta_predicate(_G1_,...., _Gn) is directive
+
+Declares that this predicate manipulates references to predicates.
+Each _Gi_ is a mode specification.
+
+If the argument is `:`, it does not refer directly to a predicate
+but must be module expanded. If the argument is an integer, the argument
+is a goal or a closure and must be expanded. Otherwise, the argument is
+not expanded. Note that the system already includes declarations for all
+built-ins.
+
+For example, the declaration for call/1 and setof/3 are:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+:- meta_predicate call(0), setof(?,0,?).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+meta_predicate declaration
+ implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration)
+
+*/
+
+% directive now meta_predicate Ps :- $meta_predicate(Ps).
+
+:- dynamic prolog:'$meta_predicate'/4.
+
+:- multifile prolog:'$meta_predicate'/4, '$inline'/2.
+
+'$meta_predicate'(M:P) :-
+ var(P),
+ '$do_error'(instantiation_error,meta_predicate(M:P)).
+'$meta_predicate'(M:P) :-
+ var(M),
+ '$do_error'(instantiation_error,meta_predicate(M:P)).
+'$meta_predicate'(M:(P,Ps)) :- !,
+ '$meta_predicate'(M:P),
+ '$meta_predicate'(M:Ps).
+'$meta_predicate'( M:D ) :-
+ '$yap_strip_module'( M:D, M1, P),
+ '$install_meta_predicate'(M1:P).
+
+'$install_meta_predicate'(M1:P) :-
+ functor(P,F,N),
+ ( M1 = prolog -> M = _ ; M1 = M),
+ ( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
+ asserta(prolog:'$meta_predicate'(F,M,N,P)),
+ '$predicate_flags'(P, M1, Fl, Fl),
+ NFlags is Fl \/ 0x200000,
+ '$predicate_flags'(P, M1, Fl, NFlags).
+
+ % comma has its own problems.
+
+:- '$install_meta_predicate'(prolog:','(0,0)).
+
+%% handle module transparent predicates by defining a
+%% new context module.
+'$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :-
+ '$yap_strip_module'(HM:H, M, NH),
+ '$module_transparent'(_, M, _, NH), !.
+'$is_mt'(_H, B, HM, _SM, BM, B, BM).
+
+
+
+% I assume the clause has been processed, so the
+% var case is long gone! Yes :)
+'$clean_cuts'(G,(yap_hacks:current_choicepoint(DCP),NG)) :-
+ '$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) :- !,
+ '$conj_has_cuts'(G1, DCP, NG1, OK),
+ '$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !,
+ '$conj_has_cuts'(G1, DCP, NG1, OK),
+ '$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !,
+ % G1: the system must have done it already
+ '$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !,
+ % G1: the system must have done it already
+ '$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !,
+ % G1: the system must have done it already
+ '$conj_has_cuts'(G2, DCP, NG2, OK),
+ '$conj_has_cuts'(G3, DCP, NG3, OK).
+'$conj_has_cuts'(G,_,G, _).
+
+% return list of vars in expanded positions on the head of a clause.
+%
+% these variables should not be expanded by meta-calls in the body of the goal.
+%
+% should be defined before caller.
+%
+'$module_u_vars'(M, H, UVars) :-
+ '$do_module_u_vars'(M:H,UVars).
+
+'$do_module_u_vars'(M:H,UVars) :-
+ functor(H,F,N),
+ '$meta_predicate'(F,M,N,D), !,
+ '$do_module_u_vars'(N,D,H,UVars).
+'$do_module_u_vars'(_,[]).
+
+'$do_module_u_vars'(0,_,_,[]) :- !.
+'$do_module_u_vars'(I,D,H,LF) :-
+ arg(I,D,X), ( X=':' ; integer(X)),
+ arg(I,H,A), '$uvar'(A, LF, L), !,
+ I1 is I-1,
+ '$do_module_u_vars'(I1,D,H,L).
+'$do_module_u_vars'(I,D,H,L) :-
+ I1 is I-1,
+ '$do_module_u_vars'(I1,D,H,L).
+
+'$uvar'(Y, [Y|L], L) :- var(Y), !.
+% support all/3
+'$uvar'(same( G, _), LF, L) :-
+ '$uvar'(G, LF, L).
+'$uvar'('^'( _, G), LF, L) :-
+ '$uvar'(G, LF, L).
+
+% expand module names in a body
+% args are:
+% goals to expand
+% code to pass to listing
+% code to pass to compiler
+% head module HM
+% source module SM
+% current module for looking up preds M
+%
+% to understand the differences, you can consider:
+%
+% a:(d:b(X)) :- g:c(X), d(X), user:hello(X)).
+%
+% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get:
+%
+% d:b(X) :- g:c(g:X), a:d(X), user:hello(X).
+%
+% on the other hand,
+%
+% a:(d:b(X) :- c(X), d(X), d:e(X)).
+%
+% will give
+%
+% d:b(X) :- a:c(a:X), a:d(X), e(X).
+%
+%
+% head variab'$expand_goals'(M:G,G1,GO,HM,SM,,_M,HVars)les.
+% goals or arguments/sub-arguments?
+% I cannot use call here because of format/3
+% modules:
+% A4: module for body of clause (this is the one used in looking up predicates)
+% A5: context module (this is the current context
+% A6: head module (this is the one used in compiling and accessing).
+%
+%
+%'$expand_goals'(V,NG,NG,HM,SM,BM,HVars):-l writeln(V), fail.
+'$expand_goals'(V,NG,NGO,HM,SM,BM,HVars-H) :-
+ var(V),
+ !,
+ ( lists:identical_member(V, HVars)
+ ->
+ '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
+ ;
+ ( atom(BM)
+ ->
+ NG = call(BM:V),
+ NGO = '$execute_in_mod'(V,BM)
+ ;
+ '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H)
+ )
+ ).
+'$expand_goals'(BM:V,NG,NGO,HM,SM,_BM,HVarsH) :-
+ !,
+ '$yap_strip_module'( BM:V, CM, G),
+ '$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH).
+% if I don't know what the module is, I cannot do anything to the goal,
+% so I just put a call for later on.
+'$expand_goals'(V,NG,NGO,_HM,_SM,BM,_HVarsH) :-
+ var(BM),
+ !,
+ NG = call(BM:V),
+ NGO = '$execute_wo_mod'(V,BM).
+'$expand_goals'(depth_bound_call(G,D),
+ depth_bound_call(G1,D),
+ ('$set_depth_limit_for_next_call'(D),GO),
+ HM,SM,BM,HVars) :-
+ '$expand_goals'(G,G1,GO,HM,SM,BM,HVars),
+ '$composed_built_in'(GO), !.
+'$expand_goals'((A,B),(A1,B1),(AO,BO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- var(A), !,
+ '$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A*->B;C),(A1*->B1;C1),
+ (
+ yap_hacks:current_choicepoint(DCP),
+ AO,
+ yap_hacks:cut_at(DCP),BO
+ ;
+ CO
+ ),
+ HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
+ '$clean_cuts'(AOO, AO),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+ '$expand_goals'(C,C1,CO,HM,SM,BM,HVars).
+'$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A|B),(A1|B1),(AO|BO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A->B),(A1->B1),(AO->BO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
+ '$clean_cuts'(AOO, AO),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :-
+ nonvar(G),
+ G = (A = B),
+ !.
+'$expand_goals'(\+A,\+A1,(AO-> false;true),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
+'$expand_goals'(once(A),once(A1),
+ (yap_hacks:current_choice_point(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+ '$clean_cuts'(AO0, CP, AO).
+'$expand_goals'(ignore(A),ignore(A1),
+ (AO -> true ; true),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+ '$clean_cuts'(AO0, AO).
+'$expand_goals'(forall(A,B),forall(A1,B1),
+ ((AO, ( BO-> false ; true)) -> false ; true),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+ '$clean_cuts'(AO0, AO).
+'$expand_goals'(not(A),not(A1),(AO -> fail; true),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
+'$expand_goals'(if(A,B,C),if(A1,B1,C1),
+ (yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+ '$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
+ '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'((A*->B;C),(A1*->B1;C1),
+ (yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+ '$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
+ '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'((A*->B),(A1*->B1),
+ (yap_hacks:current_choicepoint(DCP),AO,BO),HM,SM,BM,HVars) :- !,
+ '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+ '$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+ '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'(true,true,true,_,_,_,_) :- !.
+'$expand_goals'(fail,fail,fail,_,_,_,_) :- !.
+'$expand_goals'(false,false,false,_,_,_,_) :- !.
+'$expand_goals'(M:G,call(M:G),
+ '$execute_wo_mod'(G,M),_,_,_,_) :-
+ var(M),
+ !.
+'$expand_goals'(G, G1, GO, HM, SM, BM, HVars) :-
+ '$yap_strip_module'(BM:G, NBM, GM),
+ '$do_expand_goals'(NBM:GM, G1, GO, HM, SM, BM, HVars).
+
+'$do_expand_goals'(V:G, call(V:G), call(V:G), HM, SM, BM, HVars) :-
+ var(V), !.
+'$do_expand_goals'(G, G1, GO, HM, SM, BM, HVarsH) :-
+ '$yap_strip_module'(BM:G, NBM, GM),
+ '$do_expand_goal'(GM, G1, GO, HM, SM, NBM, HVarsH).
+
+ /**
+ * @brief Perform meta-variable and user expansion on a goal _G_
+ *
+ * given the example
+~~~~~
+:- module(m, []).
+
+o:p(B) :- n:g, X is 2+3, call(B).
+~~~~~
+ *
+ * @param G input goal, without module quantification.
+ * @param G1F output, non-optimised for debugging
+ * @param GOF output, optimised, ie, `n:g`, `prolog:(X is 2+3)`, `call(m:B)`, where `prolog` does not need to be explicit
+ * @param GOF output, optimised, `n:g`, `prolog:(X=5)`, `call(m:B)`
+ * @param HM head module, input, o
+ * @param HM source module, input, m
+ * @param M current module, input, `n`, `m`, `m`
+ * @param HVars-H, list of meta-variables and initial head, `[]` and `p(B)`
+ *
+ *
+ */
+'$expand_goal'(GM, G1F, GOF, HM, SM, BM, HVarsH) :-
+ '$yap_strip_module'(BM:GM, M, G),
+ '$do_expand_goal'(G, G1F, GOF, HM, SM, M, HVarsH).
+
+'$do_expand_goal'(G, G1F, GOF, HM, SM, BM, HVarsH) :-
+ '_user_expand_goal'(BM:G, BMG2), !,
+ '$yap_strip_module'( BMG2, BM2, G2),
+ '$new_cycle_of_goal_expansion'( G2, BM:G, G1F, GOF, HM, SM, BM2, HVarsH).
+'$do_expand_goal'(G, G1F, GOF, HM, SM, BM, HVars-H) :-
+ % expand import table, to avoid overheads
+ (
+ '$imported_predicate'(G, BM, GI, MI)
+ ->
+ true
+ ;
+ GI = G,
+ MI = BM
+ ),
+ % expand meta-arguments using the call module, BM, not the actual built-in module, MI
+ (
+ functor(GI, F, Arity ),
+ '$meta_predicate'(F,MI,Arity,PredDef)
+ ->
+ '$meta_expand'(GI, PredDef, HM, SM, BM, HVars, GG)
+ ;
+ GI = GG
+ ),
+ '$end_goal_expansion'(GG, G1F, GOF, HM, SM, MI, H).
+
+
+/**
+ * @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_)
+1 *
+ * expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore
+ *
+ * @return
+*/
+'$meta_expand'(G, _, _HM, _SM, CM, HVars, OG) :-
+ var(G),
+ !,
+ (
+ lists:identical_member(G, HVars)
+ ->
+ OG = G
+ ;
+ OG = CM:G
+ ).
+% nothing I can do here:
+'$meta_expand'(G0, PredDef, HM, SM, CM, HVars, NG) :-
+ G0 =.. [Name|GArgs],
+ PredDef =.. [Name|GDefs],
+ functor(PredDef, Name, Arity ),
+ length(NGArgs, Arity),
+ NG =.. [Name|NGArgs],
+ '$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs).
+
+'$expand_args'([], _, _ , _, [], _, []).
+'$expand_args'([A|GArgs], HM, SM, CM, [M|GDefs], HVars, [NA|NGArgs]) :-
+ ( M == ':' -> true ; number(M) ),
+ !,
+ '$expand_arg'(A, HM, SM, CM, HVars, NA),
+ '$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs).
+'$expand_args'([A|GArgs], HM, SM, CM, [_|GDefs], HVars, [A|NGArgs]) :-
+ '$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs).
+
+
+% check if an argument should be expanded
+'$expand_arg'(G, _HM, _SM, CM, HVars, OG) :-
+ var(G),
+ !,
+ ( lists:identical_member(G, HVars) -> OG = G; OG = CM:G).
+'$expand_arg'(G, _HM, _SM, CM, _HVars, NCM:NG) :-
+ '$yap_strip_module'(CM:G, NCM, NG).
+
+'$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :-
+ '$match_mod'(G, HM, SM, BM, G1F),
+ '$c_built_in'(G1F, BM, H, GO),
+ '$yap_strip_module'(BM:GO, MO, IGO),
+ '$match_mod'(IGO, HM, SM, MO, GOF).
+
+'$new_cycle_of_goal_expansion'( G, BM:G1, G1F, GOF, HM, SM, M, HVarsH) :-
+ BM:G1 \== M:G,
+ !,
+ '$expand_goals'(G, G1F, GOF, HM, SM, BM, HVarsH).
+
+'$match_mod'(G, HMod, SMod, M, O) :-
+ (
+ % \+ '$is_multifile'(G1,M),
+ %->
+ '$system_predicate'(G,prolog)
+ ->
+ O = G
+ ;
+ M == HMod, M == SMod
+ ->
+ O = G
+ ;
+ O = M:G
+ ).
+
+expand_goal(Input, Output) :-
+ '$expand_meta_call'(Input, [], Output ).
+
+'$expand_meta_call'(G, HVars, MF:GF ) :-
+ source_module(SM),
+ '$yap_strip_module'(SM:G, M, IG),
+ '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
+ '$yap_strip_module'(M:GF0, MF, GF).
+
+'$build_up'(HM, NH, SM, true, NH, true, NH) :- HM == SM, !.
+'$build_up'(HM, NH, _SM, true, HM:NH, true, HM:NH) :- !.
+'$build_up'(HM, NH, SM, B1, (NH :- B1), BO, ( NH :- BO)) :- HM == SM, !.
+'$build_up'(HM, NH, _SM, B1, (HM:NH :- B1), BO, ( HM:NH :- BO)) :- !.
+
+'$expand_clause_body'(true, _NH1, _HM1, _SM, _M, true, true ) :- !.
+'$expand_clause_body'(B, H, HM, SM, M, B1, BO ) :-
+ '$module_u_vars'(HM , H, UVars), % collect head variables in
+ % expanded positions
+ % support for SWI's meta primitive.
+ '$is_mt'(H, B, HM, SM, M, IB, BM),
+ '$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H),
+ (
+ '$full_clause_optimisation'(H, BM, BO1, BO)
+ ->
+ true
+ ;
+ BO = BO1
+ ).
+
+%
+% check if current module redefines an imported predicate.
+% and remove import.
+%
+'$not_imported'(H, Mod) :-
+ recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
+ NM \= Mod,
+ functor(NH,N,Ar),
+ '$early_print'(warning,redefine_imported(Mod,NM,N/Ar)),
+ erase(R),
+ fail.
+'$not_imported'(_, _).
+
+
+'$verify_import'(_M:G, prolog:G) :-
+ '$system_predicate'(G, prolog).
+'$verify_import'(M:G, NM:NG) :-
+ '$get_undefined_pred'(G, M, NG, NM),
+ !.
+'$verify_import'(MG, MG).
+
+
+
+% expand arguments of a meta-predicate
+% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
+
+
+% expand module names in a clause (interface predicate).
+% A1: Input Clause
+% A2: Output Class to Compiler (lives in module HM)
+% A3: Output Class to clause/2 and listing (lives in module HM)
+%
+% modules:
+% A6: head module (this is the one used in compiling and accessing).
+% A5: context module (this is the current context
+% A4: module for body of clause (this is the one used in looking up predicates)
+%
+ % has to be last!!!
+'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
+ '$yap_strip_module'(SM0:MHB, SM, HB), % remove layers of modules over the clause. SM is the source module.
+ '$head_and_body'(HB, H, B), % HB is H :- B.
+ '$yap_strip_module'(SM:H, HM, NH), % further module expansion
+ '$not_imported'(NH, HM),
+ '$yap_strip_module'(SM:B, BM, B0), % further module expansion
+ '$expand_clause_body'(B0, NH, HM, SM0, BM, B1, BO),
+ '$build_up'(HM, NH, SM0, B1, Cl1, BO, ClO).
+
+
+:- '$meta_predicate'(prolog:(
+ abolish(:),
+ abolish(:,+),
+ all(?,0,-),
+ assert(:),
+ assert(:,+),
+ assert_static(:),
+ asserta(:),
+ asserta(:,+),
+ asserta_static(:),
+ assertz(:),
+ assertz(:,+),
+ assertz_static(:),
+ at_halt(0),
+ bagof(?,0,-),
+ bb_get(:,-),
+ bb_put(:,+),
+ bb_delete(:,?),
+ bb_update(:,?,?),
+ call(0),
+ call(1,?),
+ call(2,?,?),
+ call(3,?,?,?),
+ call_with_args(0),
+ call_with_args(1,?),
+ call_with_args(2,?,?),
+ call_with_args(3,?,?,?),
+ call_with_args(4,?,?,?,?),
+ call_with_args(5,?,?,?,?,?),
+ call_with_args(6,?,?,?,?,?,?),
+ call_with_args(7,?,?,?,?,?,?,?),
+ call_with_args(8,?,?,?,?,?,?,?,?),
+ call_with_args(9,?,?,?,?,?,?,?,?,?),
+ call_cleanup(0,0),
+ call_cleanup(0,?,0),
+ call_residue(0,?),
+ call_residue_vars(0,?),
+ call_shared_object_function(:,+),
+ catch(0,?,0),
+ clause(:,?),
+ clause(:,?,?),
+ compile(:),
+ consult(:),
+ current_predicate(:),
+ current_predicate(?,:),
+ db_files(:),
+ depth_bound_call(0,+),
+ discontiguous(:),
+ ensure_loaded(:),
+ exo_files(:),
+ findall(?,0,-),
+ findall(?,0,-,?),
+ forall(0,0),
+ format(+,:),
+ format(+,+,:),
+ freeze(?,0),
+ hide_predicate(:),
+ if(0,0,0),
+ ignore(0),
+ incore(0),
+ multifile(:),
+ nospy(:),
+ not(0),
+ notrace(0),
+ once(0),
+ phrase(2,?),
+ phrase(2,?,+),
+ predicate_property(:,?),
+ predicate_statistics(:,-,-,-),
+ on_exception(+,0,0),
+ qsave_program(+,:),
+ reconsult(:),
+ retract(:),
+ retract(:,?),
+ retractall(:),
+ reconsult(:),
+ setof(?,0,-),
+ setup_call_cleanup(0,0,0),
+ setup_call_catcher_cleanup(0,0,?,0),
+ spy(:),
+ stash_predicate(:),
+ use_module(:),
+ use_module(:,?),
+ use_module(?,:,?),
+ when(+,0),
+ with_mutex(+,0),
+ with_output_to(?,0),
+ '->'(0 , 0),
+ '*->'(0 , 0),
+ ';'(0 , 0),
+% ','(0 , 0),
+ ^(+,0),
+ {}(0,?,?),
+ ','(2,2,?,?),
+ ;(2,2,?,?),
+ '|'(2,2,?,?),
+ ->(2,2,?,?),
+ \+(2,?,?),
+ \+( 0 )
+ )).
diff --git a/pl/modules.yap b/pl/modules.yap
index 9f0c5c1b7..36a0ca5cf 100644
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -1,4 +1,3 @@
-
/*************************************************************************
* *
* YAP Prolog *
@@ -16,125 +15,9 @@
* *
*************************************************************************/
+
/**
-
- \defgroup YAPModules The YAP Module system
-
- @ingroup consult
-
- The YAP module system is based on the Quintus/SISCtus module
-system ˜\cite quintus . In this design, modules are named collections of predicates,
-and all predicates belong to a single module. By default, predicates are only
-visible within a module, or _private_ to that module. The module
-may also define a list of predicates that are
-_exported_, that is, visible to other modules.
-
-The main predicates in the module system are:
-
- * module/2 associates a source file to a module. It has two arguments: the name of the new module, and a list of predicates exported by the module.
-
- * use_module/1 and use_module/2 can be used to load a module. They take as first argument the source file for the module. Whereas use_module/1 loads all exported predicates, use_module/2 only takes the ones given by the second argument.
-
-YAP pre-defines a number of modules. Most system predicates belong to
- the module `prolog`. Predicates from the module `prolog` are
-automatically visible to every module. The `system` module was
- introduced for SWI-Prolog compatibility, and in YAP mostly acts as an
-alias to `prolog`. The `user` module is also visible to all other modules.
-
-The YAP engine is always associated to a module, the current source
-module or type-in module. By default, all predicates
-read-in and all calls to a goal will be made to predicates visible to
-the current source module, Initially, the source module for YAP is the
-module `user`. Thus Prolog programs that do not define modules will
-operate within the `user` module. In this case, all predicates will be
-visible to all source files.
-
-YAP includes a number of libraries and packages, most of them
- defining their own modules. Note that there is no system mechanism to
- avoid clashes between module names, so it is up to the programmer to
- carefully choose the names for her own program modules.
-
-The main mechanism to change the current type-in module is by using
-the module/2 declaration.This declaration sets the source module when
- it starts consulting a file, and resets it at the end. One can set
-the type-in module permanently by using the built-in `module/1`.
-
-\subsection Explicit Naming
-
-The module system allows one to _explicitly_ specify the source mode for
-a clause by prefixing a clause with its module, say:
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-user:(a :- b).
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-it is also possible to type
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-
-user:a :- user:b.
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-both formulations describe the same clause, independently of the
-current type-in module.
-
-In fact, it is sufficient to specify the source mode for the clause's
-head:
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-user:a :- b.
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-if the current type-in module is `m`, the clause could also be written as:
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-user:a :- m:b.
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The compiler rewrites the source clauses to ensure that explicit calls
-are respected, and that implicit calls are made to the current source
-module.
-
-A goal should refer to a predicate visible within the current type-in
-module. Thus, if a goal appears in a text file with a module
-declaration, the goal refers to that module's context (but see the
-initialization/1 directive for more details).
-
-Again, one can override this rule by prefixing a goal with a module to
-be consulted. The following query:
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-?- nasa:launch(apollo,13).
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- invokes the goal `launch(apollo,13)` as if the current source
-module was `nasa`.
-
-YAP and other Prolog systems allow the module prefix to see all
-predicates visible in the module, including predicates private to the
-module. This rule allows maximum flexibility, but it also breaks
-encapsulation and should be used with care. The ciao language proposes
-a different approach to this problem, see \cite DBLP:conf/cl/GrasH00 .
-
-Modules are not always associated with a source-file. They
-may range over several files, by using the
-`include`directive. Moreover, they may not be associated to any source
-file. As an example,
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-?- assert( nasa:launch(apollo,13) ).
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-will create a module `nasa`, if does not already exist. In fact it is
-sufficient to call a predicate from a module to implicitly create the
-module. Hence after this call:
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
-?- nasa:launch(apollo,13).
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-there will be a `nasa`module in the system, even if nasa:launch/2 is
-not at all defined.
-
-\{
-
+@file modules.yap
**/
:- system_module( '$_modules', [abolish_module/1,
add_import_module/3,
@@ -160,7 +43,7 @@ not at all defined.
'$extend_exports'/3,
'$get_undefined_pred'/4,
'$imported_predicate'/4,
- '$meta_expansion'/6,
+ '$meta_expand'/6,
'$meta_predicate'/2,
'$meta_predicate'/4,
'$module'/3,
@@ -169,6 +52,8 @@ not at all defined.
'$module_transparent'/2,
'$module_transparent'/4]).
+
+
:- use_system_module( '$_arith', ['$c_built_in'/3]).
:- use_system_module( '$_consult', ['$lf_opt'/3,
@@ -180,6 +65,9 @@ not at all defined.
:- use_system_module( '$_eval', ['$full_clause_optimisation'/4]).
+:- multifile '$system_module'/1.
+
+
:- '$purge_clauses'(module(_,_), prolog).
:- '$purge_clauses'('$module'(_,_), prolog).
:- '$purge_clauses'(use_module(_), prolog).
@@ -274,7 +162,7 @@ a(X) :-
% d1.pl
:- module( d1, [b/1,c/1] ).
-b(2).
+vvb(2).
c(3).
@@ -342,101 +230,7 @@ Unfortunately it is still not possible to change argument order.
use_module(F,Is) :-
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
-/**
- \pred module(+M) is det
- set the type-in module
-
-Defines _M_ to be the current working or type-in module. All files
-which are not bound to a module are assumed to belong to the working
-module (also referred to as type-in module). To compile a non-module
-file into a module which is not the working one, prefix the file name
-with the module name, in the form ` _Module_: _File_`, when
-loading the file.
-
-**/
-module(N) :-
- var(N),
- '$do_error'(instantiation_error,module(N)).
-module(N) :-
- atom(N), !,
- % set it as current module.
- '$current_module'(_,N).
-module(N) :-
- '$do_error'(type_error(atom,N),module(N)).
-
-/**
- \pred module(+ Module:atom, +ExportList:list) is directive
- define a new module
-
-This directive defines the file where it appears as a _module file_;
-it must be the first declaration in the file. _Module_ must be an
-atom specifying the module name; _ExportList_ must be a list
-containing the module's public predicates specification, in the form
-`[predicate_name/arity,...]`. The _ExportList_ can include
-operator declarations for operators that are exported by the module.
-
-The public predicates of a module file can be made accessible to other
-files through loading the source file, using the directives
-use_module/1 or use_module/2,
-ensure_loaded/1 and the predicates
-consult/1 or reconsult/1. The
-non-public predicates of a module file are not supposed to be visible
-to other modules; they can, however, be accessed by prefixing the module
-name with the `:/2` operator.
-
-**/
-'$module_dec'(N, Ps) :-
- source_location(F, _),
- b_getval( '$source_file', F0 ),
- '$add_module_on_file'(N, F, F0, Ps),
- '$current_module'(_,N).
-
-'$module'(_,N,P) :-
- '$module_dec'(N,P).
-
-/**
- \pred module(+ M:atom,+ L:list ) is directive
- the current file defines module _M_ with exports _L_. The list may include
-
- + predicate indicators
-
- + operator definitions that look like calls to op/3.
-
-The list _L_ may include predicates imported from other modules. If
-you want to fully reexport a module, or a sub-set, also consider reexport/1.
-
-Similar to module/2, this directive defines the file where it
-appears in as a module file; it must be the first declaration in the file.
- _M_ must be an atom specifying the module name; _L_ must be a
-list containing the module's public predicates specification, in the
-form `[predicate_name/arity,...]`.
-
-The last argument _Options_ must be a list of options, which can be:
- + filename
- the filename for a module to import into the current module.
-
- + library( +File )
- a library file to import into the current module.
-
- + hide( +Opt)
- if _Opt_ is `false`, keep source code for current module, if `true`, disable.
-
- + export(+PredicateIndicator )
- Add predicates to the public list of the context module. This implies
- the predicate will be imported into another module if this module
- is imported with use_module/1 and use_module/2.
-
- + export_list(? _Mod_,? _ListOfPredicateIndicator_)
- The list _ListOfPredicateIndicator_ contains all predicates
- exported by module _Mod_
-
-Note that predicates are normally exported using the directive
-`module/2`. The `export/1` argumwnt is meant to allow export from
-dynamically created modules. The directive argument may also be a list
-of predicates.
-
-**/
'$module'(O,N,P,Opts) :- !,
'$module'(O,N,P),
'$process_module_decls_options'(Opts,module(Opts,N,P)).
@@ -479,31 +273,6 @@ of predicates.
'$prepare_restore_hidden'(Old,New) :-
recorda('$system_initialization', source_mode(New,Old), _).
-'$add_module_on_file'(DonorMod, DonorF, SourceF, Exports) :-
- recorded('$module','$module'(OtherF, DonorMod, _, _, _),R),
- % the module has been found, are we reconsulting?
- (
- DonorF \= OtherF
- ->
- '$do_error'(permission_error(module,redefined,DonorMod, OtherF, DonorF),module(DonorMod,Exports))
- ;
- recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _), R),
- erase( R ),
- fail
- ).
-'$add_module_on_file'(DonorM, DonorF, SourceF, Exports) :-
- '$current_module'( HostM ),
- ( recorded('$module','$module'( HostF, HostM, _, _, _),_) -> true ; HostF = user_input ),
- % first build the initial export tablee
- '$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
- sort( AllExports0, AllExports ),
- ( source_location(_, Line) -> true ; Line = 0 ),
- '$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
- % last, export everything to the host: if the loading crashed you didn't actually do
- % no evil.
- recorda('$module','$module'(DonorF,DonorM,SourceF, AllExports, Line),_),
- ( recorded('$source_file','$source_file'( DonorF, Time, _), R), erase(R),
- recorda('$source_file','$source_file'( DonorF, Time, DonorM), _) ).
'$extend_exports'(HostF, Exports, DonorF ) :-
( recorded('$module','$module'( DonorF, DonorM, _,DonorExports, _),_) -> true ; DonorF = user_input ),
@@ -523,14 +292,10 @@ of predicates.
'$module_produced by'(M,MI,N1,K1).
-/** \pred current_module( ? Mod:atom) is nondet
- : _Mod_ is any user-visible module.
-
-*/
-/** @pred current_module( _M_)
+/** @pred current_module( ? Mod:atom) is nondet
-Succeeds if _M_ are defined modules. A module is defined as soon as some
+Succeeds if _M_ is a user-visible modules. A module is defined as soon as some
predicate defined in the module is loaded, as soon as a goal in the
module is called, or as soon as it becomes the current type-in module.
@@ -538,58 +303,16 @@ module is called, or as soon as it becomes the current type-in module.
*/
current_module(Mod) :-
'$all_current_modules'(Mod),
- \+ '$system_module'(Mod).
-
-/** \pred current_module( ? Mod:atom, ? File : file ) is nondet
- : _Mod_ is any user-visible module and _File_ its source file, or `user` if none exists.
-
-*/
-/** @pred current_module( _M_, _F_)
-
-Succeeds if _M_ are current modules associated to the file _F_.
-
-
+ \+ prolog:'$system_module'(Mod).
+/** @pred current_module( ? Mod:atom, ? _F_ : file ) is nondet
+Succeeds if _M_ is a module associated with the file _F_, that is, if _File_ is the source for _M_. If _M_ is not declared in a file, _F_ unifies with `user`.
*/
current_module(Mod,TFN) :-
'$all_current_modules'(Mod),
( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ).
-/** \pred source_module( - Mod:atom ) is nondet
- : _Mod_ is the current read-in or source module.
-
-*/
-source_module(Mod) :-
- '$current_module'(Mod).
-
-
-% expand module names in a clause (interface predicate).
-% A1: Input Clause
-% A2: Output Class to Compiler (lives in module HM)
-% A3: Output Class to clause/2 and listing (lives in module HM)
-%
-% modules:
-% A4: module for body of clause (this is the one used in looking up predicates)
-% A5: context module (this is the current context
-% A6: head module (this is the one used in compiling and accessing).
-%
-%
-'$module_expansion'(H, H, H, _HM, _BM, _SM) :- var(H), !.
-'$module_expansion'((H:-B), (H:-B1), (H:-BOO), HM, BM, SM) :- !,
- '$is_mt'(HM, H, SM, B, IB, NSM),
- '$module_u_vars'(H,UVars,HM), % collect head variables in
- % expanded positions
- '$expand_modules'(IB, B1, BO, HM, BM, NSM, UVars-H),
- ('$full_clause_optimisation'(H, NSM, BO, BOO) ->
- true
- ;
- BO = BOO
- ).
-% do not expand bodyless clauses.
-'$module_expansion'(H,H,H,_,_,_).
-
-
'$trace_module'(X) :-
telling(F),
tell('P0:debug'),
@@ -608,264 +331,34 @@ source_module(Mod) :-
'$trace_module'(_,_).
-% expand module names in a body
-% args are:
-% goals to expand
-% code to pass to listing
-% code to pass to compiler
-% current module for looking up preds M
-% source module SM
-% head module HM
-%
-% to understand the differences, you can consider:
-%
-% a:(d:b(X) :- g:c(X), d(X), user:hello(X)).
-%
-% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get:
-%
-% d:b(X) :- g:c(g:X), a:d(X), user:hello(X).
-%
-% on the other hand,
-%
-% a:(d:b(X) :- c(X), d(X), d:e(X)).
-%
-% will give
-%
-% d:b(X) :- a:c(a:X), a:d(X), e(X).
-%
-%
-% head variab'$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars)les.
-% goals or arguments/sub-arguments?
-% I cannot use call here because of format/3
-% modules:
-% A4: module for body of clause (this is the one used in looking up predicates)
-% A5: context module (this is the current context
-% A6: head module (this is the one used in compiling and accessing).
-%
-%
-%'$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),
- ( 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).
-'$expand_modules'((A;B),(A1;B1),(AO;BO),HM,BM,SM,HVars) :- var(A), !,
- '$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
- '$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
-'$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,AOO,HM,BM,SM,HVars),
- '$clean_cuts'(AOO, AO),
- '$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
- '$expand_modules'(C,C1,CO,HM,BM,SM,HVars).
-'$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).
-'$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).
-'$expand_modules'((A->B),(A1->B1),(AO->BO),HM,BM,SM,HVars) :- !,
- '$expand_modules'(A,A1,AOO,HM,BM,SM,HVars),
- '$clean_cuts'(AOO, AO),
- '$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
-'$expand_modules'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :-
- nonvar(G),
- G = (A = B),
+'$continue_imported'(Mod,Mod,Pred,Pred) :-
+ '$pred_exists'(Pred, Mod),
!.
-'$expand_modules'(\+A,\+A1,(AO-> false;true),HM,BM,SM,HVars) :- !,
- '$expand_modules'(A,A1,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),
- '$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
- '$clean_cuts'(AO0, DCP, AO).
-'$expand_modules'(true,true,true,_,_,_,_) :- !.
-'$expand_modules'(fail,fail,fail,_,_,_,_) :- !.
-'$expand_modules'(false,false,false,_,_,_,_) :- !.
-% if I don't know what the module is, I cannot do anything to the goal,
-% so I just put a call for later on.
-'$expand_modules'(M:G,call(M:G),
- '$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !.
-'$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars) :- !,
- '$expand_modules'(G,G1,GO,HM,M,M,HVars).
-'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :-
- '$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars).
- % is this imported from some other module M1?
+'$continue_imported'(FM,Mod,FPred,Pred) :-
+ recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), !,
+ '$continue_imported'(FM, IM, FPred, IPred).
+'$continue_imported'(FM,Mod,FPred,Pred) :-
+ prolog:'$parent_module'(Mod,IM),
+ '$continue_imported'(FM, IM, FPred, Pred).
-'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars) :-
- '$pred_exists'(G, BM), !,
- '$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars).
-'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars) :-
- '$imported_predicate'(G, BM, GG, M1),
- !,
- '$expand_goal_meta'(GG, G1, GO, HM, M1, SM, HVars).
-% we assume that if it is not defined here, it must be elsewhere.
-'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars) :-
- '$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars).
-
-'$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars) :-
- '$meta_expansion'(G, HM, BM, SM, GI, HVars), !,
- '$complete_goal_expansion'(GI, HM, BM, SM, G1, GO, HVars).
-'$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars) :-
- '$complete_goal_expansion'(G, HM, BM, SM, G1, GO, HVars).
-
-expand_goal(G, G) :-
- var(G), !.
-expand_goal(M:G, M:NG) :-
- '$do_expand'(G, M, prolog, []-G, NG), !.
-expand_goal(G, NG) :-
- '$current_module'(Mod),
- '$do_expand'(G, Mod, prolog, []-G, NG), !.
-expand_goal(G, G).
-
-'$do_expand'(G, _HM, _BM, SM, HVars-_, OG) :- var(G), !,
- ( lists:identical_member(G, HVars) -> OG = G; OG = SM:G).
-% nothing I can do here:
-'$do_expand'(M:G, _HM, _BM, _SM, _HVars, M:G) :- !,
- nonvar(M), var(G), !.
-'$do_expand'(M:G, HM, _BM, _SM, HVars, M:GI) :- !,
- nonvar(M),
- '$do_expand'(G, HM, M, M, HVars, GI).
-'$do_expand'(G, _HM, _BM, SM, _HVars, GI) :-
- (
- '$pred_exists'(goal_expansion(G,GI), SM),
- call(SM:goal_expansion(G, GI))
- ->
- true
- ;
- '$pred_exists'(goal_expansion(G,GI), system),
- system:goal_expansion(G, GI)
- ->
- true
- ;
- user:goal_expansion(G, SM, GI)
- ->
- true
- ;
- user:goal_expansion(G, GI)
- ), !.
-'$do_expand'(G, HM, BM, SM, HVars, NG) :-
- '$is_metapredicate'(G,BM), !,
- functor(G, Name, Arity),
- prolog:'$meta_predicate'(Name,BM,Arity,PredDef),
- G =.. [Name|GArgs],
- PredDef =.. [Name|GDefs],
- '$expand_args'(GArgs, HM, BM, SM, GDefs, HVars, NGArgs),
- NG =.. [Name|NGArgs].
-
-'$expand_args'([], _, _, _, [], _, []).
-'$expand_args'([A|GArgs], HM, BM, SM, [M|GDefs], HVars, [NA|NGArgs]) :-
- ( M == ':' -> true ; number(M) ),
- '$do_expand'(A, HM, BM, SM, HVars, NA), !,
- '$expand_args'(GArgs, HM, BM, SM, GDefs, HVars, NGArgs).
-'$expand_args'([A|GArgs], HM, BM, SM, [_|GDefs], HVars, [A|NGArgs]) :-
- '$expand_args'(GArgs, HM, BM, SM, GDefs, HVars, NGArgs).
-
-% args are:
-% goal to expand
-% current module for looking up pred
-% current module from head of clause
-% context module
-% :- module(m, []). o:p :- n:(g, l).
-% would be o, n, m.
-% goal to pass to listing
-% goal to pass to compiler
-% head variables.
-'$complete_goal_expansion'(G, HM, BM, SM, G1, GO, HVars) :-
-% '$pred_goal_expansion_on',
- '$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-H) :-
- '$all_system_predicate'(G, BM, BM0), !,
- % make built-in processing transparent.
- '$match_mod'(G, HM, BM0, SM, G1),
- '$c_built_in'(G1, SM, H, G2).
-'$complete_goal_expansion'(G, HM, BM, SM, NG, NG, _) :-
- '$match_mod'(G, HM, BM, SM, NG).
-
-%'$match_mod'(G, GMod, GMod, NG) :- !,
-% NG = G.
-'$match_mod'(G, _, M, _, G) :-
- nonvar(G),
- '$system_predicate'(G,prolog),
-% \+ '$is_metapredicate'(G, prolog),
- \+ '$is_multifile'(G,M),
- !. % prolog: needs no module info.
-% same module as head, and body goal (I cannot get rid of qualifier before
-% meta-call.
-'$match_mod'(G, HMod, BM, _HM, G) :- HMod == BM, !.
-'$match_mod'(G, _, GMod, _, GMod:G).
% be careful here not to generate an undefined exception.
+'$imported_predicate'(G, ImportingMod, G, prolog) :-
+ '$system_predicate'(G, prolog), !.
'$imported_predicate'(G, ImportingMod, G0, ExportingMod) :-
- '$enter_undefp',
( var(G) -> true ;
var(ImportingMod) -> true ;
'$undefined'(G, ImportingMod)
),
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
- ExportingMod \= ImportingMod, !,
- '$exit_undefp'.
-'$imported_predicate'(_G, _ImportingMod, _, _) :-
- '$exit_undefp',
- fail.
+ ExportingMod \= ImportingMod,
+ !.
-% This predicate should be bidirectional: both
-% a consumer and a generator.
-%'$get_undefined_pred'(G, ImportingMod, call(G), ImportingMod) :-
-% var(G), !.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
- '$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
+ '$continue_imported'(ExportingMod, ExportingModI, G0, G0I),
+ !.
% SWI builtin
'$get_undefined_pred'(G, _ImportingMod, G, user) :-
nonvar(G),
@@ -873,18 +366,27 @@ expand_goal(G, G).
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$dialect',swi,_),
get_prolog_flag(autoload, true),
- '$autoload'(G, ImportingMod, ExportingModI, swi),
+ prolog_flag(unknown, OldUnk, fail),
+ (
+ '$autoload'(G, ImportingMod, ExportingModI, swi)
+ ->
+ prolog_flag(unknown, _, OldUnk)
+ ;
+ prolog_flag(unknown, _, OldUnk),
+ fail
+ ),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
% autoload
% parent module mechanism
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
- prolog:'$parent_module'(ImportingMod,ExportingModI),
+ '$parent_module'(ImportingMod,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
'$autoload'(G, _ImportingMod, ExportingMod, Dialect) :-
functor(G, Name, Arity),
- call(Dialect:index(Name,Arity,ExportingMod,_)), !.
+ call(Dialect:index(Name,Arity,ExportingMod,_)),
+ !.
'$autoload'(G, ImportingMod, ExportingMod, _Dialect) :-
functor(G, N, K),
functor(G0, N, K),
@@ -894,332 +396,24 @@ expand_goal(G, G).
'$autoloader_find_predicate'(G,ExportingModI) :-
- '$nb_getval'('$autoloader_set', true, fail), !,
+ '$nb_getval'('$autoloader_set', true, false), !,
autoloader:find_predicate(G,ExportingModI).
'$autoloader_find_predicate'(G,ExportingModI) :-
- '$exit_undefp',
- yap_flag(autoload, false),
+ yap_flag(autoload, true, false),
+ yap_flag( unknown, Unknown, fast_fail),
+ yap_flag(debug, Debug, false), !,
load_files([library(autoloader),
autoloader:library('INDEX'),
swi:library('dialect/swi/INDEX')],
[autoload(true),if(not_loaded)]),
nb_setval('$autoloader_set', true),
- yap_flag(autoload, true),
- '$enter_undefp',
+ yap_flag(autoload, _, true),
+ yap_flag( unknown, _, Unknown),
+ yap_flag( debug, _, Debug),
autoloader:find_predicate(G,ExportingModI).
-'$continue_imported'(Mod,Mod,Pred,Pred) :-
- \+ '$undefined'(Pred, Mod), !.
-'$continue_imported'(FM,Mod,FPred,Pred) :-
- recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), !,
- '$continue_imported'(FM, IM, FPred, IPred).
-'$continue_imported'(FM,Mod,FPred,Pred) :-
- prolog:'$parent_module'(Mod,IM),
- '$continue_imported'(FM, IM, FPred, Pred).
-
-
/**
-
- \defgroup YAPMetaPredicates Using Meta-Calls with Modules
- \ingroup YAPModules
-
-@{
-
- \pred meta_predicate(_G1_,...., _Gn) is directive
-
-Declares that this predicate manipulates references to predicates.
-Each _Gi_ is a mode specification.
-
-If the argument is `:`, it does not refer directly to a predicate
-but must be module expanded. If the argument is an integer, the argument
-is a goal or a closure and must be expanded. Otherwise, the argument is
-not expanded. Note that the system already includes declarations for all
-built-ins.
-
-For example, the declaration for call/1 and setof/3 are:
-
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-:- meta_predicate call(0), setof(?,0,?).
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-meta_predicate declaration
- implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration)
-
-*/
-
-% directive now meta_predicate Ps :- $meta_predicate(Ps).
-
-:- dynamic('$meta_predicate'/4).
-
-:- multifile '$meta_predicate'/4.
-
-'$meta_predicate'(P, M) :-
- var(P),
- '$do_error'(instantiation_error,module(M)).
-'$meta_predicate'((P,Ps), M) :- !,
- '$meta_predicate'(P, M),
- '$meta_predicate'(Ps, M).
-'$meta_predicate'(M:D, _) :- !,
- '$meta_predicate'(D, M).
-'$meta_predicate'(P, M1) :-
- '$install_meta_predicate'(P, M1).
-
-
-'$install_meta_predicate'(P, M1) :-
- functor(P,F,N),
- ( M1 = prolog -> M = _ ; M1 = M),
- ( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
- asserta(prolog:'$meta_predicate'(F,M,N,P)),
- '$predicate_flags'(P, M1, Fl, Fl),
- NFlags is Fl \/ 0x200000,
- '$predicate_flags'(P, M1, Fl, NFlags).
-
-% return list of vars in expanded positions on the head of a clause.
-%
-% these variables should not be expanded by meta-calls in the body of the goal.
-%
-'$module_u_vars'(H,UVars,M) :-
- functor(H,F,N),
- '$meta_predicate'(F,M,N,D), !,
- '$module_u_vars'(N,D,H,UVars).
-'$module_u_vars'(_,[],_).
-
-'$module_u_vars'(0,_,_,[]) :- !.
-'$module_u_vars'(I,D,H,LF) :-
- arg(I,D,X), ( X=':' ; integer(X)),
- arg(I,H,A), '$uvar'(A, LF, L), !,
- I1 is I-1,
- '$module_u_vars'(I1,D,H,L).
-'$module_u_vars'(I,D,H,L) :-
- I1 is I-1,
- '$module_u_vars'(I1,D,H,L).
-
-'$uvar'(Y, [Y|L], L) :- var(Y), !.
-% support all/3
-'$uvar'(same( G, _), LF, L) :-
- '$uvar'(G, LF, L).
-'$uvar'('^'( _, G), LF, L) :-
- '$uvar'(G, LF, L).
-
-% expand arguments of a meta-predicate
-% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
-
-
-'$meta_expansion'(G, HM, BM, SM, G1,HVars) :-
- functor(G,F,N),
- '$meta_predicate'(F,BM,N,D),
- !, % we're in an argument
-% format(user_error,'[ ~w (~a, ~a, ~a)',[G, HM, BM, SM]),
- functor(G1,F,N),
- '$meta_expansion_loop'(N, D, G, G1, HVars, HM, BM, SM).
-% format(user_error,' gives ~w]~n',[G1]).
-
-
-% expand argument
-'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
-'$meta_expansion_loop'(I,D,G,NG,HVars, HM, BM, SM) :-
- arg(I,D,X),
- (X==':' -> true ; integer(X)),
- arg(I,G,A),
- '$should_expand'(A,HVars),
- !,
- ( X ==0 ->
- '$values'('$c_arith',Old, false),
- '$meta_expansion0'(A, HM, BM, SM, NA, HVars),
- '$values'('$c_arith', _False, Old)
- ;
- NA = SM:A
- ),
- arg(I,NG,NA),
- I1 is I-1,
- '$meta_expansion_loop'(I1, D, G, NG, HVars, HM, BM, SM).
-'$meta_expansion_loop'(I, D, G, NG, HVars, HM, BM, SM) :-
- arg(I,G,A),
- arg(I,NG,A),
- I1 is I-1,
- '$meta_expansion_loop'(I1, D, G, NG, HVars, HM, BM, SM).
-
-'$meta_expansion0'(G, _HM, _BM, SM, SM:G, _HVars) :-
- var(G), !.
-'$meta_expansion0'(M:G, _HM, _BM, _SM, G1, _HVars) :-
- var(M), !,
- G1 = '$execute_wo_mod'(G,M).
-% support for all/3
-'$meta_expansion0'(same(G, P), HM, BM, SM, same(G1, P),HVars) :- !,
- '$meta_expansion0'(G, HM, BM, SM, G1,HVars).
-'$meta_expansion0'(G, _HM, _BM, SM, M1:G1,_HVars) :-
- strip_module(SM:G,M1,G1).
-
-
-% check if an argument should be expanded
-'$should_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
-'$should_expand'(_:_,_) :- !, fail.
-'$should_expand'(_,_).
-
-'$not_in_vars'(_,[]).
-'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
-
-/*
- \pred module_transparent( + _Preds_ ) is directive
- _Preds_ is a list of predicates that can access the calling context.
-
- _Preds_ is a comma separated sequence of name/arity predicate
-indicators (like in dynamic/1). Each goal associated with a
-transparent declared predicate will inherit the context module from
-its parent goal.
-
-*/
-:- dynamic('$module_transparent'/4).
-
-'$module_transparent'((P,Ps), M) :- !,
- '$module_transparent'(P, M),
- '$module_transparent'(Ps, M).
-'$module_transparent'(M:D, _) :- !,
- '$module_transparent'(D, M).
-'$module_transparent'(F/N, M) :-
- '$module_transparent'(F,M,N,_), !.
-'$module_transparent'(F/N, M) :-
- functor(P,F,N),
- asserta(prolog:'$module_transparent'(F,M,N,P)),
- '$predicate_flags'(P, M, Fl, Fl),
- NFlags is Fl \/ 0x200004,
- '$predicate_flags'(P, M, Fl, NFlags).
-
-%% handle module transparent predicates by defining a
-%% new context module.
-'$is_mt'(M, H, _, B, (context_module(CM),B), CM) :-
- '$module_transparent'(_, M, _, H), !.
-'$is_mt'(_M, _H, CM, B, B, CM).
-
-% comma has its own problems.
-:- '$install_meta_predicate'(','(0,0), prolog).
-
-
-:- meta_predicate
- abolish(:),
- abolish(:,+),
- all(?,0,-),
- assert(:),
- assert(:,+),
- assert_static(:),
- asserta(:),
- asserta(:,+),
- asserta_static(:),
- assertz(:),
- assertz(:,+),
- assertz_static(:),
- at_halt(0),
- bagof(?,0,-),
- bb_get(:,-),
- bb_put(:,+),
- bb_delete(:,?),
- bb_update(:,?,?),
- call(0),
- call(1,?),
- call(2,?,?),
- call(3,?,?,?),
- call_with_args(0),
- call_with_args(1,?),
- call_with_args(2,?,?),
- call_with_args(3,?,?,?),
- call_with_args(4,?,?,?,?),
- call_with_args(5,?,?,?,?,?),
- call_with_args(6,?,?,?,?,?,?),
- call_with_args(7,?,?,?,?,?,?,?),
- call_with_args(8,?,?,?,?,?,?,?,?),
- call_with_args(9,?,?,?,?,?,?,?,?,?),
- call_cleanup(0,0),
- call_cleanup(0,?,0),
- call_residue(0,?),
- call_residue_vars(0,?),
- call_shared_object_function(:,+),
- catch(0,?,0),
- clause(:,?),
- clause(:,?,?),
- compile(:),
- consult(:),
- current_predicate(:),
- current_predicate(?,:),
- db_files(:),
- depth_bound_call(0,+),
- discontiguous(:),
- ensure_loaded(:),
- exo_files(:),
- findall(?,0,-),
- findall(?,0,-,?),
- forall(0,0),
- format(+,:),
- format(+,+,:),
- freeze(?,0),
- hide_predicate(:),
- if(0,0,0),
- ignore(0),
- incore(0),
- multifile(:),
- nospy(:),
- not(0),
- notrace(0),
- once(0),
- phrase(2,?),
- phrase(2,?,+),
- predicate_property(:,?),
- predicate_statistics(:,-,-,-),
- on_exception(+,0,0),
- qsave_program(+,:),
- reconsult(:),
- retract(:),
- retract(:,?),
- retractall(:),
- reconsult(:),
- setof(?,0,-),
- setup_call_cleanup(0,0,0),
- setup_call_catcher_cleanup(0,0,?,0),
- spy(:),
- stash_predicate(:),
- use_module(:),
- use_module(:,?),
- use_module(?,:,?),
- when(+,0),
- with_mutex(+,0),
- with_output_to(?,0),
- '->'(0 , 0),
- '*->'(0 , 0),
- ';'(0 , 0),
- ','(0 , 0),
- ^(+,0),
- {}(0,?,?),
- ','(2,2,?,?),
- ;(2,2,?,?),
- '|'(2,2,?,?),
- ->(2,2,?,?),
- \+(2,?,?),
- \+( 0 ).
-
-/**
-
-@}
-
-@{
- \defgroup YAPDynamicYAPModules Dynamic Modules
- \ingroup YAPModules
-
- YAP (in the footsteps of SWI-Prolog) allows to create modules that
- are not bound to files. One application is in Inductive Logic Programming,
- where dynamic modules can be used to represent training examples. YAP now include
- built-ins to create a module. manipulate its interface, and eventually abolish the
- module, releasing all the data therein.
-
-*/
-
-/**
-
- \pred declare_module(+Module, +Super, +File, +Line, +Redefine) is det
- declare explicitely a module
-
-Start a new (source-)module _Module_ that inherits all exports from
-_Super_. The module is as if defined in file _File_ and _Line_ and if _Redefine_
-holds true may
be associated to a new file.
\param[in] _Module_ is the name of the module to declare
@@ -1295,123 +489,6 @@ export_resource(Resource) :-
export_list(Module, List) :-
recorded('$module','$module'(_,Module,_,List,_),_).
-'$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, MyExports, _) :-
- '$simple_conversion'(Exports, Tab, MyExports).
-'$convert_for_export'([], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
- '$clean_conversion'([], Exports, Module, ContextModule, Tab, MyExports, Goal).
-'$convert_for_export'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
- '$clean_conversion'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal).
-'$convert_for_export'(except(Excepts), Exports, Module, ContextModule, Tab, MyExports, Goal) :-
- '$neg_conversion'(Excepts, Exports, Module, ContextModule, MyExports, Goal),
- '$simple_conversion'(MyExports, Tab, _).
-
-'$simple_conversion'([], [], []).
-'$simple_conversion'([F/N|Exports], [F/N-F/N|Tab], [F/N|E]) :-
- '$simple_conversion'(Exports, Tab, E).
-'$simple_conversion'([F//N|Exports], [F/N2-F/N2|Tab], [F/N2|E]) :-
- N2 is N+1,
- '$simple_conversion'(Exports, Tab, E).
-'$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :-
- '$simple_conversion'(Exports, Tab, E).
-'$simple_conversion'([F//N as NF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :-
- N2 is N+1,
- '$simple_conversion'(Exports, Tab, E).
-'$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :-
- '$simple_conversion'(Exports, Tab, E).
-
-'$clean_conversion'([], _, _, _, [], [], _).
-'$clean_conversion'([(N1/A1 as N2)|Ps], List, Module, ContextModule, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- !,
- ( lists:memberchk(N1/A1, List)
- ->
- true
- ;
- '$bad_export'((N1/A1 as N2), Module, ContextModule)
- ),
- '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
-'$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
- (
- lists:memberchk(N1/A1, List)
- ->
- true
- ;
- '$bad_export'(N1/A1, Module, ContextModule)
- ),
- '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
-'$clean_conversion'([N1//A1|Ps], List, Module, ContextModule, [N1/A2-N1/A2|Tab], [N1/A2|MyExports], Goal) :- !,
- A2 is A1+2,
- (
- lists:memberchk(N1/A2, List)
- ->
- true
- ;
- '$bad_export'(N1//A1, Module, ContextModule)
-
- ),
- '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
-'$clean_conversion'([N1//A1 as N2|Ps], List, Module, ContextModule, [N2/A2-N1/A2|Tab], [N2/A2|MyExports], Goal) :- !,
- A2 is A1+2,
- (
- lists:memberchk(N2/A2, List)
- ->
- true
- ;
- '$bad_export'((N1//A1 as A2), Module, ContextModule)
- ),
- '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
-'$clean_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|MyExports], Goal) :- !,
- (
- lists:memberchk(op(Prio,Assoc,Name), List)
- ->
- true
- ;
- '$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
- ),
- '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
-'$clean_conversion'([P|_], _List, _, _, _, _, Goal) :-
- '$do_error'(domain_error(module_export_predicates,P), Goal).
-
-'$bad_export'(_, _Module, _ContextModule) :- !.
-'$bad_export'(Name/Arity, Module, ContextModule) :-
- functor(P, Name, Arity),
- predicate_property(Module:P, _), !,
- print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
-'$bad_export'(Name//Arity, Module, ContextModule) :-
- Arity2 is Arity+2,
- functor(P, Name, Arity2),
- predicate_property(Module:P, _), !,
- print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
-'$bad_export'(Indicator, Module, ContextModule) :- !,
- print_message(warning, declaration( Indicator, Module, ContextModule, undefined)).
-
-'$neg_conversion'([], Exports, _, _, Exports, _).
-'$neg_conversion'([N1/A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
- (
- lists:delete(List, N1/A1, RList)
- ->
- '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
- ;
- '$bad_export'(N1/A1, Module, ContextModule)
- ).
-'$neg_conversion'([N1//A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
- A2 is A1+2,
- (
- lists:delete(List, N1/A2, RList)
- ->
- '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
- ;
- '$bad_export'(N1//A1, Module, ContextModule)
- ).
-'$neg_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
- (
- lists:delete(List, op(Prio,Assoc,Name), RList)
- ->
- '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
- ;
- '$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
- ).
-'$clean_conversion'([P|_], _List, _, _, _, Goal) :-
- '$do_error'(domain_error(module_export_predicates,P), Goal).
-
'$add_to_imports'([], _, _).
% no need to import from the actual module
@@ -1461,11 +538,17 @@ export_list(Module, List) :-
( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ),
M2 \= M1, !,
- b_getval('$lf_status', TOpts),
- '$lf_opt'(redefine_module, TOpts, Action),
- '$redefine_action'(Action, M1, M2, Mod, ContextM, N/K).
+ '$redefine_import'( M1, M2, Mod, ContextM, N/K).
'$check_import'(_,_,_,_).
+'$redefine_import'( M1, M2, Mod, ContextM, N/K) :-
+ '$nb_getval'('$lf_status', TOpts, fail),
+ '$lf_opt'(redefine_module, TOpts, Action), !,
+ '$redefine_action'(Action, M1, M2, Mod, ContextM, N/K).
+'$redefine_import'( M1, M2, Mod, ContextM, N/K) :-
+ '$redefine_action'(false, M1, M2, Mod, ContextM, N/K).
+
+
'$redefine_action'(ask, M1, M2, M, _, N/K) :-
stream_property(user_input,tty(true)), !,
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,M2]),
@@ -1486,36 +569,6 @@ export_list(Module, List) :-
'$skipeol'(C),
(C == y -> true; C == n).
-% I assume the clause has been processed, so the
-% var case is long gone! Yes :)
-'$clean_cuts'(G,(yap_hacks:current_choicepoint(DCP),NG)) :-
- '$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) :- !,
- '$conj_has_cuts'(G1, DCP, NG1, OK),
- '$conj_has_cuts'(G2, DCP, NG2, OK).
-'$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !,
- '$conj_has_cuts'(G1, DCP, NG1, OK),
- '$conj_has_cuts'(G2, DCP, NG2, OK).
-'$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !,
- % G1: the system must have done it already
- '$conj_has_cuts'(G2, DCP, NG2, OK).
-'$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !,
- % G1: the system must have done it already
- '$conj_has_cuts'(G2, DCP, NG2, OK).
-'$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !,
- % G1: the system must have done it already
- '$conj_has_cuts'(G2, DCP, NG2, OK),
- '$conj_has_cuts'(G3, DCP, NG3, OK).
-'$conj_has_cuts'(G,_,G, _).
-
/**
@pred set_base_module( +ExportingModule ) is det
All exported predicates from _ExportingModule_ are automatically available to the
@@ -1667,24 +720,6 @@ ls_imports :-
fail.
ls_imports.
-
-'$system_module'('$swi').
-'$system_module'('$win_menu').
-'$system_module'('$arrays').
-'$system_module'('prolog').
-'$system_module'('system').
-'$system_module'('$hacks').
-'$system_module'('$attributes').
-'$system_module'('$coroutining').
-'$system_module'('$db_load').
-'$system_module'('predicate_options').
-'$system_module'('dialect').
-'$system_module'('$history').
-'$system_module'('$messages').
-'$system_module'('autoloader').
-'$system_module'('$win_menu').
-'$system_module'('ypp').
-
unload_module(Mod) :-
clause( '$meta_predicate'(_F,Mod,_N,_P), _, R),
erase(R),
@@ -1723,13 +758,6 @@ unload_module(Mod) :-
recorded('$module','$module'( _, Mod, _, _, _), R),
erase(R),
fail.
-/**
-
-@}
-
-@}
-
-**/
/* debug */
module_state :-
@@ -1737,4 +765,3 @@ module_state :-
format('HostF ~a, HostM ~a, SourceF ~w, Everything ~w, Line ~d.~n', [HostF,HostM,SourceF, Everything, Line]),
fail.
module_state.
-
diff --git a/pl/newmod.yap b/pl/newmod.yap
new file mode 100644
index 000000000..158cea28d
--- /dev/null
+++ b/pl/newmod.yap
@@ -0,0 +1,207 @@
+/**
+ @pred module(+M) is det
+ set the type-in module
+
+
+Defines _M_ to be the current working or type-in module. All files
+which are not bound to a module are assumed to belong to the working
+module (also referred to as type-in module). To compile a non-module
+file into a module which is not the working one, prefix the file name
+with the module name, in the form ` _Module_: _File_`, when
+loading the file.
+
+**/
+module(N) :-
+ var(N),
+ '$do_error'(instantiation_error,module(N)).
+module(N) :-
+ atom(N), !,
+ % set it as current module.
+ '$current_module'(_,N).
+module(N) :-
+ '$do_error'(type_error(atom,N),module(N)).
+
+/**
+ \pred module(+ Module:atom, +ExportList:list) is directive
+ define a new module
+
+This directive defines the file where it appears as a _module file_;
+it must be the first declaration in the file. _Module_ must be an
+atom specifying the module name; _ExportList_ must be a list
+containing the module's public predicates specification, in the form
+`[predicate_name/arity,...]`. The _ExportList_ can include
+operator declarations for operators that are exported by the module.
+
+The public predicates of a module file can be made accessible to other
+files through loading the source file, using the directives
+use_module/1 or use_module/2,
+ensure_loaded/1 and the predicates
+consult/1 or reconsult/1. The
+non-public predicates of a module file are not supposed to be visible
+to other modules; they can, however, be accessed by prefixing the module
+name with the `:/2` operator.
+
+**/
+'$module_dec'(system(N), Ps) :- !,
+ '$system_module'(N),
+ recordz('$system_initialization', prolog:'$mk_system_predicates'( Ps , N ), _),
+ '$current_module'(_,N).
+'$module_dec'(N, Ps) :-
+ source_location(F,_Line),
+ '$nb_getval'( '$source_file', F0 , fail),
+ '$add_module_on_file'(N, F, F0, Ps),
+ '$current_module'(_,N).
+
+'$mk_system_predicates'( Ps, N ) :-
+ lists:member(Name/A , Ps),
+ functor(P,Name,A),
+ '$mk_system_predicate'(P, N),
+ fail.
+'$mk_system_predicates'( _Ps, _N ).
+
+'$module'(_,N,P) :-
+ '$module_dec'(N,P).
+
+ '$add_module_on_file'(DonorMod, DonorF, SourceF, Exports) :-
+ recorded('$module','$module'(OtherF, DonorMod, _, _, _),R),
+ % the module has been found, are we reconsulting?
+ (
+ DonorF \= OtherF
+ ->
+ '$do_error'(permission_error(module,redefined,DonorMod, OtherF, DonorF),module(DonorMod,Exports))
+ ;
+ recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _), R),
+ erase( R ),
+ fail
+ ).
+ '$add_module_on_file'(DonorM, DonorF, SourceF, Exports) :-
+ '$current_module'( HostM ),
+ ( recorded('$module','$module'( HostF, HostM, _, _, _),_) -> true ; HostF = user_input ),
+ % first build the initial export table
+ '$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
+ sort( AllExports0, AllExports ),
+ ( source_location(_, Line) -> true ; Line = 0 ),
+ '$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
+ % last, export everything to the host: if the loading crashed you didn't actually do
+ % no evil.
+ recorda('$module','$module'(DonorF,DonorM,SourceF, AllExports, Line),_),
+ ( recorded('$source_file','$source_file'( DonorF, Time, _), R), erase(R),
+ recorda('$source_file','$source_file'( DonorF, Time, DonorM), _) ).
+
+
+ '$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, MyExports, _) :-
+ '$simple_conversion'(Exports, Tab, MyExports).
+ '$convert_for_export'([], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
+ '$clean_conversion'([], Exports, Module, ContextModule, Tab, MyExports, Goal).
+ '$convert_for_export'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
+ '$clean_conversion'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal).
+ '$convert_for_export'(except(Excepts), Exports, Module, ContextModule, Tab, MyExports, Goal) :-
+ '$neg_conversion'(Excepts, Exports, Module, ContextModule, MyExports, Goal),
+ '$simple_conversion'(MyExports, Tab, _).
+
+ '$simple_conversion'([], [], []).
+ '$simple_conversion'([F/N|Exports], [F/N-F/N|Tab], [F/N|E]) :-
+ '$simple_conversion'(Exports, Tab, E).
+ '$simple_conversion'([F//N|Exports], [F/N2-F/N2|Tab], [F/N2|E]) :-
+ N2 is N+1,
+ '$simple_conversion'(Exports, Tab, E).
+ '$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :-
+ '$simple_conversion'(Exports, Tab, E).
+ '$simple_conversion'([F//N as NF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :-
+ N2 is N+1,
+ '$simple_conversion'(Exports, Tab, E).
+ '$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :-
+ '$simple_conversion'(Exports, Tab, E).
+
+ '$clean_conversion'([], _, _, _, [], [], _).
+ '$clean_conversion'([(N1/A1 as N2)|Ps], List, Module, ContextModule, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- !,
+ ( lists:memberchk(N1/A1, List)
+ ->
+ true
+ ;
+ '$bad_export'((N1/A1 as N2), Module, ContextModule)
+ ),
+ '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+ '$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
+ (
+ lists:memberchk(N1/A1, List)
+ ->
+ true
+ ;
+ '$bad_export'(N1/A1, Module, ContextModule)
+ ),
+ '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+ '$clean_conversion'([N1//A1|Ps], List, Module, ContextModule, [N1/A2-N1/A2|Tab], [N1/A2|MyExports], Goal) :- !,
+ A2 is A1+2,
+ (
+ lists:memberchk(N1/A2, List)
+ ->
+ true
+ ;
+ '$bad_export'(N1//A1, Module, ContextModule)
+
+ ),
+ '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+ '$clean_conversion'([N1//A1 as N2|Ps], List, Module, ContextModule, [N2/A2-N1/A2|Tab], [N2/A2|MyExports], Goal) :- !,
+ A2 is A1+2,
+ (
+ lists:memberchk(N2/A2, List)
+ ->
+ true
+ ;
+ '$bad_export'((N1//A1 as A2), Module, ContextModule)
+ ),
+ '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+ '$clean_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|MyExports], Goal) :- !,
+ (
+ lists:memberchk(op(Prio,Assoc,Name), List)
+ ->
+ true
+ ;
+ '$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
+ ),
+ '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+ '$clean_conversion'([P|_], _List, _, _, _, _, Goal) :-
+ '$do_error'(domain_error(module_export_predicates,P), Goal).
+
+ '$bad_export'(_, _Module, _ContextModule) :- !.
+ '$bad_export'(Name/Arity, Module, ContextModule) :-
+ functor(P, Name, Arity),
+ predicate_property(Module:P, _), !,
+ print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
+ '$bad_export'(Name//Arity, Module, ContextModule) :-
+ Arity2 is Arity+2,
+ functor(P, Name, Arity2),
+ predicate_property(Module:P, _), !,
+ print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
+ '$bad_export'(Indicator, Module, ContextModule) :- !,
+ print_message(warning, declaration( Indicator, Module, ContextModule, undefined)).
+
+ '$neg_conversion'([], Exports, _, _, Exports, _).
+ '$neg_conversion'([N1/A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
+ (
+ lists:delete(List, N1/A1, RList)
+ ->
+ '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
+ ;
+ '$bad_export'(N1/A1, Module, ContextModule)
+ ).
+ '$neg_conversion'([N1//A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
+ A2 is A1+2,
+ (
+ lists:delete(List, N1/A2, RList)
+ ->
+ '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
+ ;
+ '$bad_export'(N1//A1, Module, ContextModule)
+ ).
+ '$neg_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
+ (
+ lists:delete(List, op(Prio,Assoc,Name), RList)
+ ->
+ '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
+ ;
+ '$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
+ ).
+ '$clean_conversion'([P|_], _List, _, _, _, Goal) :-
+ '$do_error'(domain_error(module_export_predicates,P), Goal).
diff --git a/pl/undefined.yap b/pl/undefined.yap
index b85089982..45d7c24f1 100644
--- a/pl/undefined.yap
+++ b/pl/undefined.yap
@@ -37,35 +37,73 @@ with SICStus Prolog.
*/
+
+
+/**
+ * @pred '$undefp_expand'(+ M0:G0, -MG)
+ *
+ * @param G0 input goal
+ * @param M0 current module
+ * @param G1 new goal
+ *
+ * @return succeeds on finding G1, otherwise fails.
+ *
+ * Tries:
+ * 1 - `user:unknown_predicate_handler`
+ * 2 - `goal_expansion`
+ * 1 - `import` mechanism`
+*/
+'$undefp_expand'(M0:G0, MG) :-
+ user:unknown_predicate_handler(G0,M0,M1:G1),
+ M0:G0 \== M1:G1,
+ !,
+ (
+ '$pred_exists'(G1, M1)
+ ->
+ MG = M1:G1
+ ;
+ '$undefp_expand_user'(M1:G1, MG)
+ ).
+'$undefp_expand'(MG0, MG) :-
+ '$undefp_expand_user'(MG0, MG).
+
+'$undefp_expand_user'(M0:G0, MG) :-
+ '_user_expand_goal'(M0:G0, MG1),
+ M0:G0 \== MG1,
+ !,
+ '$yap_strip_module'( MG1, M1, G1),
+ (
+ '$pred_exists'(G1, M1)
+ ->
+ MG = M1:G1
+ ;
+ '$undefp_expand_import'(M1:G1, MG)
+ ).
+'$undefp_expand_user'(MG0, MG) :-
+ '$undefp_expand_import'(MG0, MG).
+
+'$undefp_expand_import'(M0:G0, M1:G1) :-
+ '$get_undefined_pred'(G0, M0, G1, M1),
+ M0:G0 \== M1:G1.
+
'$undefp'([M0|G0], Default) :-
% make sure we do not loop on undefined predicates
- % for undefined_predicates.
- '$disable_debugging',
- '$enter_undefp',
- ( '$get_undefined_pred'(G0, M0, Goal, NM)
+ yap_flag( unknown, Unknown, fast_fail),
+ yap_flag( debug, Debug, false),
+ (
+ '$undefp_expand'(M0:G0, NM:Goal),
+ Goal \= fail,
+ '$complete_goal'(M0, G0, Goal, NM, NG)
->
- '$exit_undefp',
- Goal \= fail,
- '$complete_goal'(M0, G0, Goal, NM, NG),
- '$execute0'(NG, NM)
+ yap_flag( unknown, _, Unknown),
+ yap_flag( debug, _, Debug),
+ '$execute0'(NG, NM)
;
- user:unknown_predicate_handler(G0,M0,NG)
- ->
- '$exit_undefp',
- '$enable_debugging',
- call(M0:NG)
- ;
- '$messages' = M0,
- '$enable_debugging',
- fail
- ;
- '$exit_undefp',
- '$enable_debugging',
- '$handle_error'(Default,G0,M0)
+ yap_flag( unknown, _, Unknown),
+ yap_flag( debug, _, Debug),
+ '$handle_error'(Default,G0,M0)
).
-
-
/** @pred unknown(- _O_,+ _N_)
The unknown predicate, informs about what the user wants to be done
@@ -106,8 +144,6 @@ the output of a message of the form:
Undefined predicate: user:xyz(A1,A2)
~~~~~
followed by the failure of that call.
-
-
*/
:- multifile user:unknown_predicate_handler/3.
@@ -123,11 +159,13 @@ followed by the failure of that call.
'$handle_error'(fail,_Goal,_Mod) :-
fail.
+:- '$set_no_trace'('$handle_error'(_,_,_), prolog).
+
'$complete_goal'(M, _G, CurG, CurMod, NG) :-
(
'$is_metapredicate'(CurG,CurMod)
->
- '$meta_expansion'(CurG, M, CurMod, M, NG, [])
+ '$expand_meta_call'(CurMod:CurG, [], NG)
;
NG = CurG
).