home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
lifeos2.zip
/
LIFE-1.02
/
TOOLS
/
DEBUG.LF
< prev
next >
Wrap
Text File
|
1996-06-04
|
9KB
|
564 lines
% Debugger for predicates by source code transformation.
%
% Author: Richard Meyer
%
% Date: June 16th 1993
%
% USE: 'debug(Name,Level,Verbose)'
% AFTER all the clauses for 'Name' have been defined.
% WARNING: Will corrupt dynamic predicates and functions.
%
% $Id: debug.lf,v 1.2 1994/12/08 23:50:39 duchier Exp $
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Code common to both predicates and functions.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
module("debug")?
public(debug,undebug,goal)?
%%%write("
%%%DEBUG: source transformation to provide spy-points.
%%%Use:
%%% > import(""debug"")?
%%% > debug(Name,Level,Verbose)?
%%% Name = name of function or predicate to debug
%%% Level := {fail;clause;goal}
%%% Verbose := {true;false}
%%% > undebug(Name)?
%%%Read: 'Tools/Debug.doc' for more information.
%%%")?
%
% Debug - top-level entry point
%
debug(What,Level,Verbose) :-
Level={clause;fail;goal},!,
Verbose={true;false},!,
(
is_function(What),
!,
Type=(->),
S=function,
RW=rewrite_func
;
is_predicate(What),
!,
Type=(:-),
S=predicate,
RW=rewrite_pred
;
write_err("Debug: ",What," is not a predicate or a function"),
nl,
fail
),
dynamic(What),
(
get_old_clauses(What,Clauses),
!
;
read_and_retract(What,Clauses,Type),
assert(old_clauses(What,Clauses,Type,S))
),
(
Clauses:==[],
!,
write_err("*** No clauses for '",What,"'"),
nl_err
;
write("Added debugging code to ",S," '",What,
"': level=",Level,
", verbose=",Verbose,
", clauses=",length(Clauses)),
nl,
RW=@(Clauses,What,Level,Verbose),
RW
).
%
% Undebug
%
undebug(What) :-
get_old_clauses(What,Clauses),
!,
assert_list(Clauses),
retract(old_clauses(What) :- succeed).
undebug(What) :- write("Debug: no stored clauses for ",What),nl.
assert_list([H|T]) :- !,assert(H),assert_list(T).
assert_list([]).
%
% Restore the old clauses for a predicate or function
%
dynamic(old_clauses)?
get_old_clauses(What,Clauses) :-
clause(old_clauses(What,Clauses,Type,Sort):-succeed),
!,
write("Debug: restored original clauses for ",Sort," '",What,"'"),
nl,
read_and_retract(What,ModifiedClauses,Type).
%
% Output a trace message
% Note: this could be improved with indenting.
%
prefix(X) :- write("<",X,"> ").
debug_indent(0) :- !.
debug_indent(N) :- write(" "),debug_indent(N-1).
%
% Take verbose flag into account
%
write_term(T,V) -> cond(V,T,root_sort(T)).
%
% Read and retract the original clauses
%
read_and_retract(P,[H|T],Type) :-
R=root_sort(P),
H=root_sort(Type),
H.1=R,
H.2=@,
% write("H=",H),nl,
clause(H),
!,
retract(H),
read_and_retract(P,T,Type).
read_and_retract(P,[],T).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% P R E D I C A T E S
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Rewrite a predicate
%
rewrite_pred(Clauses,Pred,Level,Verbose) :-
cond(Level :\== fail,call_pred(Pred,Verbose)),
rewrite_clauses(Clauses,Pred,Level,Verbose,1),
fail_pred(Pred,Verbose),
! .
rewrite_pred(C,Pred,L,V) :-
write_err("*** Debug failed for '",Pred,"': program corrupted."),
nl_err.
%
% Call predicate
%
call_pred(P,V) :-
R=root_sort(P),
M=write_term(R,V),
assert(R :- (prefix("CALL"),write(M,": entry call"),nl,fail)).
%
% Fail predicate
%
fail_pred(P,V) :-
R=root_sort(P),
M=write_term(R,V),
assert(R :- (prefix("FAIL"),write(M,": fails"),nl,fail)).
%
% Rewrite clauses
%
rewrite_clauses([H|T],Pred,Level,Verbose,N) :-
!,
H=(Head:-Body),
cond(Level :\== fail,try_clause(Pred,N)),
rewrite_body(Body,Body2,Pred,Level,Verbose,N,1),
cond(Level :== fail,
NewBody=Body2,
NewBody=(Body2,prefix("SUCC"),write(Pred,"#",N,": succeeds"),nl)
),
assert(Head :- NewBody),
rewrite_clauses(T,Pred,Level,Verbose,N+1).
rewrite_clauses([],Pred,Level,Verbose,N).
%
% Try clause
%
try_clause(Pred,N) :-
R=root_sort(Pred),
cond(N>1,
assert(Pred :- ( prefix("REDO"),
write(R,": try clause #",N),
nl,
fail))).
%
% Rewrite the body of a clause
%
non_strict(rewrite_body)?
rewrite_body(Top,Top,Pred,Level,Verb,N,M) :-
Top :== @,
!.
rewrite_body((A,B),(A2,B2),Pred,Level,Verb,N,M) :-
!,
rewrite_body(A,A2,Pred,Level,Verb,N,M),
NM=M+1,
rewrite_body(B,B2,Pred,Level,Verb,N,NM).
rewrite_body((A;B),(A2;B3),Pred,Level,Verb,N,M) :-
!,
rewrite_body(A,A2,Pred,Level,Verb,N,M),
rewrite_body(B,B2,Pred,Level,Verb,N,M),
cond(Level :== goal,
B3=(prefix("REDO"),
write(Pred,"#",N,": retry disjunction"),
nl,
B2),
B3=B2).
rewrite_body(!,C,Pred,Level,Verb,N,M) :-
!,
C=(!,(
cond(Level:==fail,
succeed,
( prefix("CUT!"),
cond(Level:==goal,
write(Pred,"#",N,".",M,": cut!"),
write(Pred,"#",N,": cut!")),
nl)
)
;
prefix("FAIL"),
write(Pred,"#",N,": fails and alternatives cut"),
nl,
fail
)
).
rewrite_body(C:cond(A),D:cond(A),Pred,Level,Verb,N,M) :-
!,
cond(has_feature(2,C,T),
( rewrite_body(T,T2,Pred,Level,Verb,N,M),
D.2=T)),
cond(has_feature(3,C,F),
( rewrite_body(F,F2,Pred,Level,Verb,N,M),
D.3=F)).
% Default:
rewrite_body(A,A2,Pred,Level,Verb,N,M) :-
cond(Level:==goal,
A2=( prefix("GOAL"),
write(Pred,"#",N,".",M,": ",write_term(A,Verb)),
nl,
A),
A2=A).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% F U N C T I O N S
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Rewrite a function
%
rewrite_func(Rules,Func,Level,Verbose) :-
% cond(Level :\== fail,call_func(Func,Verbose)),
rewrite_rules(Rules,Func,Level,Verbose,1),
fail_func(Func,Verbose),
! .
rewrite_func(C,Func,L,V) :-
write_err("*** Debug failed for '",Func,"': program corrupted."),
nl_err.
%
% Call function
% Can't implement this without renaming - so won't
%call_func(P,V) :-
% R=root_sort(P),
% M=write_term(R,V),
% assert(R :- (prefix("CALL"),write(M,": entry call"),nl,fail)).
%
% Fail function:
%
fail_func(P,V) :-
R=root_sort(P),
M=write_term(R,V),
assert((R -> @ | prefix("FAIL"),write(M,": fails"),nl,fail)).
%
% Rewrite rules
%
rewrite_rules([H|T],Func,Level,Verbose,N) :-
!,
rewrite_rule(H,Func,Level,Verbose,N),
rewrite_rules(T,Func,Level,Verbose,N+1).
rewrite_rules([],Func,Level,Verbose,N).
%
% Debug messages for functions:
%
func_fail(M,N) :-
prefix("FAIL"),
write(M,": fails at clause #",N),
nl,
fail.
eval_fail(M,N) :-
prefix("FAIL"),
write(M,": evaluation at clause #",N),
nl,
fail.
body_fail(M,N) :-
prefix("FAIL"),
write(M,": such-that goals at clause #",N),
nl,
fail.
%
% Rewrite a function rule
%
non_strict(rewrite_rule)?
% Goal level
rewrite_rule((Pattern -> W),Func,goal,Verbose,N) :-
W :== `(|) ,
!,
W= `(Value | Body),
M=write_term(Pattern,Verbose),
rewrite_body(Body,Body2,Func,goal,Verbose,N,1),
Check=( Succ<<-@,
(
prefix("PATT"),
write(M,": pattern matches clause #",N),
nl,
Succ<<-patt,
Result=Value,
prefix("EVAL"),
write(M,": clause #",N,", result=",
`write_term(Result,Verbose)),
nl,
Succ<<-evall,
Body2,
prefix("SUCC"),
write(M,": clause #",N),
nl,
Succ<<-succ
;
`(Succ:==succ),
!,
fail
;
`(Succ:==evall),
!,
body_fail(M,N)
;
`(Succ:==patt),
!,
eval_fail(M,N)
;
func_fail(M,N)
)),
assert((Pattern-> Result | Check)).
rewrite_rule(Pattern -> Value,Func,goal,Verbose,N) :-
!,
M=write_term(Pattern,Verbose),
Check=( Succ<<-@,
(
prefix("PATT"),
write(M,": pattern matches clause #",N),
nl,
Succ<<-patt,
Result=Value,
prefix("EVAL"),
write(M,": clause #",N,", result=",
`write_term(Result,Verbose)),
nl,
Succ<<-evall
;
`(Succ:==evall),
!,
fail
;
`(Succ:==patt),
!,
eval_fail(M,N)
;
func_fail(M,N)
)),
assert((Pattern-> Result | Check)).
% Clause level
rewrite_rule((Pattern -> W),Func,clause,Verbose,N) :-
W :== ` | ,
!,
W= `(Value | Body),
M=write_term(Pattern,Verbose),
Result=Value,
Check=( Succ<<-@,
( Body,
prefix("SUCC"),
write(M,": clause #",N,", result=",
`write_term(Result,Verbose)),
nl,
Succ<<-succ
;
`(Succ:==succ),
!,
fail
;
func_fail(M,N)
)),
assert((Pattern-> Result | Check)).
rewrite_rule(Pattern -> Value,Func,clause,Verbose,N) :-
!,
M=write_term(Pattern,Verbose),
Result=Value,
Check=( Succ<<-@,
( prefix("EVAL"),
write(M,": clause #",N,", result=",
`write_term(Result,Verbose)),
nl,
Succ<<-evall
;
`(Succ:==evall),
!,
fail
;
func_fail(M,N)
)),
assert((Pattern-> Result | Check)).
% Fail level
rewrite_rule((Pattern -> W),Func,fail,Verbose,N) :-
W :== ` | ,
!,
W= `(Value | Body),
M=write_term(Pattern,Verbose),
Check=( Succ<<-@,
( Body,
Succ<<-succ
;
`(Succ:==@),
func_fail(M,N)
)),
assert((Pattern-> Value | Check)).
rewrite_rule((Pattern -> Value),Func,fail,Verbose,N) :-
!,
M=write_term(Pattern,Verbose),
Check=( Succ<<-@,
( Succ<<-succ
;
`(Succ:==@),
func_fail(M,N)
)),
assert((Pattern-> Value | Check)).