{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Futhark.IR.Mem.Simplify
  ( simplifyProgGeneric,
    simplifyStmsGeneric,
    simpleGeneric,
    SimplifyMemory,
  )
where

import Control.Monad
import Data.List (find)
import qualified Futhark.Analysis.SymbolTable as ST
import qualified Futhark.Analysis.UsageTable as UT
import Futhark.Construct
import Futhark.IR.Mem
import qualified Futhark.IR.Mem.IxFun as IxFun
import qualified Futhark.Optimise.Simplify as Simplify
import qualified Futhark.Optimise.Simplify.Engine as Engine
import Futhark.Optimise.Simplify.Rep
import Futhark.Optimise.Simplify.Rule
import Futhark.Optimise.Simplify.Rules
import Futhark.Pass
import Futhark.Pass.ExplicitAllocations (simplifiable)
import Futhark.Util

simpleGeneric ::
  (SimplifyMemory rep inner) =>
  (OpWithWisdom inner -> UT.UsageTable) ->
  Simplify.SimplifyOp rep (OpWithWisdom inner) ->
  Simplify.SimpleOps rep
simpleGeneric :: (OpWithWisdom inner -> UsageTable)
-> SimplifyOp rep (OpWithWisdom inner) -> SimpleOps rep
simpleGeneric = (OpWithWisdom inner -> UsageTable)
-> SimplifyOp rep (OpWithWisdom inner) -> SimpleOps rep
forall rep inner.
(SimplifiableRep rep, ExpDec rep ~ (), BodyDec rep ~ (),
 Mem rep inner) =>
(OpWithWisdom inner -> UsageTable)
-> (OpWithWisdom inner
    -> SimpleM rep (OpWithWisdom inner, Stms (Wise rep)))
-> SimpleOps rep
simplifiable

simplifyProgGeneric ::
  (SimplifyMemory rep inner) =>
  Simplify.SimpleOps rep ->
  Prog rep ->
  PassM (Prog rep)
simplifyProgGeneric :: SimpleOps rep -> Prog rep -> PassM (Prog rep)
simplifyProgGeneric SimpleOps rep
ops =
  SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Prog rep
-> PassM (Prog rep)
forall rep.
SimplifiableRep rep =>
SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Prog rep
-> PassM (Prog rep)
Simplify.simplifyProg
    SimpleOps rep
ops
    RuleBook (Wise rep)
forall rep inner. SimplifyMemory rep inner => RuleBook (Wise rep)
callKernelRules
    HoistBlockers rep
forall rep inner. (Op rep ~ MemOp inner) => HoistBlockers rep
blockers {blockHoistBranch :: BlockPred (Wise rep)
Engine.blockHoistBranch = BlockPred (Wise rep)
forall rep inner rep p.
(Typed (LetDec rep), Op rep ~ MemOp inner) =>
SymbolTable rep -> p -> Stm rep -> Bool
blockAllocs}
  where
    blockAllocs :: SymbolTable rep -> p -> Stm rep -> Bool
blockAllocs SymbolTable rep
vtable p
_ (Let Pat rep
_ StmAux (ExpDec rep)
_ (Op Alloc {})) =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SymbolTable rep -> Bool
forall rep. SymbolTable rep -> Bool
ST.simplifyMemory SymbolTable rep
vtable
    -- Do not hoist statements that produce arrays.  This is
    -- because in the KernelsMem representation, multiple
    -- arrays can be located in the same memory block, and moving
    -- their creation out of a branch can thus cause memory
    -- corruption.  At this point in the compiler we have probably
    -- already moved all the array creations that matter.
    blockAllocs SymbolTable rep
_ p
_ (Let Pat rep
pat StmAux (ExpDec rep)
_ ExpT rep
_) =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (TypeBase Shape NoUniqueness -> Bool)
-> [TypeBase Shape NoUniqueness] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TypeBase Shape NoUniqueness -> Bool
forall shape u. TypeBase shape u -> Bool
primType ([TypeBase Shape NoUniqueness] -> Bool)
-> [TypeBase Shape NoUniqueness] -> Bool
forall a b. (a -> b) -> a -> b
$ Pat rep -> [TypeBase Shape NoUniqueness]
forall dec. Typed dec => PatT dec -> [TypeBase Shape NoUniqueness]
patTypes Pat rep
pat

simplifyStmsGeneric ::
  ( HasScope rep m,
    MonadFreshNames m,
    SimplifyMemory rep inner
  ) =>
  Simplify.SimpleOps rep ->
  Stms rep ->
  m (Stms rep)
simplifyStmsGeneric :: SimpleOps rep -> Stms rep -> m (Stms rep)
simplifyStmsGeneric SimpleOps rep
ops Stms rep
stms = do
  Scope rep
scope <- m (Scope rep)
forall rep (m :: * -> *). HasScope rep m => m (Scope rep)
askScope
  SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Scope rep
-> Stms rep
-> m (Stms rep)
forall (m :: * -> *) rep.
(MonadFreshNames m, SimplifiableRep rep) =>
SimpleOps rep
-> RuleBook (Wise rep)
-> HoistBlockers rep
-> Scope rep
-> Stms rep
-> m (Stms rep)
Simplify.simplifyStms
    SimpleOps rep
ops
    RuleBook (Wise rep)
forall rep inner. SimplifyMemory rep inner => RuleBook (Wise rep)
callKernelRules
    HoistBlockers rep
forall rep inner. (Op rep ~ MemOp inner) => HoistBlockers rep
blockers
    Scope rep
scope
    Stms rep
stms

isResultAlloc :: Op rep ~ MemOp op => Engine.BlockPred rep
isResultAlloc :: BlockPred rep
isResultAlloc SymbolTable rep
_ UsageTable
usage (Let (Pat [PatElemT (LetDec rep)
pe]) StmAux (ExpDec rep)
_ (Op Alloc {})) =
  VName -> UsageTable -> Bool
UT.isInResult (PatElemT (LetDec rep) -> VName
forall dec. PatElemT dec -> VName
patElemName PatElemT (LetDec rep)
pe) UsageTable
usage
isResultAlloc SymbolTable rep
_ UsageTable
_ Stm rep
_ = Bool
False

isAlloc :: Op rep ~ MemOp op => Engine.BlockPred rep
isAlloc :: BlockPred rep
isAlloc SymbolTable rep
_ UsageTable
_ (Let Pat rep
_ StmAux (ExpDec rep)
_ (Op Alloc {})) = Bool
True
isAlloc SymbolTable rep
_ UsageTable
_ Stm rep
_ = Bool
False

blockers ::
  (Op rep ~ MemOp inner) =>
  Simplify.HoistBlockers rep
blockers :: HoistBlockers rep
blockers =
  HoistBlockers rep
forall rep. HoistBlockers rep
Engine.noExtraHoistBlockers
    { blockHoistPar :: BlockPred (Wise rep)
Engine.blockHoistPar = BlockPred (Wise rep)
forall rep op. (Op rep ~ MemOp op) => BlockPred rep
isAlloc,
      blockHoistSeq :: BlockPred (Wise rep)
Engine.blockHoistSeq = BlockPred (Wise rep)
forall rep op. (Op rep ~ MemOp op) => BlockPred rep
isResultAlloc,
      isAllocation :: Stm (Wise rep) -> Bool
Engine.isAllocation = BlockPred (Wise rep)
forall rep op. (Op rep ~ MemOp op) => BlockPred rep
isAlloc SymbolTable (Wise rep)
forall a. Monoid a => a
mempty UsageTable
forall a. Monoid a => a
mempty
    }

-- | Some constraints that must hold for the simplification rules to work.
type SimplifyMemory rep inner =
  ( Simplify.SimplifiableRep rep,
    LetDec rep ~ LetDecMem,
    ExpDec rep ~ (),
    BodyDec rep ~ (),
    CanBeWise (Op rep),
    BuilderOps (Wise rep),
    Mem rep inner
  )

callKernelRules :: SimplifyMemory rep inner => RuleBook (Wise rep)
callKernelRules :: RuleBook (Wise rep)
callKernelRules =
  RuleBook (Wise rep)
forall rep.
(BuilderOps rep, TraverseOpStms rep, Aliased rep) =>
RuleBook rep
standardRules
    RuleBook (Wise rep) -> RuleBook (Wise rep) -> RuleBook (Wise rep)
forall a. Semigroup a => a -> a -> a
<> [TopDownRule (Wise rep)]
-> [BottomUpRule (Wise rep)] -> RuleBook (Wise rep)
forall m. [TopDownRule m] -> [BottomUpRule m] -> RuleBook m
ruleBook
      [ RuleBasicOp (Wise rep) (TopDown (Wise rep))
-> TopDownRule (Wise rep)
forall rep a. RuleBasicOp rep a -> SimplificationRule rep a
RuleBasicOp RuleBasicOp (Wise rep) (TopDown (Wise rep))
forall rep u.
(BuilderOps rep, LetDec rep ~ (VarWisdom, MemBound u)) =>
TopDownRuleBasicOp rep
copyCopyToCopy,
        RuleIf (Wise rep) (TopDown (Wise rep)) -> TopDownRule (Wise rep)
forall rep a. RuleIf rep a -> SimplificationRule rep a
RuleIf RuleIf (Wise rep) (TopDown (Wise rep))
forall rep inner.
SimplifyMemory rep inner =>
TopDownRuleIf (Wise rep)
unExistentialiseMemory,
        RuleOp (Wise rep) (TopDown (Wise rep)) -> TopDownRule (Wise rep)
forall rep a. RuleOp rep a -> SimplificationRule rep a
RuleOp RuleOp (Wise rep) (TopDown (Wise rep))
forall rep inner.
SimplifyMemory rep inner =>
TopDownRuleOp (Wise rep)
decertifySafeAlloc
      ]
      []

-- | If a branch is returning some existential memory, but the size of
-- the array is not existential, and the index function of the array
-- does not refer to any names in the pattern, then we can create a
-- block of the proper size and always return there.
unExistentialiseMemory :: SimplifyMemory rep inner => TopDownRuleIf (Wise rep)
unExistentialiseMemory :: TopDownRuleIf (Wise rep)
unExistentialiseMemory TopDown (Wise rep)
vtable Pat (Wise rep)
pat StmAux (ExpDec (Wise rep))
_ (SubExp
cond, BodyT (Wise rep)
tbranch, BodyT (Wise rep)
fbranch, IfDec (BranchType (Wise rep))
ifdec)
  | TopDown (Wise rep) -> Bool
forall rep. SymbolTable rep -> Bool
ST.simplifyMemory TopDown (Wise rep)
vtable,
    [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
fixable <- ([(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
   PrimExp VName, VName, Space)]
 -> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
 -> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
      PrimExp VName, VName, Space)])
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
-> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
hasConcretisableMemory [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
forall a. Monoid a => a
mempty ([PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
 -> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
      PrimExp VName, VName, Space)])
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
forall a b. (a -> b) -> a -> b
$ PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
forall dec. PatT dec -> [PatElemT dec]
patElems PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat,
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
fixable = RuleM (Wise rep) () -> Rule (Wise rep)
forall rep. RuleM rep () -> Rule rep
Simplify (RuleM (Wise rep) () -> Rule (Wise rep))
-> RuleM (Wise rep) () -> Rule (Wise rep)
forall a b. (a -> b) -> a -> b
$ do
    -- Create non-existential memory blocks big enough to hold the
    -- arrays.
    ([(VName, VName)]
arr_to_mem, [(VName, VName)]
oldmem_to_mem) <-
      ([((VName, VName), (VName, VName))]
 -> ([(VName, VName)], [(VName, VName)]))
