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

fix spy

Browse Source
This commit is contained in:
Vitor Santos Costa 2015-01-16 20:07:18 -08:00
parent c081e9774d
commit 58357b1af4
1 changed files with 82 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

170
pl/debug.yap
View File

@ -88,95 +88,85 @@ mode and the existing spy-points, when the debugger is on.
% First part : setting and reseting spy points % First part : setting and reseting spy points
% $suspy does most of the work % $suspy does most of the work
'$suspy'(V,S,M) :- var(V) , !, '$suspy'(V,S) :-
'$do_error'(instantiation_error,M:spy(V,S)). strip_module( V, M, Indicators ),
'$suspy'((M:S),P,_) :- !, (
'$suspy'(S,P,M). ground( Indicators )
'$suspy'([],_,_) :- !. ->
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ). true
'$suspy'(F/N,S,M) :- !, ;
functor(T,F,N), '$do_error'(instantiation_error,M:spy(V,S) )
'$do_suspy'(S, F, N, T, M). ),
'$suspy'(A,S,M) :- atom(A), !, /* muat be ground, can be conjunction, list or single element */
'$suspy_predicates_by_name'(A,S,M). ( lists:member( I0, Indicators ),
'$suspy'(P,spy,M) :- !, strip_module( I0, M, I ),
'$do_error'(domain_error(predicate_spec,P),spy(M:P)). '$do_suspy'( M:I, S ),
'$suspy'(P,nospy,M) :- fail
'$do_error'(domain_error(predicate_spec,P),nospy(M:P)). ;
conjunctions:conj_member( I0, Indicators ),
strip_module( I0, M, I ),
'$do_suspy'( M:I, S ),
fail
;
true
).
'$suspy_predicates_by_name'(A,S,M) :- '$do_suspy'(M:A, Action) :-
% just check one such predicate exists atom( A ), !,
( (
current_predicate(A,M:_) current_predicate( M:A/N ),
-> functor( G, A, N)
M = EM, *->
A = NA '$exec_spy'( M, G, Action )
; ;
recorded('$import','$import'(EM,M,GA,_,A,_),_), print_message(warning,no_match( M:A ) )
functor(GA,NA,_) ).
), '$do_suspy'(M:A/N, Action) :- !,
!, ( current_predicate( M:A/N )
'$do_suspy_predicates_by_name'(NA,S,EM). *->
'$suspy_predicates_by_name'(A,spy,M) :- !, functor( G, A, N),
print_message(warning,no_match(spy(M:A))). '$exec_spy'( M, G, Action )
'$suspy_predicates_by_name'(A,nospy,M) :- ;
print_message(warning,no_match(nospy(M:A))). G =.. [ Action, M:A/N],
print_message(warning,no_match( G ) )
'$do_suspy_predicates_by_name'(A,S,M) :- ).
current_predicate(A,M:T), '$do_suspy'( I, Action) :-
functor(T,A,N), G =.. [ Action, I],
'$do_suspy'(S, A, N, T, M). '$do_error'(domain_error(predicate_spec,I), G ).
'$do_suspy_predicates_by_name'(A, S, M) :-
recorded('$import','$import'(EM,M,_,T,A,N),_),
'$do_suspy'(S, A, N, T, EM).
% '$exec_spy'( M, G, Action ) :-
% protect against evil arguments. '$import_chain'( M, G, M0, S0 ),
% '$system_predicate'(S0,M0),
'$do_suspy'(S, F, N, T, M) :- '$flags'(S0,M0,F,F),
recorded('$import','$import'(EM,M,T0,_,F,N),_), !, (
functor(T0, F0, N0), F /\ 0x118dd080 =\= 0
'$do_suspy'(S, F0, N0, T, EM). ->
'$do_suspy'(S, F, N, T, M) :- Call =.. [Action,M0:S0],
'$undefined'(T,M), !, functor(S0,N0,A0),
( S = spy -> '$do_error'(permission_error(access,private_procedure,M0:A0/N0),Call)
print_message(warning,no_match(spy(M:F/N)))
; ;
print_message(warning,no_match(nospy(M:F/N))) true
). ),
'$do_suspy'(S, F, N, T, M) :- '$suspy2'(Action, S0, M0 ).
'$system_predicate'(T,M),
'$flags'(T,M,F,F),
F /\ 0x118dd080 =\= 0,
( S = spy ->
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
;
'$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M).
'$suspy2'(spy,F,N,T,M) :- '$suspy2'(spy,T,M) :-
recorded('$spy','$spy'(T,M),_), !, recorded('$spy','$spy'(T,M),_), !,
functor(T,F,N),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)). print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
'$suspy2'(spy,F,N,T,M) :- !, '$suspy2'(spy,T,M) :- !,
recorda('$spy','$spy'(T,M),_), recorda('$spy','$spy'(T,M),_),
'$set_spy'(T,M), '$set_spy'(T,M),
functor(T,F,N),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)). print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
'$suspy2'(nospy,F,N,T,M) :- '$suspy2'(nospy,T,M) :-
recorded('$spy','$spy'(T,M),R), !, recorded('$spy','$spy'(T,M),R), !,
erase(R), erase(R),
'$rm_spy'(T,M), '$rm_spy'(T,M),
functor(T,F,N),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)). print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
'$suspy2'(nospy,F,N,_,M) :- '$suspy2'(nospy,T,M) :-
functor(T,F,N),
print_message(informational,breakp(no,breakpoint_for,M:F/N)). print_message(informational,breakp(no,breakpoint_for,M:F/N)).
'$pred_being_spied'(G, M) :- '$pred_being_spied'(G, M) :-
@ -189,33 +179,30 @@ Sets spy-points on all the predicates represented by
_P_. _P_ can either be a single specification or a list of _P_. _P_ can either be a single specification or a list of
specifications. Each one must be of the form _Name/Arity_ specifications. Each one must be of the form _Name/Arity_
or _Name_. In the last case all predicates with the name or _Name_. In the last case all predicates with the name
_Name_ will be spied. As in C-Prolog, system predicates and _Name_ will be spied.
predicates written in C, cannot be spied.
*/ */
spy Spec :- spy Spec :-
'$init_debugger', '$init_debugger',
prolog:debug_action_hook(spy(Spec)), !. prolog:debug_action_hook(spy(Spec)), !.
spy L :- spy L :-
'$current_module'(M), '$suspy'(L, spy), fail.
'$suspy'(L, spy, M), fail. spy _ :- debug.
spy _ :- debug.
/** @pred nospy( + _P_ ) /** @pred nospy( + _P_ )
Removes spy-points from all predicates specified by _P_. Removes spy-points from all predicates specified by _P_.
The possible forms for _P_ are the same as in `spy P`. The possible forms for _P_ are the same as in spy/1.
*/ */
nospy Spec :- nospy Spec :-
'$init_debugger', '$init_debugger',
prolog:debug_action_hook(nospy(Spec)), !. prolog:debug_action_hook(nospy(Spec)), !.
nospy L :- nospy L :-
'$current_module'(M), '$suspy'(L, nospy), fail.
'$suspy'(L, nospy, M), fail.
nospy _. nospy _.
/** @pred nospyall /** @pred nospyall
@ -232,8 +219,11 @@ nospyall :-
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail. recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
nospyall. nospyall.
% debug mode -> debug flag = 1 /** debug
Enters debug mode, meaning that it resets the state of the debugger and
enables the operation of spy-points and creeping.
*/
debug :- debug :-
'$init_debugger', '$init_debugger',
( nb_getval('$spy_gn',_) -> true ; nb_setval('$spy_gn',1) ), ( nb_getval('$spy_gn',_) -> true ; nb_setval('$spy_gn',1) ),
@ -887,6 +877,10 @@ be lost.
'$is_metapredicate'(G, M), !, '$is_metapredicate'(G, M), !,
'$meta_expansion'(G,M,M,M,G1,[]), '$meta_expansion'(G,M,M,M,G1,[]),
'$spycall_expanded'(G1, M, CalledFromDebugger, InRedo). '$spycall_expanded'(G1, M, CalledFromDebugger, InRedo).
'$spycall'(G, M, _CalledFromDebugger, _InRedo) :-
'$undefined'(G, M), !,
'$current_module'(Mod),
'$undefp'([M|G], Mod).
'$spycall'(G, M, CalledFromDebugger, InRedo) :- '$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo). '$spycall_expanded'(G, M, CalledFromDebugger, InRedo).