{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Definition of the lore used by the simplification engine.
module Futhark.Optimise.Simplify.Lore
       (
         Wise
       , VarWisdom (..)
       , ExpWisdom
       , removeStmWisdom
       , removeLambdaWisdom
       , removeFunDefWisdom
       , removeExpWisdom
       , removePatternWisdom
       , removeBodyWisdom
       , removeScopeWisdom
       , addScopeWisdom
       , addWisdomToPattern
       , mkWiseBody
       , mkWiseLetStm
       , mkWiseExpAttr

       , CanBeWise (..)
       )
       where

import Control.Monad.Identity
import Control.Monad.Reader
import qualified Data.Kind
import qualified Data.Map.Strict as M

import Futhark.Representation.AST
import Futhark.Representation.AST.Attributes.Ranges
import Futhark.Representation.AST.Attributes.Aliases
import Futhark.Representation.Aliases
  (unNames, Names' (..), VarAliases, ConsumedInExp)
import qualified Futhark.Representation.Aliases as Aliases
import qualified Futhark.Representation.Ranges as Ranges
import Futhark.Binder
import Futhark.Transform.Rename
import Futhark.Transform.Substitute
import Futhark.Analysis.Rephrase

data Wise lore

-- | The wisdom of the let-bound variable.
data VarWisdom = VarWisdom { VarWisdom -> VarAliases
varWisdomAliases :: VarAliases
                           , VarWisdom -> Range
varWisdomRange :: Range
                           }
                  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 Range
range) =
    VarAliases -> Range -> VarWisdom
VarWisdom (Map VName VName -> VarAliases -> VarAliases
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs VarAliases
als) (Map VName VName -> Range -> Range
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs Range
range)

instance FreeIn VarWisdom where
  freeIn' :: VarWisdom -> FV
freeIn' (VarWisdom VarAliases
als Range
range) = VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
als FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Range -> FV
forall a. FreeIn a => a -> FV
freeIn' Range
range

-- | Wisdom about an expression.
data ExpWisdom = ExpWisdom { ExpWisdom -> VarAliases
_expWisdomConsumed :: ConsumedInExp
                           , ExpWisdom -> VarAliases
expWisdomFree :: Names'
                           }
                 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 FreeAttr 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
. Names -> FV
fvNames (Names -> FV) -> (ExpWisdom -> Names) -> ExpWisdom -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarAliases -> Names
unNames (VarAliases -> Names)
-> (ExpWisdom -> VarAliases) -> ExpWisdom -> Names
forall b c a. (b -> c) -> (a -> b) -> 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 -> [Range]
bodyWisdomRanges :: [Range]
                             , BodyWisdom -> VarAliases
bodyWisdomFree :: Names'
                             }
                  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 [Range]
rs VarAliases
free) =
    [VarAliases] -> VarAliases -> [Range] -> 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 -> [Range] -> [Range]
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs [Range]
rs)
    (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 [Range]
rs 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
<> [Range] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Range]
rs FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VarAliases -> FV
forall a. FreeIn a => a -> FV
freeIn' VarAliases
free

instance FreeAttr 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
. Names -> FV
fvNames (Names -> FV) -> (BodyWisdom -> Names) -> BodyWisdom -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarAliases -> Names
unNames (VarAliases -> Names)
-> (BodyWisdom -> VarAliases) -> BodyWisdom -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyWisdom -> VarAliases
bodyWisdomFree

instance (Annotations lore,
          CanBeWise (Op lore)) => Annotations (Wise lore) where
  type LetAttr (Wise lore) = (VarWisdom, LetAttr lore)
  type ExpAttr (Wise lore) = (ExpWisdom, ExpAttr lore)
  type BodyAttr (Wise lore) = (BodyWisdom, BodyAttr lore)
  type FParamAttr (Wise lore) = FParamAttr lore
  type LParamAttr (Wise lore) = LParamAttr lore
  type RetType (Wise lore) = RetType lore
  type BranchType (Wise lore) = BranchType lore
  type Op (Wise lore) = OpWithWisdom (Op lore)

withoutWisdom :: (HasScope (Wise lore) m, Monad m) =>
                 ReaderT (Scope lore) m a ->
                 m a
withoutWisdom :: ReaderT (Scope lore) m a -> m a
withoutWisdom ReaderT (Scope lore) m a
m = do
  Scope lore
