{-# LANGUAGE TypeFamilies #-}
module Futhark.IR.SeqMem
( SeqMem,
simplifyProg,
simpleSeqMem,
module Futhark.IR.Mem,
)
where
import Futhark.Analysis.PrimExp.Convert
import Futhark.IR.Mem
import Futhark.IR.Mem.Simplify
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 SeqMem
instance RepTypes SeqMem where
type LetDec SeqMem = LetDecMem
type FParamInfo SeqMem = FParamMem
type LParamInfo SeqMem = LParamMem
type RetType SeqMem = RetTypeMem
type BranchType SeqMem = BranchTypeMem
type OpC SeqMem = MemOp NoOp
instance ASTRep SeqMem where
expTypesFromPat :: forall (m :: * -> *).
(HasScope SeqMem m, Monad m) =>
Pat (LetDec SeqMem) -> m [BranchType SeqMem]
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 PrettyRep SeqMem
instance TC.Checkable SeqMem where
checkOp :: Op (Aliases SeqMem) -> TypeM SeqMem ()
checkOp (Alloc SubExp
size Space
_) = forall rep.
Checkable rep =>
[TypeBase (ShapeBase SubExp) NoUniqueness]
-> SubExp -> TypeM rep ()
TC.require [forall shape u. PrimType -> TypeBase shape u
Prim PrimType
int64] SubExp
size
checkOp (Inner NoOp (Aliases SeqMem)
NoOp) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkFParamDec :: VName -> FParamInfo SeqMem -> TypeM SeqMem ()
checkFParamDec = forall rep u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkLParamDec :: VName -> LParamInfo SeqMem -> TypeM SeqMem ()
checkLParamDec = forall rep u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkLetBoundDec :: VName -> LetDec SeqMem -> TypeM SeqMem ()
checkLetBoundDec = forall rep u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkRetType :: [RetType SeqMem] -> TypeM SeqMem ()
checkRetType = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall rep 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 SeqMem (FParam (Aliases SeqMem))
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 SeqMem))
-> Exp (Aliases SeqMem) -> TypeM SeqMem ()
matchPat = forall rep (inner :: * -> *).
(Mem rep inner, LetDec rep ~ LetDecMem, Checkable rep) =>
Pat (LetDec (Aliases rep)) -> Exp (Aliases rep) -> TypeM rep ()
matchPatToExp
matchReturnType :: [RetType SeqMem] -> Result -> TypeM SeqMem ()
matchReturnType = forall rep (inner :: * -> *).
(Mem rep inner, Checkable rep) =>
[RetTypeMem] -> Result -> TypeM rep ()
matchFunctionReturnType
matchBranchType :: [BranchType SeqMem] -> Body (Aliases SeqMem) -> TypeM SeqMem ()
matchBranchType = forall rep (inner :: * -> *).
(Mem rep inner, Checkable rep) =>
[BranchTypeMem] -> Body (Aliases rep) -> TypeM rep ()
matchBranchReturnType
matchLoopResult :: [FParam (Aliases SeqMem)] -> Result -> TypeM SeqMem ()
matchLoopResult = forall rep (inner :: * -> *).
(Mem rep inner, Checkable rep) =>
[FParam (Aliases rep)] -> Result -> TypeM rep ()
matchLoopResultMem
instance BuilderOps SeqMem where
mkExpDecB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ SeqMem) =>
Pat (LetDec SeqMem) -> Exp SeqMem -> m (ExpDec SeqMem)
mkExpDecB Pat (LetDec SeqMem)
_ Exp SeqMem
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mkBodyB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ SeqMem) =>
Stms SeqMem -> Result -> m (Body SeqMem)
mkBodyB Stms SeqMem
stms Result
res = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall rep. BodyDec rep -> Stms rep -> Result -> Body rep
Body () Stms SeqMem
stms Result
res
mkLetNamesB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ SeqMem) =>
[VName] -> Exp SeqMem -> m (Stm SeqMem)
mkLetNamesB = forall (m :: * -> *) (inner :: * -> *).
(LetDec (Rep m) ~ LetDecMem, Mem (Rep m) inner, MonadBuilder m,
ExpDec (Rep m) ~ ()) =>
Space
-> ExpDec (Rep m) -> [VName] -> Exp (Rep m) -> m (Stm (Rep m))
mkLetNamesB' Space
DefaultSpace ()
instance TraverseOpStms SeqMem where
traverseOpStms :: forall (m :: * -> *).
Monad m =>
OpStmsTraverser m (Op SeqMem) SeqMem
traverseOpStms Scope SeqMem -> Stms SeqMem -> m (Stms SeqMem)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance BuilderOps (Engine.Wise SeqMem) where
mkExpDecB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ Wise SeqMem) =>
Pat (LetDec (Wise SeqMem))
-> Exp (Wise SeqMem) -> m (ExpDec (Wise SeqMem))
mkExpDecB Pat (LetDec (Wise SeqMem))
pat Exp (Wise SeqMem)
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall rep.
Informing rep =>
Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
Engine.mkWiseExpDec Pat (LetDec (Wise SeqMem))
pat () Exp (Wise SeqMem)
e
mkBodyB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ Wise SeqMem) =>
Stms (Wise SeqMem) -> Result -> m (Body (Wise SeqMem))
mkBodyB Stms (Wise SeqMem)
stms Result
res = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall rep.
Informing rep =>
BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
Engine.mkWiseBody () Stms (Wise SeqMem)
stms Result
res
mkLetNamesB :: forall (m :: * -> *).
(MonadBuilder m, Rep m ~ Wise SeqMem) =>
[VName] -> Exp (Wise SeqMem) -> m (Stm (Wise SeqMem))
mkLetNamesB = forall rep (inner :: * -> *) (m :: * -> *).
(Mem rep inner, LetDec rep ~ LetDecMem,
OpReturns (inner (Wise rep)), ExpDec rep ~ (), Rep m ~ Wise rep,
HasScope (Wise rep) m, MonadBuilder m,
AliasedOp (inner (Wise rep)), RephraseOp (MemOp inner),
CanBeWise inner) =>
Space -> [VName] -> Exp (Wise rep) -> m (Stm (Wise rep))
mkLetNamesB'' Space
DefaultSpace
instance TraverseOpStms (Engine.Wise SeqMem) where
traverseOpStms :: forall (m :: * -> *).
Monad m =>
OpStmsTraverser m (Op (Wise SeqMem)) (Wise SeqMem)
traverseOpStms Scope (Wise SeqMem) -> Stms (Wise SeqMem) -> m (Stms (Wise SeqMem))
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure
simplifyProg :: Prog SeqMem -> PassM (Prog SeqMem)
simplifyProg :: Prog SeqMem -> PassM (Prog SeqMem)
simplifyProg = forall rep (inner :: * -> *).
SimplifyMemory rep inner =>
SimpleOps rep -> Prog rep -> PassM (Prog rep)
simplifyProgGeneric SimpleOps SeqMem
simpleSeqMem
simpleSeqMem :: Engine.SimpleOps SeqMem
simpleSeqMem :: SimpleOps SeqMem
simpleSeqMem =
forall rep (inner :: * -> *).
SimplifyMemory rep inner =>
(inner (Wise rep) -> UsageTable)
-> SimplifyOp rep (inner (Wise rep)) -> SimpleOps rep
simpleGeneric (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) 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 {k} (rep :: k). NoOp rep
NoOp, forall a. Monoid a => a
mempty)