{-# LANGUAGE UndecidableInstances #-}
module Futhark.Transform.Rename
(
renameProg,
renameExp,
renameStm,
renameBody,
renameLambda,
renamePat,
renameSomething,
renameBound,
RenameM,
substituteRename,
renamingStms,
Rename (..),
Renameable,
)
where
import Control.Monad.Reader
import Control.Monad.State
import Data.Map.Strict qualified as M
import Data.Maybe
import Futhark.FreshNames hiding (newName)
import Futhark.IR.Prop.Names
import Futhark.IR.Prop.Patterns
import Futhark.IR.Syntax
import Futhark.IR.Traversals
import Futhark.MonadFreshNames (MonadFreshNames (..), modifyNameSource, newName)
import Futhark.Transform.Substitute
runRenamer :: RenameM a -> VNameSource -> (a, VNameSource)
runRenamer :: forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM StateT VNameSource (Reader RenameEnv) a
m) VNameSource
src = forall r a. Reader r a -> r -> a
runReader (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT VNameSource (Reader RenameEnv) a
m VNameSource
src) RenameEnv
env
where
env :: RenameEnv
env = Map VName VName -> RenameEnv
RenameEnv forall k a. Map k a
M.empty
renameProg ::
(Renameable rep, MonadFreshNames m) =>
Prog rep ->
m (Prog rep)
renameProg :: forall {k} (rep :: k) (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Prog rep -> m (Prog rep)
renameProg Prog rep
prog = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall a b. (a -> b) -> a -> b
$
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer forall a b. (a -> b) -> a -> b
$
forall {k} (rep :: k) a.
Renameable rep =>
Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms (forall {k} (rep :: k). Prog rep -> Stms rep
progConsts Prog rep
prog) forall a b. (a -> b) -> a -> b
$ \Stms rep
consts -> do
[FunDef rep]
funs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename (forall {k} (rep :: k). Prog rep -> [FunDef rep]
progFuns Prog rep
prog)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog rep
prog {progConsts :: Stms rep
progConsts = Stms rep
consts, progFuns :: [FunDef rep]
progFuns = [FunDef rep]
funs}
renameExp ::
(Renameable rep, MonadFreshNames m) =>
Exp rep ->
m (Exp rep)
renameExp :: forall {k} (rep :: k) (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Exp rep -> m (Exp rep)
renameExp = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rename a => a -> RenameM a
rename
renameStm ::
(Renameable rep, MonadFreshNames m) =>
Stm rep ->
m (Stm rep)
renameStm :: forall {k} (rep :: k) (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Stm rep -> m (Stm rep)
renameStm Stm rep
binding = do
Exp rep
e <- forall {k} (rep :: k) (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Exp rep -> m (Exp rep)
renameExp forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). Stm rep -> Exp rep
stmExp Stm rep
binding
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stm rep
binding {stmExp :: Exp rep
stmExp = Exp rep
e}
renameBody ::
(Renameable rep, MonadFreshNames m) =>
Body rep ->
m (Body rep)
renameBody :: forall {k} (rep :: k) (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Body rep -> m (Body rep)
renameBody = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rename a => a -> RenameM a
rename
renameLambda ::
(Renameable rep, MonadFreshNames m) =>
Lambda rep ->
m (Lambda rep)
renameLambda :: forall {k} (rep :: k) (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Lambda rep -> m (Lambda rep)
renameLambda = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rename a => a -> RenameM a
rename
renamePat ::
(Rename dec, MonadFreshNames m) =>
Pat dec ->
m (Pat dec)
renamePat :: forall dec (m :: * -> *).
(Rename dec, MonadFreshNames m) =>
Pat dec -> m (Pat dec)
renamePat = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {dec}. Rename dec => Pat dec -> RenameM (Pat dec)
rename'
where
rename' :: Pat dec -> RenameM (Pat dec)
rename' Pat dec
pat = forall a. [VName] -> RenameM a -> RenameM a
renameBound (forall dec. Pat dec -> [VName]
patNames Pat dec
pat) forall a b. (a -> b) -> a -> b
$ forall a. Rename a => a -> RenameM a
rename Pat dec
pat
renameSomething ::
(Rename a, MonadFreshNames m) =>
a ->
m a
renameSomething :: forall a (m :: * -> *). (Rename a, MonadFreshNames m) => a -> m a
renameSomething = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rename a => a -> RenameM a
rename
newtype RenameEnv = RenameEnv {RenameEnv -> Map VName VName
envNameMap :: M.Map VName VName}
newtype RenameM a = RenameM (StateT VNameSource (Reader RenameEnv) a)
deriving
( forall a b. a -> RenameM b -> RenameM a
forall a b. (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RenameM b -> RenameM a
$c<$ :: forall a b. a -> RenameM b -> RenameM a
fmap :: forall a b. (a -> b) -> RenameM a -> RenameM b
$cfmap :: forall a b. (a -> b) -> RenameM a -> RenameM b
Functor,
Functor RenameM
forall a. a -> RenameM a
forall a b. RenameM a -> RenameM b -> RenameM a
forall a b. RenameM a -> RenameM b -> RenameM b
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall a b c. (a -> b -> c) -> RenameM a -> RenameM b -> RenameM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. RenameM a -> RenameM b -> RenameM a
$c<* :: forall a b. RenameM a -> RenameM b -> RenameM a
*> :: forall a b. RenameM a -> RenameM b -> RenameM b
$c*> :: forall a b. RenameM a -> RenameM b -> RenameM b
liftA2 :: forall a b c. (a -> b -> c) -> RenameM a -> RenameM b -> RenameM c
$cliftA2 :: forall a b c. (a -> b -> c) -> RenameM a -> RenameM b -> RenameM c
<*> :: forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
$c<*> :: forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
pure :: forall a. a -> RenameM a
$cpure :: forall a. a -> RenameM a
Applicative,
Applicative RenameM
forall a. a -> RenameM a
forall a b. RenameM a -> RenameM b -> RenameM b
forall a b. RenameM a -> (a -> RenameM b) -> RenameM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> RenameM a
$creturn :: forall a. a -> RenameM a
>> :: forall a b. RenameM a -> RenameM b -> RenameM b
$c>> :: forall a b. RenameM a -> RenameM b -> RenameM b
>>= :: forall a b. RenameM a -> (a -> RenameM b) -> RenameM b
$c>>= :: forall a b. RenameM a -> (a -> RenameM b) -> RenameM b
Monad,
Monad RenameM
RenameM VNameSource
VNameSource -> RenameM ()
forall (m :: * -> *).
Monad m
-> m VNameSource -> (VNameSource -> m ()) -> MonadFreshNames m
putNameSource :: VNameSource -> RenameM ()
$cputNameSource :: VNameSource -> RenameM ()
getNameSource :: RenameM VNameSource
$cgetNameSource :: RenameM VNameSource
MonadFreshNames,
MonadReader RenameEnv
)
renamerSubstitutions :: RenameM Substitutions
renamerSubstitutions :: RenameM (Map VName VName)
renamerSubstitutions = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenameEnv -> Map VName VName
envNameMap
substituteRename :: Substitute a => a -> RenameM a
substituteRename :: forall a. Substitute a => a -> RenameM a
substituteRename a
x = do
Map VName VName
substs <- RenameM (Map VName VName)
renamerSubstitutions
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs a
x
class Rename a where
rename :: a -> RenameM a
instance Rename VName where
rename :: VName -> RenameM VName
rename VName
name = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. a -> Maybe a -> a
fromMaybe VName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameEnv -> Map VName VName
envNameMap)
instance Rename a => Rename [a] where
rename :: [a] -> RenameM [a]
rename = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename
instance (Rename a, Rename b) => Rename (a, b) where
rename :: (a, b) -> RenameM (a, b)
rename (a
a, b
b) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename b
b
instance (Rename a, Rename b, Rename c) => Rename (a, b, c) where
rename :: (a, b, c) -> RenameM (a, b, c)
rename (a
a, b
b, c
c) = do
a
a' <- forall a. Rename a => a -> RenameM a
rename a
a
b
b' <- forall a. Rename a => a -> RenameM a
rename b
b
c
c' <- forall a. Rename a => a -> RenameM a
rename c
c
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a', b
b', c
c')
instance Rename a => Rename (Maybe a) where
rename :: Maybe a -> RenameM (Maybe a)
rename = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rename a => a -> RenameM a
rename)
instance Rename Bool where
rename :: Bool -> RenameM Bool
rename = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Rename Ident where
rename :: Ident -> RenameM Ident
rename (Ident VName
name Type
tp) = do
VName
name' <- forall a. Rename a => a -> RenameM a
rename VName
name
Type
tp' <- forall a. Rename a => a -> RenameM a
rename Type
tp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ VName -> Type -> Ident
Ident VName
name' Type
tp'
renameBound :: [VName] -> RenameM a -> RenameM a
renameBound :: forall a. [VName] -> RenameM a -> RenameM a
renameBound [VName]
vars RenameM a
body = do
[VName]
vars' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadFreshNames m => VName -> m VName
newName [VName]
vars
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ([VName] -> RenameEnv -> RenameEnv
renameBound' [VName]
vars') RenameM a
body
where
renameBound' :: [VName] -> RenameEnv -> RenameEnv
renameBound' [VName]
vars' RenameEnv
env =
RenameEnv
env
{ envNameMap :: Map VName VName
envNameMap =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [VName]
vars [VName]
vars')
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RenameEnv -> Map VName VName
envNameMap RenameEnv
env
}
renamingStms :: Renameable rep => Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms :: forall {k} (rep :: k) a.
Renameable rep =>
Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms Stms rep
stms Stms rep -> RenameM a
m = Stms rep -> Stms rep -> RenameM a
descend forall a. Monoid a => a
mempty Stms rep
stms
where
descend :: Stms rep -> Stms rep -> RenameM a
descend Stms rep
stms' Stms rep
rem_stms = case forall {k} (rep :: k). Stms rep -> Maybe (Stm rep, Stms rep)
stmsHead Stms rep
rem_stms of
Maybe (Stm rep, Stms rep)
Nothing -> Stms rep -> RenameM a
m Stms rep
stms'
Just (Stm rep
stm, Stms rep
rem_stms') -> forall a. [VName] -> RenameM a -> RenameM a
renameBound (forall dec. Pat dec -> [VName]
patNames forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k). Stm rep -> Pat (LetDec rep)
stmPat Stm rep
stm) forall a b. (a -> b) -> a -> b
$ do
Stm rep
stm' <- forall a. Rename a => a -> RenameM a
rename Stm rep
stm
Stms rep -> Stms rep -> RenameM a
descend (Stms rep
stms' forall a. Semigroup a => a -> a -> a
<> forall {k} (rep :: k). Stm rep -> Stms rep
oneStm Stm rep
stm') Stms rep
rem_stms'
instance Renameable rep => Rename (FunDef rep) where
rename :: FunDef rep -> RenameM (FunDef rep)
rename (FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [RetType rep]
ret [Param (FParamInfo rep)]
params Body rep
body) =
forall a. [VName] -> RenameM a -> RenameM a
renameBound (forall a b. (a -> b) -> [a] -> [b]
map forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params) forall a b. (a -> b) -> a -> b
$ do
[Param (FParamInfo rep)]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [Param (FParamInfo rep)]
params
Body rep
body' <- forall a. Rename a => a -> RenameM a
rename Body rep
body
[RetType rep]
ret' <- forall a. Rename a => a -> RenameM a
rename [RetType rep]
ret
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
Maybe EntryPoint
-> Attrs
-> Name
-> [RetType rep]
-> [FParam rep]
-> Body rep
-> FunDef rep
FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [RetType rep]
ret' [Param (FParamInfo rep)]
params' Body rep
body'
instance Rename SubExp where
rename :: SubExp -> RenameM SubExp
rename (Var VName
v) = VName -> SubExp
Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename VName
v
rename (Constant PrimValue
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PrimValue -> SubExp
Constant PrimValue
v
instance Rename dec => Rename (Param dec) where
rename :: Param dec -> RenameM (Param dec)
rename (Param Attrs
attrs VName
name dec
dec) =
forall dec. Attrs -> VName -> dec -> Param dec
Param forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename Attrs
attrs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename VName
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename dec
dec
instance Rename dec => Rename (Pat dec) where
rename :: Pat dec -> RenameM (Pat dec)
rename (Pat [PatElem dec]
xs) = forall dec. [PatElem dec] -> Pat dec
Pat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename [PatElem dec]
xs
instance Rename dec => Rename (PatElem dec) where
rename :: PatElem dec -> RenameM (PatElem dec)
rename (PatElem VName
ident dec
dec) = forall dec. VName -> dec -> PatElem dec
PatElem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename VName
ident forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename dec
dec
instance Rename Certs where
rename :: Certs -> RenameM Certs
rename (Certs [VName]
cs) = [VName] -> Certs
Certs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename [VName]
cs
instance Rename Attrs where
rename :: Attrs -> RenameM Attrs
rename = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Rename dec => Rename (StmAux dec) where
rename :: StmAux dec -> RenameM (StmAux dec)
rename (StmAux Certs
cs Attrs
attrs dec
dec) =
forall dec. Certs -> Attrs -> dec -> StmAux dec
StmAux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename Certs
cs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename Attrs
attrs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename dec
dec
instance Rename SubExpRes where
rename :: SubExpRes -> RenameM SubExpRes
rename (SubExpRes Certs
cs SubExp
se) = Certs -> SubExp -> SubExpRes
SubExpRes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename Certs
cs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename SubExp
se
instance Renameable rep => Rename (Body rep) where
rename :: Body rep -> RenameM (Body rep)
rename (Body BodyDec rep
dec Stms rep
stms Result
res) = do
BodyDec rep
dec' <- forall a. Rename a => a -> RenameM a
rename BodyDec rep
dec
forall {k} (rep :: k) a.
Renameable rep =>
Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms Stms rep
stms forall a b. (a -> b) -> a -> b
$ \Stms rep
stms' ->
forall {k} (rep :: k).
BodyDec rep -> Stms rep -> Result -> Body rep
Body BodyDec rep
dec' Stms rep
stms' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename Result
res
instance Renameable rep => Rename (Stm rep) where
rename :: Stm rep -> RenameM (Stm rep)
rename (Let Pat (LetDec rep)
pat StmAux (ExpDec rep)
dec Exp rep
e) = forall {k} (rep :: k).
Pat (LetDec rep) -> StmAux (ExpDec rep) -> Exp rep -> Stm rep
Let forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename Pat (LetDec rep)
pat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename StmAux (ExpDec rep)
dec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename Exp rep
e
instance Renameable rep => Rename (Exp rep) where
rename :: Exp rep -> RenameM (Exp rep)
rename (WithAcc [WithAccInput rep]
inputs Lambda rep
lam) =
forall {k} (rep :: k). [WithAccInput rep] -> Lambda rep -> Exp rep
WithAcc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename [WithAccInput rep]
inputs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename Lambda rep
lam
rename (DoLoop [(Param (FParamInfo rep), SubExp)]
merge LoopForm rep
form Body rep
loopbody) = do
let ([Param (FParamInfo rep)]
params, [SubExp]
args) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo rep), SubExp)]
merge
[SubExp]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [SubExp]
args
case LoopForm rep
form of
ForLoop VName
i IntType
it SubExp
boundexp [(Param (LParamInfo rep), VName)]
loop_vars -> forall a. [VName] -> RenameM a -> RenameM a
renameBound [VName
i] forall a b. (a -> b) -> a -> b
$ do
let ([Param (LParamInfo rep)]
arr_params, [VName]
loop_arrs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (LParamInfo rep), VName)]
loop_vars
SubExp
boundexp' <- forall a. Rename a => a -> RenameM a
rename SubExp
boundexp
[VName]
loop_arrs' <- forall a. Rename a => a -> RenameM a
rename [VName]
loop_arrs
forall a. [VName] -> RenameM a -> RenameM a
renameBound (forall a b. (a -> b) -> [a] -> [b]
map forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall dec. Param dec -> VName
paramName [Param (LParamInfo rep)]
arr_params) forall a b. (a -> b) -> a -> b
$ do
[Param (FParamInfo rep)]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [Param (FParamInfo rep)]
params
[Param (LParamInfo rep)]
arr_params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [Param (LParamInfo rep)]
arr_params
VName
i' <- forall a. Rename a => a -> RenameM a
rename VName
i
Body rep
loopbody' <- forall a. Rename a => a -> RenameM a
rename Body rep
loopbody
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall {k} (rep :: k).
[(FParam rep, SubExp)] -> LoopForm rep -> Body rep -> Exp rep
DoLoop
(forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo rep)]
params' [SubExp]
args')
(forall {k} (rep :: k).
VName -> IntType -> SubExp -> [(LParam rep, VName)] -> LoopForm rep
ForLoop VName
i' IntType
it SubExp
boundexp' forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Param (LParamInfo rep)]
arr_params' [VName]
loop_arrs')
Body rep
loopbody'
WhileLoop VName
cond ->
forall a. [VName] -> RenameM a -> RenameM a
renameBound (forall a b. (a -> b) -> [a] -> [b]
map forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params) forall a b. (a -> b) -> a -> b
$ do
[Param (FParamInfo rep)]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [Param (FParamInfo rep)]
params
Body rep
loopbody' <- forall a. Rename a => a -> RenameM a
rename Body rep
loopbody
VName
cond' <- forall a. Rename a => a -> RenameM a
rename VName
cond
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
[(FParam rep, SubExp)] -> LoopForm rep -> Body rep -> Exp rep
DoLoop (forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo rep)]
params' [SubExp]
args') (forall {k} (rep :: k). VName -> LoopForm rep
WhileLoop VName
cond') Body rep
loopbody'
rename Exp rep
e = forall {k1} {k2} (m :: * -> *) (frep :: k1) (trep :: k2).
Monad m =>
Mapper frep trep m -> Exp frep -> m (Exp trep)
mapExpM Mapper rep rep RenameM
mapper Exp rep
e
where
mapper :: Mapper rep rep RenameM
mapper =
Mapper
{ mapOnBody :: Scope rep -> Body rep -> RenameM (Body rep)
mapOnBody = forall a b. a -> b -> a
const forall a. Rename a => a -> RenameM a
rename,
mapOnSubExp :: SubExp -> RenameM SubExp
mapOnSubExp = forall a. Rename a => a -> RenameM a
rename,
mapOnVName :: VName -> RenameM VName
mapOnVName = forall a. Rename a => a -> RenameM a
rename,
mapOnRetType :: RetType rep -> RenameM (RetType rep)
mapOnRetType = forall a. Rename a => a -> RenameM a
rename,
mapOnBranchType :: BranchType rep -> RenameM (BranchType rep)
mapOnBranchType = forall a. Rename a => a -> RenameM a
rename,
mapOnFParam :: Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep))
mapOnFParam = forall a. Rename a => a -> RenameM a
rename,
mapOnLParam :: Param (LParamInfo rep) -> RenameM (Param (LParamInfo rep))
mapOnLParam = forall a. Rename a => a -> RenameM a
rename,
mapOnOp :: Op rep -> RenameM (Op rep)
mapOnOp = forall a. Rename a => a -> RenameM a
rename
}
instance Rename PrimType where
rename :: PrimType -> RenameM PrimType
rename = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Rename shape => Rename (TypeBase shape u) where
rename :: TypeBase shape u -> RenameM (TypeBase shape u)
rename (Array PrimType
et shape
size u
u) = forall shape u. PrimType -> shape -> u -> TypeBase shape u
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename PrimType
et forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename shape
size forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u
rename (Prim PrimType
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall shape u. PrimType -> TypeBase shape u
Prim PrimType
t
rename (Mem Space
space) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall shape u. Space -> TypeBase shape u
Mem Space
space
rename (Acc VName
acc ShapeBase SubExp
ispace [Type]
ts u
u) =
forall shape u.
VName -> ShapeBase SubExp -> [Type] -> u -> TypeBase shape u
Acc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename VName
acc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename ShapeBase SubExp
ispace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename [Type]
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u
instance Renameable rep => Rename (Lambda rep) where
rename :: Lambda rep -> RenameM (Lambda rep)
rename (Lambda [Param (LParamInfo rep)]
params Body rep
body [Type]
ret) =
forall a. [VName] -> RenameM a -> RenameM a
renameBound (forall a b. (a -> b) -> [a] -> [b]
map forall dec. Param dec -> VName
paramName [Param (LParamInfo rep)]
params) forall a b. (a -> b) -> a -> b
$ do
[Param (LParamInfo rep)]
params' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [Param (LParamInfo rep)]
params
Body rep
body' <- forall a. Rename a => a -> RenameM a
rename Body rep
body
[Type]
ret' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [Type]
ret
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
[LParam rep] -> Body rep -> [Type] -> Lambda rep
Lambda [Param (LParamInfo rep)]
params' Body rep
body' [Type]
ret'
instance Rename Names where
rename :: Names -> RenameM Names
rename = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VName] -> Names
namesFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> [VName]
namesToList
instance Rename Rank where
rename :: Rank -> RenameM Rank
rename = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Rename d => Rename (ShapeBase d) where
rename :: ShapeBase d -> RenameM (ShapeBase d)
rename (Shape [d]
l) = forall d. [d] -> ShapeBase d
Shape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Rename a => a -> RenameM a
rename [d]
l
instance Rename ExtSize where
rename :: ExtSize -> RenameM ExtSize
rename (Free SubExp
se) = forall a. a -> Ext a
Free forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename SubExp
se
rename (Ext Int
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> Ext a
Ext Int
x
instance Rename () where
rename :: () -> RenameM ()
rename = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Rename d => Rename (DimIndex d) where
rename :: DimIndex d -> RenameM (DimIndex d)
rename (DimFix d
i) = forall d. d -> DimIndex d
DimFix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename d
i
rename (DimSlice d
i d
n d
s) = forall d. d -> d -> d -> DimIndex d
DimSlice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Rename a => a -> RenameM a
rename d
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename d
n forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Rename a => a -> RenameM a
rename d
s
type Renameable rep =
( Rename (LetDec rep),
Rename (ExpDec rep),
Rename (BodyDec rep),
Rename (FParamInfo rep),
Rename (LParamInfo rep),
Rename (RetType rep),
Rename (BranchType rep),
Rename (Op rep)
)