module expansion, again
This commit is contained in:
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_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),
|
||||||
|
@ -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 */
|
||||||
->
|
->
|
||||||
|
@ -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
|
||||||
|
@ -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,[]),
|
||||||
|
@ -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),
|
||||||
|
@ -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),
|
||||||
|
30
pl/preds.yap
30
pl/preds.yap
@ -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.
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user