{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | Representation used by the simplification engine.  It contains
-- aliasing information and a bit of caching for various information
-- that is looked up frequently.  The name is an old relic; feel free
-- to suggest a better one.
module Futhark.Optimise.Simplify.Rep
  ( Wise,
    VarWisdom (..),
    ExpWisdom,
    removeStmWisdom,
    removeLambdaWisdom,
    removeFunDefWisdom,
    removeExpWisdom,
    removePatWisdom,
    removeBodyWisdom,
    removeScopeWisdom,
    addScopeWisdom,
    addWisdomToPat,
    mkWiseBody,
    mkWiseStm,
    mkWiseExpDec,
    CanBeWise (..),

    -- * Constructing representation
    Informing,
    informLambda,
    informFunDef,
    informStms,
    informBody,
  )
where

import Control.Category
import Control.Monad.Identity
import Control.Monad.Reader
import Data.Map.Strict qualified as M
import Futhark.Builder
import Futhark.IR
import Futhark.IR.Aliases
  ( AliasDec (..),
    ConsumedInExp,
    VarAliases,
    unAliases,
  )
import Futhark.IR.Aliases qualified as Aliases
import Futhark.IR.Prop.Aliases
import Futhark.Transform.Rename
import Futhark.Transform.Substitute
import Futhark.Util.Pretty
import Prelude hiding (id, (.))

-- | Representative phantom type for the simplifier representation.
data Wise rep

-- | The information associated with a 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
$c== :: VarWisdom -> VarWisdom -> Bool
== :: VarWisdom -> VarWisdom -> Bool
$c/= :: VarWisdom -> VarWisdom -> Bool
/= :: 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
$ccompare :: VarWisdom -> VarWisdom -> Ordering
compare :: VarWisdom -> VarWisdom -> Ordering
$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
>= :: VarWisdom -> VarWisdom -> Bool
$cmax :: VarWisdom -> VarWisdom -> VarWisdom
max :: VarWisdom -> VarWisdom -> VarWisdom
$cmin :: VarWisdom -> VarWisdom -> VarWisdom
min :: VarWisdom -> VarWisdom -> 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
$cshowsPrec :: Int -> VarWisdom -> ShowS
showsPrec :: Int -> VarWisdom -> ShowS
$cshow :: VarWisdom -> String
show :: VarWisdom -> String
$cshowList :: [VarWisdom] -> ShowS
showList :: [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

-- | Simplifier information about an expression.
data ExpWisdom = ExpWisdom
  { ExpWisdom -> VarAliases
_expWisdomConsumed :: ConsumedInExp,
    -- | The free variables in the expression.
    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
$c== :: ExpWisdom -> ExpWisdom -> Bool
== :: ExpWisdom -> ExpWisdom -> Bool
$c/= :: ExpWisdom -> ExpWisdom -> Bool
/= :: 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
$ccompare :: ExpWisdom -> ExpWisdom -> Ordering
compare :: ExpWisdom -> ExpWisdom -> Ordering
$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
>= :: ExpWisdom -> ExpWisdom -> Bool
$cmax :: ExpWisdom -> ExpWisdom -> ExpWisdom
max :: ExpWisdom -> ExpWisdom -> ExpWisdom
$cmin :: ExpWisdom -> ExpWisdom -> ExpWisdom
min :: ExpWisdom -> ExpWisdom -> 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
$cshowsPrec :: Int -> ExpWisdom -> ShowS
showsPrec :: Int -> ExpWisdom -> ShowS
$cshow :: ExpWisdom -> String
show :: ExpWisdom -> String
$cshowList :: [ExpWisdom] -> ShowS
showList :: [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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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

-- | Simplifier information 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
$c== :: BodyWisdom -> BodyWisdom -> Bool
== :: BodyWisdom -> BodyWisdom -> Bool
$c/= :: BodyWisdom -> BodyWisdom -> Bool
/= :: 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
$ccompare :: BodyWisdom -> BodyWisdom -> Ordering
compare :: BodyWisdom -> BodyWisdom -> Ordering
$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
>= :: BodyWisdom -> BodyWisdom -> Bool
$cmax :: BodyWisdom -> BodyWisdom -> BodyWisdom
max :: BodyWisdom -> BodyWisdom -> BodyWisdom
$cmin :: BodyWisdom -> BodyWisdom -> BodyWisdom
min :: BodyWisdom -> BodyWisdom -> 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
$cshowsPrec :: Int -> BodyWisdom -> ShowS
showsPrec :: Int -> BodyWisdom -> ShowS
$cshow :: BodyWisdom -> String
show :: BodyWisdom -> String
$cshowList :: [BodyWisdom] -> ShowS
showList :: [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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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
  ( Informing rep,
    Ord (OpC rep (Wise rep)),
    Eq (OpC rep (Wise rep)),
    Show (OpC rep (Wise rep)),
    IsOp (OpC rep (Wise rep)),
    Pretty (OpC rep (Wise 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 OpC (Wise rep) = OpC rep

withoutWisdom ::
  (HasScope (Wise rep) m, Monad m) =>
  ReaderT (Scope rep) m a ->
  m a
withoutWisdom :: forall rep (m :: * -> *) a.
(HasScope (Wise rep) m, Monad m) =>
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 a. (Scope (Wise rep) -> a) -> m a
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 (Informing rep, IsOp (OpC rep (Wise rep))) => ASTRep (Wise rep) where
  expTypesFromPat :: forall (m :: * -> *).
(HasScope (Wise rep) m, Monad m) =>
Pat (LetDec (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])
-> (Pat (VarWisdom, LetDec rep)
    -> ReaderT (Scope rep) m [BranchType rep])
-> Pat (VarWisdom, LetDec rep)
-> m [BranchType rep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Pat (LetDec rep) -> ReaderT (Scope rep) m [BranchType rep]
forall rep (m :: * -> *).
(ASTRep rep, HasScope rep m, Monad m) =>
Pat (LetDec rep) -> m [BranchType rep]
forall (m :: * -> *).
(HasScope rep m, Monad m) =>
Pat (LetDec rep) -> m [BranchType rep]
expTypesFromPat (Pat (LetDec rep) -> ReaderT (Scope rep) m [BranchType rep])
-> (Pat (VarWisdom, LetDec rep) -> Pat (LetDec rep))
-> Pat (VarWisdom, LetDec rep)
-> ReaderT (Scope rep) m [BranchType rep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Pat (VarWisdom, LetDec rep) -> Pat (LetDec rep)
forall a. Pat (VarWisdom, a) -> Pat a
removePatWisdom

instance Pretty VarWisdom where
  pretty :: forall ann. VarWisdom -> Doc ann
pretty VarWisdom
_ = () -> Doc ann
forall ann. () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ()

instance (Informing rep, Pretty (OpC rep (Wise rep))) => PrettyRep (Wise rep) where
  ppExpDec :: forall a. ExpDec (Wise rep) -> Exp (Wise rep) -> Maybe (Doc a)
ppExpDec (ExpWisdom
_, ExpDec rep
dec) = ExpDec rep -> Exp rep -> Maybe (Doc a)
forall a. ExpDec rep -> Exp rep -> Maybe (Doc a)
forall rep a.
PrettyRep rep =>
ExpDec rep -> Exp rep -> Maybe (Doc a)
ppExpDec ExpDec rep
dec (Exp rep -> Maybe (Doc a))
-> (Exp (Wise rep) -> Exp rep) -> Exp (Wise rep) -> Maybe (Doc a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
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. RephraseOp (OpC 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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 (Informing 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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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)
Body (Wise rep) -> BodyDec (Wise rep)
forall rep. Body rep -> BodyDec rep
bodyDec
  consumedInBody :: Body (Wise rep) -> Names
consumedInBody = VarAliases -> Names
unAliases (VarAliases -> Names)
-> (Body (Wise rep) -> VarAliases) -> Body (Wise rep) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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)
Body (Wise rep) -> BodyDec (Wise rep)
forall rep. Body rep -> BodyDec rep
bodyDec

removeWisdom :: (RephraseOp (OpC rep)) => Rephraser Identity (Wise rep) rep
removeWisdom :: forall rep.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom =
  Rephraser
    { rephraseExpDec :: ExpDec (Wise rep) -> Identity (ExpDec rep)
rephraseExpDec = ExpDec rep -> Identity (ExpDec rep)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpDec rep -> Identity (ExpDec rep))
-> ((ExpWisdom, ExpDec rep) -> ExpDec rep)
-> (ExpWisdom, ExpDec rep)
-> Identity (ExpDec rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LetDec rep -> Identity (LetDec rep))
-> ((VarWisdom, LetDec rep) -> LetDec rep)
-> (VarWisdom, LetDec rep)
-> Identity (LetDec rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BodyDec rep -> Identity (BodyDec rep))
-> ((BodyWisdom, BodyDec rep) -> BodyDec rep)
-> (BodyWisdom, BodyDec rep)
-> Identity (BodyDec rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 rep -> Identity (FParamInfo rep)
FParamInfo (Wise rep) -> Identity (FParamInfo rep)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      rephraseLParamDec :: LParamInfo (Wise rep) -> Identity (LParamInfo rep)
rephraseLParamDec = LParamInfo rep -> Identity (LParamInfo rep)
LParamInfo (Wise rep) -> Identity (LParamInfo rep)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      rephraseRetType :: RetType (Wise rep) -> Identity (RetType rep)
rephraseRetType = RetType rep -> Identity (RetType rep)
RetType (Wise rep) -> Identity (RetType rep)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      rephraseBranchType :: BranchType (Wise rep) -> Identity (BranchType rep)
rephraseBranchType = BranchType rep -> Identity (BranchType rep)
BranchType (Wise rep) -> Identity (BranchType rep)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      rephraseOp :: Op (Wise rep) -> Identity (Op rep)
rephraseOp = Rephraser Identity (Wise rep) rep
-> OpC rep (Wise rep) -> Identity (Op rep)
forall (op :: * -> *) (m :: * -> *) from to.
(RephraseOp op, Monad m) =>
Rephraser m from to -> op from -> m (op to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> OpC rep from -> m (OpC rep to)
rephraseInOp Rephraser Identity (Wise rep) rep
forall rep.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom
    }

-- | Remove simplifier information from scope.
removeScopeWisdom :: Scope (Wise rep) -> Scope rep
removeScopeWisdom :: forall rep. Scope (Wise rep) -> Scope rep
removeScopeWisdom = (NameInfo (Wise rep) -> NameInfo rep)
-> Map VName (NameInfo (Wise rep)) -> Map VName (NameInfo 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 (a
_, LetDec rep
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

-- | Add simplifier information to scope.  All the aliasing
-- information will be vacuous, however.
addScopeWisdom :: Scope rep -> Scope (Wise rep)
addScopeWisdom :: forall rep. Scope rep -> Scope (Wise rep)
addScopeWisdom = (NameInfo rep -> NameInfo (Wise rep))
-> Map VName (NameInfo rep) -> Map VName (NameInfo (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

-- | Remove simplifier information from function.
removeFunDefWisdom :: (RephraseOp (OpC rep)) => FunDef (Wise rep) -> FunDef rep
removeFunDefWisdom :: forall rep. RephraseOp (OpC rep) => 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 b c a. (b -> c) -> (a -> b) -> a -> c
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.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom

-- | Remove simplifier information from statement.
removeStmWisdom :: (RephraseOp (OpC rep)) => Stm (Wise rep) -> Stm rep
removeStmWisdom :: forall rep. RephraseOp (OpC rep) => 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 b c a. (b -> c) -> (a -> b) -> a -> c
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.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom

-- | Remove simplifier information from lambda.
removeLambdaWisdom :: (RephraseOp (OpC rep)) => Lambda (Wise rep) -> Lambda rep
removeLambdaWisdom :: forall rep. RephraseOp (OpC rep) => 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 b c a. (b -> c) -> (a -> b) -> a -> c
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.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom

-- | Remove simplifier information from body.
removeBodyWisdom :: (RephraseOp (OpC rep)) => Body (Wise rep) -> Body rep
removeBodyWisdom :: forall rep. RephraseOp (OpC rep) => 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 b c a. (b -> c) -> (a -> b) -> a -> c
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.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom

-- | Remove simplifier information from expression.
removeExpWisdom :: (RephraseOp (OpC rep)) => Exp (Wise rep) -> Exp rep
removeExpWisdom :: forall rep. RephraseOp (OpC rep) => 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 b c a. (b -> c) -> (a -> b) -> a -> c
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.
RephraseOp (OpC rep) =>
Rephraser Identity (Wise rep) rep
removeWisdom

-- | Remove simplifier information from pattern.
removePatWisdom :: Pat (VarWisdom, a) -> Pat a
removePatWisdom :: forall a. Pat (VarWisdom, a) -> Pat a
removePatWisdom = Identity (Pat a) -> Pat a
forall a. Identity a -> a
runIdentity (Identity (Pat a) -> Pat a)
-> (Pat (VarWisdom, a) -> Identity (Pat a))
-> Pat (VarWisdom, a)
-> Pat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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)
-> Pat (VarWisdom, a) -> Identity (Pat a)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> Pat from -> m (Pat to)
rephrasePat (a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Identity a)
-> ((VarWisdom, a) -> a) -> (VarWisdom, a) -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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)

-- | Add simplifier information to pattern.
addWisdomToPat ::
  (Informing rep) =>
  Pat (LetDec rep) ->
  Exp (Wise rep) ->
  Pat (LetDec (Wise rep))
addWisdomToPat :: forall rep.
Informing rep =>
Pat (LetDec rep) -> Exp (Wise rep) -> Pat (LetDec (Wise rep))
addWisdomToPat Pat (LetDec rep)
pat Exp (Wise rep)
e =
  (VarAliases, LetDec rep) -> (VarWisdom, LetDec rep)
forall {b}. (VarAliases, b) -> (VarWisdom, b)
f ((VarAliases, LetDec rep) -> (VarWisdom, LetDec rep))
-> Pat (VarAliases, LetDec rep) -> Pat (VarWisdom, LetDec rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pat (LetDec rep) -> Exp (Wise rep) -> Pat (VarAliases, LetDec rep)
forall rep dec.
(Aliased rep, Typed dec) =>
Pat dec -> Exp rep -> Pat (VarAliases, dec)
Aliases.mkAliasedPat Pat (LetDec rep)
pat Exp (Wise rep)
e
  where
    f :: (VarAliases, b) -> (VarWisdom, b)
f (VarAliases
als, b
dec) = (VarAliases -> VarWisdom
VarWisdom VarAliases
als, b
dec)

-- | Produce a body with simplifier information.
mkWiseBody ::
  (Informing rep) =>
  BodyDec rep ->
  Stms (Wise rep) ->
  Result ->
  Body (Wise rep)
mkWiseBody :: forall rep.
Informing rep =>
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 -> Body 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.mkBodyAliasing Stms (Wise rep)
stms Result
res

-- | Produce a statement with simplifier information.
mkWiseStm ::
  (Informing rep) =>
  Pat (LetDec rep) ->
  StmAux (ExpDec rep) ->
  Exp (Wise rep) ->
  Stm (Wise rep)
mkWiseStm :: forall rep.
Informing rep =>
Pat (LetDec rep)
-> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
mkWiseStm Pat (LetDec rep)
pat (StmAux Certs
cs Attrs
attrs ExpDec rep
dec) Exp (Wise rep)
e =
  let pat' :: Pat (LetDec (Wise rep))
pat' = Pat (LetDec rep) -> Exp (Wise rep) -> Pat (LetDec (Wise rep))
forall rep.
Informing rep =>
Pat (LetDec rep) -> Exp (Wise rep) -> Pat (LetDec (Wise rep))
addWisdomToPat Pat (LetDec rep)
pat Exp (Wise rep)
e
   in Pat (LetDec (Wise rep))
-> StmAux (ExpDec (Wise rep)) -> Exp (Wise rep) -> Stm (Wise rep)
forall rep.
Pat (LetDec rep) -> StmAux (ExpDec rep) -> Exp rep -> Stm rep
Let Pat (LetDec (Wise rep))
pat' (Certs -> Attrs -> ExpDec (Wise rep) -> StmAux (ExpDec (Wise rep))
forall dec. Certs -> Attrs -> dec -> StmAux dec
StmAux Certs
cs Attrs
attrs (ExpDec (Wise rep) -> StmAux (ExpDec (Wise rep)))
-> ExpDec (Wise rep) -> StmAux (ExpDec (Wise rep))
forall a b. (a -> b) -> a -> b
$ Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
forall rep.
Informing rep =>
Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
mkWiseExpDec Pat (LetDec (Wise rep))
pat' ExpDec rep
dec Exp (Wise rep)
e) Exp (Wise rep)
e

-- | Produce simplifier information for an expression.
mkWiseExpDec ::
  (Informing rep) =>
  Pat (LetDec (Wise rep)) ->
  ExpDec rep ->
  Exp (Wise rep) ->
  ExpDec (Wise rep)
mkWiseExpDec :: forall rep.
Informing rep =>
Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
mkWiseExpDec Pat (LetDec (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
$ Pat (VarWisdom, LetDec rep) -> Names
forall a. FreeIn a => a -> Names
freeIn Pat (VarWisdom, LetDec rep)
Pat (LetDec (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, Informing rep) => Buildable (Wise rep) where
  mkExpPat :: [Ident] -> Exp (Wise rep) -> Pat (LetDec (Wise rep))
mkExpPat [Ident]
ids Exp (Wise rep)
e =
    Pat (LetDec rep) -> Exp (Wise rep) -> Pat (LetDec (Wise rep))
forall rep.
Informing rep =>
Pat (LetDec rep) -> Exp (Wise rep) -> Pat (LetDec (Wise rep))
addWisdomToPat ([Ident] -> Exp rep -> Pat (LetDec rep)
forall rep. Buildable rep => [Ident] -> Exp rep -> Pat (LetDec rep)
mkExpPat [Ident]
ids (Exp rep -> Pat (LetDec rep)) -> Exp rep -> Pat (LetDec rep)
forall a b. (a -> b) -> a -> b
$ Exp (Wise rep) -> Exp rep
forall rep. RephraseOp (OpC rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom Exp (Wise rep)
e) Exp (Wise rep)
e

  mkExpDec :: Pat (LetDec (Wise rep)) -> Exp (Wise rep) -> ExpDec (Wise rep)
mkExpDec Pat (LetDec (Wise rep))
pat Exp (Wise rep)
e =
    Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
forall rep.
Informing rep =>
Pat (LetDec (Wise rep))
-> ExpDec rep -> Exp (Wise rep) -> ExpDec (Wise rep)
mkWiseExpDec Pat (LetDec (Wise rep))
pat (Pat (LetDec rep) -> Exp rep -> ExpDec rep
forall rep.
Buildable rep =>
Pat (LetDec rep) -> Exp rep -> ExpDec rep
mkExpDec (Pat (VarWisdom, LetDec rep) -> Pat (LetDec rep)
forall a. Pat (VarWisdom, a) -> Pat a
removePatWisdom Pat (VarWisdom, LetDec rep)
Pat (LetDec (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. RephraseOp (OpC rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom Exp (Wise rep)
e) Exp (Wise rep)
e

  mkLetNames :: forall (m :: * -> *).
(MonadFreshNames m, HasScope (Wise rep) m) =>
[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 a. (Scope (Wise rep) -> a) -> m a
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 (LetDec 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)
forall (m :: * -> *).
(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. RephraseOp (OpC rep) => Exp (Wise rep) -> Exp rep
removeExpWisdom Exp (Wise rep)
e
      Stm (Wise rep) -> ReaderT (Scope rep) m (Stm (Wise rep))
forall a. a -> ReaderT (Scope rep) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 (LetDec rep)
-> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
forall rep.
Informing rep =>
Pat (LetDec rep)
-> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
mkWiseStm Pat (LetDec 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 -> Body rep
forall rep. Buildable rep => Stms rep -> Result -> Body rep
mkBody ((Stm (Wise rep) -> Stm rep) -> Stms (Wise rep) -> Stms rep
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm (Wise rep) -> Stm rep
forall rep. RephraseOp (OpC 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.
Informing rep =>
BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
mkWiseBody BodyDec rep
bodyrep Stms (Wise rep)
stms Result
res

-- | Constraints that let us transform a representation into a 'Wise'
-- representation.
type Informing rep =
  ( ASTRep rep,
    AliasedOp (OpC rep (Wise rep)),
    RephraseOp (OpC rep),
    CanBeWise (OpC rep),
    FreeIn (OpC rep (Wise rep))
  )

-- | A type class for indicating that this operation can be lifted into the simplifier representation.
class CanBeWise op where
  addOpWisdom :: (Informing rep) => op rep -> op (Wise rep)

instance CanBeWise NoOp where
  addOpWisdom :: forall rep. Informing rep => NoOp rep -> NoOp (Wise rep)
addOpWisdom NoOp rep
NoOp = NoOp (Wise rep)
forall {k} (rep :: k). NoOp rep
NoOp

-- | Construct a 'Wise' statement.
informStm :: (Informing rep) => Stm rep -> Stm (Wise rep)
informStm :: forall rep. Informing rep => Stm rep -> Stm (Wise rep)
informStm (Let Pat (LetDec rep)
pat StmAux (ExpDec rep)
aux Exp rep
e) = Pat (LetDec rep)
-> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
forall rep.
Informing rep =>
Pat (LetDec rep)
-> StmAux (ExpDec rep) -> Exp (Wise rep) -> Stm (Wise rep)
mkWiseStm Pat (LetDec rep)
pat StmAux (ExpDec rep)
aux (Exp (Wise rep) -> Stm (Wise rep))
-> Exp (Wise rep) -> Stm (Wise rep)
forall a b. (a -> b) -> a -> b
$ Exp rep -> Exp (Wise rep)
forall rep. Informing rep => Exp rep -> Exp (Wise rep)
informExp Exp rep
e

-- | Construct 'Wise' statements.
informStms :: (Informing rep) => Stms rep -> Stms (Wise rep)
informStms :: forall rep. Informing rep => Stms rep -> Stms (Wise rep)
informStms = (Stm rep -> Stm (Wise rep))
-> Seq (Stm rep) -> Seq (Stm (Wise rep))
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm rep -> Stm (Wise rep)
forall rep. Informing rep => Stm rep -> Stm (Wise rep)
informStm

-- | Construct a 'Wise' body.
informBody :: (Informing rep) => Body rep -> Body (Wise rep)
informBody :: forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody (Body BodyDec rep
dec Stms rep
stms Result
res) = BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
forall rep.
Informing rep =>
BodyDec rep -> Stms (Wise rep) -> Result -> Body (Wise rep)
mkWiseBody BodyDec rep
dec (Stms rep -> Stms (Wise rep)
forall rep. Informing rep => Stms rep -> Stms (Wise rep)
informStms Stms rep
stms) Result
res

-- | Construct a 'Wise' lambda.
informLambda :: (Informing rep) => Lambda rep -> Lambda (Wise rep)
informLambda :: forall rep. Informing rep => Lambda rep -> Lambda (Wise rep)
informLambda (Lambda [LParam rep]
ps [Type]
ret Body rep
body) = [LParam (Wise rep)]
-> [Type] -> Body (Wise rep) -> Lambda (Wise rep)
forall rep. [LParam rep] -> [Type] -> Body rep -> Lambda rep
Lambda [LParam rep]
[LParam (Wise rep)]
ps [Type]
ret (Body rep -> Body (Wise rep)
forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody Body rep
body)

-- | Construct a 'Wise' expression.
informExp :: (Informing rep) => Exp rep -> Exp (Wise rep)
informExp :: forall rep. Informing rep => Exp rep -> Exp (Wise rep)
informExp (Match [SubExp]
cond [Case (Body rep)]
cases Body rep
defbody (MatchDec [BranchType rep]
ts MatchSort
ifsort)) =
  [SubExp]
-> [Case (Body (Wise rep))]
-> Body (Wise rep)
-> MatchDec (BranchType (Wise rep))
-> Exp (Wise rep)
forall rep.
[SubExp]
-> [Case (Body rep)]
-> Body rep
-> MatchDec (BranchType rep)
-> Exp rep
Match [SubExp]
cond ((Case (Body rep) -> Case (Body (Wise rep)))
-> [Case (Body rep)] -> [Case (Body (Wise rep))]
forall a b. (a -> b) -> [a] -> [b]
map ((Body rep -> Body (Wise rep))
-> Case (Body rep) -> Case (Body (Wise rep))
forall a b. (a -> b) -> Case a -> Case b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Body rep -> Body (Wise rep)
forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody) [Case (Body rep)]
cases) (Body rep -> Body (Wise rep)
forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody Body rep
defbody) ([BranchType rep] -> MatchSort -> MatchDec (BranchType rep)
forall rt. [rt] -> MatchSort -> MatchDec rt
MatchDec [BranchType rep]
ts MatchSort
ifsort)
informExp (Loop [(FParam rep, SubExp)]
merge LoopForm
form Body rep
loopbody) =
  [(FParam (Wise rep), SubExp)]
-> LoopForm -> Body (Wise rep) -> Exp (Wise rep)
forall rep.
[(FParam rep, SubExp)] -> LoopForm -> Body rep -> Exp rep
Loop [(FParam rep, SubExp)]
[(FParam (Wise rep), SubExp)]
merge LoopForm
form (Body (Wise rep) -> Exp (Wise rep))
-> Body (Wise rep) -> Exp (Wise rep)
forall a b. (a -> b) -> a -> b
$ Body rep -> Body (Wise rep)
forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody Body rep
loopbody
informExp Exp rep
e = Identity (Exp (Wise rep)) -> Exp (Wise rep)
forall a. Identity a -> a
runIdentity (Identity (Exp (Wise rep)) -> Exp (Wise rep))
-> Identity (Exp (Wise rep)) -> Exp (Wise rep)
forall a b. (a -> b) -> a -> b
$ Mapper rep (Wise rep) Identity
-> Exp rep -> Identity (Exp (Wise rep))
forall (m :: * -> *) frep trep.
Monad m =>
Mapper frep trep m -> Exp frep -> m (Exp trep)
mapExpM Mapper rep (Wise rep) Identity
mapper Exp rep
e
  where
    mapper :: Mapper rep (Wise rep) Identity
mapper =
      Mapper
        { mapOnBody :: Scope (Wise rep) -> Body rep -> Identity (Body (Wise rep))
mapOnBody = (Body rep -> Identity (Body (Wise rep)))
-> Scope (Wise rep) -> Body rep -> Identity (Body (Wise rep))
forall a b. a -> b -> a
const ((Body rep -> Identity (Body (Wise rep)))
 -> Scope (Wise rep) -> Body rep -> Identity (Body (Wise rep)))
-> (Body rep -> Identity (Body (Wise rep)))
-> Scope (Wise rep)
-> Body rep
-> Identity (Body (Wise rep))
forall a b. (a -> b) -> a -> b
$ Body (Wise rep) -> Identity (Body (Wise rep))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Body (Wise rep) -> Identity (Body (Wise rep)))
-> (Body rep -> Body (Wise rep))
-> Body rep
-> Identity (Body (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Body rep -> Body (Wise rep)
forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody,
          mapOnSubExp :: SubExp -> Identity SubExp
mapOnSubExp = SubExp -> Identity SubExp
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnVName :: VName -> Identity VName
mapOnVName = VName -> Identity VName
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnRetType :: RetType rep -> Identity (RetType (Wise rep))
mapOnRetType = RetType rep -> Identity (RetType rep)
RetType rep -> Identity (RetType (Wise rep))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnBranchType :: BranchType rep -> Identity (BranchType (Wise rep))
mapOnBranchType = BranchType rep -> Identity (BranchType rep)
BranchType rep -> Identity (BranchType (Wise rep))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnFParam :: FParam rep -> Identity (FParam (Wise rep))
mapOnFParam = FParam rep -> Identity (FParam rep)
FParam rep -> Identity (FParam (Wise rep))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnLParam :: LParam rep -> Identity (LParam (Wise rep))
mapOnLParam = LParam rep -> Identity (LParam rep)
LParam rep -> Identity (LParam (Wise rep))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
          mapOnOp :: Op rep -> Identity (Op (Wise rep))
mapOnOp = OpC rep (Wise rep) -> Identity (OpC rep (Wise rep))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpC rep (Wise rep) -> Identity (OpC rep (Wise rep)))
-> (Op rep -> OpC rep (Wise rep))
-> Op rep
-> Identity (OpC rep (Wise rep))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Op rep -> OpC rep (Wise rep)
forall rep. Informing rep => OpC rep rep -> OpC rep (Wise rep)
forall (op :: * -> *) rep.
(CanBeWise op, Informing rep) =>
op rep -> op (Wise rep)
addOpWisdom
        }

-- | Construct a 'Wise' function definition.
informFunDef :: (Informing rep) => FunDef rep -> FunDef (Wise rep)
informFunDef :: forall rep. Informing rep => FunDef rep -> FunDef (Wise rep)
informFunDef (FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [(RetType rep, RetAls)]
rettype [FParam rep]
params Body rep
body) =
  Maybe EntryPoint
-> Attrs
-> Name
-> [(RetType (Wise rep), RetAls)]
-> [FParam (Wise rep)]
-> Body (Wise rep)
-> FunDef (Wise rep)
forall rep.
Maybe EntryPoint
-> Attrs
-> Name
-> [(RetType rep, RetAls)]
-> [FParam rep]
-> Body rep
-> FunDef rep
FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [(RetType rep, RetAls)]
[(RetType (Wise rep), RetAls)]
rettype [FParam rep]
[FParam (Wise rep)]
params (Body (Wise rep) -> FunDef (Wise rep))
-> Body (Wise rep) -> FunDef (Wise rep)
forall a b. (a -> b) -> a -> b
$ Body rep -> Body (Wise rep)
forall rep. Informing rep => Body rep -> Body (Wise rep)
informBody Body rep
body