{-# 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
       , mkWiseExpDec

       , CanBeWise (..)
       )
       where

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

import Futhark.IR
import Futhark.IR.Prop.Ranges
import Futhark.IR.Prop.Aliases
import Futhark.IR.Aliases
  (unNames, Names' (..), VarAliases, ConsumedInExp)
import qualified Futhark.IR.Aliases as Aliases
import qualified Futhark.IR.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 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
. 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 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
. 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 (Decorations lore,
          CanBeWise (Op lore)) => Decorations (Wise lore) where
  type LetDec (Wise lore) = (VarWisdom, LetDec lore)
  type ExpDec (Wise lore) = (ExpWisdom, ExpDec lore)
  type BodyDec (Wise lore) = (BodyWisdom, BodyDec lore)
  type FParamInfo (Wise lore) = FParamInfo lore
  type LParamInfo (Wise lore) = LParamInfo 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 (ASTLore lore, CanBeWise (Op lore)) => ASTLore (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, LetDec lore)
    -> ReaderT (Scope lore) m [BranchType lore])
-> PatternT (VarWisdom, LetDec lore)
-> m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (LetDec lore) -> ReaderT (Scope lore) m [BranchType lore]
forall lore (m :: * -> *).
(ASTLore lore, HasScope lore m, Monad m) =>
Pattern lore -> m [BranchType lore]
expTypesFromPattern (PatternT (LetDec lore)
 -> ReaderT (Scope lore) m [BranchType lore])
-> (PatternT (VarWisdom, LetDec lore) -> PatternT (LetDec lore))
-> PatternT (VarWisdom, LetDec lore)
-> ReaderT (Scope lore) m [BranchType lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT (VarWisdom, LetDec lore) -> PatternT (LetDec lore)
forall a. PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom

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

instance (PrettyLore lore, CanBeWise (Op lore)) => PrettyLore (Wise lore) where
  ppExpLore :: ExpDec (Wise lore) -> Exp (Wise lore) -> Maybe Doc
ppExpLore (_, dec) = ExpDec lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpDec lore -> Exp lore -> Maybe Doc
ppExpLore ExpDec lore
dec (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, dec) where
  aliasesOf :: (VarWisdom, dec) -> Names
aliasesOf = VarAliases -> Names
unNames (VarAliases -> Names)
-> ((VarWisdom, dec) -> VarAliases) -> (VarWisdom, dec) -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarWisdom -> VarAliases
varWisdomAliases (VarWisdom -> VarAliases)
-> ((VarWisdom, dec) -> VarWisdom)
-> (VarWisdom, dec)
-> VarAliases
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarWisdom, dec) -> VarWisdom
forall a b. (a, b) -> a
fst

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

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

instance (ASTLore 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, BodyDec lore) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyDec lore) -> BodyWisdom)
-> (Body (Wise lore) -> (BodyWisdom, BodyDec lore))
-> Body (Wise lore)
-> BodyWisdom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body (Wise lore) -> (BodyWisdom, BodyDec lore)
forall lore. BodyT lore -> BodyDec lore
bodyDec
  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, BodyDec lore) -> BodyWisdom
forall a b. (a, b) -> a
fst ((BodyWisdom, BodyDec lore) -> BodyWisdom)
-> (Body (Wise lore) -> (BodyWisdom, BodyDec lore))
-> Body (Wise lore)
-> BodyWisdom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body (Wise lore) -> (BodyWisdom, BodyDec lore)
forall lore. BodyT lore -> BodyDec lore
bodyDec

