%             ---------------------------------------------
%               Programmstrukturanalysator f�r TOY Prolog
%              (c) 1983 Kluzniak/Szpakowicz, IIUW Warszawa
%
%             �nderungen f�r TOY Prolog ST V4  (c) 1987 JJK
%             ---------------------------------------------

calltree( Name/Arity ) :- dmember(proc(Name, Arity, Ord, Calls), Queue),
                          fill(Queue, Queue),
                          print_calls([proc(Name,Arity,Ord,Calls)],3,1,_).

fill([], _) :- !.
fill([proc(Name,Arity,_,[])|QTail], Q) :- predefined(Name, Arity), !,
                                          fill(QTail, Q).

fill([proc(Name,Arity,_,undefined)|QTail], Q) :-
         not clause(Name, Arity, 1, _, _), !, fill(QTail, Q).
fill([proc(Name,Arity,_,Calls)|QTail], Q) :-
         add_calls(Name, Arity, 1, Calls, Q), fill(QTail, Q).

add_calls(Name, Arity, N, Calls, Q) :-
         clause(Name, Arity, N, _, Body), !,
         body_calls(Body, Calls, Q), N1 is N + 1,
         add_calls(Name, Arity, N1, Calls, Q).
add_calls(_, _, _, [], _) :- !.
add_calls(_, _, _, _, _).

body_calls(true, _, _) :- !.
body_calls((Call, Others), Calls, Q) :- !,
         cfunctor(Call, Name, Arity),
         dmember(proc(Name,Arity,Ord,Callees), Calls),
         dmember(proc(Name,Arity,Ord,Callees), Q),
         add_insides(Call, Calls, Q),
         body_calls(Others, Calls, Q).
body_calls(SingleCall, Calls, Q) :-
         cfunctor(SingleCall, Name, Arity),
         dmember(proc(Name,Arity,Ord,Callees), Calls),
         dmember(proc(Name,Arity,Ord,Callees), Q),
         add_insides(SingleCall, Calls, Q).

cfunctor(Var, call, 1) :- var(Var), !.
cfunctor(Call, Fun, Ar) :- functor(Call, Fun, Ar).

add_insides(Call, Q1, Q2) :- meta_call_1(Call, Arg), !,
                             add_inside(Arg, Q1, Q2).
add_insides(Call, Q1, Q2) :- meta_call_2(Call, Arg1, Arg2), !,
                             add_inside(Arg1, Q1, Q2),
                             add_inside(Arg2, Q1, Q2).
add_insides(_, _, _).

add_inside(V, _, _) :- var(V), !.
add_inside(N, _, _) :- integer(N), !.
add_inside(Call, Q1, Q2) :- functor(Call, Name, Arity),
                            dmember(proc(Name,Arity,Ord,Callees), Q1),
                            dmember(proc(Name,Arity,Ord,Callees), Q2),
                            add_insides(Call, Q1, Q2).

meta_call_1(call(Call), Call).
meta_call_1(tag(Call), Call).
meta_call_1(not Call, Call).
meta_call_1(check(Call), Call).
meta_call_1(side_effects(Call), Call).
meta_call_1(once(Call), Call).
meta_call_1(try(Call), Call).

meta_call_2((A, B), A, B).
meta_call_2((A; B), A, B).

print_calls([], _, Ord, Ord) :- !.
print_calls([proc(Name,Arity,Ord,undefined) | Calls], Tab, Ord, NOrd) :-
         !, start_undefined(Ord, Tab),
         writeq(Name/Arity), display('    ** undefined **'), nl,
         TOrd is Ord + 1, print_calls(Calls, Tab, TOrd, NOrd).
print_calls([proc(Name,Arity,Ord,Callees) | Calls], Tab, Ord, NOrd) :-
         !, start_line(Ord, Tab), writeq(Name/Arity), nl,
         InnerTab is Tab + 3, InnerOrd is Ord + 1,
         print_calls(Callees, InnerTab, InnerOrd, TOrd),
         print_calls(Calls, Tab, TOrd, NOrd).
print_calls([proc(Name,Arity,AnotherOrd,_) | Calls], Tab, Ord, NOrd) :-
         start_unnumbered_line(Tab), writeq(Name/Arity),
         repetition(Name, Arity, AnotherOrd), nl,
         print_calls(Calls, Tab, Ord, NOrd).

repetition(Name, Arity, _) :- predefined(Name, Arity), !.
repetition(_, _, Ord) :- display('  (see '), display(Ord), display(')').

start_line(Ord, Tab) :- number_line(Ord), !, tab(Tab, ' ').

number_line(N) :- N < 10, display('   '), display(N).
number_line(N) :- N < 100, display('  '), display(N).
number_line(N) :- N < 1000, display(' '), display(N).
number_line(N) :- display(N).

start_unnumbered_line(Tab) :- display('    '), tab(Tab, ' ').

start_undefined(Ord, Tab) :- number_line(Ord), tab(Tab, '.').

tab(0, _) :- !.
tab(N, Ch) :- wch(Ch), N1 is N - 1, tab(N1, Ch).