scope <- (Scope (Wise lore) -> Scope lore) -> m (Scope lore)
forall lore (m :: * -> *) a.
HasScope lore m =>
(Scope lore -> a) -> m a
asksScope Scope (Wise lore) -> Scope lore
forall lore. Scope (Wise lore) -> Scope lore
removeScopeWisdom
  ReaderT (Scope lore) m a -> Scope lore -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Scope lore) m a
m Scope lore
scope

instance (Attributes lore, CanBeWise (Op lore)) => Attributes (Wise lore) where
  expTypesFromPattern :: Pattern (Wise lore) -> m [BranchType (Wise lore)]
expTypesFromPattern =
    ReaderT (Scope lore) m [BranchType lore] -> m [BranchType lore]
forall lore (m :: * -> *) a.
(HasScope (Wise lore) m, Monad m) =>
ReaderT (Scope lore) m a -> m a
withoutWisdom (ReaderT (Scope lore) m [BranchType lore] -> m [BranchType lore])
-> (PatternT (VarWisdom, LetAttr lore)
    -> ReaderT (Scope lore) m [BranchType lore])
-> PatternT (VarWisdom, LetAttr lore)
-> m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (LetAttr lore) -> ReaderT (Scope lore) m [BranchType lore]
forall lore (m :: * -> *).
(Attributes lore, HasScope lore m, Monad m) =>
Pattern lore -> m [BranchType lore]
expTypesFromPattern (PatternT (LetAttr lore)
 -> ReaderT (Scope lore) m [BranchType lore])
-> (PatternT (VarWisdom, LetAttr lore) -> PatternT (LetAttr lore))
-> PatternT (VarWisdom, LetAttr lore)
-> ReaderT (Scope lore) m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (VarWisdom, LetAttr lore) -> PatternT (LetAttr lore)
forall a. PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom

instance PrettyAnnot (PatElemT attr) => PrettyAnnot (PatElemT (VarWisdom, attr)) where
  ppAnnot :: PatElemT (VarWisdom, attr) -> Maybe Doc
ppAnnot = PatElemT attr -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot (PatElemT attr -> Maybe Doc)
-> (PatElemT (VarWisdom, attr) -> PatElemT attr)
-> PatElemT (VarWisdom, attr)
-> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarWisdom, attr) -> attr)
-> PatElemT (VarWisdom, attr) -> PatElemT attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VarWisdom, attr) -> attr
forall a b. (a, b) -> b
snd

instance (PrettyLore lore, CanBeWise (Op lore)) => PrettyLore (Wise lore) where
  ppExpLore :: ExpAttr (Wise lore) -> Exp (Wise lore) -> Maybe Doc
ppExpLore (_, attr) = ExpAttr lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpAttr lore -> Exp lore -> Maybe Doc
ppExpLore ExpAttr lore
attr (Exp lore -> Maybe Doc)
-> (Exp (Wise lore) -> Exp lore) -> Exp (Wise lore) -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom

instance AliasesOf (VarWisdom, attr) where
  aliasesOf :: (VarWisdom, attr) -> Names
aliasesOf = VarAliases -> Names
unNames (VarAliases -> Names)
-> ((VarWisdom, attr) -> VarAliases) -> (VarWisdom, attr) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarWisdom -> VarAliases
varWisdomAliases (VarWisdom -> VarAliases)
-> ((VarWisdom, attr) -> VarWisdom)
-> (VarWisdom, attr)
-> VarAliases
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarWisdom, attr) -> VarWisdom
forall a b. (a, b) -> a
fst

instance RangeOf (VarWisdom, attr) where
  rangeOf :: (VarWisdom, attr) -> Range
rangeOf = VarWisdom -> Range
varWisdomRange (VarWisdom -> Range)
-> ((VarWisdom, attr) -> VarWisdom) -> (VarWisdom, attr) -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarWisdom, attr) -> VarWisdom
forall a b. (a, b) -> a
fst

instance RangesOf (BodyWisdom, attr) where
  rangesOf :: (BodyWisdom, attr) -> [Range]
rangesOf = BodyWisdom -> [Range]
bodyWisdomRanges (BodyWisdom -> [Range])
-> ((BodyWisdom, attr) -> BodyWisdom)
-> (BodyWisdom, attr)
-> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyWisdom, attr) -> BodyWisdom
forall a b. (a, b) -> a
fst

