% GrTrace -- a graphical trace facility for Xerox Quintus Prolog.
%	Written by Herb Jellinek, Xerox Corporation, February 1986.
%	Adapted from a mass of uncommented code I found in the Prolog
%	Library.
%
%	This program uses the Interlisp-D program Grapher to display
%	the call graph.  It shows the results of unification, success,
%	backtracking, and failure.
%
%	You should declare any predicates you want to trace
%	with this program to be dynamic.

%	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%	This software is copyright (c) 1986 Xerox Corporation.  All rights are
%	reserved, baby.
%	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

:- dynamic stack/2, traceon/0.

trace(X) :-
   (traceon; assert(traceon)),
   asserta((X :- assert(traceon), fail)),
   asserta((X :-
   	traceon, !,
	retract(traceon),
	enterx(X, D2), !,
	  (
	   call(X),
	   forwardx(X, D2),
	   backwardx(X, D2);
	   
	   failx(X, D2), !,
	   fail
	  )
	  )).

enterx(X, D2) :-
   (stack(D1, _); D1 is 0, asserta(stack(0,1))),
   D2 is D1 + 1,
   asserta(stack(D2, 1)),
   trace_hook(D2, X, call).

forwardx(X, D2) :-
   retract(stack(D2, B)),
   stack(D1, Blast),
   trace_hook(D2, X, solution),
   B2 is B + 1,
   asserta(stack(D2, B2)),
   asserta(stack(D1, Blast)),
   !.

backwardx(X, D2) :-
   (true;
   
    stack(D2, B),
    asserta(stack(D2, B)),
    trace_hook(D2, X, backtrack), !,
    fail
   ).

failx(X, D2) :-
   stack(D2, N),
   clearstack(D2, N),
   trace_hook(D2, X, fail).

clearstack(Dgiven, N) :-
   stack(D, B), !,
   (
    D >= Dgiven,
    retract(stack(D, B)), !,
    clearstack(Dgiven, N);
    (
     N > 1,
     retract(stack(_, _)),
     Nm1 is N - 1,
     clearstack(Dgiven, Nm1);
     
     true
    )
   ).

trace_hook(D, Term, EntryType) :-
	lisp_apply('PROLOG-TRACE', [D,Term,EntryType],_).

% trace_hook(D, Term, EntryType) :-
%    nl,
%    write('(ADDTOTREE '), write(D), write(' (QUOTE '),
%    write(EntryType), write(') "'), write(Term), write('")').

untrace(X) :-
   clause(X, Q1),
   retract(':-'(X, Q1)),
   clause(X, Q2),
   retract(':-'(X, Q2)),
   abolish(stack, 2),
   !.