{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Representation used by the simplification engine.
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

-- | The wisdom of the let-bound variable.
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

-- | Wisdom about an expression.
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

-- | Wisdom about a body.
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)
stms 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)
stms Result
res),
      BodyDec rep
dec
    )
    Stms (Wise rep)
stms
    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)
stms 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)
stms 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)
stms) 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)
stms 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 () = ()