-> RuleM (Wise rep) [((VName, VName), (VName, VName))]
-> RuleM (Wise rep) ([(VName, VName)], [(VName, VName)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((VName, VName), (VName, VName))]
-> ([(VName, VName)], [(VName, VName)])
forall a b. [(a, b)] -> ([a], [b])
unzip (RuleM (Wise rep) [((VName, VName), (VName, VName))]
 -> RuleM (Wise rep) ([(VName, VName)], [(VName, VName)]))
-> RuleM (Wise rep) [((VName, VName), (VName, VName))]
-> RuleM (Wise rep) ([(VName, VName)], [(VName, VName)])
forall a b. (a -> b) -> a -> b
$
        [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
-> ((PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)
    -> RuleM (Wise rep) ((VName, VName), (VName, VName)))
-> RuleM (Wise rep) [((VName, VName), (VName, VName))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
fixable (((PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
   PrimExp VName, VName, Space)
  -> RuleM (Wise rep) ((VName, VName), (VName, VName)))
 -> RuleM (Wise rep) [((VName, VName), (VName, VName))])
-> ((PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)
    -> RuleM (Wise rep) ((VName, VName), (VName, VName)))
-> RuleM (Wise rep) [((VName, VName), (VName, VName))]
forall a b. (a -> b) -> a -> b
$ \(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
arr_pe, PrimExp VName
mem_size, VName
oldmem, Space
space) -> do
          SubExp
size <- String -> PrimExp VName -> RuleM (Wise rep) SubExp
forall (m :: * -> *) a.
(MonadBuilder m, ToExp a) =>
String -> a -> m SubExp
toSubExp String
"size" PrimExp VName
mem_size
          VName
mem <- String -> Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) VName
forall (m :: * -> *).
MonadBuilder m =>
String -> Exp (Rep m) -> m VName
letExp String
"mem" (Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) VName)
-> Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) VName
forall a b. (a -> b) -> a -> b
$ Op (Wise rep) -> ExpT (Wise rep)
forall rep. Op rep -> ExpT rep
Op (Op (Wise rep) -> ExpT (Wise rep))
-> Op (Wise rep) -> ExpT (Wise rep)
forall a b. (a -> b) -> a -> b
$ SubExp -> Space -> MemOp (OpWithWisdom inner)
forall inner. SubExp -> Space -> MemOp inner
Alloc SubExp
size Space
space
          ((VName, VName), (VName, VName))
