% Program structure analyser for TOY Prolog
% (c) 1983 Kluzniak/Szpakowicz, IIUW Warszawa

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

add(El, [El | Tail]) :- !.
add(El, [_ | Tail]) :- add(El, Tail).

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), sum(N, 1, N1),
         add_calls(Name, Arity, N1, Calls, Q).
add_calls(_, _, _, [], _) :- !.
add_calls(_, _, _, _, _).

body_calls([], _, _) :- !.
body_calls([Call | BodyTail], Calls, Q) :-
         functor(Call, Name, Arity),
         add(proc(Name,Arity,Ord,Callees), Calls),
         add(proc(Name,Arity,Ord,Callees), Q),
         add_insides(Call, Calls, Q),
         body_calls(BodyTail, Calls, Q).

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),
                            add(proc(Name,Arity,Ord,Callees), Q1),
                            add(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_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,
         sum(Ord, 1, TOrd), 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,
         sum(Tab, 3, InnerTab), sum(Ord, 1, InnerOrd),
         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), sum(N1, 1, N), tab(N1, Ch).

end.