removeWisdom :: CanBeWise (Op lore) => Rephraser Identity (Wise lore) lore
removeWisdom :: Rephraser Identity (Wise lore) lore
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 { rephraseExpLore :: ExpDec (Wise lore) -> Identity (ExpDec lore)
rephraseExpLore = ExpDec lore -> Identity (ExpDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpDec lore -> Identity (ExpDec lore))
-> ((ExpWisdom, ExpDec lore) -> ExpDec lore)
-> (ExpWisdom, ExpDec lore)
-> Identity (ExpDec lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExpWisdom, ExpDec lore) -> ExpDec lore
forall a b. (a, b) -> b
snd
                         , rephraseLetBoundLore :: LetDec (Wise lore) -> Identity (LetDec lore)
rephraseLetBoundLore = LetDec lore -> Identity (LetDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (LetDec lore -> Identity (LetDec lore))
-> ((VarWisdom, LetDec lore) -> LetDec lore)
-> (VarWisdom, LetDec lore)
-> Identity (LetDec lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarWisdom, LetDec lore) -> LetDec lore
forall a b. (a, b) -> b
snd
                         , rephraseBodyLore :: BodyDec (Wise lore) -> Identity (BodyDec lore)
rephraseBodyLore = BodyDec lore -> Identity (BodyDec lore)
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyDec lore -> Identity (BodyDec lore))
-> ((BodyWisdom, BodyDec lore) -> BodyDec lore)
-> (BodyWisdom, BodyDec lore)
-> Identity (BodyDec lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyWisdom, BodyDec lore) -> BodyDec lore
forall a b. (a, b) -> b
snd
                         , rephraseFParamLore :: FParamInfo (Wise lore) -> Identity (FParamInfo lore)
rephraseFParamLore = FParamInfo (Wise lore) -> Identity (FParamInfo lore)
forall (m :: * -> *) a. Monad m => a -> m a
return
                         , rephraseLParamLore :: LParamInfo (Wise lore) -> Identity (LParamInfo lore)
rephraseLParamLore = LParamInfo (Wise lore) -> Identity (LParamInfo 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.
(LetDec lore ~ (a, LetDec lore), FParamInfo lore ~ FParamInfo lore,
 LParamInfo lore ~ LParamInfo lore) =>
NameInfo lore -> NameInfo lore
unAlias
  where unAlias :: NameInfo lore -> NameInfo lore
unAlias (LetName (_, dec)) = LetDec lore -> NameInfo lore
forall lore. LetDec lore -> NameInfo lore
LetName LetDec lore
dec
        unAlias (FParamName FParamInfo lore
dec) = FParamInfo lore -> NameInfo lore
forall lore. FParamInfo lore -> NameInfo lore
FParamName FParamInfo lore
FParamInfo lore
dec
        unAlias (LParamName LParamInfo lore
dec) = LParamInfo lore -> NameInfo lore
forall lore. LParamInfo lore -> NameInfo lore
LParamName LParamInfo lore
LParamInfo lore
dec
        unAlias (IndexName IntType
it) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexName 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.
(LetDec lore ~ (VarWisdom, LetDec lore),
 FParamInfo lore ~ FParamInfo lore,
 LParamInfo lore ~ LParamInfo lore) =>
NameInfo lore -> NameInfo lore
alias
  where alias :: NameInfo lore -> NameInfo lore
alias (LetName LetDec lore
dec) = LetDec lore -> NameInfo lore
forall lore. LetDec lore -> NameInfo lore
LetName (VarAliases -> Range -> VarWisdom
VarWisdom VarAliases
forall a. Monoid a => a
mempty Range
unknownRange, LetDec lore
dec)
        alias (FParamName FParamInfo lore
dec) = FParamInfo lore -> NameInfo lore
forall lore. FParamInfo lore -> NameInfo lore
FParamName FParamInfo lore
FParamInfo lore
dec
        alias (LParamName LParamInfo lore
dec) = LParamInfo lore -> NameInfo lore
forall lore. LParamInfo lore -> NameInfo lore
LParamName LParamInfo lore
LParamInfo lore
dec
        alias (IndexName IntType
it) = IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexName 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 :: (ASTLore 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, LetDec lore)]
-> [PatElemT (VarWisdom, LetDec lore)]
-> PatternT (VarWisdom, LetDec lore)
forall dec. [PatElemT dec] -> [PatElemT dec] -> PatternT dec
Pattern
  ((PatElemT (VarAliases, LetDec lore)
 -> PatElemT (VarWisdom, LetDec lore))
-> [PatElemT (VarAliases, LetDec lore)]
-> [PatElemT (VarWisdom, LetDec lore)]
forall a b. (a -> b) -> [a] -> [b]
map (PatElemT (VarAliases, LetDec lore)
-> Range -> PatElemT (VarWisdom, LetDec lore)
forall b.
PatElemT (VarAliases, b) -> Range -> PatElemT (VarWisdom, b)
`addRanges` Range
unknownRange) [PatElemT (VarAliases, LetDec lore)]
ctxals)
  ((PatElemT (VarAliases, LetDec lore)
 -> Range -> PatElemT (VarWisdom, LetDec lore))
-> [PatElemT (VarAliases, LetDec lore)]
-> [Range]
-> [PatElemT (VarWisdom, LetDec lore)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PatElemT (VarAliases, LetDec lore)
-> Range -> PatElemT (VarWisdom, LetDec lore)
forall b.
PatElemT (VarAliases, b) -> Range -> PatElemT (VarWisdom, b)
addRanges [PatElemT (VarAliases, LetDec lore)]
valals [Range]
ranges)
  where ([PatElemT (VarAliases, LetDec lore)]
ctxals, [PatElemT (VarAliases, LetDec lore)]
valals) = Pattern lore
-> Exp (Wise lore)
-> ([PatElemT (VarAliases, LetDec lore)],
    [PatElemT (VarAliases, LetDec lore)])
forall lore dec.
(Aliased lore, Typed dec) =>
PatternT dec
-> Exp lore
-> ([PatElemT (VarAliases, dec)], [PatElemT (VarAliases, dec)])
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 dec. PatElemT dec -> dec
patElemDec 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 :: (ASTLore lore, CanBeWise (Op lore)) =>
              BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody :: BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody BodyDec lore
innerlore Stms (Wise lore)
bnds Result
res =
  BodyDec (Wise lore)
-> Stms (Wise lore) -> Result -> Body (Wise lore)
forall lore. BodyDec 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 (LetDec lore), FreeIn (LParamInfo lore),
 FreeIn (FParamInfo lore), FreeDec (BodyDec lore),
 FreeDec (ExpDec lore)) =>
Stms lore -> Result -> FV
freeInStmsAndRes Stms (Wise lore)
bnds Result
res),
        BodyDec 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 :: (ASTLore lore, CanBeWise (Op lore)) =>
                Pattern lore
             -> StmAux (ExpDec lore) -> Exp (Wise lore)
             -> Stm (Wise lore)