-> RuleM (Wise rep) ((VName, VName), (VName, VName))
forall (m :: * -> *) a. Monad m => a -> m a
return ((PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> VName
forall dec. PatElemT dec -> VName
patElemName PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
arr_pe, VName
mem), (VName
oldmem, VName
mem))

    -- Update the branches to contain Copy expressions putting the
    -- arrays where they are expected.
    let updateBody :: BodyT (Wise rep)
-> RuleM (Wise rep) (Body (Rep (RuleM (Wise rep))))
updateBody BodyT (Wise rep)
body = RuleM (Wise rep) Result
-> RuleM (Wise rep) (Body (Rep (RuleM (Wise rep))))
forall (m :: * -> *).
MonadBuilder m =>
m Result -> m (Body (Rep m))
buildBody_ (RuleM (Wise rep) Result
 -> RuleM (Wise rep) (Body (Rep (RuleM (Wise rep)))))
-> RuleM (Wise rep) Result
-> RuleM (Wise rep) (Body (Rep (RuleM (Wise rep))))
forall a b. (a -> b) -> a -> b
$ do
          Result
res <- Body (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) Result
forall (m :: * -> *). MonadBuilder m => Body (Rep m) -> m Result
bodyBind Body (Rep (RuleM (Wise rep)))
BodyT (Wise rep)
body
          (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
 -> SubExpRes -> RuleM (Wise rep) SubExpRes)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> Result
