
%% This file (macro) contains predicates needed 
%% for handling (feature bundle) segments, i.e. for 
%% defining the feature set, and for defining and 
%% evaluating segment macros. 

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

%% MACRO_SET_UP
%% Incorporate user's macro definitions. Adds macros 
%% for uninstantiated and default-valued segments

macro_set_up:- 
    nl, write('COMPILING SEGMENT MACROS'), nl, 
    feature_list(X),              % look up feature set
    order_features,               % records position of features in list 
    get_defaults(X,Ys,Zs),        % Zs list of default values, Ys list of vars
    SEG   =.. [seg|Ys],         % make underspecified segment
    SEG_D =.. [seg|Zs],         % make default valued segment
    abolish(macro,2),             % erase previous definitions
    abolish(candidate,2),         % erase `candidate' record
    assert(macro(seg,SEG)),              % define underspecified segment
    assert(macro(seg_d,SEG_D)),          % define default valued segment
    fail_drive((macro A = B,               % Convert user's definitions to 
                assert(macro(A,B)))),      % form used by prog. 
    write('(macro compilation completed)'), nl. 

macro_set_up:-                   % Warn failure of macro compilation
    \+(feature_list([_|_])), nl, 
    write(' *** feature set undefined *** '), nl, 
    write(' *** segment macro compilation failed *** '), nl.


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

%% FEATURE_SET
%% used to define the set of features that make up 
%% segments, and their positional encoding

feature_set([X|Xs]):-  % requires that feature set is not empty
    abolish(feature_list,1),    
    assert(feature_list([X|Xs])).  % feature set stored with feature_list 

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

%% ORDER_FEATURES
%% Assign numerical position to features of user's 
%% feature set; record total number of features

order_features:-  
    abolish(feature,1), 
    abolish(feature_posn,2),     % erase previous records (if any) 
    abolish(feature_count,1),      
    feature_list(L),             % look up the feature list
    set_feature_positions(L,0).  % do the work


set_feature_positions([F/D|Fs],M):-
    M1 is M + 1, 
    assert(feature(F)),             % record F is a feature. 
    assert(feature_posn(F/D,M1)),   % record position of F in feature_list. 
    set_feature_positions(Fs,M1).   % Recurse.
    
set_feature_positions([],M):-      % finished
    assert(feature_count(M)).      % record total number of features

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    
%% GET_DEFAULTS: <feat-list><vars><defaults>
%% from user's feature list (Arg 1), derives list of the 
%% feature default values (Arg 3), as well as a list of new
%% variables (Arg 2) , for defining uninstantiated seg. 

get_defaults([],[],[]).
get_defaults([_F/X|Fs],[_|Ys],[X|Zs]):-
    get_defaults(Fs,Ys,Zs). 

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

%% MACRO_EVAL: <input statement><evaluated result>
%% evaluate a macro call. 
%
% If the input is not a macro call, it is returned
% unchanged. (Hence, if atomic segments are used, these
% pass through unchanged.) 

macro_eval(X,Y):-        
   macro_eval2(X,Y), !.   % handles the cases. 

macro_eval(X,X):-         % catch all warning of failure. 
   nl,
   write(' *** evaluation of macro '), 
   write(X), write(' has failed *** '), 
   !, fail.                            % fail

%%%%%%%%%%%%%%%%%%%%%%%
% macro_eval2/2:          % handles the cases. 

macro_eval2(X,Y):-        % input a variable, returned unchanged. 
   var(X),  
   X = Y, !. 
   
macro_eval2(@X,@X):-                  % Input looks like a macro, but has 
   var(X), nl,                        % variable head. Return unchanged. 
   write(' *** variable for macro head *** '), !.        % Give warning. 
   
macro_eval2(@(X:C),Z):- !,      % Macro has head X, plus changes C.
   macro_eval2(@X,Y),           % Separately evaluate X.
   substitute(C,Y,Z).           % Then substitute changes to give result.
   
macro_eval2(([A|B] // Y),Z):-    % Overwrite F=V's in list on seg Y
   !, 
   macro_eval2(Y,Y2),            % First evaluate Y.
   substitute([A|B],Y2,Z).       % Then make substitutions. 
   
macro_eval2(@(X/Y),Z):- !, % `Compromise' case. X,Y macros. Result (Z) 
                           % just like Y, but with instantatiated values
			   % of X substituted. 
   macro_eval2(@X,X2),   
   macro_eval2(@Y,Y2),
   compromise(X2,Y2,Z).    % Calculates the compromise of X and Y
   
