{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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 qualified Futhark.Optimise.Simplify.Engine as Engine
import Futhark.Pass
import Futhark.Pass.ExplicitAllocations (BinderOps (..), mkLetNamesB', mkLetNamesB'')
import qualified Futhark.TypeCheck as TC
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 Op SeqMem = MemOp ()
instance ASTRep SeqMem where
expTypesFromPattern :: forall (m :: * -> *).
(HasScope SeqMem m, Monad m) =>
Pattern SeqMem -> m [BranchType SeqMem]
expTypesFromPattern = [BranchTypeMem] -> m [BranchTypeMem]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BranchTypeMem] -> m [BranchTypeMem])
-> (PatternT LetDecMem -> [BranchTypeMem])
-> PatternT LetDecMem
-> m [BranchTypeMem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VName, BranchTypeMem) -> BranchTypeMem)
-> [(VName, BranchTypeMem)] -> [BranchTypeMem]
forall a b. (a -> b) -> [a] -> [b]
map (VName, BranchTypeMem) -> BranchTypeMem
forall a b. (a, b) -> b
snd ([(VName, BranchTypeMem)] -> [BranchTypeMem])
-> (PatternT LetDecMem -> [(VName, BranchTypeMem)])
-> PatternT LetDecMem
-> [BranchTypeMem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(VName, BranchTypeMem)], [(VName, BranchTypeMem)])
-> [(VName, BranchTypeMem)]
forall a b. (a, b) -> b
snd (([(VName, BranchTypeMem)], [(VName, BranchTypeMem)])
-> [(VName, BranchTypeMem)])
-> (PatternT LetDecMem
-> ([(VName, BranchTypeMem)], [(VName, BranchTypeMem)]))
-> PatternT LetDecMem
-> [(VName, BranchTypeMem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT LetDecMem
-> ([(VName, BranchTypeMem)], [(VName, BranchTypeMem)])
bodyReturnsFromPattern
instance OpReturns SeqMem where
opReturns :: forall (m :: * -> *).
(Monad m, HasScope SeqMem m) =>
Op SeqMem -> m [ExpReturns]
opReturns (Alloc SubExp
_ Space
space) = [ExpReturns] -> m [ExpReturns]
forall (m :: * -> *) a. Monad m => a -> m a
return [Space -> ExpReturns
forall d u ret. Space -> MemInfo d u ret
MemMem Space
space]
opReturns (Inner ()) = [ExpReturns] -> m [ExpReturns]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance PrettyRep SeqMem
instance TC.CheckableOp SeqMem where
checkOp :: OpWithAliases (Op SeqMem) -> TypeM SeqMem ()
checkOp (Alloc SubExp
size Space
_) =
[TypeBase (ShapeBase SubExp) NoUniqueness]
-> SubExp -> TypeM SeqMem ()
forall rep.
Checkable rep =>
[TypeBase (ShapeBase SubExp) NoUniqueness]
-> SubExp -> TypeM rep ()
TC.require [PrimType -> TypeBase (ShapeBase SubExp) NoUniqueness
forall shape u. PrimType -> TypeBase shape u
Prim PrimType
int64] SubExp
size
checkOp (Inner ()) =
() -> TypeM SeqMem ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance TC.Checkable SeqMem where
checkFParamDec :: VName -> FParamInfo SeqMem -> TypeM SeqMem ()
checkFParamDec = VName -> FParamInfo SeqMem -> TypeM SeqMem ()
forall rep u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkLParamDec :: VName -> LParamInfo SeqMem -> TypeM SeqMem ()
checkLParamDec = VName -> LParamInfo SeqMem -> TypeM SeqMem ()
forall rep u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkLetBoundDec :: VName -> LetDec SeqMem -> TypeM SeqMem ()
checkLetBoundDec = VName -> LetDec SeqMem -> TypeM SeqMem ()
forall rep u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
checkRetType :: [RetType SeqMem] -> TypeM SeqMem ()
checkRetType = (RetTypeMem -> TypeM SeqMem ()) -> [RetTypeMem] -> TypeM SeqMem ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TypeBase (ShapeBase (Ext SubExp)) Uniqueness -> TypeM SeqMem ()
forall rep u.
Checkable rep =>
TypeBase (ShapeBase (Ext SubExp)) u -> TypeM rep ()
TC.checkExtType (TypeBase (ShapeBase (Ext SubExp)) Uniqueness -> TypeM SeqMem ())
-> (RetTypeMem -> TypeBase (ShapeBase (Ext SubExp)) Uniqueness)
-> RetTypeMem
-> TypeM SeqMem ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetTypeMem -> TypeBase (ShapeBase (Ext SubExp)) Uniqueness
forall t.
DeclExtTyped t =>
t -> TypeBase (ShapeBase (Ext SubExp)) Uniqueness
declExtTypeOf)
primFParam :: VName -> PrimType -> TypeM SeqMem (FParam (Aliases SeqMem))
primFParam VName
name PrimType
t = Param FParamMem -> TypeM SeqMem (Param FParamMem)
forall (m :: * -> *) a. Monad m => a -> m a
return (Param FParamMem -> TypeM SeqMem (Param FParamMem))
-> Param FParamMem -> TypeM SeqMem (Param FParamMem)
forall a b. (a -> b) -> a -> b
$ VName -> FParamMem -> Param FParamMem
forall dec. VName -> dec -> Param dec
Param VName
name (PrimType -> FParamMem
forall d u ret. PrimType -> MemInfo d u ret
MemPrim PrimType
t)
matchPattern :: Pattern (Aliases SeqMem) -> Exp (Aliases SeqMem) -> TypeM SeqMem ()
matchPattern = Pattern (Aliases SeqMem) -> Exp (Aliases SeqMem) -> TypeM SeqMem ()
forall rep.
(Mem rep, Checkable rep) =>
Pattern (Aliases rep) -> Exp (Aliases rep) -> TypeM rep ()
matchPatternToExp
matchReturnType :: [RetType SeqMem] -> [SubExp] -> TypeM SeqMem ()
matchReturnType = [RetType SeqMem] -> [SubExp] -> TypeM SeqMem ()
forall rep.
(Mem rep, Checkable rep) =>
[RetTypeMem] -> [SubExp] -> TypeM rep ()
matchFunctionReturnType
matchBranchType :: [BranchType SeqMem] -> Body (Aliases SeqMem) -> TypeM SeqMem ()
matchBranchType = [BranchType SeqMem] -> Body (Aliases SeqMem) -> TypeM SeqMem ()
forall rep.
(Mem rep, Checkable rep) =>
[BranchTypeMem] -> Body (Aliases rep) -> TypeM rep ()
matchBranchReturnType
matchLoopResult :: [FParam (Aliases SeqMem)]
-> [FParam (Aliases SeqMem)] -> [SubExp] -> TypeM SeqMem ()
matchLoopResult = [FParam (Aliases SeqMem)]
-> [FParam (Aliases SeqMem)] -> [SubExp] -> TypeM SeqMem ()
forall rep.
(Mem rep, Checkable rep) =>
[FParam (Aliases rep)]
-> [FParam (Aliases rep)] -> [SubExp] -> TypeM rep ()
matchLoopResultMem
instance BinderOps SeqMem where
mkExpDecB :: forall (m :: * -> *).
(MonadBinder m, Rep m ~ SeqMem) =>
Pattern SeqMem -> Exp SeqMem -> m (ExpDec SeqMem)
mkExpDecB Pattern SeqMem
_ Exp SeqMem
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mkBodyB :: forall (m :: * -> *).
(MonadBinder m, Rep m ~ SeqMem) =>
Stms SeqMem -> [SubExp] -> m (Body SeqMem)
mkBodyB Stms SeqMem
stms [SubExp]
res = Body SeqMem -> m (Body SeqMem)
forall (m :: * -> *) a. Monad m => a -> m a
return (Body SeqMem -> m (Body SeqMem)) -> Body SeqMem -> m (Body SeqMem)
forall a b. (a -> b) -> a -> b
$ BodyDec SeqMem -> Stms SeqMem -> [SubExp] -> Body SeqMem
forall rep. BodyDec rep -> Stms rep -> [SubExp] -> BodyT rep
Body () Stms SeqMem
stms [SubExp]
res
mkLetNamesB :: forall (m :: * -> *).
(MonadBinder m, Rep m ~ SeqMem) =>
[VName] -> Exp SeqMem -> m (Stm SeqMem)
mkLetNamesB = ExpDec (Rep m) -> [VName] -> Exp (Rep m) -> m (Stm (Rep m))
forall (m :: * -> *) inner.
(Op (Rep m) ~ MemOp inner, MonadBinder m, ExpDec (Rep m) ~ (),
Allocator (Rep m) (PatAllocM (Rep m))) =>
ExpDec (Rep m) -> [VName] -> Exp (Rep m) -> m (Stm (Rep m))
mkLetNamesB' ()
instance BinderOps (Engine.Wise SeqMem) where
mkExpDecB :: forall (m :: * -> *).
(MonadBinder m, Rep m ~ Wise SeqMem) =>
Pattern (Wise SeqMem)
-> Exp (Wise SeqMem) -> m (ExpDec (Wise SeqMem))
mkExpDecB Pattern (Wise SeqMem)
pat Exp (Wise SeqMem)
e = (ExpWisdom, ()) -> m (ExpWisdom, ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpWisdom, ()) -> m (ExpWisdom, ()))
-> (ExpWisdom, ()) -> m (ExpWisdom, ())
forall a b. (a -> b) -> a -> b
$ Pattern (Wise SeqMem)
-> ExpDec SeqMem -> Exp (Wise SeqMem) -> ExpDec (Wise SeqMem)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pattern (Wise rep)
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
Engine.mkWiseExpDec Pattern (Wise SeqMem)
pat () Exp (Wise SeqMem)
e
mkBodyB :: forall (m :: * -> *).
(MonadBinder m, Rep m ~ Wise SeqMem) =>
Stms (Wise SeqMem) -> [SubExp] -> m (Body (Wise SeqMem))
mkBodyB Stms (Wise SeqMem)
stms [SubExp]
res = Body (Wise SeqMem) -> m (Body (Wise SeqMem))
forall (m :: * -> *) a. Monad m => a -> m a
return (Body (Wise SeqMem) -> m (Body (Wise SeqMem)))
-> Body (Wise SeqMem) -> m (Body (Wise SeqMem))
forall a b. (a -> b) -> a -> b
$ BodyDec SeqMem
-> Stms (Wise SeqMem) -> [SubExp] -> Body (Wise SeqMem)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
BodyDec rep -> Stms (Wise rep) -> [SubExp] -> Body (Wise rep)
Engine.mkWiseBody () Stms (Wise SeqMem)
stms [SubExp]
res
mkLetNamesB :: forall (m :: * -> *).
(MonadBinder m, Rep m ~ Wise SeqMem) =>
[VName] -> Exp (Wise SeqMem) -> m (Stm (Wise SeqMem))
mkLetNamesB = [VName] -> Exp (Wise SeqMem) -> m (Stm (Wise SeqMem))
forall (m :: * -> *) inner rep.
(Op (Rep m) ~ MemOp inner, ExpDec rep ~ (), HasScope (Wise rep) m,
Allocator rep (PatAllocM rep), MonadBinder m,
CanBeWise (Op rep)) =>
[VName] -> Exp (Wise rep) -> m (Stm (Wise rep))
mkLetNamesB''
simplifyProg :: Prog SeqMem -> PassM (Prog SeqMem)
simplifyProg :: Prog SeqMem -> PassM (Prog SeqMem)
simplifyProg = SimpleOps SeqMem -> Prog SeqMem -> PassM (Prog SeqMem)
forall rep inner.
(SimplifyMemory rep, Op rep ~ MemOp inner) =>
SimpleOps rep -> Prog rep -> PassM (Prog rep)
simplifyProgGeneric SimpleOps SeqMem
simpleSeqMem
simpleSeqMem :: Engine.SimpleOps SeqMem
simpleSeqMem :: SimpleOps SeqMem
simpleSeqMem =
(OpWithWisdom () -> UsageTable)
-> SimplifyOp SeqMem () -> SimpleOps SeqMem
forall rep inner.
(SimplifyMemory rep, Op rep ~ MemOp inner) =>
(OpWithWisdom inner -> UsageTable)
-> SimplifyOp rep inner -> SimpleOps rep
simpleGeneric (UsageTable -> () -> UsageTable
forall a b. a -> b -> a
const UsageTable
forall a. Monoid a => a
mempty) (SimplifyOp SeqMem () -> SimpleOps SeqMem)
-> SimplifyOp SeqMem () -> SimpleOps SeqMem
forall a b. (a -> b) -> a -> b
$ SimpleM SeqMem ((), Stms (Wise SeqMem))
-> () -> SimpleM SeqMem ((), Stms (Wise SeqMem))
forall a b. a -> b -> a
const (SimpleM SeqMem ((), Stms (Wise SeqMem))
-> () -> SimpleM SeqMem ((), Stms (Wise SeqMem)))
-> SimpleM SeqMem ((), Stms (Wise SeqMem))
-> ()
-> SimpleM SeqMem ((), Stms (Wise SeqMem))
forall a b. (a -> b) -> a -> b
$ ((), Stms (Wise SeqMem)) -> SimpleM SeqMem ((), Stms (Wise SeqMem))
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Stms (Wise SeqMem)
forall a. Monoid a => a
mempty)