4
22
23make_grammar_table :-
24 cleanup_grammar_data,
25 make_rule_id_list,
26 generate_rule_data,
27 enhance_rule_id_list,
28 !.
29
30cleanup_grammar_data :-
31 retractall(dctg_rule_info(_, _, _, _)),
32 retractall(dctg_id_table(_, _, _, _)),
33 !.
34
38
39get_rule_name(Call2) :-
40 clause(semantic_rule(ID, _, Call, _), _),
41 Call =.. [Name|Args],
42 clone_list(Args, T),
43 append(T, [node(_, _, ID), _, _], AllArgs),
44 Call2 =.. [Name|AllArgs].
45
48
49clone_list([], []) :- !.
50clone_list([_|T], [_|T2]) :-
51 clone_list(T, T2),
52 !.
53
57
58generate_rule_data :-
59 findall(Call, get_rule_name(Call), Calls),
60 rem_dups(Calls, Calls2),
61 grammar_depth_top_loop(Calls2, [], [], Calls3),
62 grammar_type_top_loop(Calls2, [], [], Terminal),
63 set_rule_data(Calls3, Terminal),
64 !.
65
82
83grammar_depth_top_loop([], Known, _, Known) :- !.
84grammar_depth_top_loop(Calls, Known, MinCalls, Known3) :-
85 process_rules(Calls, Known, MinCalls, [], Known2, Unknown),
86 find_rule_mins(Known2, MinCalls, MinCalls2),
87 ((length(Calls, L), length(Unknown, L)) -> 88 write('Problem - '),write(L),write(' rules cannot terminate:'),
89 nl, writelist(Unknown), nl,
90 write('these terminated - '),nl, writelist(Known2),nl,
91 write('These are mincalls - '),nl, writelist(MinCalls2),nl,
92 fail
93 ;
94 grammar_depth_top_loop(Unknown, Known2, MinCalls2, Known3)),
95 !.
96
103
104process_rules([], Known, _, Unknown, Known, Unknown) :- !.
105process_rules([Call|Rest], Known, MinCalls, Unknown, Known2, Unknown2) :-
106 copy_term(Call, Call2),
107 clause(Call2, Body),
108 find_min_depth_body(Body, MinCalls, 0, BodyDepth),
109 !,
110 MinD is BodyDepth + 1,
111 process_rules(Rest, [(Call,MinD)|Known], MinCalls, Unknown, Known2, Unknown2).
112process_rules([Call|Rest], Known, MinCalls, Unknown, Known2, Unknown2) :-
113 !,
114 process_rules(Rest, Known, MinCalls, [Call|Unknown], Known2, Unknown2).
115
119
120find_min_depth_body((Goal,Rest), MinCalls, MinDSoFar, MinD) :-
121 is_a_rule_call(Goal),
122 !,
123 find_min_depth(Goal, MinCalls, Val),
124 MinDSoFar2 is max(Val, MinDSoFar),
125 find_min_depth_body(Rest, MinCalls, MinDSoFar2, MinD).
126find_min_depth_body((_,Rest), MinCalls, MinDSoFar, MinD) :-
127 !,
128 find_min_depth_body(Rest, MinCalls, MinDSoFar, MinD).
129find_min_depth_body(Goal, MinCalls, MinDSoFar, MinD) :-
130 is_a_rule_call(Goal),
131 !,
132 find_min_depth(Goal, MinCalls, Val),
133 MinD is max(Val, MinDSoFar).
134find_min_depth_body(_, _, MinD, MinD) :-
135 !.
136
139
140find_min_depth(Goal, [(G,M)|_], M) :-
141 Goal =.. [G|_],
142 !.
143find_min_depth(Goal, [_|R], M) :-
144 find_min_depth(Goal, R, M),
145 !.
146
148
149is_a_rule_call(Goal) :-
150 Goal =.. [Name|_],
151 dctg_id_table(Name, _, _, _),
152 !.
153
158
159find_rule_mins([], MinCalls, MinCalls) :- !.
160find_rule_mins([(Call,Depth)|Rest], MinCalls, MinCalls2) :-
161 Call =.. [CallName|_],
162 \+ member((CallName,_), MinCalls),
163 !,
164 find_rule_mins(Rest, [(CallName,Depth)|MinCalls], MinCalls2).
165find_rule_mins([_|Rest], MinCalls, MinCalls2) :-
166 find_rule_mins(Rest, MinCalls, MinCalls2).
167
169
170abstract_member(GoalName, [(First,_)|_]) :-
171 First =.. [GoalName|_].
172abstract_member(GoalName, [_|Rest]) :-
173 abstract_member(GoalName, Rest).
174
177
178find_minimum_depth(_, [], D, D).
179find_minimum_depth(CallName, [(Call, D)|Rest], MinSoFar, MinDepth) :-
180 Call =.. [CallName|_],
181 NewMin is min(D, MinSoFar),
182 find_minimum_depth(CallName, Rest, NewMin, MinDepth),
183 !.
184find_minimum_depth(CallName, [_|Rest], MinSoFar, MinDepth) :-
185 find_minimum_depth(CallName, Rest, MinSoFar, MinDepth),
186 !.
187
188
201
202grammar_type_top_loop(Calls, Terms, Nonterms, Terms2) :-
203 grammar_type_loop(Calls, [], Terms,Nonterms,Unknown, Terms3, Nonterms3),
204 (length(Calls, A), length(Unknown, A) ->
205 Terms3 = Terms2
206 ;
207 grammar_type_top_loop(Unknown, Terms3, Nonterms3, Terms2)),
208 !.
209
210grammar_type_loop([], Unknown, Term, Nonterm, Unknown, Term, Nonterm) :- !.
211grammar_type_loop([Call|Rest], Unknown, Term, Nonterm, Unknown2, Term2,
212 Nonterm2) :-
213 user_override(Call, Term, Nonterm, Term3, Nonterm3),
214 grammar_type_loop(Rest, Unknown, Term3, Nonterm3, Unknown2, Term2, Nonterm2).
215grammar_type_loop([Call|Rest], Unknown, Term, Nonterm, Unknown2, Term2,
216 Nonterm2) :-
217 copy_term(Call, Call2),
218 clause(Call2, Body),
219 goal_type(Call, Body, Rest, Unknown, Term, Nonterm, Unknown3, Term3, Nonterm3),
220 grammar_type_loop(Rest, Unknown3, Term3, Nonterm3, Unknown2, Term2, Nonterm2).
221
228
229user_override(Call, Term, Nonterm, [Call|Term], Nonterm) :-
230 Call =.. [Name|_],
231 dctg_override_P(OverTerm, _),
232 member(Name, OverTerm),
233 !.
234user_override(Call, Term, Nonterm, Term, [Call|Nonterm]) :-
235 Call =.. [Name|_],
236 dctg_override_P(_, OverNonterm),
237 member(Name, OverNonterm),
238 !.
239
240
257
258goal_type(Call, Goals, _, U, T, NT, U, T, [Call|NT]) :- 259 (Goals = (A,_) -> true ; Goals = A),
260 (abstract_member2(A, NT) ; same_goal(Call, A)),
261 !.
262goal_type(Call, Goals, Rest, U, T, NT, [Call|U], T, NT) :- 263 (Goals = (A,_) -> true ; Goals = A),
264 (abstract_member2(A, U) ; abstract_member2(A, Rest)),
265 !.
266goal_type(Call, (_,B), Rest, U, T, NT, U2, T2, NT2) :-
267 !,
268 goal_type(Call, B, Rest, U, T, NT, U2, T2, NT2).
269goal_type(Call, _, _, U, T, NT, U, [Call|T], NT). 270
271
273
274abstract_member2(Goal, [First|_]) :-
275 same_goal(Goal, First).
276abstract_member2(Goal, [_|Rest]) :-
277 abstract_member2(Goal, Rest).
278
279same_goal(A, B) :-
280 A =.. [N|_],
281 B =.. [N|_],
282 !.
283
285
286set_rule_data([], _) :- !.
287set_rule_data([(Rule, Depth)|Rest], Terminal) :-
288 Rule =.. [Name|Args],
289 append(_, [node(_, _, ID), _, _], Args),
290 (member(Rule, Terminal) ->
291 Type = terminal
292 ;
293 Type = nonterminal),
294 assert(dctg_rule_info(Name, ID, Rule, Depth, Type)),
295 set_rule_data(Rest, Terminal),
296 !.
297
301
302make_rule_id_list :-
303 findall((Name, IDs), make_rule_id_list2(Name, IDs), RuleIDs),
304 make_id_entries(RuleIDs),
305 !.
306
307make_rule_id_list2(Name, RuleIDs2) :-
308 bagof(ID, get_rule_stuff(Name, ID), RuleIDs),
309 rem_dups(RuleIDs, RuleIDs2).
310
311get_rule_stuff(Name, ID) :-
312 clause(semantic_rule(ID, _, Call, _), _),
313 Call =.. [Name|_].
314
315make_id_entries([]) :- !.
316make_id_entries([(Name, IDs)|Rest]) :-
317 assert(dctg_id_table(Name, IDs, _, _)),
318 make_id_entries(Rest),
319 !.
320
323
324enhance_rule_id_list :-
325 retract(dctg_id_table(Name, IDs, _, _)),
326 identify_type(IDs, Terms, Nonterms),
327 assert(dctg_id_table(Name, IDs, Terms, Nonterms)),
328 fail.
329enhance_rule_id_list.
330
331identify_type([], [], []).
332identify_type([ID|Rest], [ID|Terms], Nonterms) :-
333 dctg_rule_info(_, ID, _, _, terminal),
334 !,
335 identify_type(Rest, Terms, Nonterms).
336identify_type([ID|Rest], Terms, [ID|Nonterms]) :-
337 identify_type(Rest, Terms, Nonterms)