2% Brian Ross
    3% Dec 10, 1998
    4
    5% DCTG post-processor: generates relevant tables needed by GP processing.
    6%
    7% 1. dctg_rule_info(Name, ID, Call, MinDepth, Type)
    8%	Name = name of rule 
    9%	ID = DCTG ID label
   10%	Call = call image for DCTG rule invocation
   11%	MinDepth = minimum depth to terminal generation 
   12%	Type = terminal, nonterminal
   13%
   14% 2. dctg_id_table(Name, IDList, TermList, NontermList)
   15%	Name = functor name
   16%	IDList = list of rule ID's for that functor
   17%	TermList, NontermList = lists of terminals, nonterminals
   18%
   19% Some assumptions: 
   20% - Grammar rules should be uniquely identifiable by functor name.
   21%   Should not use same functor name for different arity grammar rules!
   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
   35% get_rule_name constructs a call to a DCTG rule, such that all the args are
   36% variable except for the node structure, which has the ID number set.
   37% This uniquely identifies a DCTG rule header.
   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
   46% Given a list, clone_list creates a list of the same size, 
   47% but with uninst. args
   48
   49clone_list([], []) :- !.
   50clone_list([_|T], [_|T2]) :-
   51	clone_list(T, T2),
   52	!.
   53
   54% generate_rule_data gets all the rule headers (Calls) and finds: (i) the
   55% minimum depth to terminals for each rule; (ii) whether a rules is a
   56% terminal or nonterminal. Result saved in dctg_rule_info/4.
   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
   66% grammar_depth_top_loop(Calls, Known, MinCalls, Known2)
   67% Processes rules until all have min depths found, or no changes occurred
   68% (which means there's a problem with the rules).
   69%	Calls - rules to process
   70%	Known - rules with min depths
   71%	MinCalls - overall minimum for entire rules, to be used in goal analysis
   72%	Known - new Known set
   73%
   74% Algorithm for depth determination:
   75% Repeat until no unknown rules (hopefully! else there's infinite recursion) 
   76%	Process all unknown rules:
   77%  		If all goals have known minimum depths in a rule
   78%		then find maximum of these and add to Known list
   79%	Process all Known rules:
   80%		If a new rule has been added to Known (not in Minimum list)
   81%		then add it to Minimum list.
   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)) ->  % if no changes...
   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
   97% process_rules(Calls, Known, MinCalls, Unknown, Known2, Unknown2):
   98%	Calls - to process
   99%	Known, Unknown - rules with known/unknown minima
  100%	MinCalls - solved rules (can be used in body analyses of other rules)
  101%	Known2, Unknown2 - final values of above
  102% Find depth of body for rules. If available, add rule to Known, else Unknown.
  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
  116% find_min_depth_body(Body, MinCalls, MinDSoFar, MinD)
  117% Finds the depth value of body (max of all min vals of goals in body).
  118% Fails if an goal with unknown depth is found.
  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
  137% find_min_depth searches for goal name in list, and returns corresp.
  138% depth if found.
  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
  147% is_a_rule_call checks if a goal refers to a DCTG rule
  148
  149is_a_rule_call(Goal) :-
  150	Goal =.. [Name|_],
  151	dctg_id_table(Name, _, _, _),	
  152	!.
  153
  154% find_rule_mins(Calls, MinCalls, MinCalls2):
  155% Checks the current Known list for new overall minimum depths. 
  156% If a goal shows up in Known for the first time (ie. not in MinCalls)
  157% then it's depth value must be the minimum for that rule set: add it as such.
  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
  168% abstract_member checks if functor names match 
  169
  170abstract_member(GoalName, [(First,_)|_]) :-
  171	First =.. [GoalName|_].	
  172abstract_member(GoalName, [_|Rest]) :-
  173	abstract_member(GoalName, Rest).	
  174
  175% find_minimum_depth(Name, Calls, MinSoFar, Min):
  176% Finds the minimum depth value for Name in list of Calls.
  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
  189% grammar_type_top_loop(Calls, Terms, Nonterms, Terms2):
  190%	Calls - rules to process
  191%	Terms, Nonterms - terminals and nonterminals so far
  192%	Terms2 - final results of above
  193%
  194% Determine if rules can be classified as terminals. 
  195% Processing continues until no change in the set of rules that are unknown -
  196% these leftovers are classified as 'nonterminals'.
  197% First, user-override is checked. If it fail's then analysis done.
  198% See 'rule_type' for more details.
  199% Note that intermediate nonterminal determination is done as well;
  200% this could be deleted in the future to save some processing.
  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
  222% user_override(Call, Term, Nonterm, Term2, Nonterm2):
  223%	Call - rule head to process
  224%	Term, Nonterm - list of rules identified as terms and nonterms
  225%	Term2, Nonterm2 - final values of Term, Nonterm
  226% If the user has Call functor name in dctg_override parameter lists, then
  227% add that call to term or nonterm as appropriate. Otherwise, fail.
  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
  241% goal_type(Call, Body, Unknown, Term, Nonterm, Unknown2, Term2, Nonterm2)
  242%	Call - current head of rule being analyzed
  243%	Body - body of current rule
  244%	Rest - rules not yet processed
  245%	Unknown - unknown classifications
  246%	Term, Nonterm - Rules known to be terminal or nonterminal
  247%	Unknown2,Term2,Nonterm2 - Final values of results 
  248%
  249% This performs abstract interp of a single rule body.
  250% The order of tests in the following is critical.
  251%	1. If goal is a nonterm, then that rule is a nonterm.
  252%	2. If goal is same as rule name, then that rule is a nonterm.
  253%	3. If a goal is unknown, or not yet processed,
  254%		then that rule is unknown.
  255%	4. Else if the rest of the goals in that clause are term, 
  256%		then that rule is terminal.
  257
  258goal_type(Call, Goals, _, U, T, NT, U, T, [Call|NT]) :-  % 1, 2
  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) :- % 3
  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). % 4
  270
  271
  272% abstract_member2 checks if functor names match 
  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
  284% save depths, term/nonterm in dctg_rule_info assertions
  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
  298% make_rule_id_list makes a table giving rule name and the ID numbers of its
  299% associated rules. Last 2 args are placeholders for term and nonterm lists,
  300% to be set later.
  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
  321% enhance each dctg_id_table entry with list of which rules are terminal,
  322% and which are nonterminal. 
  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)