{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Futhark.IR.MC.Op
( MCOp (..),
traverseMCOpStms,
typeCheckMCOp,
simplifyMCOp,
module Futhark.IR.SegOp,
)
where
import Data.Bifunctor (first)
import Futhark.Analysis.Metrics
import qualified Futhark.Analysis.SymbolTable as ST
import Futhark.IR
import Futhark.IR.Aliases (Aliases)
import Futhark.IR.Prop.Aliases
import Futhark.IR.SegOp
import qualified Futhark.IR.TypeCheck as TC
import qualified Futhark.Optimise.Simplify as Simplify
import qualified Futhark.Optimise.Simplify.Engine as Engine
import Futhark.Optimise.Simplify.Rep
import Futhark.Transform.Rename
import Futhark.Transform.Substitute
import Futhark.Util.Pretty
( Pretty,
nestedBlock,
ppr,
(<+>),
(</>),
)
import Prelude hiding (id, (.))
data MCOp rep op
=
ParOp
(Maybe (SegOp () rep))
(SegOp () rep)
|
OtherOp op
deriving (MCOp rep op -> MCOp rep op -> Bool
(MCOp rep op -> MCOp rep op -> Bool)
-> (MCOp rep op -> MCOp rep op -> Bool) -> Eq (MCOp rep op)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall rep op.
(RepTypes rep, Eq op) =>
MCOp rep op -> MCOp rep op -> Bool
/= :: MCOp rep op -> MCOp rep op -> Bool
$c/= :: forall rep op.
(RepTypes rep, Eq op) =>
MCOp rep op -> MCOp rep op -> Bool
== :: MCOp rep op -> MCOp rep op -> Bool
$c== :: forall rep op.
(RepTypes rep, Eq op) =>
MCOp rep op -> MCOp rep op -> Bool
Eq, Eq (MCOp rep op)
Eq (MCOp rep op)
-> (MCOp rep op -> MCOp rep op -> Ordering)
-> (MCOp rep op -> MCOp rep op -> Bool)
-> (MCOp rep op -> MCOp rep op -> Bool)
-> (MCOp rep op -> MCOp rep op -> Bool)
-> (MCOp rep op -> MCOp rep op -> Bool)
-> (MCOp rep op -> MCOp rep op -> MCOp rep op)
-> (MCOp rep op -> MCOp rep op -> MCOp rep op)
-> Ord (MCOp rep op)
MCOp rep op -> MCOp rep op -> Bool
MCOp rep op -> MCOp rep op -> Ordering
MCOp rep op -> MCOp rep op -> MCOp rep op
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall rep op. (RepTypes rep, Ord op) => Eq (MCOp rep op)
forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Bool
forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Ordering
forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> MCOp rep op
min :: MCOp rep op -> MCOp rep op -> MCOp rep op
$cmin :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> MCOp rep op
max :: MCOp rep op -> MCOp rep op -> MCOp rep op
$cmax :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> MCOp rep op
>= :: MCOp rep op -> MCOp rep op -> Bool
$c>= :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Bool
> :: MCOp rep op -> MCOp rep op -> Bool
$c> :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Bool
<= :: MCOp rep op -> MCOp rep op -> Bool
$c<= :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Bool
< :: MCOp rep op -> MCOp rep op -> Bool
$c< :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Bool
compare :: MCOp rep op -> MCOp rep op -> Ordering
$ccompare :: forall rep op.
(RepTypes rep, Ord op) =>
MCOp rep op -> MCOp rep op -> Ordering
$cp1Ord :: forall rep op. (RepTypes rep, Ord op) => Eq (MCOp rep op)
Ord, Int -> MCOp rep op -> ShowS
[MCOp rep op] -> ShowS
MCOp rep op -> String
(Int -> MCOp rep op -> ShowS)
-> (MCOp rep op -> String)
-> ([MCOp rep op] -> ShowS)
-> Show (MCOp rep op)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall rep op.
(RepTypes rep, Show op) =>
Int -> MCOp rep op -> ShowS
forall rep op. (RepTypes rep, Show op) => [MCOp rep op] -> ShowS
forall rep op. (RepTypes rep, Show op) => MCOp rep op -> String
showList :: [MCOp rep op] -> ShowS
$cshowList :: forall rep op. (RepTypes rep, Show op) => [MCOp rep op] -> ShowS
show :: MCOp rep op -> String
$cshow :: forall rep op. (RepTypes rep, Show op) => MCOp rep op -> String
showsPrec :: Int -> MCOp rep op -> ShowS
$cshowsPrec :: forall rep op.
(RepTypes rep, Show op) =>
Int -> MCOp rep op -> ShowS
Show)
traverseMCOpStms :: Monad m => OpStmsTraverser m op rep -> OpStmsTraverser m (MCOp rep op) rep
traverseMCOpStms :: OpStmsTraverser m op rep -> OpStmsTraverser m (MCOp rep op) rep
traverseMCOpStms OpStmsTraverser m op rep
_ Scope rep -> Stms rep -> m (Stms rep)
f (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) =
Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op)
-> m (Maybe (SegOp () rep)) -> m (SegOp () rep -> MCOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SegOp () rep -> m (SegOp () rep))
-> Maybe (SegOp () rep) -> m (Maybe (SegOp () rep))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OpStmsTraverser m (SegOp () rep) rep
forall (m :: * -> *) lvl rep.
Monad m =>
OpStmsTraverser m (SegOp lvl rep) rep
traverseSegOpStms Scope rep -> Stms rep -> m (Stms rep)
f) Maybe (SegOp () rep)
par_op m (SegOp () rep -> MCOp rep op)
-> m (SegOp () rep) -> m (MCOp rep op)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpStmsTraverser m (SegOp () rep) rep
forall (m :: * -> *) lvl rep.
Monad m =>
OpStmsTraverser m (SegOp lvl rep) rep
traverseSegOpStms Scope rep -> Stms rep -> m (Stms rep)
f SegOp () rep
op
traverseMCOpStms OpStmsTraverser m op rep
onInner Scope rep -> Stms rep -> m (Stms rep)
f (OtherOp op
op) = op -> MCOp rep op
forall rep op. op -> MCOp rep op
OtherOp (op -> MCOp rep op) -> m op -> m (MCOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpStmsTraverser m op rep
onInner Scope rep -> Stms rep -> m (Stms rep)
f op
op
instance (ASTRep rep, Substitute op) => Substitute (MCOp rep op) where
substituteNames :: Map VName VName -> MCOp rep op -> MCOp rep op
substituteNames Map VName VName
substs (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) =
Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (Map VName VName -> SegOp () rep -> SegOp () rep
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs (SegOp () rep -> SegOp () rep)
-> Maybe (SegOp () rep) -> Maybe (SegOp () rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SegOp () rep)
par_op) (Map VName VName -> SegOp () rep -> SegOp () rep
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs SegOp () rep
op)
substituteNames Map VName VName
substs (OtherOp op
op) =
op -> MCOp rep op
forall rep op. op -> MCOp rep op
OtherOp (op -> MCOp rep op) -> op -> MCOp rep op
forall a b. (a -> b) -> a -> b
$ Map VName VName -> op -> op
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs op
op
instance (ASTRep rep, Rename op) => Rename (MCOp rep op) where
rename :: MCOp rep op -> RenameM (MCOp rep op)
rename (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) = Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op)
-> RenameM (Maybe (SegOp () rep))
-> RenameM (SegOp () rep -> MCOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SegOp () rep) -> RenameM (Maybe (SegOp () rep))
forall a. Rename a => a -> RenameM a
rename Maybe (SegOp () rep)
par_op RenameM (SegOp () rep -> MCOp rep op)
-> RenameM (SegOp () rep) -> RenameM (MCOp rep op)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SegOp () rep -> RenameM (SegOp () rep)
forall a. Rename a => a -> RenameM a
rename SegOp () rep
op
rename (OtherOp op
op) = op -> MCOp rep op
forall rep op. op -> MCOp rep op
OtherOp (op -> MCOp rep op) -> RenameM op -> RenameM (MCOp rep op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> op -> RenameM op
forall a. Rename a => a -> RenameM a
rename op
op
instance (ASTRep rep, FreeIn op) => FreeIn (MCOp rep op) where
freeIn' :: MCOp rep op -> FV
freeIn' (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) = Maybe (SegOp () rep) -> FV
forall a. FreeIn a => a -> FV
freeIn' Maybe (SegOp () rep)
par_op FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> SegOp () rep -> FV
forall a. FreeIn a => a -> FV
freeIn' SegOp () rep
op
freeIn' (OtherOp op
op) = op -> FV
forall a. FreeIn a => a -> FV
freeIn' op
op
instance (ASTRep rep, IsOp op) => IsOp (MCOp rep op) where
safeOp :: MCOp rep op -> Bool
safeOp (ParOp Maybe (SegOp () rep)
_ SegOp () rep
op) = SegOp () rep -> Bool
forall op. IsOp op => op -> Bool
safeOp SegOp () rep
op
safeOp (OtherOp op
op) = op -> Bool
forall op. IsOp op => op -> Bool
safeOp op
op
cheapOp :: MCOp rep op -> Bool
cheapOp (ParOp Maybe (SegOp () rep)
_ SegOp () rep
op) = SegOp () rep -> Bool
forall op. IsOp op => op -> Bool
cheapOp SegOp () rep
op
cheapOp (OtherOp op
op) = op -> Bool
forall op. IsOp op => op -> Bool
cheapOp op
op
instance TypedOp op => TypedOp (MCOp rep op) where
opType :: MCOp rep op -> m [ExtType]
opType (ParOp Maybe (SegOp () rep)
_ SegOp () rep
op) = SegOp () rep -> m [ExtType]
forall op t (m :: * -> *).
(TypedOp op, HasScope t m) =>
op -> m [ExtType]
opType SegOp () rep
op
opType (OtherOp op
op) = op -> m [ExtType]
forall op t (m :: * -> *).
(TypedOp op, HasScope t m) =>
op -> m [ExtType]
opType op
op
instance
(Aliased rep, AliasedOp op, ASTRep rep) =>
AliasedOp (MCOp rep op)
where
opAliases :: MCOp rep op -> [Names]
opAliases (ParOp Maybe (SegOp () rep)
_ SegOp () rep
op) = SegOp () rep -> [Names]
forall op. AliasedOp op => op -> [Names]
opAliases SegOp () rep
op
opAliases (OtherOp op
op) = op -> [Names]
forall op. AliasedOp op => op -> [Names]
opAliases op
op
consumedInOp :: MCOp rep op -> Names
consumedInOp (ParOp Maybe (SegOp () rep)
_ SegOp () rep
op) = SegOp () rep -> Names
forall op. AliasedOp op => op -> Names
consumedInOp SegOp () rep
op
consumedInOp (OtherOp op
op) = op -> Names
forall op. AliasedOp op => op -> Names
consumedInOp op
op
instance
(CanBeAliased (Op rep), CanBeAliased op, ASTRep rep) =>
CanBeAliased (MCOp rep op)
where
type OpWithAliases (MCOp rep op) = MCOp (Aliases rep) (OpWithAliases op)
addOpAliases :: AliasTable -> MCOp rep op -> OpWithAliases (MCOp rep op)
addOpAliases AliasTable
aliases (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) =
Maybe (SegOp () (Aliases rep))
-> SegOp () (Aliases rep) -> MCOp (Aliases rep) (OpWithAliases op)
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (AliasTable -> SegOp () rep -> OpWithAliases (SegOp () rep)
forall op. CanBeAliased op => AliasTable -> op -> OpWithAliases op
addOpAliases AliasTable
aliases (SegOp () rep -> SegOp () (Aliases rep))
-> Maybe (SegOp () rep) -> Maybe (SegOp () (Aliases rep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SegOp () rep)
par_op) (AliasTable -> SegOp () rep -> OpWithAliases (SegOp () rep)
forall op. CanBeAliased op => AliasTable -> op -> OpWithAliases op
addOpAliases AliasTable
aliases SegOp () rep
op)
addOpAliases AliasTable
aliases (OtherOp op
op) =
OpWithAliases op -> MCOp (Aliases rep) (OpWithAliases op)
forall rep op. op -> MCOp rep op
OtherOp (OpWithAliases op -> MCOp (Aliases rep) (OpWithAliases op))
-> OpWithAliases op -> MCOp (Aliases rep) (OpWithAliases op)
forall a b. (a -> b) -> a -> b
$ AliasTable -> op -> OpWithAliases op
forall op. CanBeAliased op => AliasTable -> op -> OpWithAliases op
addOpAliases AliasTable
aliases op
op
removeOpAliases :: OpWithAliases (MCOp rep op) -> MCOp rep op
removeOpAliases (ParOp par_op op) =
Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (SegOp () (Aliases rep) -> SegOp () rep
forall op. CanBeAliased op => OpWithAliases op -> op
removeOpAliases (SegOp () (Aliases rep) -> SegOp () rep)
-> Maybe (SegOp () (Aliases rep)) -> Maybe (SegOp () rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SegOp () (Aliases rep))
par_op) (OpWithAliases (SegOp () rep) -> SegOp () rep
forall op. CanBeAliased op => OpWithAliases op -> op
removeOpAliases OpWithAliases (SegOp () rep)
SegOp () (Aliases rep)
op)
removeOpAliases (OtherOp op) =
op -> MCOp rep op
forall rep op. op -> MCOp rep op
OtherOp (op -> MCOp rep op) -> op -> MCOp rep op
forall a b. (a -> b) -> a -> b
$ OpWithAliases op -> op
forall op. CanBeAliased op => OpWithAliases op -> op
removeOpAliases OpWithAliases op
op
instance
(CanBeWise (Op rep), CanBeWise op, ASTRep rep) =>
CanBeWise (MCOp rep op)
where
type OpWithWisdom (MCOp rep op) = MCOp (Wise rep) (OpWithWisdom op)
removeOpWisdom :: OpWithWisdom (MCOp rep op) -> MCOp rep op
removeOpWisdom (ParOp par_op op) =
Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (SegOp () (Wise rep) -> SegOp () rep
forall op. CanBeWise op => OpWithWisdom op -> op
removeOpWisdom (SegOp () (Wise rep) -> SegOp () rep)
-> Maybe (SegOp () (Wise rep)) -> Maybe (SegOp () rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SegOp () (Wise rep))
par_op) (OpWithWisdom (SegOp () rep) -> SegOp () rep
forall op. CanBeWise op => OpWithWisdom op -> op
removeOpWisdom OpWithWisdom (SegOp () rep)
SegOp () (Wise rep)
op)
removeOpWisdom (OtherOp op) =
op -> MCOp rep op
forall rep op. op -> MCOp rep op
OtherOp (op -> MCOp rep op) -> op -> MCOp rep op
forall a b. (a -> b) -> a -> b
$ OpWithWisdom op -> op
forall op. CanBeWise op => OpWithWisdom op -> op
removeOpWisdom OpWithWisdom op
op
addOpWisdom :: MCOp rep op -> OpWithWisdom (MCOp rep op)
addOpWisdom (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) =
Maybe (SegOp () (Wise rep))
-> SegOp () (Wise rep) -> MCOp (Wise rep) (OpWithWisdom op)
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp (SegOp () rep -> SegOp () (Wise rep)
forall op. CanBeWise op => op -> OpWithWisdom op
addOpWisdom (SegOp () rep -> SegOp () (Wise rep))
-> Maybe (SegOp () rep) -> Maybe (SegOp () (Wise rep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SegOp () rep)
par_op) (SegOp () rep -> OpWithWisdom (SegOp () rep)
forall op. CanBeWise op => op -> OpWithWisdom op
addOpWisdom SegOp () rep
op)
addOpWisdom (OtherOp op
op) =
OpWithWisdom op -> MCOp (Wise rep) (OpWithWisdom op)
forall rep op. op -> MCOp rep op
OtherOp (OpWithWisdom op -> MCOp (Wise rep) (OpWithWisdom op))
-> OpWithWisdom op -> MCOp (Wise rep) (OpWithWisdom op)
forall a b. (a -> b) -> a -> b
$ op -> OpWithWisdom op
forall op. CanBeWise op => op -> OpWithWisdom op
addOpWisdom op
op
instance (ASTRep rep, ST.IndexOp op) => ST.IndexOp (MCOp rep op) where
indexOp :: SymbolTable rep
-> Int -> MCOp rep op -> [TPrimExp Int64 VName] -> Maybe Indexed
indexOp SymbolTable rep
vtable Int
k (ParOp Maybe (SegOp () rep)
_ SegOp () rep
op) [TPrimExp Int64 VName]
is = SymbolTable rep
-> Int -> SegOp () rep -> [TPrimExp Int64 VName] -> Maybe Indexed
forall op rep.
(IndexOp op, ASTRep rep, IndexOp (Op rep)) =>
SymbolTable rep
-> Int -> op -> [TPrimExp Int64 VName] -> Maybe Indexed
ST.indexOp SymbolTable rep
vtable Int
k SegOp () rep
op [TPrimExp Int64 VName]
is
indexOp SymbolTable rep
vtable Int
k (OtherOp op
op) [TPrimExp Int64 VName]
is = SymbolTable rep
-> Int -> op -> [TPrimExp Int64 VName] -> Maybe Indexed
forall op rep.
(IndexOp op, ASTRep rep, IndexOp (Op rep)) =>
SymbolTable rep
-> Int -> op -> [TPrimExp Int64 VName] -> Maybe Indexed
ST.indexOp SymbolTable rep
vtable Int
k op
op [TPrimExp Int64 VName]
is
instance (PrettyRep rep, Pretty op) => Pretty (MCOp rep op) where
ppr :: MCOp rep op -> Doc
ppr (ParOp Maybe (SegOp () rep)
Nothing SegOp () rep
op) = SegOp () rep -> Doc
forall a. Pretty a => a -> Doc
ppr SegOp () rep
op
ppr (ParOp (Just SegOp () rep
par_op) SegOp () rep
op) =
Doc
"par" Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" (SegOp () rep -> Doc
forall a. Pretty a => a -> Doc
ppr SegOp () rep
par_op)
Doc -> Doc -> Doc
</> Doc
"seq" Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" (SegOp () rep -> Doc
forall a. Pretty a => a -> Doc
ppr SegOp () rep
op)
ppr (OtherOp op
op) = op -> Doc
forall a. Pretty a => a -> Doc
ppr op
op
instance (OpMetrics (Op rep), OpMetrics op) => OpMetrics (MCOp rep op) where
opMetrics :: MCOp rep op -> MetricsM ()
opMetrics (ParOp Maybe (SegOp () rep)
par_op SegOp () rep
op) = Maybe (SegOp () rep) -> MetricsM ()
forall op. OpMetrics op => op -> MetricsM ()
opMetrics Maybe (SegOp () rep)
par_op MetricsM () -> MetricsM () -> MetricsM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SegOp () rep -> MetricsM ()
forall op. OpMetrics op => op -> MetricsM ()
opMetrics SegOp () rep
op
opMetrics (OtherOp op
op) = op -> MetricsM ()
forall op. OpMetrics op => op -> MetricsM ()
opMetrics op
op
typeCheckMCOp ::
TC.Checkable rep =>
(op -> TC.TypeM rep ()) ->
MCOp (Aliases rep) op ->
TC.TypeM rep ()
typeCheckMCOp :: (op -> TypeM rep ()) -> MCOp (Aliases rep) op -> TypeM rep ()
typeCheckMCOp op -> TypeM rep ()
_ (ParOp (Just SegOp () (Aliases rep)
par_op) SegOp () (Aliases rep)
op) = do
((), ())
_ <- (() -> TypeM rep ()) -> SegOp () (Aliases rep) -> TypeM rep ()
forall rep lvl.
Checkable rep =>
(lvl -> TypeM rep ()) -> SegOp lvl (Aliases rep) -> TypeM rep ()
typeCheckSegOp () -> TypeM rep ()
forall (m :: * -> *) a. Monad m => a -> m a
return SegOp () (Aliases rep)
par_op TypeM rep () -> TypeM rep () -> TypeM rep ((), ())
forall rep a b. TypeM rep a -> TypeM rep b -> TypeM rep (a, b)
`TC.alternative` (() -> TypeM rep ()) -> SegOp () (Aliases rep) -> TypeM rep ()
forall rep lvl.
Checkable rep =>
(lvl -> TypeM rep ()) -> SegOp lvl (Aliases rep) -> TypeM rep ()
typeCheckSegOp () -> TypeM rep ()
forall (m :: * -> *) a. Monad m => a -> m a
return SegOp () (Aliases rep)
op
() -> TypeM rep ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
typeCheckMCOp op -> TypeM rep ()
_ (ParOp Maybe (SegOp () (Aliases rep))
Nothing SegOp () (Aliases rep)
op) =
(() -> TypeM rep ()) -> SegOp () (Aliases rep) -> TypeM rep ()
forall rep lvl.
Checkable rep =>
(lvl -> TypeM rep ()) -> SegOp lvl (Aliases rep) -> TypeM rep ()
typeCheckSegOp () -> TypeM rep ()
forall (m :: * -> *) a. Monad m => a -> m a
return SegOp () (Aliases rep)
op
typeCheckMCOp op -> TypeM rep ()
f (OtherOp op
op) = op -> TypeM rep ()
f op
op
simplifyMCOp ::
( Engine.SimplifiableRep rep,
BodyDec rep ~ ()
) =>
Simplify.SimplifyOp rep op ->
MCOp (Wise rep) op ->
Engine.SimpleM rep (MCOp (Wise rep) op, Stms (Wise rep))
simplifyMCOp :: SimplifyOp rep op
-> MCOp (Wise rep) op
-> SimpleM rep (MCOp (Wise rep) op, Stms (Wise rep))
simplifyMCOp SimplifyOp rep op
f (OtherOp op
op) = do
(op
op', Stms (Wise rep)
stms) <- SimplifyOp rep op
f op
op
(MCOp (Wise rep) op, Stms (Wise rep))
-> SimpleM rep (MCOp (Wise rep) op, Stms (Wise rep))
forall (m :: * -> *) a. Monad m => a -> m a
return (op -> MCOp (Wise rep) op
forall rep op. op -> MCOp rep op
OtherOp op
op', Stms (Wise rep)
stms)
simplifyMCOp SimplifyOp rep op
_ (ParOp Maybe (SegOp () (Wise rep))
par_op SegOp () (Wise rep)
op) = do
(Maybe (SegOp () (Wise rep))
par_op', Stms (Wise rep)
par_op_hoisted) <-
case Maybe (SegOp () (Wise rep))
par_op of
Maybe (SegOp () (Wise rep))
Nothing -> (Maybe (SegOp () (Wise rep)), Stms (Wise rep))
-> SimpleM rep (Maybe (SegOp () (Wise rep)), Stms (Wise rep))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SegOp () (Wise rep))
forall a. Maybe a
Nothing, Stms (Wise rep)
forall a. Monoid a => a
mempty)
Just SegOp () (Wise rep)
x -> (SegOp () (Wise rep) -> Maybe (SegOp () (Wise rep)))
-> (SegOp () (Wise rep), Stms (Wise rep))
-> (Maybe (SegOp () (Wise rep)), Stms (Wise rep))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SegOp () (Wise rep) -> Maybe (SegOp () (Wise rep))
forall a. a -> Maybe a
Just ((SegOp () (Wise rep), Stms (Wise rep))
-> (Maybe (SegOp () (Wise rep)), Stms (Wise rep)))
-> SimpleM rep (SegOp () (Wise rep), Stms (Wise rep))
-> SimpleM rep (Maybe (SegOp () (Wise rep)), Stms (Wise rep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SegOp () (Wise rep)
-> SimpleM rep (SegOp () (Wise rep), Stms (Wise rep))
forall rep lvl.
(SimplifiableRep rep, BodyDec rep ~ (), Simplifiable lvl) =>
SegOp lvl (Wise rep)
-> SimpleM rep (SegOp lvl (Wise rep), Stms (Wise rep))
simplifySegOp SegOp () (Wise rep)
x
(SegOp () (Wise rep)
op', Stms (Wise rep)
op_hoisted) <- SegOp () (Wise rep)
-> SimpleM rep (SegOp () (Wise rep), Stms (Wise rep))
forall rep lvl.
(SimplifiableRep rep, BodyDec rep ~ (), Simplifiable lvl) =>
SegOp lvl (Wise rep)
-> SimpleM rep (SegOp lvl (Wise rep), Stms (Wise rep))
simplifySegOp SegOp () (Wise rep)
op
(MCOp (Wise rep) op, Stms (Wise rep))
-> SimpleM rep (MCOp (Wise rep) op, Stms (Wise rep))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SegOp () (Wise rep))
-> SegOp () (Wise rep) -> MCOp (Wise rep) op
forall rep op. Maybe (SegOp () rep) -> SegOp () rep -> MCOp rep op
ParOp Maybe (SegOp () (Wise rep))
par_op' SegOp () (Wise rep)
op', Stms (Wise rep)
par_op_hoisted Stms (Wise rep) -> Stms (Wise rep) -> Stms (Wise rep)
forall a. Semigroup a => a -> a -> a
<> Stms (Wise rep)
op_hoisted)