module expansion, again
This commit is contained in:
Vitor Santos Costa
parent
8d8a4104b9
commit
ca0c43ba8d
@ -40,8 +40,8 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
'$do_c_built_metacall'(G, M, OUT).
|
||||
'$do_c_built_in'(Mod:G, _, OUT) :-
|
||||
strip_module(Mod:G, M, G1),
|
||||
var(G1), !,
|
||||
'$do_c_built_metacall'(G1, M, OUT).
|
||||
( var(G1) -> M = M2, G1 = G2 ; G1 = M2:G2), !,
|
||||
'$do_c_built_metacall'(G2, M2, OUT).
|
||||
'$do_c_built_in'(\+ G, _, OUT) :-
|
||||
nonvar(G),
|
||||
G = (A = B),
|
||||
|
||||
@ -1113,7 +1113,9 @@ bootstrap(F) :-
|
||||
% Expanded is the final expanded term.
|
||||
%
|
||||
'$precompile_term'(Term, Expanded0, Expanded, BodyMod, SourceMod) :-
|
||||
%format('[ ~w~n',[Term]),
|
||||
'$module_expansion'(Term, Expanded0, ExpandedI, BodyMod, SourceMod), !,
|
||||
%format(' -> ~w~n',[Expanded0]),
|
||||
(
|
||||
'$access_yap_flags'(9,1) /* strict_iso on */
|
||||
->
|
||||
|
||||
@ -146,24 +146,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
|
||||
'$nb_getval'('$catch', Ball, fail),
|
||||
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
|
||||
|
||||
% Only efective if yap compiled with -DDEBUG
|
||||
|
||||
@ -35,7 +35,7 @@ prolog:'$stack_dump' :-
|
||||
run_formats([], _).
|
||||
run_formats([Com-Args|StackInfo], Stream) :-
|
||||
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,CP,Lines,[]),
|
||||
|
||||
@ -49,7 +49,6 @@
|
||||
% call Goal and pretend it has not seen anything. This hook is used
|
||||
% by the GNU-Emacs interface to for communication between GNU-EMACS
|
||||
% and SWI-Prolog.
|
||||
|
||||
prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
|
||||
repeat,
|
||||
prompt_history(Prompt),
|
||||
|
||||
@ -301,10 +301,10 @@ expand_goal(G, G).
|
||||
NG =.. [Name|NGArgs].
|
||||
|
||||
'$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), !,
|
||||
'$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).
|
||||
|
||||
% args are:
|
||||
@ -459,21 +459,43 @@ expand_goal(G, G).
|
||||
'$module_u_vars'(_,[],_).
|
||||
|
||||
'$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,H,Y), var(Y), !,
|
||||
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).
|
||||
|
||||
% expand arguments of a meta-predicate
|
||||
% $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) :-
|
||||
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]),
|
||||
functor(G1,F,N),
|
||||
'$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'(I,D,G,NG,HVars,CurMod,M,HM) :-
|
||||
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,
|
||||
'$meta_expansion_loop'(I1, 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).
|
||||
|
||||
% check if an argument should be expanded
|
||||
'$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
|
||||
'$do_expand'(_:_,_) :- !, fail.
|
||||
'$do_expand'(_,_).
|
||||
'$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).
|
||||
@ -571,8 +599,6 @@ source_module(Mod) :-
|
||||
forall(0,0),
|
||||
format(+,:),
|
||||
format(+,+,:),
|
||||
format_time(?,+,:),
|
||||
format_time(?,+,:,+),
|
||||
freeze(?,0),
|
||||
hide_predicate(:),
|
||||
if(0,0,0),
|
||||
|
||||
30
pl/preds.yap
30
pl/preds.yap
@ -1063,3 +1063,33 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :-
|
||||
'$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.
|
||||
|
||||
|
||||
@ -142,7 +142,7 @@ bagof(Template, Generator, Bag) :-
|
||||
% But this version of all does not allow for repeated answers
|
||||
% if you want them use findall
|
||||
|
||||
all(T,G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
|
||||
all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
|
||||
all(T,G,S) :-
|
||||
'$init_db_queue'(Ref),
|
||||
( '$catch'(Error,'$clean_findall'(Ref,Error),_),
|
||||
|
||||
Reference in New Issue
Block a user