% $Id: tree_extensions.pl,v 1.20 2003/05/01 15:44:33 dm Exp $
%
% This file defines a special syntax for phrase structure rules,
% lexical entries, lexical rules, and empty elements in order to
% map the extralogical parts phonology and dtrs to the attributes
% phon and dtrs in the feature structure itself.
%
% The second part of the file contains some general predicates
% for providing a general interface to grammar specific features
% and types.
%
% IMPORTANT: This file has to be loaded as part of a grammar file 
% of the user (not as part of the Trale system) in order for the
% trale grammar compiler to read the definitions in this file
% as part of the user's grammar! This is generally done by including
% :- [trale_home(tree_extensions)]. in the grammar file. In the
% file trale_extras.pl loaded as part of the trale system we define 
% :- tree_extensions. as shorthand for this.  
%
% Author: Detmar Meurers
%
%%% ==================================================================
% Tree extensions

:- multifile term_expansion/4, if/2.
:- discontiguous term_expansion/4, if/2.

% The definitions in grammar_interface.pl, which are loaded as part of
% the trale system, are needed  for these tree_extensions to work.

% ------------------------------------------------------
% new operators

:-op(1150,xfx,~~>).  % lexical entries
:-op(1150,fx,trace). % empty element
:-op(1175,xfx,##).   % used for rule and lex_rule

% ------------------------------------------------------
% translating new lexical entry syntax

term_expansion((Phon ~~> Desc),_,(Phon ---> (Desc, PFeat:[(a_ Phon)])),[]) :-
   phon_feat_(PFeat).

% ------------------------------------------------------
% translating empty elements

term_expansion((trace Desc),_,(empty (Desc, PFeat:[])),[]) :-
   phon_feat_(PFeat).

% ------------------------------------------------------
% translating new lexical rule syntax

% matches both of the following: 
% ##(Name,morphs(if(**>(DescIn,DescOut),Cond),Morphs))
% ##(Name,morphs(**>(DescIn,DescOut),Morphs))

term_expansion(##(Name,morphs(Rule0,Morphs0)),_,lex_rule(Name,morphs(Rule,Morphs)),[]) :-
   phon_feat_(PFeat),
   DescOut = (DescOut0, PFeat:[(a_ Phon)]),
   (  functor(Rule0,if,_)
   -> Rule0 = (DescIn **> DescOut0 if Cond),
      Rule  = (DescIn **> DescOut  if Cond)
   ;  Rule0 = (DescIn **> DescOut0),
      Rule  = (DescIn **> DescOut)
   ),
   phonify_morphs(Morphs0,Morphs,Phon).

phonify_morphs((Morph,Morphs),(PMorph,PMorphs),Phon) :- !,
    phonify_morphs(Morph,PMorph,Phon),
    phonify_morphs(Morphs,PMorphs,Phon).

phonify_morphs((PattIn becomes PattOut),X,Y) :- !,
   phonify_morphs((PattIn becomes PattOut when true),X,Y).

phonify_morphs((PattIn becomes PattOut when Cond),
   (PattIn becomes PattOut 
           when (Cond,when(ground(PattOut),(morph_pattern(PattOut,Chars),
                    make_char_list(Codes,Chars),
                    name(Phon,Codes))))),
           Phon).

% ------------------------------------------------------
% translating new phrase structure rule syntax


% How the layout is represented
%
%  ##(RuleName,
%     ===>(Moth,
%          DtrsIn))
%  
%  [1,1,
%     [1,1,
%        1]],
%  
%  % if the functor were the first layout this would be:
%  [##,RuleName,
%      [===>,Moth,
%            DtrsIn]],
%  
%  
%  
%  rule(RuleName,
%       (===> (,(:(PFeat,MPhon),
%                (,(:(DFeat,MDtrs),
%                   Moth)))), 
%             DtrsIn))
%  
%  [1,1,
%     [1,[1,[1,1,
%              1],
%           [1,[1,1,
%                 1],
%               1]],
%        1]]
%  
%  % if the functor were the first layout this would be:
%  [rule,RuleName,
%        [===>,[,,[:,PFeat,
%                   MPhon],
%                  [,,[:,DFeat,
%                        MDtrs],
%                        Moth]],
%              DtrsIn]]
%  
  
term_expansion((RuleName ## (Moth ===> DtrsIn)),
               [L_Rule,L_RuleName,[L_Arrow,L_Moth,L_DtrsIn]],
              (RuleName rule (Moth,(PFeat:MPhon),(DFeat:MDtrs)) ===> DtrsOut), 
               [L_Rule,L_RuleName,[L_Arrow,[L_MothN,L_Moth,[L_MothN,[L_MothN,L_MothN,L_MothN],[L_MothN,L_MothN,L_MothN]]],L_DtrsOut]]) :-
%              [L_Rule,L_RuleName,[L_Arrow,[L_MothN,L_Moth,_NewFeats],L_DtrsOut]]
   (atom(L_Moth) -> L_MothN = L_Moth; [L_MothN|_] = L_Moth), % get line number of the mother
   phon_feat_(PFeat),
   dtrs_feat_(DFeat),
   treat_dtrs(DtrsIn,DtrsOut,PhonList,DtrsList,PFeat,
             (tree_list_append(PhonList,MPhon),
               tree_list_append(DtrsList,MDtrs)),
             _),
   % For the new dtrs, set line for body layout to that of rule name
   % (one could try to improve this by copying layout as far as possible,
   %  given that we know what clauses we add).
   term2layout(DtrsOut,L_DtrsOut,L_Rule).

treat_dtr((cat> Desc),(cat> (Desc,(PFeat:Phon),Dtr)),Phon,[Dtr],PFeat,
     Goals,Goals) :- !.
treat_dtr((sem_head> Desc),(sem_head> (Desc,(PFeat:Phon),Dtr)),Phon,[Dtr],PFeat,
     Goals,Goals) :- !.
treat_dtr((cats> Descs),(cats> (Descs,Dtrs)),Phon,Dtrs,_,
     GoalsIn,(tree_cats_to_phon(Dtrs,Phon),GoalsIn)) :- !.
treat_dtr(X,X,[],[],_,G,G).

treat_dtrs((In,InRest),(Out,OutRest),[Phon|Phons],[Dtr|Dtrs],PFeat,GoalsIn,GoalsOut) :- !,
   treat_dtr(In,Out,Phon,Dtr,PFeat,GoalsIn,GoalsAux),
   treat_dtrs(InRest,OutRest,Phons,Dtrs,PFeat,GoalsAux,GoalsOut).
treat_dtrs(In,(Out,(goal> GoalsOut)),[Phon],[Dtr],PFeat,GoalsIn,GoalsOut) :-
   treat_dtr(In,Out,Phon,Dtr,PFeat,GoalsIn,GoalsOut).


% ------------------------------------------------------
% TRALE relations used in the above


% tree_list_append(-,+)
% appends all lists in the list passed as first argument
tree_list_append(In,Out) if
   when( In=(e_list;ne_list),
    tree_undelayed_list_append(In,Out) ).

tree_undelayed_list_append([],[]) if true.
tree_undelayed_list_append([H|T],R) if
   tree_list_append(T,Aux),
   tree_append(H,Aux,R).

tree_append(X,Y,Z) if
   when( (X=(e_list;ne_list)
    ;Z=(e_list;ne_list)),
    undelayed_tree_append(X,Y,Z) ).

undelayed_tree_append([],L,L) if true.
undelayed_tree_append([H|T1],L,[H|T2]) if
   tree_append(T1,L,T2).

% catsToPhon(-,+)
% for converting list of categories under cats>
% to (flat) list of phonologies
tree_cats_to_phon(Cs,Ps) if
   when( (Cs = (e_list;ne_list);
    Ps = (e_list;ne_list)),
          tree_undelayed_cats_to_phon(Cs,Ps) ).

tree_undelayed_cats_to_phon([],[]) if true.
tree_undelayed_cats_to_phon([phon:P|CR],Res) if
   tree_cats_to_phon(CR,PR),
   tree_append(P,PR,Res).

%%% ==================================================================
% auxiliary predicates:

% For a term given in arg 1, this returns a layout term in arg 2 specifying
% the line number given in arg 3 for all of it
term2layout(Term,List,Line) :-
   (  simple(Term)
   -> List=Line
   ;  Term =.. [_Functor|Args],
      List = [Line|ListArgs],
      arg_term2layout(Args,ListArgs,Line)
   ).

arg_term2layout([],[],_).
arg_term2layout([H|T],[NewH|NewT],Line) :-
   term2layout(H,NewH,Line),
   arg_term2layout(T,NewT,Line).


term2list(Term,List) :-
   (  (atomic(Term);var(Term))
   -> List=Term
   ;  Term =.. [Functor|Args],
      List = [Functor|ListArgs],
      arg_term2list(Args,ListArgs)
   ).

arg_term2list([],[]).
arg_term2list([H|T],[NewH|NewT]) :-
   term2list(H,NewH),
   arg_term2list(T,NewT).

%%% ==================================================================
% Local Variables:
% mode: prolog
% End:
