
% Alignment resolution.

% ---------------------------------------------------------------------
 
% $Id: align.pl,v 2.4 1994/05/05 16:22:58 dbc Exp dbc $
 
% $Log: align.pl,v $
% Revision 2.4  1994/05/05  16:22:58  dbc
% Initial revision.
%

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

% Decorate every variable node with a mapping descriptor.  For
% an aligned varible this is a direct alignment to a template
% (a variable with distributed mapping).
%
% Decorate every function node with a list of external representations
% of the alignment of its arguments and result.

% ``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>), List(<exp_handle>), <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>)
%
%  <mapping>     ::= align(<var_handle>, List(<embedding>))     |
%                    distribute                                 |
%                    def
%
%  <embedding>   ::= <exp_handle> | rep
%
%
%  <range>       ::= <exp_handle>
%
%  <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> ::= indices  :: List(<idx_handle>)         #
%                 abbrevs  :: List(<exp_handle>)         #
%                 mapping  :: <mapping>                  #
%                 binding  :: internal | arg(<literal>)  #
%                 shape    :: 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>))
%
%  <template>          ::= variable(<var_handle>)  |  def
%
%  <arr_idx_mapping_desc>  ::=  map(<exp_handle>, <exp_handle>) :: <literal>  |
%                               id :: <literal>                               |
%                               col
%
%  <embedding_desc>    ::=  emb(<exp_handle>) :: <literal>  |
%                           rep :: <literal>
%
%
%
%  <extern_mapping>    ::=  any                          |
%                           align(<extern_template>,
%                                 List(<extern_idx_mapping>),
%                                 List(<extern_embedding>))
%
%  <extern_template>     ::=  variable(<var_handle>) |
%                             arg(<literal>)         |
%                             def
%
%  <extern_idx_mapping>  ::=  map(<external>, <external>) :: <literal>  |
%                             id :: <literal>                           |
%                             col
%
%  <extern_embedding>  ::=  emb(<external>) :: <literal> |
%                           rep :: <literal>

?- op(800, xfx, ::).

align(DHs, Syms) :- alignProgram(DHs, Syms).


% ---- Basic alignment resolution predicates ----


alignProgram(DHs, Syms) :-
    alignDeclarationList(DHs, Syms).


alignDeclarationList([], _).
alignDeclarationList([DH | DHs], Syms) :-
    symLookUp(DH, D, Syms),
    alignDeclaration(D, Syms),
    alignDeclarationList(DHs, Syms).

alignDeclaration(function(Atr), _) :-
    funAtr(Atr),
      Syms    := Atr -> syms,    DHs    := Atr -> declarations,
      Dummies := Atr -> dummies, Result := Atr -> result,
      DumMaps := Atr -> dumMaps, ResMap := Atr -> resMap,
      DumAlnGrps := Atr -> dumAlnGrps, ResAlnGrp := Atr -> resAlnGrp,
    alignProgram(DHs, Syms),
    varExternMaps([ResMap | DumMaps], [Result | Dummies], Syms),
    size(Dummies, NArgs),
    enum(NArgs, DumIds),
    buildAlignmentGroups(DumAlnGrps, ResAlnGrp, DumMaps, ResMap, DumIds).
alignDeclaration(variable(Atr), Syms) :-
    varAtr(Atr),
      IHs     := Atr -> indices, M := Atr -> mapping,
      MapDesc := Atr -> mapDesc, IntMapDesc := Atr -> imapDesc,
    buildMapDesc(MapDesc, M, IHs, Syms),
    buildInternMap(IntMapDesc, MapDesc, Syms).
alignDeclaration(expression(_, _), _).


% ----- Resolve variable alignment -----

buildMapDesc(align(def, Cols, []), def, IHs, _) :-
    mapConstant(Cols, IHs, col).
buildMapDesc(distribute, distribute, _, _).
buildMapDesc(MapDesc, align(VH, Embeddings), IHs, Syms) :-
    symLookUp(VH, variable(Atr), Syms),
    varAtr(Atr),
      TargetShape   := Atr -> ishape,
      TargetMapDesc := Atr -> imapDesc,
    immedMapDesc(ImmedIdxMapDescs, ImmedEmbeddingDescs, Embeddings,
                 IHs, Syms, TargetShape),
    composeAligns(MapDesc, TargetMapDesc,
                  VH, ImmedIdxMapDescs, ImmedEmbeddingDescs, Syms).