instance (Attributes lore, CanBeWise (Op lore)) => Aliased (Wise lore) where
  bodyAliases :: Body (Wise lore) -> [Names]
bodyAliases = (VarAliases -> Names) -> [VarAliases] -> [Names]
forall a b. (a -> b) -> [a] -> [b]
map VarAliases -> Names
unNames ([VarAliases] -> [Names])
-> (Body (Wise lore) -> [VarAliases])
-> Body (Wise lore)
-> [Names]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyWisdom -> [VarAliases]
bodyWisdomAliases (BodyWisdom -> [VarAliases])
-> (Body (Wise lore) -> BodyWisdom)
-> Body (Wise lore)
-> [VarAliases]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyWisdom, BodyAttr lore) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyAttr lore) -> BodyWisdom)
-> (Body (Wise lore) -> (BodyWisdom, BodyAttr lore))
-> Body (Wise lore)
-> BodyWisdom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body (Wise lore) -> (BodyWisdom, BodyAttr lore)
forall lore. BodyT lore -> BodyAttr lore
bodyAttr
  consumedInBody :: Body (Wise lore) -> Names
consumedInBody = VarAliases -> Names
unNames (VarAliases -> Names)
-> (Body (Wise lore) -> VarAliases) -> Body (Wise lore) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyWisdom -> VarAliases
bodyWisdomConsumed (BodyWisdom -> VarAliases)
-> (Body (Wise lore) -> BodyWisdom)
-> Body (Wise lore)
-> VarAliases
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyWisdom, BodyAttr lore) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyAttr lore) -> BodyWisdom)
-> (Body (Wise lore) -> (BodyWisdom, BodyAttr lore))
-> Body (Wise lore)
-> BodyWisdom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body (Wise lore) -> (BodyWisdom, BodyAttr lore)
forall lore. BodyT lore -> BodyAttr lore
bodyAttr