mkWiseLetStm :: Pattern lore
-> StmAux (ExpDec lore) -> Exp (Wise lore) -> Stm (Wise lore)
mkWiseLetStm Pattern lore
pat (StmAux Certificates
cs Attrs
attrs ExpDec lore
dec) Exp (Wise lore)
e =
  let pat' :: Pattern (Wise lore)
pat' = Pattern lore -> Exp (Wise lore) -> Pattern (Wise lore)
forall lore.
(ASTLore 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 (ExpDec (Wise lore))
-> Exp (Wise lore)
-> Stm (Wise lore)
forall lore.
Pattern lore -> StmAux (ExpDec lore) -> Exp lore -> Stm lore
Let Pattern (Wise lore)
pat' (Certificates
-> Attrs
-> (ExpWisdom, ExpDec lore)
-> StmAux (ExpWisdom, ExpDec lore)
forall dec. Certificates -> Attrs -> dec -> StmAux dec
StmAux Certificates
cs Attrs
attrs ((ExpWisdom, ExpDec lore) -> StmAux (ExpWisdom, ExpDec lore))
-> (ExpWisdom, ExpDec lore) -> StmAux (ExpWisdom, ExpDec lore)
forall a b. (a -> b) -> a -> b
$ Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
mkWiseExpDec Pattern (Wise lore)
pat' ExpDec lore
dec Exp (Wise lore)
e) Exp (Wise lore)
e

mkWiseExpDec :: (ASTLore lore, CanBeWise (Op lore)) =>
                 Pattern (Wise lore) -> ExpDec lore -> Exp (Wise lore)
              -> ExpDec (Wise lore)
mkWiseExpDec :: Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
mkWiseExpDec Pattern (Wise lore)
pat ExpDec 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, LetDec lore) -> Names
forall a. FreeIn a => a -> Names
freeIn PatternT (VarWisdom, LetDec lore)
Pattern (Wise lore)
pat Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> ExpDec lore -> Names
forall a. FreeIn a => a -> Names
freeIn ExpDec 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),
   ExpDec 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.
(ASTLore 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

  mkExpDec :: Pattern (Wise lore) -> Exp (Wise lore) -> ExpDec (Wise lore)
mkExpDec Pattern (Wise lore)
pat Exp (Wise lore)
e =
    Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern (Wise lore)
-> ExpDec lore -> Exp (Wise lore) -> ExpDec (Wise lore)
mkWiseExpDec Pattern (Wise lore)
pat (Pattern lore -> Exp lore -> ExpDec lore
forall lore.
Bindable lore =>
Pattern lore -> Exp lore -> ExpDec lore
mkExpDec (PatternT (VarWisdom, LetDec lore) -> Pattern lore
forall a. PatternT (VarWisdom, a) -> PatternT a
removePatternWisdom PatternT (VarWisdom, LetDec lore)
Pattern (Wise lore)
pat) (Exp lore -> ExpDec lore) -> Exp lore -> ExpDec 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 (ExpDec lore)
dec 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 (ExpDec lore) -> Exp (Wise lore) -> Stm (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
Pattern lore
-> StmAux (ExpDec lore) -> Exp (Wise lore) -> Stm (Wise lore)
mkWiseLetStm Pattern lore
pat StmAux (ExpDec lore)
dec Exp (Wise lore)
e

  mkBody :: Stms (Wise lore) -> Result -> Body (Wise lore)
mkBody Stms (Wise lore)
bnds Result
res =
    let Body BodyDec 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 BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
forall lore.
(ASTLore lore, CanBeWise (Op lore)) =>
BodyDec lore -> Stms (Wise lore) -> Result -> Body (Wise lore)
mkWiseBody BodyDec 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 () = ()