% ----- Descriptor for mapping to immediate target of alignment -----

immedMapDesc(IdxMapDescs, EmbeddingDescs, Embeddings, IHs, Syms, TargetShape) :-
    sameSize(IHs, IdxMapDescs),
    analyseEmbeddings(IdxMapDescs, EmbeddingDescs, 1, Embeddings,
                      IHs, Syms, TargetShape),
    collapseRest(IdxMapDescs).


analyseEmbeddings(_, [], _, [], _, _, []).
analyseEmbeddings(IdxMapDescs, EmbeddingDescs, D, [Embedding | Embeddings],
                  IHs, Syms, [TargetExtentH | TargetExtentHs]) :-
    analyseEmbedding(IdxMapDescs, EmbeddingDescs \ EmbeddingDescsTail,
                     D, Embedding, IHs, Syms, TargetExtentH),
    D1 is D + 1,
    analyseEmbeddings(IdxMapDescs, EmbeddingDescsTail,
                      D1, Embeddings, IHs, Syms, TargetExtentHs).
    
analyseEmbedding(_, [rep :: D | EmbeddingDescsB] \ EmbeddingDescsB,
                 D, rep, _, _, _) :- !.
analyseEmbedding(IdxMapDescs, EmbeddingDescsF \ EmbeddingDescsB,
                 D, EH, IHs, Syms, TargetExtentH) :-
    expGetDepen(ISet, LinSet, EH, Syms),
    (ISet = [], !,
      EmbeddingDescsF = [emb(EH) :: D | EmbeddingDescsB]
    |ISet = [IH], LinSet = [map(SizeH, StrideH, OffsetH, IH)], !,
      isNth(N, IHs, IH),
      (symHandle(OneH, op(one), Syms), expEqual(StrideH, OneH, Syms),
          symHandle(ZeroH, op(zero), Syms), expEqual(OffsetH, ZeroH, Syms),
          expEqual(SizeH, TargetExtentH, Syms), !,
        (isNth(N, IdxMapDescs, id :: D), ! | alignError1)
      |true,   
        (isNth(N, IdxMapDescs, map(StrideH, OffsetH) :: D), ! | alignError1)),
      EmbeddingDescsF = EmbeddingDescsB
    |true,
      alignError2).


collapseRest([]).
collapseRest([col | IdxMapDescs]) :- !, collapseRest(IdxMapDescs).
collapseRest([_   | IdxMapDescs]) :- collapseRest(IdxMapDescs).


% ----- Composition of alignments -----

composeAligns(align(variable(VH), ImmedIdxMapDescs, ImmedEmbeddingDescs),
              distribute, VH, ImmedIdxMapDescs, ImmedEmbeddingDescs, _).
composeAligns(align(Template, IdxMapDescs, EmbeddingDescs), 
	      align(Template, TargetIdxMapDescs, TargetEmbeddingDescs),
	      _, ImmedIdxMapDescs, ImmedEmbeddingDescs, Syms) :-
    composeIdxMaps(IdxMapDescs, TargetIdxMapDescs, ImmedIdxMapDescs, Syms),
    applyIdxMaps(EmbeddingDescs \ TargetEmbeddingDescs,
                 TargetIdxMapDescs, ImmedEmbeddingDescs, Syms).


composeIdxMaps([], _, [], _).
composeIdxMaps([IdxMapDesc | IdxMapDescs],
               TargetIdxMapDescs, [ImmedIdxMapDesc | ImmedIdxMapDescs], Syms) :-
    composeIdxMap(IdxMapDesc, TargetIdxMapDescs, ImmedIdxMapDesc, Syms),
    composeIdxMaps(IdxMapDescs, TargetIdxMapDescs, ImmedIdxMapDescs, Syms).

composeIdxMap(IdxMapDesc, TargetIdxMapDescs, ImmedMap :: D, Syms) :-
    isNth(D, TargetIdxMapDescs, TargetIdxMapDesc),
    composeMap(IdxMapDesc, TargetIdxMapDesc, ImmedMap, Syms).