macro_eval2(@X,Y):- !,     % Basic case. Simple user defined macro. 
   macro(X,Body), 
   macro_eval2(Body,Y). 
   
macro_eval2(X,X):-         % Non-macro input, returned unchanged. 
   \+(( X = (@ _) ; X = (_ // _))), !. 
   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% X macro evaluates to Y, convenient notation

Y <@> X:- macro_eval(X,Y). 

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

%% SUBSTITUTE: <new feat vals><old seg><new seg>
%% copy <old seg> as <new seg>, but replacing 
%% values for features in list <new feat vals>

% substitute/3: 

substitute(FVs,OldSeg,NewSeg):- 

   ((member((F=_V),FVs),           % Check for any undefined 
    \+feature(F))                  % features. Warn. Fail. 
      -> (nl, 
          write(' *** undefined feature: '),
	  write(F),  write(' used ***'), fail) 
       ; true), 
	 
   ((member((F=V1),FVs),           % Check for same feature appearing twice 
     member((F=V2),FVs),           % with conflicting values. Warn. Fail. 
     \+(V1 = V2))    
      -> (nl, write(' *** conflicting values for feature: '),
	  write(F),  write(' specified ***'), fail) 
       ; true), 
   
   macro(seg,NewSeg),                  % make NewSeg an unspecified segment. 
   substitute(FVs,OldSeg,NewSeg,1).    % Make substitutions. 

% substitute/4: 

substitute([],_,_,N):-    % finished.
   feature_count(C), 
   N > C, !. 

substitute(FVs,OldSeg,NewSeg,N):- 
   feature_posn(F/_,N), 
   delete_one((F=V),FVs ,FVs2), !,  % Feature present, so take value from list. 
   delete_any((F=V),FVs2,FVs3),     % Check for other occurrences. 
   arg(N,NewSeg,V), 
   M is N + 1, 
   substitute(FVs3,OldSeg,NewSeg,M).
   
substitute(FVs,OldSeg,NewSeg,N):-   % otherwise, feature not present in
   arg(N,OldSeg,V),                 % list, so take value from OldSeg
   arg(N,NewSeg,V), 
   M is N + 1, 
   substitute(FVs,OldSeg,NewSeg,M).

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

%% COMPROMISE <seg1><seg2><new seg>
%% <new seg> takes the *instantiated* values of 
%% <seg1>, all other values from <seg2>

compromise(Seg1,Seg2,NewSeg):- 
   macro(seg,NewSeg),               % make NewSeg an unspecified segment. 
   feature_count(N), 
   compromise(Seg1,Seg2,NewSeg,N).  % calculate the compromise. 
   
% compromise/4: 
   
compromise(_,_,_,N):-          % finished. 
   N < 1, !. 
   
compromise(Seg1,Seg2,NewSeg,N):- 
   arg(N,Seg1,Arg),
   nonvar(Arg), !,              % This argument of Seg1 is instantiated, 
   arg(N,NewSeg,Arg),           % so assign its value to NewSeg. 
   M is N-1, 
   compromise(Seg1,Seg2,NewSeg,M).  % Recurse. 
   
compromise(Seg1,Seg2,NewSeg,N):- 
   arg(N,Seg2,Arg),               % Otherwise, Seg2 value for this arg
   arg(N,NewSeg,Arg),             % assigned to NewSeg.
   M is N-1, 
   compromise(Seg1,Seg2,NewSeg,M).

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

% MACRO_EVAL_LIST: <input list><evaluated list>
% macro evaluates each of a list of macro calls.
% (Records result of each macro evaluation, for 
% subsequent suggestion of candidate identities.)  

macro_eval_list(X,X):- var(X), !. 
macro_eval_list([],[]):- !. 
macro_eval_list([A|As],[B|Bs]):- 
   macro_eval(A,B),              % Evaluate macro.  
   candidate_record(A,B),        % Record result. 
   macro_eval_list(As,Bs). 

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

% CANDIDATE_RECORD: 
% Records result of a macro evaluation, for 
% later suggestion of candidate identities. 

candidate_record(A,_B):- 
   var(A), !. 
candidate_record(@A,B):- 
   \+candidate(@A,B), 
   assert(candidate(@A,B)), !. 
candidate_record(_A,_B).

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

% LOOKUP_CANDIDATES:
% looks up set of candidates identities (i.e. source
% macro call) for a given segment, and filters this 
% down by eliminating any element whose segment is 
% subsumed by another element in the set. 

lookup_candidates(0,0):-  !.       % candidate set for 0 is just 0. 
lookup_candidates(InputSeg,Candidates):- 
    set_of([Macro,Seg],
           (candidate(Macro,Seg),  % records previous macro results
	    verify(InputSeg = Seg)),
	   MacSegs),               % look up unfiltered candidate set
    filter_candidates([],MacSegs,FilteredMacSegs), % filter candidate set
    set_of(Macro,
           Seg^member([Macro,Seg],FilteredMacSegs),
	   Candidates), !.         % collect up macros from filtered
	       	       	       	   % list of macro+segment pairs. 

% FILTER_CANDIDATES: <unfiltered><filtered>
%
% Delete any [Macro,Segment] pairs from 
% <unfiltered> list whose segment is subsumed 
% by segment of any other pair in the list 

filter_candidates(IN,Result):- 
    filter_candidates([],IN,Result). 

% filter_candidates/3:

filter_candidates(OUT,[],OUT).          % finished. 
filter_candidates(OUT,[[Mac,Seg]|IN],Result):-
    ground_copy(Seg,GSeg),        % make ground copy of current seg
    find_and_delete_unifiable([_,GSeg],OUT,NewOUT), 
                                  % delete subsumers from OUT
    find_and_delete_unifiable([_,GSeg],IN,NewIN), 
                                  % delete subsumers from IN
    filter_candidates([[Mac,Seg]|NewOUT],NewIN,Result). 
                                  % move pair to OUT list and recurse.
%%%%%%%

% Delete all elements from list Arg2, that 
% is unifiable with X. (Unifiable test done with
% verify so that no variable bindings result from
% the test.) 

find_and_delete_unifiable(_,[],[]). 
find_and_delete_unifiable(X,[Y|Ys],Zs):- 
    verify(X=Y), !, 
    find_and_delete_unifiable(X,Ys,Zs). 
find_and_delete_unifiable(X,[Y|Ys],[Y|Zs]):- 
    find_and_delete_unifiable(X,Ys,Zs). 

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

%% EVAL: <macro>
%% evaluates <macro>, prints result

eval P:- 
    macro_eval(P,Q), 
    nl, 
    numbervars(Q,0,_), 
    write(Q), nl. 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Given a segment, returns its instantiated values
%% as list of "Feature=Value" pairs

segment_feature_list(Seg,FVs):-
   Seg =.. [seg|Values], 
   feature_list(Features), 
   segment_feature_list(Features,Values,FVs).

%% segment_feature_list/3: 

segment_feature_list([],[],[]).             % finished. 

segment_feature_list([_F|Fs],[V|Vs],FVs):-
   var(V), !,                        % Feature's value uninstantiated,
   segment_feature_list(Fs,Vs,FVs).  % so ignore it. 

segment_feature_list([F/_|Fs],[V|Vs],[F=V|FVs]):- % Add F=V pair 
   segment_feature_list(Fs,Vs,FVs).               % to FVs list. 

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

% FEATURES
% Print list of features in their defined order, 
% plus a list of the features with their defaults. 

features:- 
    feature_list(FDs),                   % lookup feature set. 
    set_of((N:F),D^nth(N,F/D,FDs),FNs),  % Number the features. 
    feature_count(Count), 
    nl, write('Features: '), nl, 
    print_split_list(FNs,Count/2),     % print numbered features. 
    nl, nl, write('Defaults:'), nl, 
    print_split_list(FDs,Count/2).     % print features with defaults. 

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

% macro evaluates Y, then prints resulting seg as 
% a list of Feat=Val pairs. 
% Mainly for debugging / convenience. 

show_seg(Y):-
    X <@> Y, 
    nl, write(Y), write(' ='), nl,  
    segment_feature_list(X,FVs),    % extract F=V pairs
    print_split_list(FVs,9).        % print F=V pairs

ss(X):- show_seg(X).             % abbreviated command. 

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


