
% Index mapping---``horizontal constraints''.

% ---------------------------------------------------------------------
 
% $Id$
 
% $Log$

% ---------------------------------------------------------------------

% Define mapping domains.
% Decorate expression nodes with node and parent mapping descriptors.
% Impose constraints between node and parent (and sibling) index mappings.

% ``meta-syntax'' is
%
%  <sym_tab>     ::= Table(<declaration>)
%
%  <declaration> ::=
%    variable(<var_attr>)                  |
%    function(<fun_attr>)                  |
%    expression(<expression>, <exp_attr>)
%
%
%  <expression>  ::=
%    expRef(<exp_handle>)                                            |
%    idxRef(<exp_handle>, <idx_handle>)                              |
%    varRef(<var_handle>)                                            |
%    funRef(<fun_handle>, <tag>, List(<exp_handle>))                 |
%    subscript(<exp_handle>, List(<exp_handle>))                     |
%    arrall(List(<idx_handle>), <idx_tab>, <exp_handle>)             |
%    forall(List(<idx_handle>), List(<exp_handle>), List(<exp_handle>),
%           List(<exp_handle>))                                      |
%    size(<literal>, <exp_handle>)                                   |
%    literal(<literal>)                                              |
%    true                                                            |
%    false                                                           |
%    any
%
%  <index_declaration> ::= index(<range>, <idx_attr>)
%
%  <tag>         ::= <predef> | user
%
%  <predef>      ::= ...

% Attribute meta-syntax...
%
%  <fun_attr> ::= syms         :: <sym_tab>               #
%                 declarations :: List(<var_handle> |
%                                      <fun_handle> |
%                                      <exp_handle>)      #
%                 statements   :: List(<exp_handle>)      #
%                 dummies      :: List(<var_handle>)      #
%                 result       :: <var_handle>            #
%                 class        :: elemental | array       #
%                 dumShps      :: List(<extern_shape>)    #
%                 resShp       :: <extern_shape>          #
%                 dumMaps      :: List(<extern_mapping>)  #
%                 resMap       :: <extern_mapping>        #
%                 dumAlnGrps   :: List(List(<literal>))   #
%                 resAlnGrp    :: List(<literal>)
%
%  <var_attr> ::= shape    :: List(<exp_handle>)         #
%                 ishape   :: List(<exp_handle>)         #
%                 mapDesc  :: <var_mapping_desc>         #
%                 imapDesc :: <var_mapping_desc>
%
%  <exp_attr> ::= shape :: List(<range>)

% Syntax of external expressions...
%
%  <extern_shape> ::= List(<external>)
%
%  <external> ::= literal(<literal>)                            |
%                 varRef(<var_handle>)                          |
%                 funRef(<fun_handle>, <tag>, List(<external>)) |
%                 size(<literal>, <var_handle>)                 |
%                 arg(<literal>)                                |
%                 sizeArg(<literal>, <literal>)                 |
%                 any

% Syntax of mapping descriptors
%
%
%  <var_mapping_desc>  ::=  distribute                   |
%                           align(<template>,
%                                 List(<arr_idx_mapping_desc),
%                                 List(<embedding_desc>))
%
%  <exp_mapping_desc>  ::=  align(<template>,
%                                 List(<arr_idx_mapping_desc),
%                                 List(<idx_mapping_desc),
%                                 List(<embedding_desc>))
%
%  <arr_idx_mapping_desc>  ::=  <map> :: <dimension>
%
%  <template>          ::= def | <var_handle>
%
%  <idx_mapping_desc>  ::= <map> :: <idx_handle> -> <dimension>
%
%  <map>               ::= map(<exp_handle>, <exp_handle>)  |
%                          id                               |
%                          any
%
%  <embedding_desc>    ::=  emb(<exp_handle>) :: <dimension>  |
%                           rep :: <dimension>
%
%  <extern_mapping>    ::=  any                          |
%                           align(<extern_template>,
%                                 List(<extern_idx_mapping>),
%                                 List(<extern_embedding>))
%
%  <extern_template>     ::=  global(<var_handle>) |
%                             arg(<literal>)       |
%                             def
%
%  <extern_idx_mapping>  ::=  <extern_map> :: <dimension>
%
%  <extern_map>          ::=  map(<external>, <external>)  |
%                             id                           |
%                             any
%
%  <extern_embedding>  ::=  emb(<external>) :: <dimension> |
%                           rep :: <dimension>
%
%  <dimension>         ::=  <literal>  |  col


constrain(DHs, Syms) :- constrainProgram(DHs, [], Syms).


% ---- Basic ``constraint'' predicates ----


constrainProgram(DHs, SHs, Syms) :-
    constrainDeclarationList(DHs, Syms),
    constrainExpressionHandles(SHs, Syms, _).


constrainDeclarationList([], _).
constrainDeclarationList([DH | DHs], Syms) :-
    symLookUp(DH, D, Syms),
    constrainDeclaration(D, Syms),
    constrainDeclarationList(DHs, Syms).

constrainDeclaration(function(Atr), _) :-
    funAtr(Atr),
      Syms := Atr -> syms,
      DHs  := Atr -> declarations, SHs  := Atr -> statements,
    constrainProgram(DHs, SHs, Syms).
constrainDeclaration(variable(Atr), Syms) :-
    varAtr(Atr),
      Shape   := Atr -> ishape,
      MapDesc := Atr -> mapDesc,
    constrainExpressionHandleList(Shape, Syms, _),
    % !!! Contextual map should be default map !!!
    constrainMapDesc(MapDesc, Syms).
constrainDeclaration(expression(E, Atr), Syms) :-
    constrainExpression(E, Atr, Syms, _).


constrainExpressionHandles([], _, []).
constrainExpressionHandles([EH | EHs], Syms, [CtxMap | CtxMaps]) :-
    constrainExpressionHandle(EH, Syms, CtxMap),
    constrainExpressionHandles(EHs, Syms, CtxMaps).

constrainExpressionHandleList([], _, _).
constrainExpressionHandleList([EH | EHs], Syms, CtxMap) :-
    constrainExpressionHandle(EH, Syms, CtxMap),
    constrainExpressionHandleList(EHs, Syms, CtxMap).

constrainExpressionHandle(EH, Syms, CtxMap) :-
    symLookUp(EH, expression(E, Atr), Syms),
    constrainExpression(E, Atr, Syms, CtxMap).

constrainExpression(varRef(VH), Atr, Syms, CtxMap) :-
    expAtr(Atr),
      CtxMap := Atr -> ctxMap, LocMap := Atr -> locMap,
    symLookUp(VH, variable(VAtr), Syms),
    varAtr(VAtr),
      MapDesc := VAtr -> imapDesc,
      Shape   := VAtr -> ishape,
    getAIMap(CtxMap, CtxAIMap),
    sameSize(CtxAIMap, Shape),
    getAIMap(LocMap, LocAIMap),
    sameSize(LocAIMap, Shape),
    getIMap(LocMap, []),
    alignVarMap(LocMap, MapDesc, VH, Shape).
constrainExpression(funRef(FH, _, EHs), Atr, Syms, CtxMap) :-
    expAtr(Atr),
      ISet := Atr -> iSet, Shape := Atr -> shape,
      CtxMap     := Atr -> ctxMap,     LocMap     := Atr -> locMap,
      MapDaughts := Atr -> mapDaughts, MapDomains := Atr -> mapDomains,
    symLookUp(FH, function(FAtr), Syms),
    funAtr(FAtr),
      DumMaps      := FAtr -> dumMaps,      ResMap      := FAtr -> resMap,
      Acts         := FAtr -> acts,
      DumAlnGroups := FAtr -> dumAlnGroups, ResAlnGroup := FAtr -> resAlnGroup,
    getAIMap(CtxMap, CtxAIMap),
    sameSize(CtxAIMap, Shape),
    getAIMap(LocMap, LocAIMap),
    sameSize(LocAIMap, Shape),
    alignActMaps(ActMaps, DumMaps, ActMaps, Acts, Syms),
    alignActMap(LocMap, ResMap, ActMaps, Acts, Syms),
    domain(IdxMap, ISet),
    getIMapList([LocMap | ActMaps], IdxMap),     % Unify index maps.
    (ISet = [], !,
      gather(MapDaughts, ResAlnGroup, EHs),      % Alignment group of result.
      gathers(MapDomains, DumAlnGroups, EHs)     % Other alignment groups.
    |true,
      getTemplateList([LocMap | ActMaps], _),    % Unify templates.
      catList(DumAlnGroupsCat, [ResAlnGroup | DumAlnGroups]),
      gather(MapDaughts, DumAlnGroupsCat, EHs),  % Arguments, reordered.
      MapDomains = []),
    constrainExpressionHandles(EHs, Syms, ActMaps).
constrainExpression(subscript(EH, EHs), Atr, Syms, CtxMap) :-
    expAtr(Atr),
      ISet := Atr -> iSet,
      CtxMap     := Atr -> ctxMap,     LocMap     := Atr -> locMap,
      MapDaughts := Atr -> mapDaughts, MapDomains := Atr -> mapDomains,
    getAIMap(CtxMap, []),
    getAIMap(LocMap, []),
    domain(IdxMap, ISet),
    getIMap(LocMap, IdxMap),
    expGetDepen(ArrISet, _, EH, Syms),
    (ArrISet = [], !,
      getIMap(ArrMap, []),
      constrainExpressionHandle(EH, Syms, ArrMap),
      constrainExpressionHandleList(EHs, Syms, LocMap),
      MapDaughts = EHs,
      MapDomains = [EH]
    |true,
      constrainExpressionHandleList([EH | EHs], Syms, LocMap),
      MapDaughts = [EH | EHs],
      MapDomains = []).
constrainExpression(forall(IHs, Shape, _, EHs), Atr, Syms, CtxMap) :-
    getTemplateList([CtxMap, ShpMap, StmMap], _),   % Unify templates.
    getEmbeddingList([CtxMap, ShpMap, StmMap], _),  % Unify embeddings.
    getAIMap(CtxMap, []),
    getIMapList([ShpMap, CtxMap], CtxIdxMap),       % Unify index maps.
    getIMap(StmMap, StmIdxMap),
    constrainExpressionHandleList(Shape, Syms, ShpMap),
    addIdxMappings(StmIdxMap \ CtxIdxMap, IHs, _),
    constrainExpressionHandleList(EH, Syms, StmMap).
constrainExpression(arrall(IHs, Shape, EH), Atr, Syms, CtxMap) :-
    getTemplateList([CtxMap, ShpMap, StmMap], _),   % Unify templates.
    getEmbeddingList([CtxMap, ShpMap, StmMap], _),  % Unify embeddings.
    getAIMap(CtxMap, CtxAIMap),
    getIMapList([ShpMap, CtxMap], CtxIdxMap),       % Unify index maps.
    getIMap(StmMap, StmIdxMap),
    constrainExpressionHandleList(Shape, Syms, ShpMap),
    addIdxMappings(StmIdxMap \ CtxIdxMap, IHs, CtxAIMap),
    constrainExpressionHandleList(EH, Syms, StmMap).
constrainExpression(idxRef(SizeH, IH), Atr, Syms, CtxMap) :-
    getAIMap(CtxMap, []),
    constrainExpressionHandle(SizeH, Syms, CtxMap).
constrainExpression(size(_, EH), Atr, Syms, CtxMap) :-
    expAtr(Atr),
      ISet   := Atr -> iSet,
      CtxMap := Atr -> ctxMap, LocMap := Atr -> locMap,
    getAIMap(CtxMap, []),
    getAIMap(LocMap, []),
    domain(IdxMap, ISet),
    getIMapList([LocMap | ActMap], IdxMap),    % Unify index maps.
    getTemplateList([LocMap | ActMaps], _),    % Unify templates.
    constrainExpressionHandle(EH, Syms, ActMap).
constrainExpression(expRef(EH), Atr, _, CtxMap) :-
    expAtr(Atr),
      CtxMap := Atr -> ctxMap,
    expGetShape(Shape, EH, Syms),
    getAIMap(CtxMap, CtxAIMap),
    sameSize(CtxAIMap, Shape).
constrainExpression(E, Atr, _, CtxMap) :-
    isLiteral(E),
    expAtr(Atr),
      CtxMap := Atr -> ctxMap,
    getAIMap(CtxMap, []).


constrainMapDesc(distribute, _).
constrainMapDesc(align(T, AIMap, Embeds), Syms) :-
    constrainAIMappings(AIMap, Syms),
    constrainEmbeddings(Embeds).

constrainAIMappings([], _).
constrainAIMappings([AIMapping | AIMappings], Syms) :-
    constrainAIMapping(AIMapping, Syms),
    constrainAIMappings(AIMappings, Syms).

constrainAIMapping(M :: _, Syms) :-
    constrainLin(M, Syms).

constrainLin(map(MH, CH), Syms) :-
    constrainExpressionHandle(MH, Syms, _),
    constrainExpressionHandle(CH, Syms, _).
    % !!! Contextual maps should be default map !!!
constrainLin(id,  _).
constrainLin(any, _).

constrainEmbeddings([], _).
constrainEmbeddings([Embed | Embeds], Syms) :-
    constrainEmbedding(Embed, Syms),
    constrainEmbeddings(Embeds, Syms).

constrainEmbedding(emb(EH) :: _, Syms) :-
    constrainExpressionHandle(EH, Syms, _).
    % !!! Contextual map should be default map !!!
constrainEmbedding(rep :: _, _).


% ----- Array alignment for function actual arguments and results -----


alignActMaps([], [], _, _, _).
alignActMaps([ActMap | ActMapTail], [DumMap | DumMapTail],
             ActMaps, Acts, Syms) :-
    alignActMap(ActMap, DumMap, ActMaps, Acts, Syms),
    alignActMaps(ActMapTail, DumMapTail, ActMaps, Acts, Syms).