removeWisdom :: CanBeWise (Op lore) => Rephraser Identity (Wise lore) lore
removeWisdom :: Rephraser Identity (Wise lore) lore
removeWisdom = Rephraser :: forall (m :: * -> *) from to.
(ExpAttr from -> m (ExpAttr to))
-> (LetAttr from -> m (LetAttr to))
-> (FParamAttr from -> m (FParamAttr to))
-> (LParamAttr from -> m (LParamAttr to))
-> (BodyAttr from -> m (BodyAttr to))
-> (RetType from -> m (RetType to))
-> (BranchType from -> m (BranchType to))
-> (Op from -> m (Op to))
-> Rephraser m from to
Rephraser { rephraseExpLore :: ExpAttr (Wise lore) -> Identity (ExpAttr lore)
rephraseExpLore = ExpAttr lore -> Identity (ExpAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpAttr lore -> Identity (ExpAttr lore))
-> ((ExpWisdom, ExpAttr lore) -> ExpAttr lore)
-> (ExpWisdom, ExpAttr lore)
-> Identity (ExpAttr lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExpWisdom, ExpAttr lore) -> ExpAttr lore
forall a b. (a, b) -> b
snd
                         , rephraseLetBoundLore :: LetAttr (Wise lore) -> Identity (LetAttr lore)
rephraseLetBoundLore = LetAttr lore -> Identity (LetAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (LetAttr lore -> Identity (LetAttr lore))
-> ((VarWisdom, LetAttr lore) -> LetAttr lore)
-> (VarWisdom, LetAttr lore)
-> Identity (LetAttr lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarWisdom, LetAttr lore) -> LetAttr lore
forall a b. (a, b) -> b
snd
                         , rephraseBodyLore :: BodyAttr (Wise lore) -> Identity (BodyAttr lore)
rephraseBodyLore = BodyAttr lore -> Identity (BodyAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyAttr lore -> Identity (BodyAttr lore))
-> ((BodyWisdom, BodyAttr lore) -> BodyAttr lore)
-> (BodyWisdom, BodyAttr lore)
-> Identity (BodyAttr lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyWisdom, BodyAttr lore) -> BodyAttr lore
forall a b. (a, b) -> b
snd
                         , rephraseFParamLore :: FParamAttr (Wise lore) -> Identity (FParamAttr lore)
rephraseFParamLore = FParamAttr (Wise lore) -> Identity (FParamAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseLParamLore :: LParamAttr (Wise lore) -> Identity (LParamAttr lore)
rephraseLParamLore = LParamAttr (Wise lore) -> Identity (LParamAttr lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseRetType :: RetType (Wise lore) -> Identity (RetType lore)
rephraseRetType = RetType (Wise lore) -> Identity (RetType lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseBranchType :: BranchType (Wise lore) -> Identity (BranchType lore)
rephraseBranchType = BranchType (Wise lore) -> Identity (BranchType lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseOp :: Op (Wise lore) -> Identity (Op lore)
rephraseOp = Op lore -> Identity (Op lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (Op lore -> Identity (Op lore))
-> (OpWithWisdom (Op lore) -> Op lore)
-> OpWithWisdom (Op lore)
-> Identity (Op lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpWithWisdom (Op lore) -> Op lore
forall op. CanBeWise op => OpWithWisdom op -> op
removeOpWisdom
                         }

removeScopeWisdom :: Scope (Wise lore) -> Scope lore
removeScopeWisdom :: Scope (Wise lore) -> Scope lore
removeScopeWisdom = (NameInfo (Wise lore) -> NameInfo lore)
-> Scope (Wise lore) -> Scope lore
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo (Wise lore) -> NameInfo lore
forall lore a lore.
(LetAttr lore ~ (a, LetAttr lore),
 FParamAttr lore ~ FParamAttr lore,
 LParamAttr lore ~ LParamAttr lore) =>
NameInfo lore -> NameInfo lore
unAlias
  where unAlias :: NameInfo lore -> NameInfo lore
unAlias (LetInfo (_, attr)) = LetAttr lore -> NameInfo lore
forall lore. LetAttr lore -> NameInfo lore
LetInfo LetAttr lore
attr
        unAlias (FParamInfo FParamAttr lore
attr) = FParamAttr lore -> NameInfo lore
forall lore. FParamAttr lore -> NameInfo lore
FParamInfo FParamAttr lore
FParamAttr lore
attr
        unAlias (LParamInfo LParamAttr lore
attr) = LParamAttr lore -> NameInfo lore
forall lore. LParamAttr lore -> NameInfo lore
LParamInfo LParamAttr lore
LParamAttr lore
attr
        unAlias (IndexInfo IntType
it) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexInfo IntType
it

addScopeWisdom :: Scope lore -> Scope (Wise lore)
addScopeWisdom :: Scope lore -> Scope (Wise lore)
addScopeWisdom = (NameInfo lore -> NameInfo (Wise lore))
-> Scope lore -> Scope (Wise lore)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo lore -> NameInfo (Wise lore)
forall lore lore.
(LetAttr lore ~ (VarWisdom, LetAttr lore),
 FParamAttr lore ~ FParamAttr lore,
 LParamAttr lore ~ LParamAttr lore) =>
NameInfo lore -> NameInfo lore
alias
  where alias :: NameInfo lore -> NameInfo lore
alias (LetInfo LetAttr lore
attr) = LetAttr lore -> NameInfo lore
forall lore. LetAttr lore -> NameInfo lore
LetInfo (VarAliases -> Range -> VarWisdom
VarWisdom VarAliases
forall a. Monoid a => a
mempty Range
unknownRange, LetAttr lore
attr)
        alias (FParamInfo FParamAttr lore
attr) = FParamAttr lore -> NameInfo lore
forall lore. FParamAttr lore -> NameInfo lore
FParamInfo FParamAttr lore
FParamAttr lore
attr
        alias (LParamInfo LParamAttr lore
attr) = LParamAttr lore -> NameInfo lore
forall lore. LParamAttr lore -> NameInfo lore
LParamInfo LParamAttr lore
LParamAttr lore
attr
        alias (IndexInfo IntType
it) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexInfo IntType
it

removeFunDefWisdom :: CanBeWise (Op lore) => FunDef (Wise lore) -> FunDef lore
removeFunDefWisdom :: FunDef (Wise lore) -> FunDef lore
removeFunDefWisdom = Identity (FunDef lore) -> FunDef lore
forall a. Identity a -> a
runIdentity (Identity (FunDef lore) -> FunDef lore)
-> (FunDef (Wise lore) -> Identity (FunDef lore))
-> FunDef (Wise lore)
-> FunDef lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Wise lore) lore
-> FunDef (Wise lore) -> Identity (FunDef lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> FunDef from -> m (FunDef to)
rephraseFunDef Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeStmWisdom :: CanBeWise (Op lore) => Stm (Wise lore) -> Stm lore
removeStmWisdom :: Stm (Wise lore) -> Stm lore
removeStmWisdom = Identity (Stm lore) -> Stm lore
forall a. Identity a -> a
runIdentity (Identity (Stm lore) -> Stm lore)
-> (Stm (Wise lore) -> Identity (Stm lore))
-> Stm (Wise lore)
-> Stm lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Wise lore) lore
-> Stm (Wise lore) -> Identity (Stm lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeLambdaWisdom :: CanBeWise (Op lore) => Lambda (Wise lore) -> Lambda lore
removeLambdaWisdom :: Lambda (Wise lore) -> Lambda lore
removeLambdaWisdom = Identity (Lambda lore) -> Lambda lore
forall a. Identity a -> a
runIdentity (Identity (Lambda lore) -> Lambda lore)
-> (Lambda (Wise lore) -> Identity (Lambda lore))
-> Lambda (Wise lore)
-> Lambda lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Wise lore) lore
-> Lambda (Wise lore) -> Identity (Lambda lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Lambda from -> m (Lambda to)
rephraseLambda Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeBodyWisdom :: CanBeWise (Op lore) => Body (Wise lore) -> Body lore
removeBodyWisdom :: Body (Wise lore) -> Body lore
removeBodyWisdom = Identity (Body lore) -> Body lore
forall a. Identity a -> a
runIdentity (Identity (Body lore) -> Body lore)
-> (Body (Wise lore) -> Identity (Body lore))
-> Body (Wise lore)
-> Body lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Wise lore) lore
-> Body (Wise lore) -> Identity (Body lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removeExpWisdom :: CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom :: Exp (Wise lore) -> Exp lore
removeExpWisdom = Identity (Exp lore) -> Exp lore
forall a. Identity a -> a
runIdentity (Identity (Exp lore) -> Exp lore)
-> (Exp (Wise lore) -> Identity (Exp lore))
-> Exp (Wise lore)
-> Exp lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser Identity (Wise lore) lore
-> Exp (Wise lore) -> Identity (Exp lore)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp Rephraser Identity (Wise lore) lore
forall lore.
CanBeWise (Op lore) =>
Rephraser Identity (Wise lore) lore
removeWisdom

removePatternWisdom :: PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom :: PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom = Identity (PatternT a) -> PatternT a
forall a. Identity a -> a
runIdentity (Identity (PatternT a) -> PatternT a)
-> (PatternT (VarWisdom, a) -> Identity (PatternT a))
-> PatternT (VarWisdom, a)
-> PatternT a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarWisdom, a) -> Identity a)
-> PatternT (VarWisdom, a) -> Identity (PatternT a)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> PatternT from -> m (PatternT to)
rephrasePattern (a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Identity a)
-> ((VarWisdom, a) -> a) -> (VarWisdom, a) -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarWisdom, a) -> a
forall a b. (a, b) -> b
snd)

addWisdomToPattern :: (Attributes lore, CanBeWise (Op lore)) =>
                      Pattern lore
                   -> Exp (Wise lore)
                   -> Pattern (Wise lore)
addWisdomToPattern :: Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
addWisdomToPattern Pattern lore
pat Exp (Wise lore)
e =
  [PatElemT (VarWisdom, LetAttr lore)]
-> [PatElemT (VarWisdom, LetAttr lore)]
-> PatternT (VarWisdom, LetAttr lore)
forall attr. [PatElemT attr] -> [PatElemT attr] -> PatternT attr
Pattern
  ((PatElemT (VarAliases, LetAttr lore)
 -> PatElemT (VarWisdom, LetAttr lore))
-> [PatElemT (VarAliases, LetAttr lore)]
-> [PatElemT (VarWisdom, LetAttr lore)]
forall a b. (a -> b) -> [a] -> [b]
map (PatElemT (VarAliases, LetAttr lore)
-> Range -> PatElemT (VarWisdom, LetAttr lore)
forall b.
PatElemT (VarAliases, b) -> Range -> PatElemT (VarWisdom, b)
`addRanges` Range
unknownRange) [PatElemT (VarAliases, LetAttr lore)]
ctxals)
  ((PatElemT (VarAliases, LetAttr lore)
 -> Range -> PatElemT (VarWisdom, LetAttr lore))
-> [PatElemT (VarAliases, LetAttr lore)]
-> [Range]
-> [PatElemT (VarWisdom, LetAttr lore)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PatElemT (VarAliases, LetAttr lore)
-> Range -> PatElemT (VarWisdom, LetAttr lore)
forall b.
PatElemT (VarAliases, b) -> Range -> PatElemT (VarWisdom, b)
addRanges [PatElemT (VarAliases, LetAttr lore)]
valals [Range]
ranges)
  where ([PatElemT (VarAliases, LetAttr lore)]
ctxals, [PatElemT (VarAliases, LetAttr lore)]
valals) = Pattern lore
-> Exp (Wise lore)
-> ([PatElemT (VarAliases, LetAttr lore)],
    [PatElemT (VarAliases, LetAttr lore)])
forall lore attr.
(Aliased lore, Typed attr) =>
PatternT attr
-> Exp lore
-> ([PatElemT (VarAliases, attr)], [PatElemT (VarAliases, attr)])
Aliases.mkPatternAliases Pattern lore
pat Exp (Wise lore)
e
        addRanges :: PatElemT (VarAliases, b) -> Range -> PatElemT (VarWisdom, b)
addRanges PatElemT (VarAliases, b)
patElem Range
range =
          let (VarAliases
als, b
innerlore) = PatElemT (VarAliases, b) -> (VarAliases, b)
forall attr. PatElemT attr -> attr
patElemAttr PatElemT (VarAliases, b)
patElem
          in PatElemT (VarAliases, b)
patElem PatElemT (VarAliases, b)
-> (VarWisdom, b) -> PatElemT (VarWisdom, b)
forall oldattr newattr.
PatElemT oldattr -> newattr -> PatElemT newattr
`setPatElemLore` (VarAliases -> Range -> VarWisdom
VarWisdom VarAliases
als Range
range, b
innerlore)
        ranges :: [Range]
ranges = Exp (Wise lore) -> [Range]
forall lore. Ranged lore => Exp lore -> [Range]
expRanges Exp (Wise lore)
e

mkWiseBody :: (Attributes lore, CanBeWise (Op lore)) =>
              BodyAttr lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody :: BodyAttr lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody BodyAttr lore
innerlore Stms (Wise lore)
bnds Result
res =
  BodyAttr (Wise lore)
-> Stms (Wise lore) -> Result -> Body (Wise lore)
forall lore. BodyAttr lore -> Stms lore -> Result -> BodyT lore
Body ([VarAliases] -> VarAliases -> [Range] -> VarAliases -> BodyWisdom
BodyWisdom [VarAliases]
aliases VarAliases
consumed [Range]
ranges (Names -> VarAliases
Names' (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 lore) -> Result -> FV
forall lore.
(FreeIn (Op lore), FreeIn (LetAttr lore), FreeIn (LParamAttr lore),
 FreeIn (FParamAttr lore), FreeAttr (BodyAttr lore),
 FreeAttr (ExpAttr lore)) =>
Stms lore -> Result -> FV
freeInStmsAndRes Stms (Wise lore)
bnds Result
res),
        BodyAttr lore
innerlore) Stms (Wise lore)
bnds Result
res
  where ([VarAliases]
aliases, VarAliases
consumed) = Stms (Wise lore) -> Result -> ([VarAliases], VarAliases)
forall lore.
Aliased lore =>
Stms lore -> Result -> ([VarAliases], VarAliases)
Aliases.mkBodyAliases Stms (Wise lore)
bnds Result
res
        ranges :: [Range]
ranges = Stms (Wise lore) -> Result -> [Range]
forall lore. Stms lore -> Result -> [Range]
Ranges.mkBodyRanges Stms (Wise lore)
bnds Result
res

mkWiseLetStm :: (Attributes lore, CanBeWise (Op lore)) =>
                Pattern lore
             -> StmAux (ExpAttr lore) -> Exp (Wise lore)
             -> Stm (Wise lore)
mkWiseLetStm :: Pattern lore
-> StmAux (ExpAttr lore) -> Exp (Wise lore) -> Stm (Wise lore)
mkWiseLetStm Pattern lore
pat (StmAux Certificates
cs ExpAttr lore
attr) Exp (Wise lore)
e =
  let pat' :: Pattern (Wise lore)
pat' = Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
forall lore.
(Attributes lore, CanBeWise (Op lore)) =>
Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
addWisdomToPattern Pattern lore
pat Exp (Wise lore)
e
  in Pattern (Wise lore)
-> StmAux (ExpAttr (Wise lore))
-> Exp (Wise lore)
-> Stm (Wise lore)
forall lore.
Pattern lore -> StmAux (ExpAttr lore) -> Exp lore -> Stm lore
Let Pattern (Wise lore)
pat' (Certificates
-> (ExpWisdom, ExpAttr lore) -> StmAux (ExpWisdom, ExpAttr lore)
forall attr. Certificates -> attr -> StmAux attr
StmAux Certificates
cs ((ExpWisdom, ExpAttr lore) -> StmAux (ExpWisdom, ExpAttr lore))
-> (ExpWisdom, ExpAttr lore) -> StmAux (ExpWisdom, ExpAttr lore)
forall a b. (a -> b) -> a -> b
$ Pattern (Wise lore)
-> ExpAttr lore -> Exp (Wise lore) -> ExpAttr (Wise lore)
forall lore.
(Attributes lore, CanBeWise (Op lore)) =>
Pattern (Wise lore)
-> ExpAttr lore -> Exp (Wise lore) -> ExpAttr (Wise lore)
mkWiseExpAttr Pattern (Wise lore)
pat' ExpAttr lore
attr Exp (Wise lore)
e) Exp (Wise lore)
e

mkWiseExpAttr :: (Attributes lore, CanBeWise (Op lore)) =>
                 Pattern (Wise lore) -> ExpAttr lore -> Exp (Wise lore)
              -> ExpAttr (Wise lore)
mkWiseExpAttr :: Pattern (Wise lore)
-> ExpAttr lore -> Exp (Wise lore) -> ExpAttr (Wise lore)
mkWiseExpAttr Pattern (Wise lore)
pat ExpAttr lore
explore Exp (Wise lore)
e =
  (VarAliases -> VarAliases -> ExpWisdom
ExpWisdom
    (Names -> VarAliases
Names' (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Names
forall lore. Aliased lore => Exp lore -> Names
consumedInExp Exp (Wise lore)
e)
    (Names -> VarAliases
Names' (Names -> VarAliases) -> Names -> VarAliases
forall a b. (a -> b) -> a -> b
$ PatternT (VarWisdom, LetAttr lore) -> Names
forall a. FreeIn a => a -> Names
freeIn PatternT (VarWisdom, LetAttr lore)
Pattern (Wise lore)
pat Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> ExpAttr lore -> Names
forall a. FreeIn a => a -> Names
freeIn ExpAttr lore
explore Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Exp (Wise lore) -> Names
forall a. FreeIn a => a -> Names
freeIn Exp (Wise lore)
e),
   ExpAttr lore
explore)

instance (Bindable lore,
          CanBeWise (Op lore)) => Bindable (Wise lore) where
  mkExpPat :: [Ident] -> [Ident] -> Exp (Wise lore) -> Pattern (Wise lore)
mkExpPat [Ident]
ctx [Ident]
val Exp (Wise lore)
e =
    Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
forall lore.
(Attributes lore, CanBeWise (Op lore)) =>
Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
addWisdomToPattern ([Ident] -> [Ident] -> Exp lore -> Pattern lore
forall lore.
Bindable lore =>
[Ident] -> [Ident] -> Exp lore -> Pattern lore
mkExpPat [Ident]
ctx [Ident]
val (Exp lore -> Pattern lore) -> Exp lore -> Pattern lore
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom Exp (Wise lore)
e) Exp (Wise lore)
e

  mkExpAttr :: Pattern (Wise lore) -> Exp (Wise lore) -> ExpAttr (Wise lore)
mkExpAttr Pattern (Wise lore)
pat Exp (Wise lore)
e =
    Pattern (Wise lore)
-> ExpAttr lore -> Exp (Wise lore) -> ExpAttr (Wise lore)
forall lore.
(Attributes lore, CanBeWise (Op lore)) =>
Pattern (Wise lore)
-> ExpAttr lore -> Exp (Wise lore) -> ExpAttr (Wise lore)
mkWiseExpAttr Pattern (Wise lore)
pat (Pattern lore -> Exp lore -> ExpAttr lore
forall lore.
Bindable lore =>
Pattern lore -> Exp lore -> ExpAttr lore
mkExpAttr (PatternT (VarWisdom, LetAttr lore) -> Pattern lore
forall a. PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom PatternT (VarWisdom, LetAttr lore)
Pattern (Wise lore)
pat) (Exp lore -> ExpAttr lore) -> Exp lore -> ExpAttr lore
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom Exp (Wise lore)
e) Exp (Wise lore)
e

  mkLetNames :: [VName] -> Exp (Wise lore) -> m (Stm (Wise lore))
mkLetNames [VName]
names Exp (Wise lore)
e = do
    Scope lore
env <- (Scope (Wise lore) -> Scope lore) -> m (Scope lore)
forall lore (m :: * -> *) a.
HasScope lore m =>
(Scope lore -> a) -> m a
asksScope Scope (Wise lore) -> Scope lore
forall lore. Scope (Wise lore) -> Scope lore
removeScopeWisdom
    (ReaderT (Scope lore) m (Stm (Wise lore))
 -> Scope lore -> m (Stm (Wise lore)))
-> Scope lore
-> ReaderT (Scope lore) m (Stm (Wise lore))
-> m (Stm (Wise lore))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Scope lore) m (Stm (Wise lore))
-> Scope lore -> m (Stm (Wise lore))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Scope lore
env (ReaderT (Scope lore) m (Stm (Wise lore)) -> m (Stm (Wise lore)))
-> ReaderT (Scope lore) m (Stm (Wise lore)) -> m (Stm (Wise lore))
forall a b. (a -> b) -> a -> b
$ do
      Let Pattern lore
pat StmAux (ExpAttr lore)
attr Exp lore
_ <- [VName] -> Exp lore -> ReaderT (Scope lore) m (Stm lore)
forall lore (m :: * -> *).
(Bindable lore, MonadFreshNames m, HasScope lore m) =>
[VName] -> Exp lore -> m (Stm lore)
mkLetNames [VName]
names (Exp lore -> ReaderT (Scope lore) m (Stm lore))
-> Exp lore -> ReaderT (Scope lore) m (Stm lore)
forall a b. (a -> b) -> a -> b
$ Exp (Wise lore) -> Exp lore
forall lore. CanBeWise (Op lore) => Exp (Wise lore) -> Exp lore
removeExpWisdom Exp (Wise lore)
e
      Stm (Wise lore) -> ReaderT (Scope lore) m (Stm (Wise lore))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stm (Wise lore) -> ReaderT (Scope lore) m (Stm (Wise lore)))
-> Stm (Wise lore) -> ReaderT (Scope lore) m (Stm (Wise lore))
forall a b. (a -> b) -> a -> b
$ Pattern lore
-> StmAux (ExpAttr lore) -> Exp (Wise lore) -> Stm (Wise lore)
forall lore.
(Attributes lore, CanBeWise (Op lore)) =>
Pattern lore
-> StmAux (ExpAttr lore) -> Exp (Wise lore) -> Stm (Wise lore)
mkWiseLetStm Pattern lore
pat StmAux (ExpAttr lore)
attr Exp (Wise lore)
e

  mkBody :: Stms (Wise lore) -> Result -> Body (Wise lore)
mkBody Stms (Wise lore)
bnds Result
res =
    let Body BodyAttr lore
bodylore Stms lore
_ Result
_ = Stms lore -> Result -> BodyT lore
forall lore. Bindable lore => Stms lore -> Result -> Body lore
mkBody ((Stm (Wise lore) -> Stm lore) -> Stms (Wise lore) -> Stms lore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stm (Wise lore) -> Stm lore
forall lore. CanBeWise (Op lore) => Stm (Wise lore) -> Stm lore
removeStmWisdom Stms (Wise lore)
bnds) Result
res
    in BodyAttr lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
forall lore.
(Attributes lore, CanBeWise (Op lore)) =>
BodyAttr lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody BodyAttr lore
bodylore Stms (Wise lore)
bnds Result
res

class (AliasedOp (OpWithWisdom op),
       RangedOp (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 () = ()