-> RuleM (Wise rep) Result
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> SubExpRes -> RuleM (Wise rep) SubExpRes
updateResult (PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
forall dec. PatT dec -> [PatElemT dec]
patElems PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat) Result
res
        updateResult :: PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> SubExpRes -> RuleM (Wise rep) SubExpRes
updateResult PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem (SubExpRes Certs
cs (Var VName
v))
          | Just VName
mem <- VName -> [(VName, VName)] -> Maybe VName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> VName
forall dec. PatElemT dec -> VName
patElemName PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem) [(VName, VName)]
arr_to_mem,
            (VarWisdom
_, MemArray PrimType
pt Shape
shape NoUniqueness
u (ArrayIn VName
_ IxFun
ixfun)) <- PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
forall dec. PatElemT dec -> dec
patElemDec PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem = do
            VName
v_copy <- String -> RuleM (Wise rep) VName
forall (m :: * -> *). MonadFreshNames m => String -> m VName
newVName (String -> RuleM (Wise rep) VName)
-> String -> RuleM (Wise rep) VName
forall a b. (a -> b) -> a -> b
$ VName -> String
baseString VName
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_nonext_copy"
            let v_pat :: PatT (MemInfo SubExp NoUniqueness MemBind)
v_pat =
                  [PatElemT (MemInfo SubExp NoUniqueness MemBind)]
