
% Index dependency analysis.

% ---------------------------------------------------------------------
 
% $Id: depend.pl,v 2.4 1994/05/05 16:16:54 dbc Exp $
 
% $Log: depend.pl,v $
% Revision 2.4  1994/05/05  16:16:54  dbc
% No significant change.
%
% Revision 2.3  1994/04/26  15:54:26  dbc
% *** empty log message ***
%

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

% Decorate every expression node with the set of indices it depends on
% and all index-linear representations of that node.


% ``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(<exp_handle>, <idx_attr>)
%
%  <mapping>     ::= align(<var_handle>, List(<embedding>))     |
%                    distribute                                 |
%                    def
%
%  <embedding>   ::= <exp_handle> | rep
%
%
%  <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>        #
%
%  <var_attr> ::= indices :: List(<idx_handle>)         #
%                 abbrevs :: List(<exp_handle>)         #
%                 mapping :: <mapping>                  #
%                 binding :: internal | arg(<literal>)  #
%                 ishape  :: List(<exp_handle>)         #
%                 shape   :: List(<exp_handle>)
%
%  <exp_attr> ::= shape :: List(<exp_handle>)

% 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


depen(DHs, Syms) :- depenProgram(DHs, [], Syms).


% ---- Basic dependency predicates ----


depenProgram(DHs, SHs, Syms) :-
    depenDeclarationList(DHs, Syms),
    depenExpressionHandleList(_, _, SHs, Syms).


depenDeclarationList([], _).
depenDeclarationList([DH | DHs], Syms) :-
    symLookUp(DH, D, Syms),
    depenDeclaration(D, Syms),
    depenDeclarationList(DHs, Syms).

depenDeclaration(function(Atr), _) :-
    funAtr(Atr),
      Syms := Atr -> syms,
      DHs  := Atr -> declarations, SHs  := Atr -> statements,
    depenProgram(DHs, SHs, Syms).
depenDeclaration(variable(Atr), Syms) :-
    varAtr(Atr),
      Shape := Atr -> ishape, EHs := Atr -> abbrevs,
      M     := Atr -> mapping,
    depenShape(_, Shape, Syms),
    depenExpressionHandleList(_, _, EHs, Syms),
    depenMapping(M, Syms).
depenDeclaration(expression(E, Atr), Syms) :-
    depenExpression(_, _, E, Atr, Syms).


depenShape(ISet, Shape, Syms) :-
    depenExpressionHandleList(ISets, _, Shape, Syms),
    unionList(ISets, ISet).


depenExpressionHandleList([], [], [], _).
depenExpressionHandleList([ISet | ISets], [LinSet | LinSets],
                          [EH | EHs], Syms) :-
    depenExpressionHandle(ISet, LinSet, EH, Syms),
    depenExpressionHandleList(ISets, LinSets, EHs, Syms).

depenExpressionHandle(ISet, LinSet, EH, Syms) :-
    symLookUp(EH, expression(E, Atr), Syms),
    depenExpression(ISet, LinSet, E, Atr, Syms).

depenExpression(ISet, LinSet, expRef(EH), _, Syms) :-
    expGetDepen(ISet, LinSet, EH, Syms).
depenExpression(ISet, LinSet, idxRef(SizeH, IH), Atr, Syms) :-
    atrGetDepen(ISet, LinSet, Atr),
    depenExpressionHandle(SizeISet, _, SizeH, Syms),
    union(SizeISet, [IH], ISet),
    expInstall(SizeR, expRef(SizeH), Syms),
    symHandle(OneH,  op(one),  Syms),
    symHandle(ZeroH, op(zero), Syms),
    LinSet = [map(SizeR, OneH, ZeroH, IH)].
depenExpression(ISet, LinSet, funRef(FH, Tag, EHs), Atr, Syms) :-
    expAtr(Atr),
      Tests  := Atr -> assertions,
    atrGetDepen(ISet, LinSet, Atr),
    depenExpressionHandleList(ISets, LinSets, EHs, Syms),
    (Tag = add, !,
      addRefLinSet(LinSet, EHs, ISets, LinSets, Syms, FH, Tag)
    |Tag = sub, !,
      addRefLinSet(LinSet, EHs, ISets, LinSets, Syms, FH, Tag)
    |Tag = mul, !,
      mulRefLinSet(LinSet, EHs, ISets, LinSets, Syms, FH, Tag)
    |Tag = neg, !,
      negRefLinSet(LinSet, EHs, ISets, LinSets, Syms, FH, Tag)
    |true,
      LinSet = []),
    unionList(ISets, ISet),
    depenExpressionHandleList(_, _, Tests, Syms).