composeIdxMap(col, _, col, _).

composeMap(Map :: D, TargetMap :: D, ImmedMap, Syms) :-
    composeLin(Map, TargetMap, ImmedMap, Syms).
composeMap(col, col, _, _).


applyIdxMaps(EmbeddingDescs \ EmbeddingDescs, _, [], _).
applyIdxMaps(EmbeddingDescsF \ EmbeddingDescsB,
             TargetIdxMapDescs, [ImmedEmb :: D | ImmedEmbeddingDescs],
             Syms) :-
    isNth(D, TargetIdxMapDescs, TargetIdxMapDesc),
    applyMap(EmbeddingDescsF \ EmbeddingDescsTail,
             TargetIdxMapDesc, ImmedEmb, Syms),
    applyIdxMaps(EmbeddingDescsTail \ EmbeddingDescsB,
		 TargetIdxMapDescs, ImmedEmbeddingDescs, Syms).

applyMap([emb(EmbH) :: D | EmbeddingDescsB] \ EmbeddingDescsB,
         TargetMap :: D, emb(ImmedEmbH), Syms) :-
    applyLin(EmbH, TargetMap, ImmedEmbH, Syms).
applyMap(EmbeddingDescs \ EmbeddingDescs, col, _, _).
% !!! what if immediate embedding is replication? !!!


composeLin(map(StrideH, OffsetH), id, map(StrideH, OffsetH), _).
composeLin(map(StrideH, OffsetH), map(StrideH, OffsetH), id, _).
composeLin(map(StrideH, OffsetH),
           map(StrideAH, OffsetAH), map(StrideBH, OffsetBH), Syms) :-
    symHandle(MulH, op(mul), Syms),
    expInstall(StrideH, funRef(MulH, mul, [StrideAH, StrideBH]), Syms),
    expInstall(StrideAR, expRef(StrideAH), Syms),
    applyLin(OffsetH, map(StrideAR, OffsetAH), OffsetBH, Syms).

applyLin(EH, id, EH, _).
applyLin(E1H, map(StrideH, OffsetH), EH, Syms) :-
    symHandle(MulH, op(mul), Syms),
    expInstall(ProdH, funRef(MulH, mul, [StrideH, EH]), Syms),
    symHandle(AddH, op(add), Syms),
    expInstall(E1H, funRef(AddH, add, [ProdH, OffsetH]), Syms).


% ----- External representations of variable mappings -----

varExternMaps([], [], _).
varExternMaps([ExtMap | ExtMaps], [VH | VHs], Syms) :-
    symLookUp(VH, variable(Atr), Syms),
    varAtr(Atr),
      MapDesc := Atr -> mapDesc,
    buildExternMap(ExtMap, MapDesc, Syms),
    varExternMaps(ExtMaps, VHs, Syms).

buildExternMap(align(ExtTemplate, ExtIdxMaps, ExtEmbeds),
               align(Template, IdxMaps, Embeds), Syms) :-
    templateExtern(ExtTemplate, Template, Syms),
    idxMapsExtern(ExtIdxMaps, IdxMaps, Syms),
    embedsExtern(ExtEmbeds, Embeds, Syms),
    !.
buildExternMap(any, _, _).


templateExtern(def, def, _).
templateExtern(variable(TH), variable(TH), Syms) :-
    symLevel(TH, N, Syms),
    N > 0, !.
templateExtern(arg(N), variable(TH), Syms)     :-
    symLookUp(TH, variable(Atr), Syms),
    varAtr(Atr),
      arg(N) := Atr -> binding.


idxMapsExtern([], [], _).
idxMapsExtern([ExtIdxMap | ExtIdxMaps], [IdxMap | IdxMaps], Syms) :-
    idxMapExtern(ExtIdxMap, IdxMap, Syms),
    idxMapsExtern(ExtIdxMaps, IdxMaps, Syms).

idxMapExtern(map(MExt, CExt) :: D, map(MH, CH) :: D, Syms) :-
    buildExtern(MExt, MH, Syms),
    buildExtern(CExt, CH, Syms).