alignActMap(_, any, _, _, _) :- !.
alignActMap(ActMap
            align(arg(N), DumAIMap, DumEmbeds),
            ActMaps, Acts, Syms) :-
    !,
    isNth(N, ActMaps, TrgMap),
    externAIMap(ActToTrgAIMap, DumAIMap, Acts, Syms),
    externEmbeds(ActToTrgEmbeds, DumEmbeds, Acts, Syms),
    composeActMap(ActMap, TrgMap, ActToTrgAIMap, ActToTrgEmbeds, Syms).
alignActMap(align(T, AIMap, _, Embeds), align(T, AIMap, Embeds), _, _, _).

composeActMap(align(T, AIMap, _, Embeds),
              align(T, TrgAIMap, _, TrgEmbeds),
              ActToTrgAIMap, ActToTrgEmbeds, Syms) :-
    composeActAIMappings(AIMap, TrgAIMap, ActToTrgAIMap, Syms),
    applyActAIMaps(Embeds \ TrgEmbeds, TrgAIMap, ActToTrgEmbeds, Syms).

composeActAIMappings([], [], _).
composeActAIMappings([ActAIMapping | ActAIMapTail],
		     [ActToTrgAIMapping | ActToTrgAIMapTail], TrgAIMap) :-
    composeActAIMapping(ActAIMapping, ActToTrgAIMapping, TrgAIMap),
    composeActAIMappings(ActAIMapTail, ActToTrgAIMapTail, TrgAIMap).

composeActAIMapping(any :: col, _ :: col, _)            :- !.
composeActAIMapping(Map :: D, AlnMap :: TrgD, TrgAIMap) :-
    isNth(TrgD, TrgMapAI, TrgMap :: D),
    composeActLin(Map, AlnMap, TrgMap).

applyActAIMaps(Embeds \ Embeds, _, [], _).
applyActAIMaps([MappedEmbed | MappedEmbedsF] \ MappedEmbedsB,
               AIMap, [Embed | Embeds], Syms) :-
    applyActAIMap(MappedEmbed, AIMap, Embed, Syms),
    applyActAIMaps(MappedEmbedsF \ MappedEmbedsB, AIMap, Embeds, Syms).

applyActAIMap(MappedEmbed :: TrgD, AIMap, Embedding :: D, Syms) :-
    isNth(D, AIMap, M :: TrgD),
    applyActLin(MappedEmbed, AIMap, Embedding).

applyActLin(rep, _, rep).
applyActLin(emb(apply(M, EH)), M, emb(EH)).

composeActLin(Map, id,  Map) :- !.
composeActLin(any, any, _)   :- !.
composeActLin(TrgMap o AlnMap, AlnMap, TrgMap).


% ----- Array alignment at variable references -----


alignVarMap(align(T, AIMap, _, Embed),         align(T, AIMap, Embed), _, _).
alignVarMap(align(variable(VH), AIMap, _, []), distribute, VH, Shape) :-
    idAIMap(AIMap, Shape).

idAIMap(AIMap, Shape) :- idAIMap(AIMap, Shape, 1).

idAIMap([], _, []).
idAIMap([id :: D | AIMap], [_ | Sizes], D) :-
    D1 is D + 1,
    idAIMap(AIMap, Sizes, D1).


% ----- Support for `forall' and `arrall'. -----


addIdxMappings(IMap \ IMap, [], []).
addIdxMappings([M :: IH -> D | IMapF] \ IMapB, [IH | IHs], [M :: D | AIMap]) :-
    addIdxMappings(IMapF \ IMapB, IHs, AIMap).


% ----- Selector predicates on expression mapping descriptors -----


getTemplate(align(T, _, _, _), T).

getTemplateList([], _).
getTemplateList([Map | Maps], T) :-
    getTemplate(Map, T),
    getTemplateList(Maps, T).


getAIMap(align(_, AIMap, _, _), AIMap).

getAIMapList([], _).
getAIMapList([Map | Maps], AIMap) :-
    getAIMap(Map, AIMap),
    getAIMapList(Maps, AIMap).


getIMap(align(_, _, IdxMap, _), IdxMap).

getIMapList([], _).
getIMapList([Map | Maps], IdxMap) :-
    getIMap(Map, IdxMap),
    getIMapList(Maps, IdxMap).


getEmbedding(align(_, _, _, Embed), Embed).

getEmbeddingList([], _).
getEmbeddingList([Map | Maps], Embed) :-
    getEmbedding(Map, Embed),
    getEmbeddingList(Maps, Embed).


