{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Futhark.Optimise.Simplify.Rep
( Wise,
VarWisdom (..),
ExpWisdom,
removeStmWisdom,
removeLambdaWisdom,
removeFunDefWisdom,
removeExpWisdom,
removePatWisdom,
removeBodyWisdom,
removeScopeWisdom,
addScopeWisdom,
addWisdomToPat,
mkWiseBody,
mkWiseLetStm,
mkWiseExpDec,
CanBeWise (..),
)
where
import Control.Category
import Control.Monad.Identity
import Control.Monad.Reader
import qualified Data.Kind
import qualified Data.Map.Strict as M
import Futhark.Analysis.Rephrase
import Futhark.Builder
import Futhark.IR
import Futhark.IR.Aliases
( AliasDec (..),
ConsumedInExp,
VarAliases,
unAliases,
)
import qualified Futhark.IR.Aliases as Aliases
import Futhark.IR.Prop.Aliases
import Futhark.Transform.Rename
import Futhark.Transform.Substitute
import Futhark.Util.Pretty
import Prelude hiding (id, (.))
data Wise rep
newtype VarWisdom = VarWisdom {VarWisdom -> VarAliases
varWisdomAliases :: VarAliases}
deriving (VarWisdom -> VarWisdom -> Bool
(VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool) -> Eq VarWisdom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarWisdom -> VarWisdom -> Bool
$c/= :: VarWisdom -> VarWisdom -> Bool
== :: VarWisdom -> VarWisdom -> Bool
$c== :: VarWisdom -> VarWisdom -> Bool
Eq, Eq VarWisdom
Eq VarWisdom
-> (VarWisdom -> VarWisdom -> Ordering)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> Bool)
-> (VarWisdom -> VarWisdom -> VarWisdom)
-> (VarWisdom -> VarWisdom -> VarWisdom)
-> Ord VarWisdom
VarWisdom -> VarWisdom -> Bool
VarWisdom -> VarWisdom -> Ordering
VarWisdom -> VarWisdom -> VarWisdom
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
min :: VarWisdom -> VarWisdom -> VarWisdom
$cmin :: VarWisdom -> VarWisdom -> VarWisdom
max :: VarWisdom -> VarWisdom -> VarWisdom
$cmax :: VarWisdom -> VarWisdom -> VarWisdom
>= :: VarWisdom -> VarWisdom -> Bool
$c>= :: VarWisdom -> VarWisdom -> Bool
> :: VarWisdom -> VarWisdom -> Bool
$c> :: VarWisdom -> VarWisdom -> Bool
<= :: VarWisdom -> VarWisdom -> Bool
$c<= :: VarWisdom -> VarWisdom -> Bool
< :: VarWisdom -> VarWisdom -> Bool
$c< :: VarWisdom -> VarWisdom -> Bool
compare :: VarWisdom -> VarWisdom -> Ordering
$ccompare :: VarWisdom -> VarWisdom -> Ordering
$cp1Ord :: Eq VarWisdom
Ord, Int -> VarWisdom -> ShowS
[VarWisdom] -> ShowS
VarWisdom -> String
(Int -> VarWisdom -> ShowS)
-> (VarWisdom -> String)
-> ([VarWisdom] -> ShowS)
-> Show VarWisdom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarWisdom] -> ShowS
$cshowList :: [VarWisdom] -> ShowS
show :: VarWisdom -> String
$cshow :: VarWisdom -> String
showsPrec :: Int -> VarWisdom -> ShowS
$cshowsPrec :: Int -> VarWisdom -> ShowS
Show)
instance Rename VarWisdom where
rename :: VarWisdom -> RenameM VarWisdom
rename = VarWisdom -> RenameM VarWisdom
forall a. Substitute a => a -> RenameM a
substituteRename
instance Substitute VarWisdom where
substituteNames :: Map VName VName -> VarWisdom -> VarWisdom
substituteNames Map VName VName
substs (VarWisdom VarAliases
als) =
VarAliases -> VarWisdom
VarWisdom (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
als)
instance FreeIn VarWisdom where
freeIn' :: VarWisdom -> FV
freeIn' (VarWisdom VarAliases
als) = VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
als
data ExpWisdom = ExpWisdom
{ ExpWisdom -> VarAliases
_expWisdomConsumed :: ConsumedInExp,
ExpWisdom -> VarAliases
expWisdomFree :: AliasDec
}
deriving (ExpWisdom -> ExpWisdom -> Bool
(ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool) -> Eq ExpWisdom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpWisdom -> ExpWisdom -> Bool
$c/= :: ExpWisdom -> ExpWisdom -> Bool
== :: ExpWisdom -> ExpWisdom -> Bool
$c== :: ExpWisdom -> ExpWisdom -> Bool
Eq, Eq ExpWisdom
Eq ExpWisdom
-> (ExpWisdom -> ExpWisdom -> Ordering)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> Bool)
-> (ExpWisdom -> ExpWisdom -> ExpWisdom)
-> (ExpWisdom -> ExpWisdom -> ExpWisdom)
-> Ord ExpWisdom
ExpWisdom -> ExpWisdom -> Bool
ExpWisdom -> ExpWisdom -> Ordering
ExpWisdom -> ExpWisdom -> ExpWisdom
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
min :: ExpWisdom -> ExpWisdom -> ExpWisdom
$cmin :: ExpWisdom -> ExpWisdom -> ExpWisdom
max :: ExpWisdom -> ExpWisdom -> ExpWisdom
$cmax :: ExpWisdom -> ExpWisdom -> ExpWisdom
>= :: ExpWisdom -> ExpWisdom -> Bool
$c>= :: ExpWisdom -> ExpWisdom -> Bool
> :: ExpWisdom -> ExpWisdom -> Bool
$c> :: ExpWisdom -> ExpWisdom -> Bool
<= :: ExpWisdom -> ExpWisdom -> Bool
$c<= :: ExpWisdom -> ExpWisdom -> Bool
< :: ExpWisdom -> ExpWisdom -> Bool
$c< :: ExpWisdom -> ExpWisdom -> Bool
compare :: ExpWisdom -> ExpWisdom -> Ordering
$ccompare :: ExpWisdom -> ExpWisdom -> Ordering
$cp1Ord :: Eq ExpWisdom
Ord, Int -> ExpWisdom -> ShowS
[ExpWisdom] -> ShowS
ExpWisdom -> String
(Int -> ExpWisdom -> ShowS)
-> (ExpWisdom -> String)
-> ([ExpWisdom] -> ShowS)
-> Show ExpWisdom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpWisdom] -> ShowS
$cshowList :: [ExpWisdom] -> ShowS
show :: ExpWisdom -> String
$cshow :: ExpWisdom -> String
showsPrec :: Int -> ExpWisdom -> ShowS
$cshowsPrec :: Int -> ExpWisdom -> ShowS
Show)
instance FreeIn ExpWisdom where
freeIn' :: ExpWisdom -> FV
freeIn' = ExpWisdom -> FV
forall a. Monoid a => a
mempty
instance FreeDec ExpWisdom where
precomputed :: ExpWisdom -> FV -> FV
precomputed = FV -> FV -> FV
forall a b. a -> b -> a
const (FV -> FV -> FV) -> (ExpWisdom -> FV) -> ExpWisdom -> FV -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Names -> FV
fvNames (Names -> FV) -> (ExpWisdom -> Names) -> ExpWisdom -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VarAliases -> Names
unAliases (VarAliases -> Names)
-> (ExpWisdom -> VarAliases) -> ExpWisdom -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExpWisdom -> VarAliases
expWisdomFree
instance Substitute ExpWisdom where
substituteNames :: Map VName VName -> ExpWisdom -> ExpWisdom
substituteNames Map VName VName
substs (ExpWisdom VarAliases
cons VarAliases
free) =
VarAliases -> VarAliases -> ExpWisdom
ExpWisdom
(Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
cons)
(Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
free)
instance Rename ExpWisdom where
rename :: ExpWisdom -> RenameM ExpWisdom
rename = ExpWisdom -> RenameM ExpWisdom
forall a. Substitute a => a -> RenameM a
substituteRename
data BodyWisdom = BodyWisdom
{ BodyWisdom -> [VarAliases]
bodyWisdomAliases :: [VarAliases],
BodyWisdom -> VarAliases
bodyWisdomConsumed :: ConsumedInExp,
BodyWisdom -> VarAliases
bodyWisdomFree :: AliasDec
}
deriving (BodyWisdom -> BodyWisdom -> Bool
(BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool) -> Eq BodyWisdom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodyWisdom -> BodyWisdom -> Bool
$c/= :: BodyWisdom -> BodyWisdom -> Bool
== :: BodyWisdom -> BodyWisdom -> Bool
$c== :: BodyWisdom -> BodyWisdom -> Bool
Eq, Eq BodyWisdom
Eq BodyWisdom
-> (BodyWisdom -> BodyWisdom -> Ordering)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> Bool)
-> (BodyWisdom -> BodyWisdom -> BodyWisdom)
-> (BodyWisdom -> BodyWisdom -> BodyWisdom)
-> Ord BodyWisdom
BodyWisdom -> BodyWisdom -> Bool
BodyWisdom -> BodyWisdom -> Ordering
BodyWisdom -> BodyWisdom -> BodyWisdom
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
min :: BodyWisdom -> BodyWisdom -> BodyWisdom
$cmin :: BodyWisdom -> BodyWisdom -> BodyWisdom
max :: BodyWisdom -> BodyWisdom -> BodyWisdom
$cmax :: BodyWisdom -> BodyWisdom -> BodyWisdom
>= :: BodyWisdom -> BodyWisdom -> Bool
$c>= :: BodyWisdom -> BodyWisdom -> Bool
> :: BodyWisdom -> BodyWisdom -> Bool
$c> :: BodyWisdom -> BodyWisdom -> Bool
<= :: BodyWisdom -> BodyWisdom -> Bool
$c<= :: BodyWisdom -> BodyWisdom -> Bool
< :: BodyWisdom -> BodyWisdom -> Bool
$c< :: BodyWisdom -> BodyWisdom -> Bool
compare :: BodyWisdom -> BodyWisdom -> Ordering
$ccompare :: BodyWisdom -> BodyWisdom -> Ordering
$cp1Ord :: Eq BodyWisdom
Ord, Int -> BodyWisdom -> ShowS
[BodyWisdom] -> ShowS
BodyWisdom -> String
(Int -> BodyWisdom -> ShowS)
-> (BodyWisdom -> String)
-> ([BodyWisdom] -> ShowS)
-> Show BodyWisdom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyWisdom] -> ShowS
$cshowList :: [BodyWisdom] -> ShowS
show :: BodyWisdom -> String
$cshow :: BodyWisdom -> String
showsPrec :: Int -> BodyWisdom -> ShowS
$cshowsPrec :: Int -> BodyWisdom -> ShowS
Show)
instance Rename BodyWisdom where
rename :: BodyWisdom -> RenameM BodyWisdom
rename = BodyWisdom -> RenameM BodyWisdom
forall a. Substitute a => a -> RenameM a
substituteRename
instance Substitute BodyWisdom where
substituteNames :: Map VName VName -> BodyWisdom -> BodyWisdom
substituteNames Map VName VName
substs (BodyWisdom [VarAliases]
als VarAliases
cons VarAliases
free) =
[VarAliases] -> VarAliases -> VarAliases -> BodyWisdom
BodyWisdom
(Map VName VName -> [VarAliases] -> [VarAliases]
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs [VarAliases]
als)
(Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
cons)
(Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
free)
instance FreeIn BodyWisdom where
freeIn' :: BodyWisdom -> FV
freeIn' (BodyWisdom [VarAliases]
als VarAliases
cons VarAliases
free) =
[VarAliases] -> FV
forall a. FreeIn a => a -> FV
freeIn' [VarAliases]
als FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
cons FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
free
instance FreeDec BodyWisdom where
precomputed :: BodyWisdom -> FV -> FV
precomputed = FV -> FV -> FV
forall a b. a -> b -> a
const (FV -> FV -> FV) -> (BodyWisdom -> FV) -> BodyWisdom -> FV -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Names -> FV
fvNames (Names -> FV) -> (BodyWisdom -> Names) -> BodyWisdom -> FV
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VarAliases -> Names
unAliases (VarAliases -> Names)
-> (BodyWisdom -> VarAliases) -> BodyWisdom -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BodyWisdom -> VarAliases
bodyWisdomFree
instance (RepTypes rep, CanBeWise (Op rep)) => RepTypes (Wise rep) where
type LetDec (Wise rep) = (VarWisdom, LetDec rep)
type ExpDec (Wise rep) = (ExpWisdom, ExpDec rep)
type BodyDec (Wise rep) = (BodyWisdom, BodyDec rep)
type FParamInfo (Wise rep) = FParamInfo rep
type LParamInfo (Wise rep) = LParamInfo rep
type RetType (Wise rep) = RetType rep
type BranchType (Wise rep) = BranchType rep
type Op (Wise rep) = OpWithWisdom (Op rep)
withoutWisdom ::
(HasScope (Wise rep) m, Monad m) =>
ReaderT (Scope rep) m a ->
m a
withoutWisdom :: ReaderT (Scope rep) m a -> m a
withoutWisdom ReaderT (Scope rep) m a
m = do
Scope rep
scope <- (Scope (Wise rep) -> Scope rep) -> m (Scope rep)
forall rep (m :: * -> *) a.
HasScope rep m =>
(Scope rep -> a) -> m a
asksScope Scope (Wise rep) -> Scope rep
forall rep. Scope (Wise rep) -> Scope rep
removeScopeWisdom
ReaderT (Scope rep) m a -> Scope rep -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Scope rep) m a
m Scope rep
scope
instance (ASTRep rep, CanBeWise (Op rep)) => ASTRep (Wise rep) where
expTypesFromPat :: Pat (Wise rep) -> m [BranchType (Wise rep)]
expTypesFromPat =
ReaderT (Scope rep) m [BranchType rep] -> m [BranchType rep]
forall rep (m :: * -> *) a.
(HasScope (Wise rep) m, Monad m) =>
ReaderT (Scope rep) m a -> m a
withoutWisdom (ReaderT (Scope rep) m [BranchType rep] -> m [BranchType rep])
-> (PatT (VarWisdom, LetDec rep)
-> ReaderT (Scope rep) m [BranchType rep])
-> PatT (VarWisdom, LetDec rep)
-> m [BranchType rep]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PatT (LetDec rep) -> ReaderT (Scope rep) m [BranchType rep]
forall rep (m :: * -> *).
(ASTRep rep, HasScope rep m, Monad m) =>
Pat rep -> m [BranchType rep]
expTypesFromPat (PatT (LetDec rep) -> ReaderT (Scope rep) m [BranchType rep])
-> (PatT (VarWisdom, LetDec rep) -> PatT (LetDec rep))
-> PatT (VarWisdom, LetDec rep)
-> ReaderT (Scope rep) m [BranchType rep]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PatT (VarWisdom, LetDec rep) -> PatT (LetDec rep)
forall a. PatT (VarWisdom, a) -> PatT a
removePatWisdom
instance Pretty VarWisdom where
ppr :: VarWisdom -> Doc
ppr VarWisdom
_ = () -> Doc
forall a. Pretty a => a -> Doc
ppr ()
instance (PrettyRep rep, CanBeWise (Op rep)) => PrettyRep (Wise rep) where
ppExpDec :: ExpDec (Wise rep) -> Exp (Wise rep) -> Maybe Doc
ppExpDec (_, dec) = ExpDec rep -> Exp rep -> Maybe Doc
forall rep. PrettyRep rep => ExpDec rep -> Exp rep -> Maybe Doc
ppExpDec ExpDec rep
dec (Exp rep -> Maybe Doc)
-> (Exp (Wise rep) -> Exp rep) -> Exp (Wise rep) -> Maybe Doc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Exp (Wise rep) -> Exp rep
forall rep. CanBeWise (Op rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom
instance AliasesOf (VarWisdom, dec) where
aliasesOf :: (VarWisdom, dec) -> Names
aliasesOf = VarAliases -> Names
unAliases (VarAliases -> Names)
-> ((VarWisdom, dec) -> VarAliases) -> (VarWisdom, dec) -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VarWisdom -> VarAliases
varWisdomAliases (VarWisdom -> VarAliases)
-> ((VarWisdom, dec) -> VarWisdom)
-> (VarWisdom, dec)
-> VarAliases
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VarWisdom, dec) -> VarWisdom
forall a b. (a, b) -> a
fst
instance (ASTRep rep, CanBeWise (Op rep)) => Aliased (Wise rep) where
bodyAliases :: Body (Wise rep) -> [Names]
bodyAliases = (VarAliases -> Names) -> [VarAliases] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map VarAliases -> Names
unAliases ([VarAliases] -> [Names])
-> (Body (Wise rep) -> [VarAliases]) -> Body (Wise rep) -> [Names]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BodyWisdom -> [VarAliases]
bodyWisdomAliases (BodyWisdom -> [VarAliases])
-> (Body (Wise rep) -> BodyWisdom)
-> Body (Wise rep)
-> [VarAliases]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BodyWisdom, BodyDec rep) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyDec rep) -> BodyWisdom)
-> (Body (Wise rep) -> (BodyWisdom, BodyDec rep))
-> Body (Wise rep)
-> BodyWisdom
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body (Wise rep) -> (BodyWisdom, BodyDec rep)
forall rep. BodyT rep -> BodyDec rep
bodyDec
consumedInBody :: Body (Wise rep) -> Names
consumedInBody = VarAliases -> Names
unAliases (VarAliases -> Names)
-> (Body (Wise rep) -> VarAliases) -> Body (Wise rep) -> Names
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BodyWisdom -> VarAliases
bodyWisdomConsumed (BodyWisdom -> VarAliases)
-> (Body (Wise rep) -> BodyWisdom) -> Body (Wise rep) -> VarAliases
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BodyWisdom, BodyDec rep) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyDec rep) -> BodyWisdom)
-> (Body (Wise rep) -> (BodyWisdom, BodyDec rep))
-> Body (Wise rep)
-> BodyWisdom
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body (Wise rep) -> (BodyWisdom, BodyDec rep)
forall rep. BodyT rep -> BodyDec rep
bodyDec
removeWisdom :: CanBeWise (Op rep) => Rephraser Identity (Wise rep) rep
removeWisdom :: Rephraser Identity (Wise rep) rep
removeWisdom =
Rephraser :: forall (m :: * -> *) from to.
(ExpDec from -> m (ExpDec to))
-> (LetDec from -> m (LetDec to))
-> (FParamInfo from -> m (FParamInfo to))
-> (LParamInfo from -> m (LParamInfo to))
-> (BodyDec from -> m (BodyDec to))
-> (RetType from -> m (RetType to))
-> (BranchType from -> m (BranchType to))
-> (Op from -> m (Op to))
-> Rephraser m from to
Rephraser
{ rephraseExpDec :: ExpDec (Wise rep) -> Identity (ExpDec rep)
rephraseExpDec = ExpDec rep -> Identity (ExpDec rep)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpDec rep -> Identity (ExpDec rep))
-> ((ExpWisdom, ExpDec rep) -> ExpDec rep)
-> (ExpWisdom, ExpDec rep)
-> Identity (ExpDec rep)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ExpWisdom, ExpDec rep) -> ExpDec rep
forall a b. (a, b) -> b
snd,
rephraseLetBoundDec :: LetDec (Wise rep) -> Identity (LetDec rep)
rephraseLetBoundDec = LetDec rep -> Identity (LetDec rep)
forall (m :: * -> *) a. Monad m => a -> m a
return (LetDec rep -> Identity (LetDec rep))
-> ((VarWisdom, LetDec rep) -> LetDec rep)
-> (VarWisdom, LetDec rep)
-> Identity (LetDec rep)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VarWisdom, LetDec rep) -> LetDec rep
forall a b. (a, b) -> b
snd,
rephraseBodyDec :: BodyDec (Wise rep) -> Identity (BodyDec rep)
rephraseBodyDec = BodyDec rep -> Identity (BodyDec rep)
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyDec rep -> Identity (BodyDec rep))
-> ((BodyWisdom, BodyDec rep) -> BodyDec rep)
-> (BodyWisdom, BodyDec rep)
-> Identity (BodyDec rep)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BodyWisdom, BodyDec rep) -> BodyDec rep
forall a b. (a, b) -> b
snd,
rephraseFParamDec :: FParamInfo (Wise rep) -> Identity (FParamInfo rep)
rephraseFParamDec = FParamInfo (Wise rep) -> Identity (FParamInfo rep)
forall (m :: * -> *) a. Monad m => a -> m a
return,
rephraseLParamDec :: LParamInfo (Wise rep) -> Identity (LParamInfo rep)
rephraseLParamDec = LParamInfo (Wise rep) -> Identity (LParamInfo rep)
forall (m :: * -> *) a. Monad m => a -> m a
return,
rephraseRetType :: RetType (Wise rep) -> Identity (RetType rep)
rephraseRetType = RetType (Wise rep) -> Identity (RetType rep)
forall (m :: * -> *) a. Monad m => a -> m a
return,
rephraseBranchType :: BranchType (Wise rep) -> Identity (BranchType rep)
rephraseBranchType = BranchType (Wise rep) -> Identity (BranchType rep)
forall (m :: * -> *) a. Monad m => a -> m a
return,
rephraseOp :: Op (Wise rep) -> Identity (Op rep)
rephraseOp = Op rep -> Identity (Op rep)
forall (m :: * -> *) a. Monad m => a -> m a
return (Op rep -> Identity (Op rep))
-> (OpWithWisdom (Op rep) -> Op rep)
-> OpWithWisdom (Op rep)
-> Identity (Op rep)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OpWithWisdom (Op rep) -> Op rep
forall op. CanBeWise op => OpWithWisdom op -> op
removeOpWisdom
}
removeScopeWisdom :: Scope (Wise rep) -> Scope rep
removeScopeWisdom :: Scope (Wise rep) -> Scope rep
removeScopeWisdom = (NameInfo (Wise rep) -> NameInfo rep)
-> Scope (Wise rep) -> Scope rep
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo (Wise rep) -> NameInfo rep
forall rep a rep.
(LetDec rep ~ (a, LetDec rep), FParamInfo rep ~ FParamInfo rep,
LParamInfo rep ~ LParamInfo rep) =>
NameInfo rep -> NameInfo rep
unAlias
where
unAlias :: NameInfo rep -> NameInfo rep
unAlias (LetName (_, dec)) = LetDec rep -> NameInfo rep
forall rep. LetDec rep -> NameInfo rep
LetName LetDec rep
dec
unAlias (FParamName FParamInfo rep
dec) = FParamInfo rep -> NameInfo rep
forall rep. FParamInfo rep -> NameInfo rep
FParamName FParamInfo rep
FParamInfo rep
dec
unAlias (LParamName LParamInfo rep
dec) = LParamInfo rep -> NameInfo rep
forall rep. LParamInfo rep -> NameInfo rep
LParamName LParamInfo rep
LParamInfo rep
dec
unAlias (IndexName IntType
it) = IntType -> NameInfo rep
forall rep. IntType -> NameInfo rep
IndexName IntType
it
addScopeWisdom :: Scope rep -> Scope (Wise rep)
addScopeWisdom :: Scope rep -> Scope (Wise rep)
addScopeWisdom = (NameInfo rep -> NameInfo (Wise rep))
-> Scope rep -> Scope (Wise rep)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo rep -> NameInfo (Wise rep)
forall rep rep.
(LetDec rep ~ (VarWisdom, LetDec rep),
FParamInfo rep ~ FParamInfo rep,
LParamInfo rep ~ LParamInfo rep) =>
NameInfo rep -> NameInfo rep
alias
where
alias :: NameInfo rep -> NameInfo rep
alias (LetName LetDec rep
dec) = LetDec rep -> NameInfo rep
forall rep. LetDec rep -> NameInfo rep
LetName (VarAliases -> VarWisdom
VarWisdom VarAliases
forall a. Monoid a => a
mempty, LetDec rep
dec)
alias (FParamName FParamInfo rep
dec) = FParamInfo rep -> NameInfo rep
forall rep. FParamInfo rep -> NameInfo rep
FParamName FParamInfo rep
FParamInfo rep
dec
alias (LParamName LParamInfo rep
dec) = LParamInfo rep -> NameInfo rep
forall rep. LParamInfo rep -> NameInfo rep
LParamName LParamInfo rep
LParamInfo rep
dec
alias (IndexName IntType
it) = IntType -> NameInfo rep
forall rep. IntType -> NameInfo rep
IndexName IntType
it
removeFunDefWisdom :: CanBeWise (Op rep) => FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom :: FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom = Identity (FunDef rep) -> FunDef rep
forall a. Identity a -> a
runIdentity (Identity (FunDef rep) -> FunDef rep)
-> (FunDef (Wise rep) -> Identity (FunDef rep))
-> FunDef (Wise rep)
-> FunDef rep
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise rep) rep
-> FunDef (Wise rep) -> Identity (FunDef rep)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> FunDef from -> m (FunDef to)
rephraseFunDef Rephraser Identity (Wise rep) rep
forall rep. CanBeWise (Op rep) => Rephraser Identity (Wise rep) rep
removeWisdom
removeStmWisdom :: CanBeWise (Op rep) => Stm (Wise rep) -> Stm rep
removeStmWisdom :: Stm (Wise rep) -> Stm rep
removeStmWisdom = Identity (Stm rep) -> Stm rep
forall a. Identity a -> a
runIdentity (Identity (Stm rep) -> Stm rep)
-> (Stm (Wise rep) -> Identity (Stm rep))
-> Stm (Wise rep)
-> Stm rep
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise rep) rep
-> Stm (Wise rep) -> Identity (Stm rep)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser Identity (Wise rep) rep
forall rep. CanBeWise (Op rep) => Rephraser Identity (Wise rep) rep
removeWisdom
removeLambdaWisdom :: CanBeWise (Op rep) => Lambda (Wise rep) -> Lambda rep
removeLambdaWisdom :: Lambda (Wise rep) -> Lambda rep
removeLambdaWisdom = Identity (Lambda rep) -> Lambda rep
forall a. Identity a -> a
runIdentity (Identity (Lambda rep) -> Lambda rep)
-> (Lambda (Wise rep) -> Identity (Lambda rep))
-> Lambda (Wise rep)
-> Lambda rep
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise rep) rep
-> Lambda (Wise rep) -> Identity (Lambda rep)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Lambda from -> m (Lambda to)
rephraseLambda Rephraser Identity (Wise rep) rep
forall rep. CanBeWise (Op rep) => Rephraser Identity (Wise rep) rep
removeWisdom
removeBodyWisdom :: CanBeWise (Op rep) => Body (Wise rep) -> Body rep
removeBodyWisdom :: Body (Wise rep) -> Body rep
removeBodyWisdom = Identity (Body rep) -> Body rep
forall a. Identity a -> a
runIdentity (Identity (Body rep) -> Body rep)
-> (Body (Wise rep) -> Identity (Body rep))
-> Body (Wise rep)
-> Body rep
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise rep) rep
-> Body (Wise rep) -> Identity (Body rep)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser Identity (Wise rep) rep
forall rep. CanBeWise (Op rep) => Rephraser Identity (Wise rep) rep
removeWisdom
removeExpWisdom :: CanBeWise (Op rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom :: Exp (Wise rep) -> Exp rep
removeExpWisdom = Identity (Exp rep) -> Exp rep
forall a. Identity a -> a
runIdentity (Identity (Exp rep) -> Exp rep)
-> (Exp (Wise rep) -> Identity (Exp rep))
-> Exp (Wise rep)
-> Exp rep
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rephraser Identity (Wise rep) rep
-> Exp (Wise rep) -> Identity (Exp rep)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp Rephraser Identity (Wise rep) rep
forall rep. CanBeWise (Op rep) => Rephraser Identity (Wise rep) rep
removeWisdom
removePatWisdom :: PatT (VarWisdom, a) -> PatT a
removePatWisdom :: PatT (VarWisdom, a) -> PatT a
removePatWisdom = Identity (PatT a) -> PatT a
forall a. Identity a -> a
runIdentity (Identity (PatT a) -> PatT a)
-> (PatT (VarWisdom, a) -> Identity (PatT a))
-> PatT (VarWisdom, a)
-> PatT a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((VarWisdom, a) -> Identity a)
-> PatT (VarWisdom, a) -> Identity (PatT a)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> PatT from -> m (PatT to)
rephrasePat (a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Identity a)
-> ((VarWisdom, a) -> a) -> (VarWisdom, a) -> Identity a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VarWisdom, a) -> a
forall a b. (a, b) -> b
snd)
addWisdomToPat ::
(ASTRep rep, CanBeWise (Op rep)) =>
Pat rep ->
Exp (Wise rep) ->
Pat (Wise rep)
addWisdomToPat :: Pat rep -> Exp (Wise rep) -> Pat (Wise rep)
addWisdomToPat Pat rep
pat Exp (Wise rep)
e =
[PatElemT (VarWisdom, LetDec rep)] -> PatT (VarWisdom, LetDec rep)
forall dec. [PatElemT dec] -> PatT dec
Pat ([PatElemT (VarWisdom, LetDec rep)]
-> PatT (VarWisdom, LetDec rep))
-> [PatElemT (VarWisdom, LetDec rep)]
-> PatT (VarWisdom, LetDec rep)
forall a b. (a -> b) -> a -> b
$ (PatElemT (VarAliases, LetDec rep)
-> PatElemT (VarWisdom, LetDec rep))
-> [PatElemT (VarAliases, LetDec rep)]
-> [PatElemT (VarWisdom, LetDec rep)]
forall a b. (a -> b) -> [a] -> [b]
map PatElemT (VarAliases, LetDec rep)
-> PatElemT (VarWisdom, LetDec rep)
forall b. PatElemT (VarAliases, b) -> PatElemT (VarWisdom, b)
f ([PatElemT (VarAliases, LetDec rep)]
-> [PatElemT (VarWisdom, LetDec rep)])
-> [PatElemT (VarAliases, LetDec rep)]
-> [PatElemT (VarWisdom, LetDec rep)]
forall a b. (a -> b) -> a -> b
$ Pat rep -> Exp (Wise rep) -> [PatElemT (VarAliases, LetDec rep)]
forall rep dec.
(Aliased rep, Typed dec) =>
PatT dec -> Exp rep -> [PatElemT (VarAliases, dec)]
Aliases.mkPatAliases Pat rep
pat Exp (Wise rep)
e
where
f :: PatElemT (VarAliases, b) -> PatElemT (VarWisdom, b)
f PatElemT (VarAliases, b)
pe =
let (VarAliases
als, b
dec) = PatElemT (VarAliases, b) -> (VarAliases, b)
forall dec. PatElemT dec -> dec
patElemDec PatElemT (VarAliases, b)
pe
in PatElemT (VarAliases, b)
pe PatElemT (VarAliases, b)
-> (VarWisdom, b) -> PatElemT (VarWisdom, b)
forall oldattr newattr.
PatElemT oldattr -> newattr -> PatElemT newattr
`setPatElemDec` (VarAliases -> VarWisdom
VarWisdom VarAliases
als, b
dec)
mkWiseBody ::
(ASTRep rep, CanBeWise (Op rep)) =>
BodyDec rep ->
Stms (Wise rep) ->
Result ->
Body (Wise rep)
mkWiseBody :: BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
mkWiseBody BodyDec rep
dec Stms (Wise rep)
bnds Result
res =
BodyDec (Wise rep) -> Stms (Wise rep) -> Result -> Body (Wise rep)
forall rep. BodyDec rep -> Stms rep -> Result -> BodyT rep
Body
( [VarAliases] -> VarAliases -> VarAliases -> BodyWisdom
BodyWisdom [VarAliases]
aliases VarAliases
consumed (Names -> VarAliases
AliasDec (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ FV -> Names
forall a. FreeIn a => a -> Names
freeIn (FV -> Names) -> FV -> Names
forall a b. (a -> b) -> a -> b
$ Stms (Wise rep) -> Result -> FV
forall rep.
(FreeIn (Op rep), FreeIn (LetDec rep), FreeIn (LParamInfo rep),
FreeIn (FParamInfo rep), FreeDec (BodyDec rep),
FreeIn (RetType rep), FreeIn (BranchType rep),
FreeDec (ExpDec rep)) =>
Stms rep -> Result -> FV
freeInStmsAndRes Stms (Wise rep)
bnds Result
res),
BodyDec rep
dec
)
Stms (Wise rep)
bnds
Result
res
where
([VarAliases]
aliases, VarAliases
consumed) = Stms (Wise rep) -> Result -> ([VarAliases], VarAliases)
forall rep.
Aliased rep =>
Stms rep -> Result -> ([VarAliases], VarAliases)
Aliases.mkBodyAliases Stms (Wise rep)
bnds Result
res
mkWiseLetStm ::
(ASTRep rep, CanBeWise (Op rep)) =>
Pat rep ->
StmAux (ExpDec rep) ->
Exp (Wise rep) ->
Stm (Wise rep)
mkWiseLetStm :: Pat rep -> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
mkWiseLetStm Pat rep
pat (StmAux Certs
cs Attrs
attrs ExpDec rep
dec) Exp (Wise rep)
e =
let pat' :: Pat (Wise rep)
pat' = Pat rep -> Exp (Wise rep) -> Pat (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pat rep -> Exp (Wise rep) -> Pat (Wise rep)
addWisdomToPat Pat rep
pat Exp (Wise rep)
e
in Pat (Wise rep)
-> StmAux (ExpDec (Wise rep)) -> Exp (Wise rep) -> Stm (Wise rep)
forall rep. Pat rep -> StmAux (ExpDec rep) -> Exp rep -> Stm rep
Let Pat (Wise rep)
pat' (Certs
-> Attrs
-> (ExpWisdom, ExpDec rep)
-> StmAux (ExpWisdom, ExpDec rep)
forall dec. Certs -> Attrs -> dec -> StmAux dec
StmAux Certs
cs Attrs
attrs ((ExpWisdom, ExpDec rep) -> StmAux (ExpWisdom, ExpDec rep))
-> (ExpWisdom, ExpDec rep) -> StmAux (ExpWisdom, ExpDec rep)
forall a b. (a -> b) -> a -> b
$ Pat (Wise rep) -> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pat (Wise rep) -> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
mkWiseExpDec Pat (Wise rep)
pat' ExpDec rep
dec Exp (Wise rep)
e) Exp (Wise rep)
e
mkWiseExpDec ::
(ASTRep rep, CanBeWise (Op rep)) =>
Pat (Wise rep) ->
ExpDec rep ->
Exp (Wise rep) ->
ExpDec (Wise rep)
mkWiseExpDec :: Pat (Wise rep) -> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
mkWiseExpDec Pat (Wise rep)
pat ExpDec rep
expdec Exp (Wise rep)
e =
( VarAliases -> VarAliases -> ExpWisdom
ExpWisdom
(Names -> VarAliases
AliasDec (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ Exp (Wise rep) -> Names
forall rep. Aliased rep => Exp rep -> Names
consumedInExp Exp (Wise rep)
e)
(Names -> VarAliases
AliasDec (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ PatT (VarWisdom, LetDec rep) -> Names
forall a. FreeIn a => a -> Names
freeIn PatT (VarWisdom, LetDec rep)
Pat (Wise rep)
pat Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> ExpDec rep -> Names
forall a. FreeIn a => a -> Names
freeIn ExpDec rep
expdec Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Exp (Wise rep) -> Names
forall a. FreeIn a => a -> Names
freeIn Exp (Wise rep)
e),
ExpDec rep
expdec
)
instance (Buildable rep, CanBeWise (Op rep)) => Buildable (Wise rep) where
mkExpPat :: [Ident] -> Exp (Wise rep) -> Pat (Wise rep)
mkExpPat [Ident]
ids Exp (Wise rep)
e =
Pat rep -> Exp (Wise rep) -> Pat (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pat rep -> Exp (Wise rep) -> Pat (Wise rep)
addWisdomToPat ([Ident] -> Exp rep -> Pat rep
forall rep. Buildable rep => [Ident] -> Exp rep -> Pat rep
mkExpPat [Ident]
ids (Exp rep -> Pat rep) -> Exp rep -> Pat rep
forall a b. (a -> b) -> a -> b
$ Exp (Wise rep) -> Exp rep
forall rep. CanBeWise (Op rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom Exp (Wise rep)
e) Exp (Wise rep)
e
mkExpDec :: Pat (Wise rep) -> Exp (Wise rep) -> ExpDec (Wise rep)
mkExpDec Pat (Wise rep)
pat Exp (Wise rep)
e =
Pat (Wise rep) -> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pat (Wise rep) -> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
mkWiseExpDec Pat (Wise rep)
pat (Pat rep -> Exp rep -> ExpDec rep
forall rep. Buildable rep => Pat rep -> Exp rep -> ExpDec rep
mkExpDec (PatT (VarWisdom, LetDec rep) -> Pat rep
forall a. PatT (VarWisdom, a) -> PatT a
removePatWisdom PatT (VarWisdom, LetDec rep)
Pat (Wise rep)
pat) (Exp rep -> ExpDec rep) -> Exp rep -> ExpDec rep
forall a b. (a -> b) -> a -> b
$ Exp (Wise rep) -> Exp rep
forall rep. CanBeWise (Op rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom Exp (Wise rep)
e) Exp (Wise rep)
e
mkLetNames :: [VName] -> Exp (Wise rep) -> m (Stm (Wise rep))
mkLetNames [VName]
names Exp (Wise rep)
e = do
Scope rep
env <- (Scope (Wise rep) -> Scope rep) -> m (Scope rep)
forall rep (m :: * -> *) a.
HasScope rep m =>
(Scope rep -> a) -> m a
asksScope Scope (Wise rep) -> Scope rep
forall rep. Scope (Wise rep) -> Scope rep
removeScopeWisdom
(ReaderT (Scope rep) m (Stm (Wise rep))
-> Scope rep -> m (Stm (Wise rep)))
-> Scope rep
-> ReaderT (Scope rep) m (Stm (Wise rep))
-> m (Stm (Wise rep))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Scope rep) m (Stm (Wise rep))
-> Scope rep -> m (Stm (Wise rep))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Scope rep
env (ReaderT (Scope rep) m (Stm (Wise rep)) -> m (Stm (Wise rep)))
-> ReaderT (Scope rep) m (Stm (Wise rep)) -> m (Stm (Wise rep))
forall a b. (a -> b) -> a -> b
$ do
Let Pat rep
pat StmAux (ExpDec rep)
dec Exp rep
_ <- [VName] -> Exp rep -> ReaderT (Scope rep) m (Stm rep)
forall rep (m :: * -> *).
(Buildable rep, MonadFreshNames m, HasScope rep m) =>
[VName] -> Exp rep -> m (Stm rep)
mkLetNames [VName]
names (Exp rep -> ReaderT (Scope rep) m (Stm rep))
-> Exp rep -> ReaderT (Scope rep) m (Stm rep)
forall a b. (a -> b) -> a -> b
$ Exp (Wise rep) -> Exp rep
forall rep. CanBeWise (Op rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom Exp (Wise rep)
e
Stm (Wise rep) -> ReaderT (Scope rep) m (Stm (Wise rep))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stm (Wise rep) -> ReaderT (Scope rep) m (Stm (Wise rep)))
-> Stm (Wise rep) -> ReaderT (Scope rep) m (Stm (Wise rep))
forall a b. (a -> b) -> a -> b
$ Pat rep -> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
Pat rep -> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
mkWiseLetStm Pat rep
pat StmAux (ExpDec rep)
dec Exp (Wise rep)
e
mkBody :: Stms (Wise rep) -> Result -> Body (Wise rep)
mkBody Stms (Wise rep)
bnds Result
res =
let Body BodyDec rep
bodyrep Stms rep
_ Result
_ = Stms rep -> Result -> BodyT rep
forall rep. Buildable rep => Stms rep -> Result -> Body rep
mkBody ((Stm (Wise rep) -> Stm rep) -> Stms (Wise rep) -> Stms rep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm (Wise rep) -> Stm rep
forall rep. CanBeWise (Op rep) => Stm (Wise rep) -> Stm rep
removeStmWisdom Stms (Wise rep)
bnds) Result
res
in BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
forall rep.
(ASTRep rep, CanBeWise (Op rep)) =>
BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
mkWiseBody BodyDec rep
bodyrep Stms (Wise rep)
bnds Result
res
class
( AliasedOp (OpWithWisdom op),
IsOp (OpWithWisdom op)
) =>
CanBeWise op
where
type OpWithWisdom op :: Data.Kind.Type
removeOpWisdom :: OpWithWisdom op -> op
instance CanBeWise () where
type OpWithWisdom () = ()
removeOpWisdom :: OpWithWisdom () -> ()
removeOpWisdom () = ()