idxMapExtern(id :: D, id :: D, _).
idxMapExtern(col, col, _).


embedsExtern([], [], _).
embedsExtern([ExtEmbed | ExtEmbeds], [Embed | Embeds], Syms) :-
    embedExtern(ExtEmbed, Embed, Syms),
    embedsExtern(ExtEmbeds, Embeds, Syms).

embedExtern(emb(EExt) :: D, emb(EH) :: D, Syms) :- buildExtern(EExt, EH, Syms).
embedExtern(rep :: D, rep :: D, _).


% ----- Internal representation of mapping descriptor -----

% (An ``internal'' representation is one in which all expressions are
% ``simple'').

buildInternMap(distribute, distribute, _).
buildInternMap(align(Template, IntIdxMaps, IntEmbeds),
                   align(Template, IdxMaps, Embeds), Syms) :-
    buildInternIdxMaps(IntIdxMaps, IdxMaps, Syms),
    buildInternEmbeds(IntEmbeds, Embeds, Syms).

buildInternIdxMaps([], [], _).
buildInternIdxMaps([IntIdxMap | IntIdxMaps], [IdxMap | IdxMaps], Syms) :-
    buildInternIdxMap(IntIdxMap, IdxMap, Syms),
    buildInternIdxMaps(IntIdxMaps, IdxMaps, Syms).

buildInternIdxMap(map(MR, CR) :: D, map(MH, CH) :: D, Syms) :-
    !,
    expInstall(MR, expRef(MH), Syms),
    expInstall(CR, expRef(CH), Syms).
buildInternIdxMap(IdxMap, IdxMap, _).

buildInternEmbeds([], [], _).
buildInternEmbeds([IntEmbed | IntEmbeds], [Embed | Embeds], Syms) :-
    buildInternEmbed(IntEmbed, Embed, Syms),
    buildInternEmbeds(IntEmbeds, Embeds, Syms).

buildInternEmbed(emb(ER), emb(EH), Syms) :-
    expInstall(ER, expRef(EH, Syms), Syms).
buildInternEmbed(Embed, Embed, _).


% ---- Alignment groups ----

buildAlignmentGroups(DumAlnGrps, ResAlnGrp, DumMaps, align(arg(N), _, _),
                     DumIds) :-
    !,
    removeAlnsToArgN(ResAlnGrp, Rest, DumIds, N, DumMaps),
    partitionAlns(DumAlnGrps, Rest, DumMaps).
buildAlignmentGroups(DumAlnGrps, [], DumMaps, _, DumIds) :-
    partitionAlns(DumAlnGrps, DumIds, DumMaps).

partitionAlns([], [], _).
partitionAlns([[Id | Companions] | Groups], [Id | Pool], Maps) :-
    isNth(Id, Maps, Map),
    removeCompanions(Companions, Rest, Pool, Id, Map, Maps),
    partitionAlns(Groups, Rest, Maps).

removeCompanions(Companions, Rest, Pool, Id, any,                 Maps) :-
    removeAlnsToArgN(Companions, Rest, Pool, Id, Maps).
removeCompanions(Companions, Rest, Pool,  _, align(arg(N), _, _), Maps) :-
    !,
    removeAlnsToArgN(Companions, Rest, Pool, N, Maps).
removeCompanions([], Pool, Pool, _, _, _).

removeAlnsToArgN([], [], [], _, _).
removeAlnsToArgN([N | Alignees], Rest, [N | Pool], N, Maps) :-
    !,
    removeAlnsToArgN(Alignees, Rest, Pool, N, Maps).
removeAlnsToArgN([Id | Alignees], Rest, [Id | Pool], N, Maps) :-
    isNth(Id, Maps, align(arg(N), _, _)),
    !,
    removeAlnsToArgN(Alignees, Rest, Pool, N, Maps).
removeAlnsToArgN(Alignees, [Id | Rest], [Id | Pool], N, Maps) :-
    removeAlnsToArgN(Alignees, Rest, Pool, N, Maps).
    

% ----- Rudimentary error reporting -----
 
alignError1      :-
    printString("Index aligned to more than one dimension."), abort.

alignError2      :-
    printString("Non-linear embedding in alignment."), abort.

