1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%%                                                                           %%
    3%%      Version:  1.00   Date: 25/03/96   File: debug.pl                     %%
    4%% Last Version:                          File:                              %%
    5%% Changes:                                                                  %%
    6%% 25/03/96 Created                                                          %%
    7%%                                                                           %%
    8%% Purpose:                                                                  %%
    9%%                                                                           %%
   10%% Author:  Torsten Schaub                                                   %%
   11%%                                                                           %%
   12%% Usage:   prolog debug.pl                                                  %%
   13%%                                                                           %%
   14%%                                                                           %%
   15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   16
   17:- ensure_loaded(hooks).   18
   19:- body_hooks.   20
   21bhook1_p(Head :- Body) :-
   22	Body = (nl,write(_),nl,fail) ->
   23	     /* eliminates predicate hooks */
   24	     false;
   25	functor(Head,query,_) ->
   26	     false;
   27	%true ->
   28	     true.
   29bhook1(Head :- Body) :-
   30	functor(Head,gamma,_)  ->
   31	     Head =.. [Pred,Arg1,Arg2|_],
   32	     nl,write(trial:gamma(Arg1,Arg2)),nl;
   33        functor(Head,alpha,_)  ->
   34	     Head =.. [Pred,Arg1,Arg2|_],
   35	     nl,write(trial:alpha(Arg1,Arg2)),nl;
   36        Head = _ ->
   37	     Head =.. [Pred|_],
   38	     nl,write(trial:(Pred)),nl;
   39        %true ->
   40	     true.
   41
   42bhook2_p(Head :- Body) :-
   43	bhook1_p(Head :- Body).
   44bhook2(Head :- Body) :-
   45	functor(Head,gamma,_)  ->
   46	     Head =.. [Pred,Arg1,Arg2|_],
   47	     nl,write(success:gamma(Arg1,Arg2)),nl;
   48        functor(Head,alpha,_)  ->
   49	     Head =.. [Pred,Arg1,Arg2|_],
   50	     nl,write(success:alpha(Arg1,Arg2)),nl;
   51        Head = _ ->
   52	     Head =.. [Pred|_],
   53	     nl,write(success:(Pred)),nl;
   54        %true ->
   55	     true.
   56
   57:- pred_hooks.   58
   59phook1_p(P,N) :-
   60	P == query ->
   61                false;
   62	%true ->
   63		true.
   64phook2_p(P,N) :-
   65	phook1_p(P,N).
   66phook3_p(P,N) :-
   67	phook1_p(P,N).
   68
   69
   70phook1_tests(P,N,Result) :-
   71	phook1_p(P,N),
   72	!,
   73	head3(P,N,Head,Head3),
   74	(P = gamma ->
   75	    Head =.. [Pred,Arg1,Arg2|_],
   76	    Body=(nl,write(enter*predicate:gamma(Arg1,Arg2)),nl,fail);
   77	 P = alpha ->
   78	    Head =.. [Pred,Arg1,Arg2|_],
   79	    Body=(nl,write(enter*predicate:alpha(Arg1,Arg2)),nl,fail);
   80	%true ->
   81	    Body=(nl,write(enter*predicate:Head3),nl,fail)),
   82	Result = (Head :- Body).
   83phook1_tests(_,_,true).
   84
   85phook2_tests(P,N,Result) :-
   86	phook2_p(P,N),
   87	!,
   88	head3(P,N,Head,Head3),
   89	(P = gamma ->
   90	    Head =.. [Pred,Arg1,Arg2|_],
   91	    Body=(nl,write(end_of_tests*predicate:gamma(Arg1,Arg2)),nl,fail);
   92	 P = alpha ->
   93	    Head =.. [Pred,Arg1,Arg2|_],
   94	    Body=(nl,write(end_of_tests*predicate:alpha(Arg1,Arg2)),nl,fail);
   95	%true ->
   96	    Body=(nl,write(end_of_tests*predicate:Head3),nl,fail)),
   97	Result = (Head :- Body).
   98phook2_tests(_,_,true).
   99
  100phook3_tests(P,N,Result) :-
  101	phook3_p(P,N),
  102	!,
  103	head3(P,N,Head,Head3),
  104	(P = gamma ->
  105	    Head =.. [Pred,Arg1,Arg2|_],
  106	    Body=(nl,write(failure*predicate:gamma(Arg1,Arg2)),nl,fail);
  107	 P = alpha ->
  108	    Head =.. [Pred,Arg1,Arg2|_],
  109	    Body=(nl,write(failure*predicate:alpha(Arg1,Arg2)),nl,fail);
  110	%true ->
  111	    Body=(nl,write(failure*predicate:Head3),nl,fail)),
  112	Result = (Head :- Body).
  113phook3_tests(_,_,true).
  114
  115head3(P,N,Head,Head3) :-
  116	P == query ->
  117                Head = query;
  118	%true ->
  119		N3 is N - 3,
  120                functor(Head3,P,N3),
  121                Head3 =.. [P|Args3],
  122                append(Args3,[_,_,_],Args),
  123                Head =.. [P|Args]