{-# LANGUAGE TypeFamilies #-}

module Futhark.IR.SeqMem
  ( SeqMem,

    -- * Simplification
    simplifyProg,
    simpleSeqMem,

    -- * Module re-exports
    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 Op SeqMem = MemOp ()

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.CheckableOp SeqMem where
  checkOp :: OpWithAliases (Op SeqMem) -> TypeM SeqMem ()
checkOp (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
  checkOp (Inner ()) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance TC.Checkable SeqMem where
  checkFParamDec :: VName -> FParamInfo SeqMem -> TypeM SeqMem ()
checkFParamDec = forall {k} (rep :: k) u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
  checkLParamDec :: VName -> LParamInfo SeqMem -> TypeM SeqMem ()
checkLParamDec = forall {k} (rep :: k) u.
Checkable rep =>
VName -> MemInfo SubExp u MemBind -> TypeM rep ()
checkMemInfo
  checkLetBoundDec :: VName -> LetDec SeqMem -> TypeM SeqMem ()
checkLetBoundDec = forall {k} (rep :: k) 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 {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 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 {k} (rep :: k) 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 {k} (rep :: k) inner.
(Mem rep inner, Checkable rep) =>
[RetTypeMem] -> Result -> TypeM rep ()
matchFunctionReturnType
  matchBranchType :: [BranchType SeqMem] -> Body (Aliases SeqMem) -> TypeM SeqMem ()
matchBranchType = forall {k} (rep :: k) inner.
(Mem rep inner, Checkable rep) =>
[BranchTypeMem] -> Body (Aliases rep) -> TypeM rep ()
matchBranchReturnType
  matchLoopResult :: [FParam (Aliases SeqMem)] -> Result -> TypeM SeqMem ()
matchLoopResult = forall {k} (rep :: k) 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 {k} (rep :: k).
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) ~ ()) =>
ExpDec (Rep m) -> [VName] -> Exp (Rep m) -> m (Stm (Rep m))
mkLetNamesB' ()

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 {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 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 {k} (rep :: k).
(ASTRep rep, CanBeWise (Op 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 {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 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 {k} (rep :: k) inner.
SimplifyMemory rep inner =>
SimpleOps rep -> Prog rep -> PassM (Prog rep)
simplifyProgGeneric SimpleOps SeqMem
simpleSeqMem

simpleSeqMem :: Engine.SimpleOps SeqMem
simpleSeqMem :: SimpleOps SeqMem
simpleSeqMem =
  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 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)