1/*
    2
    3 _________________________________________________________________________
    4|	Copyright (C) 1982						  |
    5|									  |
    6|	David Warren,							  |
    7|		SRI International, 333 Ravenswood Ave., Menlo Park,	  |
    8|		California 94025, USA;					  |
    9|									  |
   10|	Fernando Pereira,						  |
   11|		Dept. of Architecture, University of Edinburgh,		  |
   12|		20 Chambers St., Edinburgh EH1 1JZ, Scotland		  |
   13|									  |
   14|	This program may be used, copied, altered or included in other	  |
   15|	programs only for academic purposes and provided that the	  |
   16|	authorship of the initial program is aknowledged.		  |
   17|	Use for commercial purposes without the previous written 	  |
   18|	agreement of the authors is forbidden.				  |
   19|_________________________________________________________________________|
   20
   21*/
   22
   23/* Print term as a tree */
   24
   25print_tree(T) :-
   26   numbervars80(T,1,_),
   27   pt0(T,0), nl, fail.
   28print_tree(_).
   29
   30pt0(A,I) :-
   31   as_is(A), !,
   32   tab(I), write(A), nl.
   33pt0([T|Ts],I) :- !,
   34   pt0(T,I),
   35   pl(Ts,I).
   36pt0(T,I) :- !,
   37   T=..[F|As],
   38   tab(I), write(F), nl,
   39   I0 is I+3,
   40   pl(As,I0).
   41
   42pl([],_) :- !.
   43pl([A|As],I) :- !,
   44   pt0(A,I),
   45   pl(As,I).
   46
   47as_is(V):- var(V),!.
   48as_is(A) :- atomic(A), !.
   49as_is(F):- functor(F,'$VAR',_).
   50as_is('_'(_)) :- !.
   51as_is(X) :-
   52   quote(X)