depenExpression(ISet, [], subscript(EH, EHs), _, Syms) :-
    depenExpressionHandle(ArrISet, _, EH, Syms),
    depenExpressionHandleList(SubscriptISets, _, EHs, Syms),
    unionList(SubscriptISets, SubscriptISet),
    union(ArrISet, SubscriptISet, ISet).
depenExpression(ISet, [], forall(IHs, Shape, AHs, EHs), _, Syms) :-
    depenShape(ShapeISet, Shape, Syms),
    depenExpressionHandleList(AbbrevISets, _, AHs, Syms),
    unionList(AbbrevISets, AbbrevISet),
    depenExpressionHandleList(ScopeISets, _, EHs, Syms),
    unionList(ScopeISets, ScopeISet),
    unionList([ShapeISet, AbbrevISet, ScopeISet], InternalISet),
    subtract(InternalISet, IHs, ISet).
depenExpression(ISet, [], arrall(IHs, Shape, EH), _, Syms) :-
    depenExpressionHandle(ScopeISet, _, EH, Syms),
    depenShape(_, Shape, Syms),  % NB: ShapeIset <= ScopeISet for `arrall'
    subtract(ScopeISet, IHs, ISet).
depenExpression([], [], varRef(_), _, _).
depenExpression(ISet, [], size(_, EH), _, Syms) :-
    depenExpressionHandle(ISet, _, EH, Syms).
depenExpression([], [], literal(_), _, _).
depenExpression([], [], true, _, _).
depenExpression([], [], false, _, _).
depenExpression([], [], any, _, _).


depenMapping(align(_, Embs), Syms) :-
    depenEmbeddingList(Embs, Syms).
depenMapping(distribute, _).
depenMapping(def, _).


depenEmbeddingList([], _).
depenEmbeddingList([Emb | Embs], Syms) :-
    depenEmbedding(Emb, Syms),
    depenEmbeddingList(Embs, Syms).

depenEmbedding(rep, _)    :- !.
depenEmbedding(EH,  Syms) :- depenExpressionHandle(_, _, EH, Syms).


% ----- Linearity analysis -----


%  E = E1 'op' E2,        'op' = + | -
%
%  lin(E) =
%    {map(M1 'op' M2, C1 'op' C2, x) |
%       map(M1, C1, x) in lin(E1) /\ map(M2, C2, x) in lin(E2)} U
%    {map(M, C1 'op' E2, x) | map(M, C1, x) in lin(E1) /\ not(x in dep(E2))} U
%    {map(M, E1 'op' C2, x) | map(M, C2, x) in lin(E2) /\ not(x in dep(E1))}

addRefLinSet(LinSet, [EH1, EH2], [ISet1, ISet2], [LinSet1, LinSet2],
             Syms, FH, Tag) :-
    addLinSetIntersect(LinSet \ Tail1, LinSet1, LinSet2, Syms, FH, Tag),
    addLinSetSubtract(Tail1 \ Tail2, LinSet1, EH2, ISet2, Syms, FH, Tag),
    addLinSetSubtract(Tail2 \ [],    LinSet2, EH1, ISet1, Syms, FH, Tag).


addLinSetIntersect(LinsF \ LinsF, [], _, _, _, _).
addLinSetIntersect(LinsF \ LinsB, [Lin1 | LinSet1], LinSet2, Syms, FH, Tag) :-
    addLinSetIntersect1(LinsF \ Tail,   Lin1, LinSet2, Syms, FH, Tag),
    addLinSetIntersect(Tail \ LinsB, LinSet1, LinSet2, Syms, FH, Tag).

addLinSetIntersect1([map(SizeH, MH, CH, IH) | LinsB] \ LinsB,
		    map(SizeH, M1H, C1H, IH), LinSet2, Syms, FH, Tag) :-
    member(map(_, M2H, C2H, IH), LinSet2), !,
    expInstall(MH, funRef(FH, Tag, [M1H, M2H]), Syms),
    expInstall(CH, funRef(FH, Tag, [C1H, C2H]), Syms).
addLinSetIntersect1(LinsB \ LinsB, _, _, _, _, _).


addLinSetSubtract(LinsF \ LinsF, [], _, _, _, _, _).
addLinSetSubtract(LinsF \ LinsB, [Lin1 | LinSet1], E2H, ISet2, Syms, FH, Tag) :-
    addLinSetSubtract1(LinsF \ Tail, Lin1, E2H, ISet2, Syms, FH, Tag),
    addLinSetSubtract(Tail \ LinsB, LinSet1, E2H, ISet2, Syms, FH, Tag).

addLinSetSubtract1([map(SizeH, M1H, CShfH, IH) | LinsB] \ LinsB,
                   map(SizeH, M1H, C1H, IH), E2H, ISet2, Syms, FH, Tag) :-
    notMember(IH, ISet2), !,
    expInstall(CShfH, funRef(FH, Tag, [C1H, E2H]), Syms).
addLinSetSubtract1(LinsF \ LinsF, _, _, _, _, _, _).


% E = E1 * E2
% 
% lin(E) =
%   {map(E2 * M, E2 * C, x) | map(M, C, x) in lin(E1) /\ not(x in dep(E2))} U
%   {map(E1 * M, E1 * C, x) | map(M, C, x) in lin(E2) /\ not(x in dep(E1))}

mulRefLinSet(LinSet, [EH1, EH2], [ISet1, ISet2], [LinSet1, LinSet2],
             Syms, FH, Tag) :-
    mulLinSetSubtract(LinSet \ Tail, LinSet1, EH2, ISet2, Syms, FH, Tag),
    mulLinSetSubtract(Tail   \ [],   LinSet2, EH1, ISet1, Syms, FH, Tag).


mulLinSetSubtract(LinsF \ LinsF, [], _, _, _, _, _).
mulLinSetSubtract(LinsF \ LinsB, [Lin1 | LinSet1], EH, ISet, Syms, FH, Tag) :-
    mulLinSetSubtract1(LinsF \ Tail, Lin1, EH, ISet, Syms, FH, Tag),
    mulLinSetSubtract(Tail \ LinsB, LinSet1, EH, ISet, Syms, FH, Tag).

mulLinSetSubtract1([map(SizeH, M1H, C1H, IH) | LinsB] \ LinsB,
                   map(SizeH, MH, CH, IH), EH, ISet, Syms, FH, Tag) :-
    notMember(IH, ISet), !,
    expInstall(M1H, funRef(FH, Tag, [EH, MH]), Syms),
    expInstall(ER, expRef(EH), Syms),
    expInstall(C1H, funRef(FH, Tag, [ER, CH]), Syms).
mulLinSetSubtract1(LinsF \ LinsF, _, _, _, _, _, _).

%  E = - E1
%
%  lin(E) = {map(- M, - C, x) | map(M, C, x) in lin(E1)}

negRefLinSet(LinSet, [_], [_], [LinSet1], Syms, FH, Tag) :-
    negLinSet(LinSet, LinSet1, Syms, FH, Tag).

negLinSet([], [], _, _, _).
negLinSet([Lin | LinSet], [Lin1 | LinSet1], Syms, FH, Tag) :-
    negLin(Lin, Lin1, Syms, FH, Tag),
    negLinSet(LinSet, LinSet1, Syms, FH, Tag).

negLin(map(SizeH, MH, CH, IH), map(SizeH, M1H, C1H, IH), Syms, FH, Tag) :-
    expInstall(MH, funRef(FH, Tag, [M1H]), Syms),
    expInstall(CH, funRef(FH, Tag, [C1H]), Syms).


% ----- Extract dependency attributes -----

expGetDepen(ISet, LinSet, EH, Syms) :-
    symLookUp(EH, expression(E, Atr), Syms),
    ((E = literal(_) | E = varRef(_) | E = any | E = true | E = false), !,
      ISet   = [],
      LinSet = []
    |E = expRef(E1H), !,
      expGetDepen(ISet, LinSet, E1H, Syms)
      % !!! Should make sure expressions in `LinSet' are references !!!
    |E = size(_, E1H), !,
      expGetDepen(ISet, LinSet, E1H, Syms)
    |true,
      atrGetDepen(ISet, LinSet, Atr)).

atrGetDepen(ISet, LinSet, Atr) :-
    expAtr(Atr),
      ISet   := Atr -> iSet,
      LinSet := Atr -> linSet.


