module expansion, again

This commit is contained in:
Vitor Santos Costa 2014-02-09 10:47:44 +00:00
parent 8d8a4104b9
commit ca0c43ba8d
8 changed files with 75 additions and 36 deletions

View File

@ -40,8 +40,8 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$do_c_built_metacall'(G, M, OUT). '$do_c_built_metacall'(G, M, OUT).
'$do_c_built_in'(Mod:G, _, OUT) :- '$do_c_built_in'(Mod:G, _, OUT) :-
strip_module(Mod:G, M, G1), strip_module(Mod:G, M, G1),
var(G1), !, ( var(G1) -> M = M2, G1 = G2 ; G1 = M2:G2), !,
'$do_c_built_metacall'(G1, M, OUT). '$do_c_built_metacall'(G2, M2, OUT).
'$do_c_built_in'(\+ G, _, OUT) :- '$do_c_built_in'(\+ G, _, OUT) :-
nonvar(G), nonvar(G),
G = (A = B), G = (A = B),

View File

@ -1113,7 +1113,9 @@ bootstrap(F) :-
% Expanded is the final expanded term. % Expanded is the final expanded term.
% %
'$precompile_term'(Term, Expanded0, Expanded, BodyMod, SourceMod) :- '$precompile_term'(Term, Expanded0, Expanded, BodyMod, SourceMod) :-
%format('[ ~w~n',[Term]),
'$module_expansion'(Term, Expanded0, ExpandedI, BodyMod, SourceMod), !, '$module_expansion'(Term, Expanded0, ExpandedI, BodyMod, SourceMod), !,
%format(' -> ~w~n',[Expanded0]),
( (
'$access_yap_flags'(9,1) /* strict_iso on */ '$access_yap_flags'(9,1) /* strict_iso on */
-> ->

View File

@ -146,24 +146,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$nb_getval'('$catch', Ball, fail), '$nb_getval'('$catch', Ball, fail),
throw(Ball). throw(Ball).
%%% The unknown predicate,
% informs about what the user wants to be done when
% there are no clauses for a certain predicate */
unknown(V0, V) :-
prolog_flag(unknown, V0, V).
'$unknown_error'(Mod:Goal) :-
functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr),
'$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)).
'$unknown_warning'(Mod:Goal) :-
functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr),
print_message(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
fail.
%%% Some "dirty" predicates %%% Some "dirty" predicates
% Only efective if yap compiled with -DDEBUG % Only efective if yap compiled with -DDEBUG

View File

@ -35,7 +35,7 @@ prolog:'$stack_dump' :-
run_formats([], _). run_formats([], _).
run_formats([Com-Args|StackInfo], Stream) :- run_formats([Com-Args|StackInfo], Stream) :-
format(Stream, Com, Args), format(Stream, Com, Args),
run_formats(StackInfo, user_error). run_formats(StackInfo, Stream).
display_stack_info(CPs,Envs,Lim,PC) :- display_stack_info(CPs,Envs,Lim,PC) :-
display_stack_info(CPs,Envs,Lim,CP,Lines,[]), display_stack_info(CPs,Envs,Lim,CP,Lines,[]),

View File

@ -49,7 +49,6 @@
% call Goal and pretend it has not seen anything. This hook is used % call Goal and pretend it has not seen anything. This hook is used
% by the GNU-Emacs interface to for communication between GNU-EMACS % by the GNU-Emacs interface to for communication between GNU-EMACS
% and SWI-Prolog. % and SWI-Prolog.
prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :- prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
repeat, repeat,
prompt_history(Prompt), prompt_history(Prompt),

View File

@ -301,10 +301,10 @@ expand_goal(G, G).
NG =.. [Name|NGArgs]. NG =.. [Name|NGArgs].
'$expand_args'([], _, [], []). '$expand_args'([], _, [], []).
'$expand_args'([A|GArgs], CurMod, 0.GDefs, [NA|NGArgs]) :- '$expand_args'([A|GArgs], CurMod, [0|GDefs], [NA|NGArgs]) :-
'$do_expand'(A, CurMod, NA), !, '$do_expand'(A, CurMod, NA), !,
'$expand_args'(GArgs, CurMod, GDefs, NGArgs). '$expand_args'(GArgs, CurMod, GDefs, NGArgs).
'$expand_args'([A|GArgs], CurMod, _.GDefs, [A|NGArgs]) :- '$expand_args'([A|GArgs], CurMod, [_|GDefs], [A|NGArgs]) :-
'$expand_args'(GArgs, CurMod, GDefs, NGArgs). '$expand_args'(GArgs, CurMod, GDefs, NGArgs).
% args are: % args are:
@ -459,21 +459,43 @@ expand_goal(G, G).
'$module_u_vars'(_,[],_). '$module_u_vars'(_,[],_).
'$module_u_vars'(0,_,_,[]) :- !. '$module_u_vars'(0,_,_,[]) :- !.
'$module_u_vars'(I,D,H,[Y|L]) :- '$module_u_vars'(I,D,H,LF) :-
arg(I,D,X), ( X=':' ; integer(X)), arg(I,D,X), ( X=':' ; integer(X)),
arg(I,H,Y), var(Y), !, arg(I,H,A), '$uvar'(A, LF, L), !,
I1 is I-1, I1 is I-1,
'$module_u_vars'(I1,D,H,L). '$module_u_vars'(I1,D,H,L).
'$module_u_vars'(I,D,H,L) :- '$module_u_vars'(I,D,H,L) :-
I1 is I-1, I1 is I-1,
'$module_u_vars'(I1,D,H,L). '$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).
% expand arguments of a meta-predicate % expand arguments of a meta-predicate
% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables) % $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
'$meta_expansion0'(G,_Mod,MP,_HM, G1,_HVars) :-
var(G), !,
G1 = call(MP:G).
'$meta_expansion0'(M:G,_Mod,_MP,_HM,G1,_HVars) :-
var(M), !,
G1 = '$execute_wo_mod'(G,M).
% support for all/3
'$meta_expansion0'(same(G, P),Mod,MP,HM, same(G1, P),HVars) :- !,
'$meta_expansion0'(G,Mod,MP,HM,G1,HVars).
'$meta_expansion0'(G,Mod,MP,HM,M2:G2,HVars) :-
nonvar(G), G \= _:_,
'$module_expansion'(G,_,G1,MP,MP,HM,HVars), !,
strip_module(MP:G1, M2, G2).
'$meta_expansion0'(G,Mod,MP,HM,M1:G1,HVars) :-
strip_module(MP:G,M1,G1).
'$meta_expansion'(G,Mod,MP,HM,G1,HVars) :- '$meta_expansion'(G,Mod,MP,HM,G1,HVars) :-
functor(G,F,N), functor(G,F,N),
'$meta_predicate'(F,Mod,N,D), !, '$meta_predicate'(F,Mod,N,D), !, % we're in an argument
% format(user_error,'[ ~w ',[G]), % format(user_error,'[ ~w ',[G]),
functor(G1,F,N), functor(G1,F,N),
'$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM). '$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM).
@ -483,9 +505,15 @@ expand_goal(G, G).
'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !. '$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
'$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :- '$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :-
arg(I,D,X), (X==':' -> true ; integer(X)), arg(I,D,X), (X==':' -> true ; integer(X)),
arg(I,G,A), '$do_expand'(A,HVars), arg(I,G,A),
'$should_expand'(A,HVars),
!, !,
arg(I,NG,M:A), ( X ==0 ->
'$meta_expansion0'(A,CurMod,M,HM,NA,HVars)
;
NA = M:A
),
arg(I,NG,NA),
I1 is I-1, I1 is I-1,
'$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM). '$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM).
'$meta_expansion_loop'(I, D, G, NG, HVars, CurMod, M, HM) :- '$meta_expansion_loop'(I, D, G, NG, HVars, CurMod, M, HM) :-
@ -495,9 +523,9 @@ expand_goal(G, G).
'$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM). '$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM).
% check if an argument should be expanded % check if an argument should be expanded
'$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars). '$should_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
'$do_expand'(_:_,_) :- !, fail. '$should_expand'(_:_,_) :- !, fail.
'$do_expand'(_,_). '$should_expand'(_,_).
'$not_in_vars'(_,[]). '$not_in_vars'(_,[]).
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L). '$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
@ -571,8 +599,6 @@ source_module(Mod) :-
forall(0,0), forall(0,0),
format(+,:), format(+,:),
format(+,+,:), format(+,+,:),
format_time(?,+,:),
format_time(?,+,:,+),
freeze(?,0), freeze(?,0),
hide_predicate(:), hide_predicate(:),
if(0,0,0), if(0,0,0),

View File

@ -1063,3 +1063,33 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :-
'$set_flag'(P, M, Flag, V). '$set_flag'(P, M, Flag, V).
unknown(V0, V) :-
strip_module(V, M, G),
recorded('$unknown_handle', M0:G0, R), !,
recordz('$unknown_handle', M:G, _),
erase( R ),
strip_module(V0, M0, G0).
unknown(V0, V) :-
strip_module(V, M, G),
recordz('$unknown_handle', M:G, _),
V0 = fail.
%%% The unknown predicate,
% informs about what the user wants to be done when
% there are no clauses for a certain predicate */
'$unknown_error'(Call) :-
recorded( '$unknown_handle', M:Goal, _),
arg(1, Goal, Call), !,
once(M:Goal).
'$unknown_error'(Mod:Goal) :-
functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr),
'$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)).
'$unknown_warning'(Mod:Goal) :-
functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr),
print_message(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
fail.