-> PatT (MemInfo SubExp NoUniqueness MemBind)
forall dec. [PatElemT dec] -> PatT dec
Pat [VName
-> MemInfo SubExp NoUniqueness MemBind
-> PatElemT (MemInfo SubExp NoUniqueness MemBind)
forall dec. VName -> dec -> PatElemT dec
PatElem VName
v_copy (MemInfo SubExp NoUniqueness MemBind
 -> PatElemT (MemInfo SubExp NoUniqueness MemBind))
-> MemInfo SubExp NoUniqueness MemBind
-> PatElemT (MemInfo SubExp NoUniqueness MemBind)
forall a b. (a -> b) -> a -> b
$ PrimType
-> Shape
-> NoUniqueness
-> MemBind
-> MemInfo SubExp NoUniqueness MemBind
forall d u ret.
PrimType -> ShapeBase d -> u -> ret -> MemInfo d u ret
MemArray PrimType
pt Shape
shape NoUniqueness
u (MemBind -> MemInfo SubExp NoUniqueness MemBind)
-> MemBind -> MemInfo SubExp NoUniqueness MemBind
forall a b. (a -> b) -> a -> b
$ VName -> IxFun -> MemBind
ArrayIn VName
mem IxFun
ixfun]
            Stm (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ()
forall (m :: * -> *). MonadBuilder m => Stm (Rep m) -> m ()
addStm (Stm (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ())
-> Stm (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ()
forall a b. (a -> b) -> a -> b
$ Pat rep -> StmAux (ExpDec rep) -> ExpT (Wise rep) -> Stm (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pat rep -> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
mkWiseLetStm Pat rep
PatT (MemInfo SubExp NoUniqueness MemBind)
v_pat (() -> StmAux ()
forall dec. dec -> StmAux dec
defAux ()) (ExpT (Wise rep) -> Stm (Wise rep))
-> ExpT (Wise rep) -> Stm (Wise rep)
forall a b. (a -> b) -> a -> b
$ BasicOp -> ExpT (Wise rep)
forall rep. BasicOp -> ExpT rep
BasicOp (VName -> BasicOp
Copy VName
v)
            SubExpRes -> RuleM (Wise rep) SubExpRes
forall (m :: * -> *) a. Monad m => a -> m a
return (SubExpRes -> RuleM (Wise rep) SubExpRes)
-> SubExpRes -> RuleM (Wise rep) SubExpRes
forall a b. (a -> b) -> a -> b
$ Certs -> SubExp -> SubExpRes
SubExpRes Certs
cs (SubExp -> SubExpRes) -> SubExp -> SubExpRes
forall a b. (a -> b) -> a -> b
$ VName -> SubExp
Var VName
v_copy
          | Just VName
mem <- VName -> [(VName, VName)] -> Maybe VName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> VName
forall dec. PatElemT dec -> VName
patElemName PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem) [(VName, VName)]
oldmem_to_mem =
            SubExpRes -> RuleM (Wise rep) SubExpRes
forall (m :: * -> *) a. Monad m => a -> m a
return (SubExpRes -> RuleM (Wise rep) SubExpRes)
-> SubExpRes -> RuleM (Wise rep) SubExpRes
forall a b. (a -> b) -> a -> b
$ Certs -> SubExp -> SubExpRes
SubExpRes Certs
cs (SubExp -> SubExpRes) -> SubExp -> SubExpRes
forall a b. (a -> b) -> a -> b
$ VName -> SubExp
Var VName
mem
        updateResult PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
_ SubExpRes
se =
          SubExpRes -> RuleM (Wise rep) SubExpRes
forall (m :: * -> *) a. Monad m => a -> m a
return SubExpRes
se
    BodyT (Wise rep)
tbranch' <- BodyT (Wise rep)
-> RuleM (Wise rep) (Body (Rep (RuleM (Wise rep))))
updateBody BodyT (Wise rep)
tbranch
    BodyT (Wise rep)
fbranch' <- BodyT (Wise rep)
-> RuleM (Wise rep) (Body (Rep (RuleM (Wise rep))))
updateBody BodyT (Wise rep)
fbranch
    Pat (Rep (RuleM (Wise rep)))
-> Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ()
forall (m :: * -> *).
MonadBuilder m =>
Pat (Rep m) -> Exp (Rep m) -> m ()
letBind Pat (Rep (RuleM (Wise rep)))
Pat (Wise rep)
pat (Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ())
-> Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ()
forall a b. (a -> b) -> a -> b
$ SubExp
-> BodyT (Wise rep)
-> BodyT (Wise rep)
-> IfDec (BranchType (Wise rep))
-> ExpT (Wise rep)
forall rep.
SubExp
-> BodyT rep -> BodyT rep -> IfDec (BranchType rep) -> ExpT rep
If SubExp
cond BodyT (Wise rep)
tbranch' BodyT (Wise rep)
fbranch' IfDec (BranchType (Wise rep))
ifdec
  where
    onlyUsedIn :: VName -> VName -> Bool
onlyUsedIn VName
name VName
here =
      Bool -> Bool
not (Bool -> Bool)
-> ([PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
    -> Bool)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> Bool)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((VName
name VName -> Names -> Bool
`nameIn`) (Names -> Bool)
-> (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
    -> Names)
-> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> Names
forall a. FreeIn a => a -> Names
freeIn) ([PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
 -> Bool)
-> ([PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
    -> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)])
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> Bool)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((VName -> VName -> Bool
forall a. Eq a => a -> a -> Bool
/= VName
here) (VName -> Bool)
-> (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
    -> VName)
-> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> VName
forall dec. PatElemT dec -> VName
patElemName) ([PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
 -> Bool)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> Bool
forall a b. (a -> b) -> a -> b
$
        PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
forall dec. PatT dec -> [PatElemT dec]
patElems PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat
    knownSize :: SubExp -> Bool
knownSize Constant {} = Bool
True
    knownSize (Var VName
v) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ VName -> Bool
inContext VName
v
    inContext :: VName -> Bool
inContext = (VName -> [VName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> [VName]
forall dec. PatT dec -> [VName]
patNames PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat)

    hasConcretisableMemory :: [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
-> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
hasConcretisableMemory [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
fixable PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem
      | (VarWisdom
_, MemArray PrimType
pt Shape
shape NoUniqueness
_ (ArrayIn VName
mem IxFun
ixfun)) <- PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
forall dec. PatElemT dec -> dec
patElemDec PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem,
        Just (Int
j, Mem Space
space) <-
          (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
 -> TypeBase Shape NoUniqueness)
-> (Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
-> (Int, TypeBase Shape NoUniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> TypeBase Shape NoUniqueness
forall dec.
Typed dec =>
PatElemT dec -> TypeBase Shape NoUniqueness
patElemType
            ((Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
 -> (Int, TypeBase Shape NoUniqueness))
-> Maybe
     (Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
-> Maybe (Int, TypeBase Shape NoUniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
 -> Bool)
-> [(Int,
     PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))]
-> Maybe
     (Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
              ((VName
mem VName -> VName -> Bool
forall a. Eq a => a -> a -> Bool
==) (VName -> Bool)
-> ((Int,
     PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
    -> VName)
-> (Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> VName
forall dec. PatElemT dec -> VName
patElemName (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
 -> VName)
-> ((Int,
     PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
    -> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
-> (Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
-> VName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))
-> PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
forall a b. (a, b) -> b
snd)
              ([Int]
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> [(Int,
     PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0 :: Int) ..] ([PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
 -> [(Int,
      PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))])
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
-> [(Int,
     PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind))]
forall a b. (a -> b) -> a -> b
$ PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)]
forall dec. PatT dec -> [PatElemT dec]
patElems PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat),
        Just SubExpRes
tse <- Int -> Result -> Maybe SubExpRes
forall int a. Integral int => int -> [a] -> Maybe a
maybeNth Int
j (Result -> Maybe SubExpRes) -> Result -> Maybe SubExpRes
forall a b. (a -> b) -> a -> b
$ BodyT (Wise rep) -> Result
forall rep. BodyT rep -> Result
bodyResult BodyT (Wise rep)
tbranch,
        Just SubExpRes
fse <- Int -> Result -> Maybe SubExpRes
forall int a. Integral int => int -> [a] -> Maybe a
maybeNth Int
j (Result -> Maybe SubExpRes) -> Result -> Maybe SubExpRes
forall a b. (a -> b) -> a -> b
$ BodyT (Wise rep) -> Result
forall rep. BodyT rep -> Result
bodyResult BodyT (Wise rep)
fbranch,
        VName
mem VName -> VName -> Bool
`onlyUsedIn` PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> VName
forall dec. PatElemT dec -> VName
patElemName PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem,
        [TPrimExp Int64 VName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (IxFun -> [TPrimExp Int64 VName]
forall num. IxFun num -> Shape num
IxFun.base IxFun
ixfun) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Shape -> Int
forall a. ArrayShape a => a -> Int
shapeRank Shape
shape, -- See #1325
        (SubExp -> Bool) -> [SubExp] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SubExp -> Bool
knownSize (Shape -> [SubExp]
forall d. ShapeBase d -> [d]
shapeDims Shape
shape),
        Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IxFun -> Names
forall a. FreeIn a => a -> Names
freeIn IxFun
ixfun Names -> Names -> Bool
`namesIntersect` [VName] -> Names
namesFromList (PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind) -> [VName]
forall dec. PatT dec -> [VName]
patNames PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat),
        SubExpRes
fse SubExpRes -> SubExpRes -> Bool
forall a. Eq a => a -> a -> Bool
/= SubExpRes
tse =
        let mem_size :: PrimExp VName
mem_size =
              TPrimExp Int64 VName -> PrimExp VName
forall t v. TPrimExp t v -> PrimExp v
untyped (TPrimExp Int64 VName -> PrimExp VName)
-> TPrimExp Int64 VName -> PrimExp VName
forall a b. (a -> b) -> a -> b
$ [TPrimExp Int64 VName] -> TPrimExp Int64 VName
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([TPrimExp Int64 VName] -> TPrimExp Int64 VName)
-> [TPrimExp Int64 VName] -> TPrimExp Int64 VName
forall a b. (a -> b) -> a -> b
$ PrimType -> TPrimExp Int64 VName
forall a. Num a => PrimType -> a
primByteSize PrimType
pt TPrimExp Int64 VName
-> [TPrimExp Int64 VName] -> [TPrimExp Int64 VName]
forall a. a -> [a] -> [a]
: (TPrimExp Int64 VName -> TPrimExp Int64 VName)
-> [TPrimExp Int64 VName] -> [TPrimExp Int64 VName]
forall a b. (a -> b) -> [a] -> [b]
map TPrimExp Int64 VName -> TPrimExp Int64 VName
forall t v. IntExp t => TPrimExp t v -> TPrimExp Int64 v
sExt64 (IxFun -> [TPrimExp Int64 VName]
forall num. IxFun num -> Shape num
IxFun.base IxFun
ixfun)
         in (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
pat_elem, PrimExp VName
mem_size, VName
mem, Space
space) (PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
 PrimExp VName, VName, Space)
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
-> [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
     PrimExp VName, VName, Space)]
forall a. a -> [a] -> [a]
: [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
fixable
      | Bool
otherwise =
        [(PatElemT (VarWisdom, MemInfo SubExp NoUniqueness MemBind),
  PrimExp VName, VName, Space)]
fixable
unExistentialiseMemory TopDown (Wise rep)
_ Pat (Wise rep)
_ StmAux (ExpDec (Wise rep))
_ (SubExp, BodyT (Wise rep), BodyT (Wise rep),
 IfDec (BranchType (Wise rep)))
_ = Rule (Wise rep)
forall rep. Rule rep
Skip

-- | If we are copying something that is itself a copy, just copy the
-- original one instead.
copyCopyToCopy ::
  ( BuilderOps rep,
    LetDec rep ~ (VarWisdom, MemBound u)
  ) =>
  TopDownRuleBasicOp rep
copyCopyToCopy :: TopDownRuleBasicOp rep
copyCopyToCopy TopDown rep
vtable pat :: Pat rep
pat@(Pat [PatElemT (LetDec rep)
pat_elem]) StmAux (ExpDec rep)
_ (Copy VName
v1)
  | Just (BasicOp (Copy VName
v2), Certs
v1_cs) <- VName -> TopDown rep -> Maybe (Exp rep, Certs)
forall rep. VName -> SymbolTable rep -> Maybe (Exp rep, Certs)
ST.lookupExp VName
v1 TopDown rep
vtable,
    Just (VarWisdom
_, MemArray PrimType
_ Shape
_ u
_ (ArrayIn VName
srcmem IxFun
src_ixfun)) <-
      Entry rep -> Maybe (VarWisdom, MemInfo SubExp u MemBind)
forall rep. Entry rep -> Maybe (LetDec rep)
ST.entryLetBoundDec (Entry rep -> Maybe (VarWisdom, MemInfo SubExp u MemBind))
-> Maybe (Entry rep) -> Maybe (VarWisdom, MemInfo SubExp u MemBind)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VName -> TopDown rep -> Maybe (Entry rep)
forall rep. VName -> SymbolTable rep -> Maybe (Entry rep)
ST.lookup VName
v1 TopDown rep
vtable,
    Just (Mem Space
src_space) <- VName -> TopDown rep -> Maybe (TypeBase Shape NoUniqueness)
forall rep.
ASTRep rep =>
VName -> SymbolTable rep -> Maybe (TypeBase Shape NoUniqueness)
ST.lookupType VName
srcmem TopDown rep
vtable,
    (VarWisdom
_, MemArray PrimType
_ Shape
_ u
_ (ArrayIn VName
destmem IxFun
dest_ixfun)) <- PatElemT (VarWisdom, MemInfo SubExp u MemBind)
-> (VarWisdom, MemInfo SubExp u MemBind)
forall dec. PatElemT dec -> dec
patElemDec PatElemT (VarWisdom, MemInfo SubExp u MemBind)
PatElemT (LetDec rep)
pat_elem,
    Just (Mem Space
dest_space) <- VName -> TopDown rep -> Maybe (TypeBase Shape NoUniqueness)
forall rep.
ASTRep rep =>
VName -> SymbolTable rep -> Maybe (TypeBase Shape NoUniqueness)
ST.lookupType VName
destmem TopDown rep
vtable,
    Space
src_space Space -> Space -> Bool
forall a. Eq a => a -> a -> Bool
== Space
dest_space,
    IxFun
dest_ixfun IxFun -> IxFun -> Bool
forall a. Eq a => a -> a -> Bool
== IxFun
src_ixfun =
    RuleM rep () -> Rule rep
forall rep. RuleM rep () -> Rule rep
Simplify (RuleM rep () -> Rule rep) -> RuleM rep () -> Rule rep
forall a b. (a -> b) -> a -> b
$ Certs -> RuleM rep () -> RuleM rep ()
forall (m :: * -> *) a. MonadBuilder m => Certs -> m a -> m a
certifying Certs
v1_cs (RuleM rep () -> RuleM rep ()) -> RuleM rep () -> RuleM rep ()
forall a b. (a -> b) -> a -> b
$ Pat (Rep (RuleM rep)) -> Exp (Rep (RuleM rep)) -> RuleM rep ()
forall (m :: * -> *).
MonadBuilder m =>
Pat (Rep m) -> Exp (Rep m) -> m ()
letBind Pat rep
Pat (Rep (RuleM rep))
pat (Exp (Rep (RuleM rep)) -> RuleM rep ())
-> Exp (Rep (RuleM rep)) -> RuleM rep ()
forall a b. (a -> b) -> a -> b
$ BasicOp -> Exp rep
forall rep. BasicOp -> ExpT rep
BasicOp (BasicOp -> Exp rep) -> BasicOp -> Exp rep
forall a b. (a -> b) -> a -> b
$ VName -> BasicOp
Copy VName
v2
copyCopyToCopy TopDown rep
vtable Pat rep
pat StmAux (ExpDec rep)
_ (Copy VName
v0)
  | Just (BasicOp (Rearrange [Int]
perm VName
v1), Certs
v0_cs) <- VName -> TopDown rep -> Maybe (Exp rep, Certs)
forall rep. VName -> SymbolTable rep -> Maybe (Exp rep, Certs)
ST.lookupExp VName
v0 TopDown rep
vtable,
    Just (BasicOp (Copy VName
v2), Certs
v1_cs) <- VName -> TopDown rep -> Maybe (Exp rep, Certs)
forall rep. VName -> SymbolTable rep -> Maybe (Exp rep, Certs)
ST.lookupExp VName
v1 TopDown rep
vtable = RuleM rep () -> Rule rep
forall rep. RuleM rep () -> Rule rep
Simplify (RuleM rep () -> Rule rep) -> RuleM rep () -> Rule rep
forall a b. (a -> b) -> a -> b
$ do
    VName
v0' <-
      Certs -> RuleM rep VName -> RuleM rep VName
forall (m :: * -> *) a. MonadBuilder m => Certs -> m a -> m a
certifying (Certs
v0_cs Certs -> Certs -> Certs
forall a. Semigroup a => a -> a -> a
<> Certs
v1_cs) (RuleM rep VName -> RuleM rep VName)
-> RuleM rep VName -> RuleM rep VName
forall a b. (a -> b) -> a -> b
$
        String -> Exp (Rep (RuleM rep)) -> RuleM rep VName
forall (m :: * -> *).
MonadBuilder m =>
String -> Exp (Rep m) -> m VName
letExp String
"rearrange_v0" (Exp (Rep (RuleM rep)) -> RuleM rep VName)
-> Exp (Rep (RuleM rep)) -> RuleM rep VName
forall a b. (a -> b) -> a -> b
$ BasicOp -> Exp rep
forall rep. BasicOp -> ExpT rep
BasicOp (BasicOp -> Exp rep) -> BasicOp -> Exp rep
forall a b. (a -> b) -> a -> b
$ [Int] -> VName -> BasicOp
Rearrange [Int]
perm VName
v2
    Pat (Rep (RuleM rep)) -> Exp (Rep (RuleM rep)) -> RuleM rep ()
forall (m :: * -> *).
MonadBuilder m =>
Pat (Rep m) -> Exp (Rep m) -> m ()
letBind Pat rep
Pat (Rep (RuleM rep))
pat (Exp (Rep (RuleM rep)) -> RuleM rep ())
-> Exp (Rep (RuleM rep)) -> RuleM rep ()
forall a b. (a -> b) -> a -> b
$ BasicOp -> Exp rep
forall rep. BasicOp -> ExpT rep
BasicOp (BasicOp -> Exp rep) -> BasicOp -> Exp rep
forall a b. (a -> b) -> a -> b
$ VName -> BasicOp
Copy VName
v0'
copyCopyToCopy TopDown rep
_ Pat rep
_ StmAux (ExpDec rep)
_ BasicOp
_ = Rule rep
forall rep. Rule rep
Skip

-- If an allocation is statically known to be safe, then we can remove
-- the certificates on it.  This can help hoist things that would
-- otherwise be stuck inside loops or branches.
decertifySafeAlloc :: SimplifyMemory rep inner => TopDownRuleOp (Wise rep)
decertifySafeAlloc :: TopDownRuleOp (Wise rep)
decertifySafeAlloc TopDown (Wise rep)
_ Pat (Wise rep)
pat (StmAux Certs
cs Attrs
attrs ExpDec (Wise rep)
_) Op (Wise rep)
op
  | Certs
cs Certs -> Certs -> Bool
forall a. Eq a => a -> a -> Bool
/= Certs
forall a. Monoid a => a
mempty,
    [Mem Space
_] <- PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
-> [TypeBase Shape NoUniqueness]
forall dec. Typed dec => PatT dec -> [TypeBase Shape NoUniqueness]
patTypes PatT (VarWisdom, MemInfo SubExp NoUniqueness MemBind)
Pat (Wise rep)
pat,
    MemOp (OpWithWisdom inner) -> Bool
forall op. IsOp op => op -> Bool
safeOp Op (Wise rep)
MemOp (OpWithWisdom inner)
op =
    RuleM (Wise rep) () -> Rule (Wise rep)
forall rep. RuleM rep () -> Rule rep
Simplify (RuleM (Wise rep) () -> Rule (Wise rep))
-> RuleM (Wise rep) () -> Rule (Wise rep)
forall a b. (a -> b) -> a -> b
$ Attrs -> RuleM (Wise rep) () -> RuleM (Wise rep) ()
forall (m :: * -> *) a. MonadBuilder m => Attrs -> m a -> m a
attributing Attrs
attrs (RuleM (Wise rep) () -> RuleM (Wise rep) ())
-> RuleM (Wise rep) () -> RuleM (Wise rep) ()
forall a b. (a -> b) -> a -> b
$ Pat (Rep (RuleM (Wise rep)))
-> Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ()
forall (m :: * -> *).
MonadBuilder m =>
Pat (Rep m) -> Exp (Rep m) -> m ()
letBind Pat (Rep (RuleM (Wise rep)))
Pat (Wise rep)
pat (Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ())
-> Exp (Rep (RuleM (Wise rep))) -> RuleM (Wise rep) ()
forall a b. (a -> b) -> a -> b
$ Op (Wise rep) -> ExpT (Wise rep)
forall rep. Op rep -> ExpT rep
Op Op (Wise rep)
op
decertifySafeAlloc TopDown (Wise rep)
_ Pat (Wise rep)
_ StmAux (ExpDec (Wise rep))
_ Op (Wise rep)
_ = Rule (Wise rep)
forall rep. Rule rep
Skip