{-# LANGUAGE TypeFamilies #-}
module Futhark.IR.MCMem
( MCMem,
simplifyProg,
module Futhark.IR.Mem,
module Futhark.IR.SegOp,
module Futhark.IR.MC.Op,
)
where
import Futhark.Analysis.PrimExp.Convert
import Futhark.IR.MC.Op
import Futhark.IR.Mem
import Futhark.IR.Mem.Simplify
import Futhark.IR.SegOp
import Futhark.IR.TypeCheck qualified as TC
import Futhark.Optimise.Simplify.Engine qualified as Engine
import Futhark.Pass
import Futhark.Pass.ExplicitAllocations (BuilderOps (..), mkLetNamesB', mkLetNamesB'')
data MCMem
instance RepTypes MCMem where
type LetDec MCMem = LetDecMem
type FParamInfo MCMem = FParamMem
type LParamInfo MCMem = LParamMem
type RetType MCMem = RetTypeMem
type BranchType MCMem = BranchTypeMem
type Op MCMem = MemOp (MCOp MCMem ())
instance ASTRep MCMem where
expTypesFromPat :: forall (m :: * -> *).
(HasScope MCMem m, Monad m) =>
Pat (LetDec MCMem) -> m [BranchType MCMem]
expTypesFromPat = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat LetDecMem -> [(VName, BranchTypeMem)]
bodyReturnsFromPat
instance OpReturns (MCOp MCMem ()) where
opReturns :: forall {k} (rep :: k) inner (m :: * -> *).
(Mem rep inner, Monad m, HasScope rep m) =>
MCOp MCMem () -> m [ExpReturns]
opReturns (ParOp Maybe (SegOp () MCMem)
_ SegOp () MCMem
op) = forall {k1} {k2} (rep :: k1) inner (m :: * -> *) lvl
(somerep :: k2).
(Mem rep inner, Monad m, HasScope rep m) =>
SegOp lvl somerep -> m [ExpReturns]
segOpReturns SegOp () MCMem
op
opReturns (OtherOp ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance OpReturns (MCOp (Engine.Wise MCMem) ()) where
opReturns :: forall {k} (rep :: k) inner (m :: * -> *).
(Mem rep inner, Monad m, HasScope rep m) =>
MCOp (Wise MCMem) () -> m [ExpReturns]
opReturns (ParOp Maybe (SegOp () (Wise MCMem))
_ SegOp () (Wise MCMem)
op) = forall {k1} {k2} (rep :: k1) inner (m :: * -> *) lvl
(somerep :: k2).
(Mem rep inner, Monad m, HasScope rep m) =>
SegOp lvl somerep -> m [ExpReturns]
segOpReturns SegOp () (Wise MCMem)
op
opReturns MCOp (Wise MCMem) ()
k = [ExtType] -> [ExpReturns]
extReturns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall op {k} (t :: k) (m :: * -> *).
(TypedOp op, HasScope t m) =>
op -> m [ExtType]
opType MCOp (Wise MCMem) ()
k
instance PrettyRep MCMem
instance TC.CheckableOp MCMem where
checkOp :: OpWithAliases (Op MCMem) -> TypeM MCMem ()
checkOp = forall {k} {rep :: k}.
Checkable rep =>
MemOp (MCOp (Aliases rep) ()) -> TypeM rep ()
typeCheckMemoryOp
where
typeCheckMemoryOp :: MemOp (MCOp (Aliases rep) ()) -> TypeM rep ()
typeCheckMemoryOp (Alloc SubExp
size Space
_) =
forall {k} (rep :: k).
Checkable rep =>
[TypeBase (ShapeBase SubExp) NoUniqueness]
-> SubExp -> TypeM rep ()
TC.require [forall shape u. PrimType -> TypeBase shape u
Prim PrimType
int64] SubExp
size
typeCheckMemoryOp (Inner MCOp (Aliases rep) ()
op) =
forall {k} (rep :: k) op.
Checkable rep =>
(op -> TypeM rep ()) -> MCOp (Aliases rep) op -> TypeM rep ()
typeCheckMCOp forall (f :: * -> *) a. Applicative f => a -> f a
pure MCOp (Aliases rep) ()
op
instance TC.Checkable MCMem where
checkFParamDec :: VName -> FParamInfo MCMem -> TypeM MCMem ()
checkFParamDec = forall {k} (rep :: k) u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkLParamDec :: VName -> LParamInfo MCMem -> TypeM MCMem ()
checkLParamDec = forall {k} (rep :: k) u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkLetBoundDec :: VName -> LetDec MCMem -> TypeM MCMem ()
checkLetBoundDec = forall {k} (rep :: k) u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkRetType :: [RetType MCMem] -> TypeM MCMem ()
checkRetType = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {k} (rep :: k) u.
Checkable rep =>
TypeBase (ShapeBase (Ext SubExp)) u -> TypeM rep ()
TC.checkExtType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
DeclExtTyped t =>
t -> TypeBase (ShapeBase (Ext SubExp)) Uniqueness
declExtTypeOf)
primFParam :: VName -> PrimType -> TypeM MCMem (FParam (Aliases MCMem))
primFParam VName
name PrimType
t = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall dec. Attrs -> VName -> dec -> Param dec
Param forall a. Monoid a => a
mempty VName
name (forall d u ret. PrimType -> MemInfo d u ret
MemPrim PrimType
t)
matchPat :: Pat (LetDec (Aliases MCMem))
-> Exp (Aliases MCMem) -> TypeM MCMem ()
matchPat = forall {k} (rep :: k) inner.
(Mem rep inner, LetDec rep ~ LetDecMem, Checkable rep) =>
Pat (LetDec (Aliases rep)) -> Exp (Aliases rep) -> TypeM rep ()
matchPatToExp
matchReturnType :: [RetType MCMem] -> Result -> TypeM MCMem ()
matchReturnType = forall {k} (rep :: k) inner.
(Mem rep inner, Checkable rep) =>
[RetTypeMem] -> Result -> TypeM rep ()
matchFunctionReturnType
matchBranchType :: [BranchType MCMem] -> Body (Aliases MCMem) -> TypeM MCMem ()
matchBranchType = forall {k} (rep :: k) inner.
(Mem rep inner, Checkable rep) =>
[BranchTypeMem] -> Body (Aliases rep) -> TypeM rep ()
matchBranchReturnType
matchLoopResult :: [FParam (Aliases MCMem)] -> Result -> TypeM MCMem ()
matchLoopResult = forall {k} (rep :: k) inner.
(Mem rep inner, Checkable rep) =>
[FParam (Aliases rep)] -> Result -> TypeM rep ()
matchLoopResultMem
instance BuilderOps MCMem where
mkExpDecB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ MCMem) =>
Pat (LetDec MCMem) -> Exp MCMem -> m (ExpDec MCMem)
mkExpDecB Pat (LetDec MCMem)
_ Exp MCMem
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mkBodyB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ MCMem) =>
Stms MCMem -> Result -> m (Body MCMem)
mkBodyB Stms MCMem
stms Result
res = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
BodyDec rep -> Stms rep -> Result -> Body rep
Body () Stms MCMem
stms Result
res
mkLetNamesB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ MCMem) =>
[VName] -> Exp MCMem -> m (Stm MCMem)
mkLetNamesB = forall (m :: * -> *) inner.
(LetDec (Rep m) ~ LetDecMem, Mem (Rep m) inner, MonadBuilder m,
ExpDec (Rep m) ~ ()) =>
ExpDec (Rep m) -> [VName] -> Exp (Rep m) -> m (Stm (Rep m))
mkLetNamesB' ()
instance BuilderOps (Engine.Wise MCMem) where
mkExpDecB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ Wise MCMem) =>
Pat (LetDec (Wise MCMem))
-> Exp (Wise MCMem) -> m (ExpDec (Wise MCMem))
mkExpDecB Pat (LetDec (Wise MCMem))
pat Exp (Wise MCMem)
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
(ASTRep rep, CanBeWise (Op rep)) =>
Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
Engine.mkWiseExpDec Pat (LetDec (Wise MCMem))
pat () Exp (Wise MCMem)
e
mkBodyB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ Wise MCMem) =>
Stms (Wise MCMem) -> Result -> m (Body (Wise MCMem))
mkBodyB Stms (Wise MCMem)
stms Result
res = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
(ASTRep rep, CanBeWise (Op rep)) =>
BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
Engine.mkWiseBody () Stms (Wise MCMem)
stms Result
res
mkLetNamesB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ Wise MCMem) =>
[VName] -> Exp (Wise MCMem) -> m (Stm (Wise MCMem))
mkLetNamesB = forall {k} (rep :: k) inner (m :: * -> *).
(Mem rep inner, LetDec rep ~ LetDecMem,
OpReturns (OpWithWisdom inner), ExpDec rep ~ (), Rep m ~ Wise rep,
HasScope (Wise rep) m, MonadBuilder m, CanBeWise inner) =>
[VName] -> Exp (Wise rep) -> m (Stm (Wise rep))
mkLetNamesB''
instance TraverseOpStms (Engine.Wise MCMem) where
traverseOpStms :: forall (m :: * -> *).
Monad m =>
OpStmsTraverser m (Op (Wise MCMem)) (Wise MCMem)
traverseOpStms = forall {k} (m :: * -> *) inner (rep :: k).
Monad m =>
OpStmsTraverser m inner rep -> OpStmsTraverser m (MemOp inner) rep
traverseMemOpStms (forall {k} (m :: * -> *) op (rep :: k).
Monad m =>
OpStmsTraverser m op rep -> OpStmsTraverser m (MCOp rep op) rep
traverseMCOpStms (forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure))
simplifyProg :: Prog MCMem -> PassM (Prog MCMem)
simplifyProg :: Prog MCMem -> PassM (Prog MCMem)
simplifyProg = forall {k} (rep :: k) inner.
SimplifyMemory rep inner =>
SimpleOps rep -> Prog rep -> PassM (Prog rep)
simplifyProgGeneric SimpleOps MCMem
simpleMCMem
simpleMCMem :: Engine.SimpleOps MCMem
simpleMCMem :: SimpleOps MCMem
simpleMCMem =
forall {k} (rep :: k) inner.
SimplifyMemory rep inner =>
(OpWithWisdom inner -> UsageTable)
-> SimplifyOp rep (OpWithWisdom inner) -> SimpleOps rep
simpleGeneric (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k) op.
(SimplifiableRep rep, BodyDec rep ~ ()) =>
SimplifyOp rep op
-> MCOp (Wise rep) op
-> SimpleM rep (MCOp (Wise rep) op, Stms (Wise rep))
simplifyMCOp forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), forall a. Monoid a => a
mempty)