1/* @(#)ptree.pl	24.1 2/24/88 */
    2
    3/* 
    4	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
    5
    6			   All Rights Reserved
    7*/
    8/* Print term as a tree */
    9
   10 :- mode print_tree(+).   11 :- mode pt(+,+).   12 :- mode pl(+,+).   13 :- mode as_is(+).   14
   15 :- public print_tree/1.   16
   17print_tree(T) :-
   18   numbervars(T,1,_),
   19   pt(T,0), nl, fail.
   20print_tree(_).
   21
   22pt(A,I) :-
   23   as_is(A), !,
   24   tab(I), write(A), nl.
   25pt([T|Ts],I) :- !,
   26   pt(T,I),
   27   pl(Ts,I).
   28pt(T,I) :- !,
   29   T=..[F|As],
   30   tab(I), write(F), nl,
   31   I0 is I+3,
   32   pl(As,I0).
   33
   34pl([],_) :- !.
   35pl([A|As],I) :- !,
   36   pt(A,I),
   37   pl(As,I).
   38
   39as_is(A) :- atomic(A), !.
   40as_is('$VAR'(_)) :- !.
   41% In case
   42as_is('_'(_)) :- !.
   43as_is(X) :-
   44   quote(X)