PatternUniq.cag

-------------------------------------------------------------------------
-- Interfacing to ARule: 
-------------------------------------------------------------------------

%%[1 hs module (ARule.PatternUniq)
%%]

%%[1 hs export (arlUniq)
%%]

%%[1 hs import (qualified Data.Set as Set, Common, Opts, ARule.ARule, Expr.Expr, FmGam, ARule.RwSubst)
%%]

%%[1 ag import ({Expr/AbsSynAG}, {ARule/AbsSynAG}, {Expr/OptsAG}, {ARule/OptsAG}, {Expr/FmGamAG}, {ARule/FmGamAG}, {ARule/CopyRuleNmAG})
%%]

%%[1 ag
WRAPPER AGARuleItf
%%]

%%[1 hs
arlUniq :: FmGam Expr -> [Nm] -> ARule -> ARule
arlUniq fg co rl
  = replUniq_Syn_AGARuleItf r2
  where r1 = sem_AGARuleItf (AGARuleItf_AGItf rl)
        r2 = wrap_AGARuleItf r1
                (Inh_AGARuleItf {opts_Inh_AGARuleItf = defaultOpts
                                ,croNmL_Inh_AGARuleItf = co
                                ,fmGam_Inh_AGARuleItf = fg
                                })
%%]

-------------------------------------------------------------------------
-- Uniq sequence nr
-------------------------------------------------------------------------

%%[1 ag
ATTR AllARuleButARule AllExpr [ | uniqSeqNr: Int | ]

SEM ARule
  | Rule            eqns    .   uniqSeqNr   =   0

SEM Expr
  | Uniq            loc     .   uniqSeqNr   =   @lhs.uniqSeqNr + 1
                    lhs     .   uniqSeqNr   =   @uniqSeqNr

SEM AGExprItf
  | AGItf           loc     .   uniqSeqNr   =   0
%%]

-------------------------------------------------------------------------
-- Uniq name
-------------------------------------------------------------------------

%%[1 ag
SEM Expr
  | Uniq            loc     .   nm          =   fmNmUniq @lhs.opts @lhs.fmGam @uniqSeqNr
%%]

-------------------------------------------------------------------------
-- Node to which uniq thread must be passed
-------------------------------------------------------------------------

%%[1 ag
ATTR AllARuleRule [ uniqThrDst: ANm | | ]

SEM AGARuleItf
  | AGItf           rule    .   uniqThrDst  =   case @lhs.croNmL of
                                                  (_:[d]) -> ANm_Lhs (fmNmUniq @lhs.opts @lhs.fmGam 0) []
                                                  (_:d:_) -> ANm_Node d (fmNmUniq @lhs.opts @lhs.fmGam 0)
%%]

-------------------------------------------------------------------------
-- Construction of AEqn for uniq's
-------------------------------------------------------------------------

%%[1 ag
SEM ARule
  | Rule            loc     .   mkUniqEqnL  =   if @eqns.uniqSeqNr > 0
                                                then [AEqn_Eqn
                                                        (AEqnDest_Many
                                                          (map AEqnDest_One
                                                               (@lhs.uniqThrDst : [ ANm_Loc (fmNmUniq @lhs.opts @lhs.fmGam u) [] | u <- [1 .. @eqns.uniqSeqNr] ])
                                                          )
                                                        )
                                                        (AExpr_Expr
                                                          (mkExprApp (exprSubst (@lhs.opts {optGenFM = FmFmtCmd}) @lhs.fmGam . Expr_Var . nmFunMkUniq $ @eqns.uniqSeqNr)
                                                                     [mkALhs (fmNmUniq @lhs.opts @lhs.fmGam 0)]
                                                          )
                                                        )
                                                     ]
                                                else []
%%]

-------------------------------------------------------------------------
-- Replica
-------------------------------------------------------------------------

%%[1 ag
ATTR AllARule AllExpr [ | | replUniq: SELF ]
ATTR AGARuleItf [ | | replUniq: ARule ]

SEM ARule
  | Rule            lhs     .   replUniq    =   ARule_Rule @ndNmL @rlNm @info (@mkUniqEqnL ++ @eqns.replUniq)

SEM Expr
  | Uniq            lhs     .   replUniq    =   mkALoc @nm

%%]