1% LOOP48
2:- module(pendulum).
3
4bugcollection(loop48).
5
6getbug :-
7	writeln('\nCheck that you are in "module(pendulum).", then'),
8	writeln('to start the program type "strongly_connected_components."\n.').
9
10bug :-
11	nl,
12	explanation.
13
14explanation :-
15writeln(' \n\
16my_abolish/2 runs into an endless loop if applied to a non-existent predicate.\n\
17\n\
18GOAL:	 strongly_connected_components \n\
19CORRECT: yes. \n\
20BUGGY:   endless loop (pendulum, constructed) \n').
21
22
23data :- nl,
24	writeln('Data are contained in this file.'),
25	nl.
26envi.
27
28
29% ============================================================================
30/* ---------------------------------------------------------------------
31|									|
32|	   ANALYSIS OF THE PREDICATE CALL GRAPH FOR DIRECTLY          	|
33|		AND INDIRECTLY RECURSIVE PREDICATES			|
34|									|
35 --------------------------------------------------------------------- */
36
37:- dynamic
38	new/1,
39	count/1,
40	stack/1,
41	dfnumber/2,
42	lowlink/2.
43
44my_error_handler(68, dir_recursive__db(X, Y), M) :-
45	!,
46	generate_directly_recursive,
47	dir_recursive__db(X,Y).
48my_error_handler(68, indir_recursive__db(X, Y), M) :-
49	!,
50	generate_indirectly_recursive,
51	indir_recursive__db(X,Y).
52my_error_handler(68, indirect_recursion__db(X), M) :-
53	!,
54	strongly_connected_components,
55	indirect_recursion__db(X).
56my_error_handler(68, Goal, Module) :-
57	error(default(68), Goal, Module).
58
59:- set_error_handler(68, my_error_handler/3).
60
61% number of predicates in the predicate call graph
62
63number_of_predicates(I) :-
64	collect_vertices(List),
65	length(List,I).
66
67% collect all predicates defined in the db in a list called Vertices,
68% where each predicate is represented as (PredName/Arity,FileName)
69
70collect_vertices(Vertices) :-
71	setof((PredName/Arity,FileName),
72		definition_in__db((PredName,Arity), FileName),
73		Vertices).
74
75
76%  ----------------------------------------------------
77%   determination of the directly recursive predicates
78%  ----------------------------------------------------
79
80all_direct_recursions(PredList) :-
81	setof((PredName/Arity,FN), directly_recursive(PredName/Arity,FN),
82						PredList).
83
84directly_recursive(PredName/Arity,FileName) :-
85	dir_recursive__db(PredName/Arity,FileName).
86directly_recursive(PredName/Arity) :-
87	dir_recursive__db(PredName/Arity,FileName).
88
89generate_directly_recursive :-
90	definition_in__db((PredName,Arity),FileName),
91	subgoals_of__db((PredName,Arity),Subgoals,FileName),
92	member((PredName,Arity),Subgoals),
93	assert(dir_recursive__db(PredName/Arity,FileName)),
94	fail.
95generate_directly_recursive.
96
97
98%  --------------------------------------------------
99%   determination of indirectly recursive predicates
100%  --------------------------------------------------
101
102all_indirect_recursions(List) :-
103	strongly_connected_components,
104	setof(PredList, indirect_recursion__db(PredList), List).
105
106indirectly_recursive(PredName/Arity,FileName) :-
107	indir_recursive__db(PredName/Arity,FileName).
108indirectly_recursive(PredName/Arity) :-
109	indir_recursive__db(PredName/Arity,FileName).
110
111generate_indirectly_recursive :-
112	indirect_recursion__db(PredList),
113	member((PredName/Arity,FileName),PredList),
114	assert(indir_recursive__db(PredName/Arity,FileName)),
115	fail.
116generate_indirectly_recursive.
117
118%  ---------------------------------------------------------
119%   computation of indirect recursions = strongly connected
120%   components (scc) with at least two elements
121%
122%   Implementation of algorithm 5.4. (LOWLINK) given in
123%   AHU, "Design and Analysis of Computer Algorithms", 1974.
124%  ---------------------------------------------------------
125
126strongly_connected_components :-
127%	collect_vertices(Vertices),
128	vertices(Vertices),		% modified in order to avoid 'setof'
129	clean_database,
130	new_vertices(Vertices),
131	assert(count(1)),
132	assert(stack([])),
133	search_all_vertices(Vertices).
134
135% for each vertex assert new(Vertex)
136
137new_vertices([]).
138new_vertices([Vertex|Vs]) :-
139	assert(new(Vertex)),
140	new_vertices(Vs).
141
142% search(Vertices)
143
144search_all_vertices([]).
145search_all_vertices([NewVertex|NewVs]) :-
146	search_vertex(NewVertex),
147	search_all_vertices(NewVs).
148
149search_vertex(Vertex) :-
150	retract(new(Vertex)),
151	!,
152	count(N),
153	assert(dfnumber(Vertex,N)),
154	assert(lowlink(Vertex,N)),
155	increment_counter,
156	push(Vertex),
157	Vertex = (P/A,F),
158	subgoals_of__db((P,A),Sons,F),
159	search_sons(Sons, Vertex),
160	process_scc(Vertex).
161search_vertex(Vertex).
162
163process_scc(Vertex) :-
164	lowlink(Vertex,N),
165	dfnumber(Vertex,N),
166	!,
167	pop_scc_from_stack(Vertex,SCC),
168	length(SCC,Length),
169	Length > 1,
170	assert(indirect_recursion__db(SCC)).
171process_scc(Vertex).
172
173pop_scc_from_stack(Vertex,[Vertex]) :-
174	pop(Vertex),
175	!.
176pop_scc_from_stack(Vertex,[V|Vs]) :-
177	pop(V),
178	pop_scc_from_stack(Vertex,Vs).
179
180% for-loop of procedure LOWLINK
181% ----
182% Note that sons don't contain file names!!
183
184search_sons([], Father) :-
185	!.
186search_sons([(PN,A)|Vs], Father) :-
187	defined((PN,A),Vertex),
188	process_vertex(Vertex,Father),
189	fail.
190search_sons([Vertex|Vs], Father) :-
191	search_sons(Vs, Father).
192
193defined((PN,A),(PN/A,FileName)) :-
194	definition_in__db((PN,A),FileName).
195
196process_vertex(Vertex,Father) :-
197	new(Vertex),
198	search_vertex(Vertex),
199	retract(lowlink(Father,LLFather)),
200	lowlink(Vertex,LLVertex),
201	min(LLFather,LLVertex,MinLink),
202	assert(lowlink(Father,MinLink)),
203	!.
204process_vertex(Vertex,Father) :-
205	dfnumber(Vertex,DFVertex),
206	dfnumber(Father,DFFather),
207	DFVertex < DFFather,
208	on_stack(Vertex),
209	retract(lowlink(Father,LLFather)),
210	min(DFVertex,LLFather,MinLink),
211	assert(lowlink(Father,MinLink)),
212	!.
213process_vertex(Vertex,Father).
214
215
216%   -------------------------------
217%   b a s i c   p r e d i c a t e s
218%   -------------------------------
219
220conc([],L,L).
221conc([X|Xs],Y,[X|L]) :-
222	conc(Xs,Y,L).
223
224increment_counter :-
225	retract(count(N)),
226	NewN is N + 1,
227	assert(count(NewN)).
228
229member(X,[X|Xs]).
230member(X,[Y|Ys]) :-
231	member(X,Ys).
232
233% remove all the global variables ...
234
235clean_database :-
236	my_abolish(lowlink, 2),
237	my_abolish(dfnumber, 2),
238	my_abolish(new, 1),
239	my_abolish(stack, 1).
240
241my_abolish(F, N) :-
242	functor(Head, F, N),
243	repeat,
244		retract((Head :- Body)),
245		no_more_clauses(F, N).
246
247no_more_clauses(F, N) :-
248	functor(Head, F, N),
249	clause(Head, Body),
250	!,
251	fail.
252no_more_clauses(F, N).
253
254% stack handling procedures
255
256push(NewElement) :-
257	retract(stack(List)),
258	assert(stack([NewElement|List])),
259	!.
260
261pop(Element) :-
262	retract(stack([Element|List])),
263	assert(stack(List)),
264	!.
265
266on_stack(Element) :-
267	stack(List),
268	member(Element,List).
269
270
271% ---------------------------------------
272
273
274% data needed for the test
275
276definition_in__db((test, 0), 'loop14.pl').
277definition_in__db((traperror, 3), 'loop14.pl').
278definition_in__db((number_of_predicates, 1), 'loop14.pl').
279definition_in__db((collect_vertices, 1), 'loop14.pl').
280definition_in__db((all_direct_recursions, 1), 'loop14.pl').
281definition_in__db((directly_recursive, 2), 'loop14.pl').
282definition_in__db((directly_recursive, 1), 'loop14.pl').
283definition_in__db((generate_directly_recursive, 0), 'loop14.pl').
284definition_in__db((all_indirect_recursions, 1), 'loop14.pl').
285definition_in__db((indirectly_recursive, 2), 'loop14.pl').
286definition_in__db((indirectly_recursive, 1), 'loop14.pl').
287definition_in__db((generate_indirectly_recursive, 0), 'loop14.pl').
288definition_in__db((strongly_connected_components, 0), 'loop14.pl').
289definition_in__db((new_vertices, 1), 'loop14.pl').
290definition_in__db((search_all_vertices, 1), 'loop14.pl').
291definition_in__db((search_vertex, 1), 'loop14.pl').
292definition_in__db((process_scc, 1), 'loop14.pl').
293definition_in__db((pop_scc_from_stack, 2), 'loop14.pl').
294definition_in__db((search_sons, 2), 'loop14.pl').
295definition_in__db((defined, 2), 'loop14.pl').
296definition_in__db((process_vertex, 2), 'loop14.pl').
297definition_in__db((conc, 3), 'loop14.pl').
298definition_in__db((increment_counter, 0), 'loop14.pl').
299definition_in__db((member, 2), 'loop14.pl').
300definition_in__db((min, 3), 'loop14.pl').
301definition_in__db((restore_program, 0), 'loop14.pl').
302definition_in__db((push, 1), 'loop14.pl').
303definition_in__db((pop, 1), 'loop14.pl').
304definition_in__db((on_stack, 1), 'loop14.pl').
305
306subgoals_of__db((test, 0), [(strongly_connected_components, 0)], 'loop14.pl').
307subgoals_of__db((traperror, 3), [], 'loop14.pl').
308subgoals_of__db((number_of_predicates, 1), [(collect_vertices, 1)], 'loop14.pl').
309subgoals_of__db((collect_vertices, 1), [(setof, 3)], 'loop14.pl').
310subgoals_of__db((all_direct_recursions, 1), [(setof, 3)], 'loop14.pl').
311subgoals_of__db((directly_recursive, 2), [(dir_recursive__db, 2)], 'loop14.pl').
312subgoals_of__db((directly_recursive, 1), [(dir_recursive__db, 2)], 'loop14.pl').
313subgoals_of__db((generate_directly_recursive, 0), [(definition_in__db, 2), (subgoals_of__db, 3), (member, 2)], 'loop14.pl').
314subgoals_of__db((all_indirect_recursions, 1), [(strongly_connected_components, 0), (setof, 3)], 'loop14.pl').
315subgoals_of__db((indirectly_recursive, 2), [(indir_recursive__db, 2)], 'loop14.pl').
316subgoals_of__db((indirectly_recursive, 1), [(indir_recursive__db, 2)], 'loop14.pl').
317subgoals_of__db((generate_indirectly_recursive, 0), [(indirect_recursion__db, 1), (member, 2)], 'loop14.pl').
318subgoals_of__db((strongly_connected_components, 0), [(vertices, 1), (new_vertices, 1), (search_all_vertices, 1)], 'loop14.pl').
319subgoals_of__db((new_vertices, 1), [(new_vertices, 1)], 'loop14.pl').
320subgoals_of__db((search_all_vertices, 1), [(search_vertex, 1), (search_all_vertices, 1)], 'loop14.pl').
321subgoals_of__db((search_vertex, 1), [(count, 1), (increment_counter, 0), (push, 1), (subgoals_of__db, 3), (search_sons, 2), (process_scc, 1)], 'loop14.pl').
322subgoals_of__db((process_scc, 1), [(lowlink, 2), (dfnumber, 2), (pop_scc_from_stack, 2)], 'loop14.pl').
323subgoals_of__db((pop_scc_from_stack, 2), [(pop_scc_from_stack, 2), (pop, 1)], 'loop14.pl').
324subgoals_of__db((search_sons, 2), [(search_sons, 2), (defined, 2), (process_vertex, 2)], 'loop14.pl').
325subgoals_of__db((defined, 2), [(definition_in__db, 2)], 'loop14.pl').
326subgoals_of__db((process_vertex, 2), [(dfnumber, 2), (dfnumber, 2), (on_stack, 1), (new, 1), (search_vertex, 1), (lowlink, 2), (min, 3)], 'loop14.pl').
327subgoals_of__db((conc, 3), [(conc, 3)], 'loop14.pl').
328subgoals_of__db((increment_counter, 0), [], 'loop14.pl').
329subgoals_of__db((member, 2), [(member, 2)], 'loop14.pl').
330subgoals_of__db((min, 3), [], 'loop14.pl').
331subgoals_of__db((restore_program, 0), [], 'loop14.pl').
332subgoals_of__db((push, 1), [], 'loop14.pl').
333subgoals_of__db((pop, 1), [], 'loop14.pl').
334subgoals_of__db((on_stack, 1), [(stack, 1), (member, 2)], 'loop14.pl').
335
336
337vertices([(process_scc / 1, 'loop48.pl'), (pop_scc_from_stack / 2, 'loop48.pl'), (search_sons / 2, 'loop48.pl'), (defined / 2, 'loop48.pl'), (process_vertex / 2, 'loop48.pl'), (conc / 3, 'loop48.pl'), (increment_counter / 0, 'loop48.pl'), (member / 2, 'loop48.pl'), (min / 3, 'loop48.pl'), (push / 1, 'loop48.pl'), (pop / 1, 'loop48.pl'), (on_stack / 1, 'loop48.pl')]).
338%%%% vertices([(number_of_predicates / 1, 'loop48.pl'), (collect_vertices / 1, 'loop48.pl'), (all_direct_recursions / 1, 'loop48.pl'), (directly_recursive / 2, 'loop48.pl'), (directly_recursive / 1, 'loop48.pl'), (generate_directly_recursive / 0, 'loop48.pl'), (all_indirect_recursions / 1, 'loop48.pl'), (indirectly_recursive / 2, 'loop48.pl'), (indirectly_recursive / 1, 'loop48.pl'), (generate_indirectly_recursive / 0, 'loop48.pl'), (strongly_connected_components / 0, 'loop48.pl'), (new_vertices / 1, 'loop48.pl'), (search_all_vertices / 1, 'loop48.pl'), (search_vertex / 1, 'loop48.pl'), (process_scc / 1, 'loop48.pl'), (pop_scc_from_stack / 2, 'loop48.pl'), (search_sons / 2, 'loop48.pl'), (defined / 2, 'loop48.pl'), (process_vertex / 2, 'loop48.pl'), (conc / 3, 'loop48.pl'), (increment_counter / 0, 'loop48.pl'), (member / 2, 'loop48.pl'), (min / 3, 'loop48.pl'), (push / 1, 'loop48.pl'), (pop / 1, 'loop48.pl'), (on_stack / 1, 'loop48.pl')]).
339
340
341
342
343
344
345
346