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

The big module cleanup

Browse Source 
meta.yap contains meta-expansion
new mod.yap contains module declarations
module.yap keeps the rest.
undefcode refers to meta expansion

lots of annoying little errors.
This commit is contained in:
Vítor Santos Costa 2015-12-15 09:01:44 +00:00
parent 95f770f747
commit d2ad352f78
5 changed files with 989 additions and 1153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

178
pl/boot.yap
View File

@ -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

582
pl/meta.yap Normal file
View File

@ -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 )
)).

1085
pl/modules.yap
View File

File diff suppressed because it is too large Load Diff

207
pl/newmod.yap Normal file
View File

@ -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).

90
pl/undefined.yap
View File

@ -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
).