

%% This file (rule_compiler) contains the predicates required for 
%% compiling the user's two level rule definitions into the form 
%% use by the program. 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% COMPILE_TWOLEVELRULES:
%
% Compiles the user defined two level rules
% to more useful form (i.e. "unsugars" the rule notation)

compile_twolevelrules:- 
   abolish(twolevelrule/9),                  % Erase previous compiled rules. 
   nl, write('COMPILING TWO LEVEL RULES:'), nl, 
   xbagof(Name, Name := _Body, RuleNames),   % Collect up the names of the rules. 
   max_atom_length(RuleNames,MaxLen),        % - just for formatting. 
   (RuleNames = [] 
        -> (nl, write('*** WARNING: No rules found. ***'))  % No rules found. End. 
	;  true),   
   ((nth(M,Rule,RuleNames), 
     nth(N,Rule,RuleNames),                          % Check for non-uniquess
     \+(N=M))   ->                                   % of rule names. Warn. Fail. 
          (nl, 
	   write('*** Warning: Duplicate rule name: '), 
	   write(Rule), write(' ***'), nl, 
	   write('*** Rules not compiled ***'))
        ; (compile_twolevelrules(RuleNames,MaxLen),  % Everything okay. Proceed compiling
	   nl, nl,                                   % by collected up rule names. 
	   write('(rule compilation completed)'), nl)). 


% compile_twolevelrules/2: <rulenames><formatting-number> 
% Recurse down list of rule names, compiling each in turn. 

compile_twolevelrules([],_MaxLen).                 % finished.    
compile_twolevelrules([Rule|Rules],MaxLen):- 
   zero_num(rulecount),                      % Each user rule may produce >1 compiled rules.
                                             % Will count these. Here zero counter. 
   fail_drive((compile_twolevelrule(Rule), % Do failure driven compilation for current rule. 
	       new_num(rulecount,_)        % Count each successful cycle -> number rules. 
	       )), 
%%    fail_drive((Rule := Body,                    % Look up current rule. 
%%                compile_twolevelrule(Rule,Body), % Do failure driven compilation 
%% 	       new_num(rulecount,_)
%% 	       )), 
   nl, write(Rule), 
   new_num(rulecount,N),       % Look up number rules produced (N actually 1 more than number)
   atom_length(Rule,AtomLen), 
   Spaces is MaxLen - AtomLen, 
   (N > 1 -> (M is N -1,          % If one or more rules produced then 
              spaces(Spaces),     % print number of rules in brackets, 
              write('  ('), 
              write(M), write(')'))
	   ; write('  ** rule compilation failed **')),  % otherwise, warn of failure. 
   compile_twolevelrules(Rules,MaxLen).   % Proceed for rest of rules. 

%%%%%%%

% compile_twolevelrule/1: <rulename>
% looks up rule, and extracts subparts of its information
% to pass onto compile_twolevelrule/5. Different cases
% are to handle different rule forms, i.e. opt vs. oblig
% and whether there are side conditions on the rule or not. 
   
compile_twolevelrule(Name):-  
   Name := Left <=> Right where Cond, 
   compile_twolevelrule(Name,oblig,Left,Right,Cond). 
compile_twolevelrule(Name):-  
   Name := Left  => Right where Cond, 
   compile_twolevelrule(Name,opt,Left,Right,Cond).  
compile_twolevelrule(Name):-   
   Name := Left <=> Right, 
   compile_twolevelrule(Name,oblig,Left,Right,true). 
compile_twolevelrule(Name):-   
   Name := Left  => Right, 
   compile_twolevelrule(Name,opt,Left,Right,true). 

%%%%%%%

% compile_twolevelrule/5: <rulename><status><leftsegs><rightsegs><cond>
% 
% Deals with special `null context' marker "*",
% evaluates segments in the left and right rule fields,  
% and evaluates preconditions, to derive final rule. 
   
compile_twolevelrule(Name,Status,Left,Right,Cond):- 
   pre_and_post_conditions(Cond,PreCond,PostCond), % Separate cond into and 
                                                   % pre and post conditions. 
   call(PreCond),                             % Evaluate preconditions. 
   rule_side_match(Left, LSC,Surf,RSC),  % Extract subfields of lhs and rhs, 
   rule_side_match(Right,LLC,Lex, RLC),  %  and handle "*" occurrences. 
   macro_eval_list(LSC,LSC2),          
   macro_eval_list(Surf,Surf2),     % Evaluate segment macros occurring 
   macro_eval_list(RSC,RSC2),       % in any of the fields. 
   macro_eval_list(LLC,LLC2),
   macro_eval_list(Lex,Lex2),
   macro_eval_list(RLC,RLC2),  
   assert(twolevelrule(Name,Status,         % Assert the compiled rule. 
                       LSC2,Surf2,RSC2,
		       LLC2,Lex2, RLC2,
		       PostCond)).

%%%%%%%%%

% Take left or right hand side of rule, 
% and separate it out into its three fields. 
% Take care of any * occurrences, and modify context
% specification to appropriate form. 

rule_side_match(A-B-C,X,B,Y):-    
    rule_context(left, A,X),    % modify context, left context case
    rule_context(right,C,Y).    % modify context, right context case

rule_context(_,V,V):- var(V),!.    % Context is a variable, leave unchanged. 
rule_context(_,(*),_):-!.          % Context is "*", return anonymous variable. 
rule_context(left,Xs,Ys):-    % Input a list, left context case. 
    reverse(Xs,Zs),           % reverse the input list, and 
    append(Zs,_,Ys).          % then give it a variable tail. 
rule_context(right,Xs,Ys):-       % Input a list, right context case. 
    append(Xs,_,Ys).              % Give list a variable tail. 

%%%%%%%%%

% pre_and_post_conditions/3: <conditions-in><preconds><postconds> 
% Separate out pre and post conditions, if any, from side conditions
% that where state with rule. 
  
pre_and_post_conditions(true,true,true).               % Were non.
pre_and_post_conditions(pre:PreCond and post:PostCond, % Both pre and post. 
                        PreCond,
			PostCond).
pre_and_post_conditions(pre:PreCond,PreCond,true).     % Precond only. 
pre_and_post_conditions(post:PostCond,true,PostCond).  % Postcond only. 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

