{-# LANGUAGE UndecidableInstances #-}

-- | This module provides facilities for transforming Futhark programs
-- such that names are unique, via the 'renameProg' function.
module Futhark.Transform.Rename
  ( -- * Renaming programs
    renameProg,

    -- * Renaming parts of a program.

    --
    -- These all require execution in a 'MonadFreshNames' environment.
    renameExp,
    renameStm,
    renameBody,
    renameLambda,
    renamePat,
    renameSomething,
    renameBound,
    renameStmsWith,

    -- * Renaming annotations
    RenameM,
    substituteRename,
    renamingStms,
    Rename (..),
    Renameable,
  )
where

import Control.Monad.Reader
import Control.Monad.State
import Data.Bitraversable
import Data.Map.Strict qualified as M
import Data.Maybe
import Futhark.FreshNames hiding (newName)
import Futhark.IR.Prop.Names
import Futhark.IR.Prop.Pat
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 = Reader RenameEnv (a, VNameSource) -> RenameEnv -> (a, VNameSource)
forall r a. Reader r a -> r -> a
runReader (StateT VNameSource (Reader RenameEnv) a
-> VNameSource -> Reader RenameEnv (a, VNameSource)
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 Map VName VName
forall k a. Map k a
M.empty

-- | Rename variables such that each is unique.  The semantics of the
-- program are unaffected, under the assumption that the program was
-- correct to begin with.  In particular, the renaming may make an
-- invalid program valid.
renameProg ::
  (Renameable rep, MonadFreshNames m) =>
  Prog rep ->
  m (Prog rep)
renameProg :: forall rep (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Prog rep -> m (Prog rep)
renameProg Prog rep
prog = (VNameSource -> (Prog rep, VNameSource)) -> m (Prog rep)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> (Prog rep, VNameSource)) -> m (Prog rep))
-> (VNameSource -> (Prog rep, VNameSource)) -> m (Prog rep)
forall a b. (a -> b) -> a -> b
$
  RenameM (Prog rep) -> VNameSource -> (Prog rep, VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM (Prog rep) -> VNameSource -> (Prog rep, VNameSource))
-> RenameM (Prog rep) -> VNameSource -> (Prog rep, VNameSource)
forall a b. (a -> b) -> a -> b
$
    Stms rep -> (Stms rep -> RenameM (Prog rep)) -> RenameM (Prog rep)
forall rep a.
Renameable rep =>
Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms (Prog rep -> Stms rep
forall rep. Prog rep -> Stms rep
progConsts Prog rep
prog) ((Stms rep -> RenameM (Prog rep)) -> RenameM (Prog rep))
-> (Stms rep -> RenameM (Prog rep)) -> RenameM (Prog rep)
forall a b. (a -> b) -> a -> b
$ \Stms rep
consts -> do
      [FunDef rep]
funs <- (FunDef rep -> RenameM (FunDef rep))
-> [FunDef rep] -> RenameM [FunDef rep]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FunDef rep -> RenameM (FunDef rep)
forall a. Rename a => a -> RenameM a
rename (Prog rep -> [FunDef rep]
forall rep. Prog rep -> [FunDef rep]
progFuns Prog rep
prog)
      Prog rep -> RenameM (Prog rep)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog rep
prog {progConsts = consts, progFuns = funs}

-- | Rename bound variables such that each is unique.  The semantics
-- of the expression is unaffected, under the assumption that the
-- expression was correct to begin with.  Any free variables are left
-- untouched.
renameExp ::
  (Renameable rep, MonadFreshNames m) =>
  Exp rep ->
  m (Exp rep)
renameExp :: forall rep (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Exp rep -> m (Exp rep)
renameExp = (VNameSource -> (Exp rep, VNameSource)) -> m (Exp rep)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> (Exp rep, VNameSource)) -> m (Exp rep))
-> (Exp rep -> VNameSource -> (Exp rep, VNameSource))
-> Exp rep
-> m (Exp rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameM (Exp rep) -> VNameSource -> (Exp rep, VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM (Exp rep) -> VNameSource -> (Exp rep, VNameSource))
-> (Exp rep -> RenameM (Exp rep))
-> Exp rep
-> VNameSource
-> (Exp rep, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp rep -> RenameM (Exp rep)
forall a. Rename a => a -> RenameM a
rename

-- | Rename bound variables such that each is unique.  The semantics
-- of the binding is unaffected, under the assumption that the
-- binding was correct to begin with.  Any free variables are left
-- untouched, as are the names in the pattern of the binding.
renameStm ::
  (Renameable rep, MonadFreshNames m) =>
  Stm rep ->
  m (Stm rep)
renameStm :: forall rep (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Stm rep -> m (Stm rep)
renameStm Stm rep
binding = do
  Exp rep
e <- Exp rep -> m (Exp rep)
forall rep (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Exp rep -> m (Exp rep)
renameExp (Exp rep -> m (Exp rep)) -> Exp rep -> m (Exp rep)
forall a b. (a -> b) -> a -> b
$ Stm rep -> Exp rep
forall rep. Stm rep -> Exp rep
stmExp Stm rep
binding
  Stm rep -> m (Stm rep)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stm rep
binding {stmExp = e}

-- | Rename bound variables such that each is unique.  The semantics
-- of the body is unaffected, under the assumption that the body was
-- correct to begin with.  Any free variables are left untouched.
renameBody ::
  (Renameable rep, MonadFreshNames m) =>
  Body rep ->
  m (Body rep)
renameBody :: forall rep (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Body rep -> m (Body rep)
renameBody = (VNameSource -> (Body rep, VNameSource)) -> m (Body rep)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> (Body rep, VNameSource)) -> m (Body rep))
-> (Body rep -> VNameSource -> (Body rep, VNameSource))
-> Body rep
-> m (Body rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameM (Body rep) -> VNameSource -> (Body rep, VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM (Body rep) -> VNameSource -> (Body rep, VNameSource))
-> (Body rep -> RenameM (Body rep))
-> Body rep
-> VNameSource
-> (Body rep, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body rep -> RenameM (Body rep)
forall a. Rename a => a -> RenameM a
rename

-- | Rename bound variables such that each is unique.  The semantics
-- of the lambda is unaffected, under the assumption that the body was
-- correct to begin with.  Any free variables are left untouched.
-- Note in particular that the parameters of the lambda are renamed.
renameLambda ::
  (Renameable rep, MonadFreshNames m) =>
  Lambda rep ->
  m (Lambda rep)
renameLambda :: forall rep (m :: * -> *).
(Renameable rep, MonadFreshNames m) =>
Lambda rep -> m (Lambda rep)
renameLambda = (VNameSource -> (Lambda rep, VNameSource)) -> m (Lambda rep)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> (Lambda rep, VNameSource)) -> m (Lambda rep))
-> (Lambda rep -> VNameSource -> (Lambda rep, VNameSource))
-> Lambda rep
-> m (Lambda rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameM (Lambda rep) -> VNameSource -> (Lambda rep, VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM (Lambda rep) -> VNameSource -> (Lambda rep, VNameSource))
-> (Lambda rep -> RenameM (Lambda rep))
-> Lambda rep
-> VNameSource
-> (Lambda rep, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lambda rep -> RenameM (Lambda rep)
forall a. Rename a => a -> RenameM a
rename

-- | Produce an equivalent pattern but with each pattern element given
-- a new name.
renamePat ::
  (Rename dec, MonadFreshNames m) =>
  Pat dec ->
  m (Pat dec)
renamePat :: forall dec (m :: * -> *).
(Rename dec, MonadFreshNames m) =>
Pat dec -> m (Pat dec)
renamePat = (VNameSource -> (Pat dec, VNameSource)) -> m (Pat dec)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> (Pat dec, VNameSource)) -> m (Pat dec))
-> (Pat dec -> VNameSource -> (Pat dec, VNameSource))
-> Pat dec
-> m (Pat dec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameM (Pat dec) -> VNameSource -> (Pat dec, VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM (Pat dec) -> VNameSource -> (Pat dec, VNameSource))
-> (Pat dec -> RenameM (Pat dec))
-> Pat dec
-> VNameSource
-> (Pat dec, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat dec -> RenameM (Pat dec)
forall {dec}. Rename dec => Pat dec -> RenameM (Pat dec)
rename'
  where
    rename' :: Pat dec -> RenameM (Pat dec)
rename' Pat dec
pat = [VName] -> RenameM (Pat dec) -> RenameM (Pat dec)
forall a. [VName] -> RenameM a -> RenameM a
renameBound (Pat dec -> [VName]
forall dec. Pat dec -> [VName]
patNames Pat dec
pat) (RenameM (Pat dec) -> RenameM (Pat dec))
-> RenameM (Pat dec) -> RenameM (Pat dec)
forall a b. (a -> b) -> a -> b
$ Pat dec -> RenameM (Pat dec)
forall a. Rename a => a -> RenameM a
rename Pat dec
pat

-- | Rename the bound variables in something (does not affect free variables).
renameSomething ::
  (Rename a, MonadFreshNames m) =>
  a ->
  m a
renameSomething :: forall a (m :: * -> *). (Rename a, MonadFreshNames m) => a -> m a
renameSomething = (VNameSource -> (a, VNameSource)) -> m a
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> (a, VNameSource)) -> m a)
-> (a -> VNameSource -> (a, VNameSource)) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameM a -> VNameSource -> (a, VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM a -> VNameSource -> (a, VNameSource))
-> (a -> RenameM a) -> a -> VNameSource -> (a, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RenameM a
forall a. Rename a => a -> RenameM a
rename

-- | Rename statements, then rename something within the scope of
-- those statements.
renameStmsWith ::
  (MonadFreshNames m, Renameable rep, Rename a) =>
  Stms rep ->
  a ->
  m (Stms rep, a)
renameStmsWith :: forall (m :: * -> *) rep a.
(MonadFreshNames m, Renameable rep, Rename a) =>
Stms rep -> a -> m (Stms rep, a)
renameStmsWith Stms rep
stms a
a =
  (VNameSource -> ((Stms rep, a), VNameSource)) -> m (Stms rep, a)
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource ((VNameSource -> ((Stms rep, a), VNameSource)) -> m (Stms rep, a))
-> (RenameM (Stms rep, a)
    -> VNameSource -> ((Stms rep, a), VNameSource))
-> RenameM (Stms rep, a)
-> m (Stms rep, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameM (Stms rep, a)
-> VNameSource -> ((Stms rep, a), VNameSource)
forall a. RenameM a -> VNameSource -> (a, VNameSource)
runRenamer (RenameM (Stms rep, a) -> m (Stms rep, a))
-> RenameM (Stms rep, a) -> m (Stms rep, a)
forall a b. (a -> b) -> a -> b
$ Stms rep
-> (Stms rep -> RenameM (Stms rep, a)) -> RenameM (Stms rep, a)
forall rep a.
Renameable rep =>
Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms Stms rep
stms ((Stms rep -> RenameM (Stms rep, a)) -> RenameM (Stms rep, a))
-> (Stms rep -> RenameM (Stms rep, a)) -> RenameM (Stms rep, a)
forall a b. (a -> b) -> a -> b
$ \Stms rep
stms' ->
    (Stms rep
stms',) (a -> (Stms rep, a)) -> RenameM a -> RenameM (Stms rep, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> RenameM a
forall a. Rename a => a -> RenameM a
rename a
a

newtype RenameEnv = RenameEnv {RenameEnv -> Map VName VName
envNameMap :: M.Map VName VName}

-- | The monad in which renaming is performed.
newtype RenameM a = RenameM (StateT VNameSource (Reader RenameEnv) a)
  deriving
    ( (forall a b. (a -> b) -> RenameM a -> RenameM b)
-> (forall a b. a -> RenameM b -> RenameM a) -> Functor RenameM
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
$cfmap :: forall a b. (a -> b) -> RenameM a -> RenameM b
fmap :: forall a b. (a -> b) -> RenameM a -> RenameM b
$c<$ :: forall a b. a -> RenameM b -> RenameM a
<$ :: forall a b. a -> RenameM b -> RenameM a
Functor,
      Functor RenameM
Functor RenameM =>
(forall a. a -> RenameM a)
-> (forall a b. RenameM (a -> b) -> RenameM a -> RenameM b)
-> (forall a b c.
    (a -> b -> c) -> RenameM a -> RenameM b -> RenameM c)
-> (forall a b. RenameM a -> RenameM b -> RenameM b)
-> (forall a b. RenameM a -> RenameM b -> RenameM a)
-> Applicative 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
$cpure :: forall a. a -> RenameM a
pure :: forall a. a -> RenameM a
$c<*> :: forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
<*> :: forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
$cliftA2 :: forall a b c. (a -> b -> c) -> RenameM a -> RenameM b -> RenameM c
liftA2 :: forall a b c. (a -> b -> c) -> RenameM a -> RenameM b -> RenameM c
$c*> :: forall a b. RenameM a -> RenameM b -> RenameM b
*> :: forall a b. RenameM a -> RenameM b -> RenameM b
$c<* :: forall a b. RenameM a -> RenameM b -> RenameM a
<* :: forall a b. RenameM a -> RenameM b -> RenameM a
Applicative,
      Applicative RenameM
Applicative RenameM =>
(forall a b. RenameM a -> (a -> RenameM b) -> RenameM b)
-> (forall a b. RenameM a -> RenameM b -> RenameM b)
-> (forall a. a -> RenameM a)
-> Monad 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
$c>>= :: forall a b. RenameM a -> (a -> RenameM b) -> RenameM b
>>= :: forall a b. RenameM a -> (a -> RenameM b) -> RenameM b
$c>> :: forall a b. RenameM a -> RenameM b -> RenameM b
>> :: forall a b. RenameM a -> RenameM b -> RenameM b
$creturn :: forall a. a -> RenameM a
return :: forall a. a -> RenameM a
Monad,
      Monad RenameM
RenameM VNameSource
Monad RenameM =>
RenameM VNameSource
-> (VNameSource -> RenameM ()) -> MonadFreshNames RenameM
VNameSource -> RenameM ()
forall (m :: * -> *).
Monad m =>
m VNameSource -> (VNameSource -> m ()) -> MonadFreshNames m
$cgetNameSource :: RenameM VNameSource
getNameSource :: RenameM VNameSource
$cputNameSource :: VNameSource -> RenameM ()
putNameSource :: VNameSource -> RenameM ()
MonadFreshNames,
      MonadReader RenameEnv
    )

-- | Produce a map of the substitutions that should be performed by
-- the renamer.
renamerSubstitutions :: RenameM Substitutions
renamerSubstitutions :: RenameM (Map VName VName)
renamerSubstitutions = (RenameEnv -> Map VName VName) -> RenameM (Map VName VName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenameEnv -> Map VName VName
envNameMap

-- | Perform a renaming using the 'Substitute' instance.  This only
-- works if the argument does not itself perform any name binding, but
-- it can save on boilerplate for simple types.
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
  a -> RenameM a
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> RenameM a) -> a -> RenameM a
forall a b. (a -> b) -> a -> b
$ Map VName VName -> a -> a
forall a. Substitute a => Map VName VName -> a -> a
substituteNames Map VName VName
substs a
x

-- | Members of class 'Rename' can be uniquely renamed.
class Rename a where
  -- | Rename the given value such that it does not contain shadowing,
  -- and has incorporated any substitutions present in the 'RenameM'
  -- environment.
  rename :: a -> RenameM a

instance Rename VName where
  rename :: VName -> RenameM VName
rename VName
name = (RenameEnv -> VName) -> RenameM VName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (VName -> Maybe VName -> VName
forall a. a -> Maybe a -> a
fromMaybe VName
name (Maybe VName -> VName)
-> (RenameEnv -> Maybe VName) -> RenameEnv -> VName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Map VName VName -> Maybe VName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name (Map VName VName -> Maybe VName)
-> (RenameEnv -> Map VName VName) -> RenameEnv -> Maybe VName
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 = (a -> RenameM a) -> [a] -> RenameM [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> RenameM a
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) = (,) (a -> b -> (a, b)) -> RenameM a -> RenameM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> RenameM a
forall a. Rename a => a -> RenameM a
rename a
a RenameM (b -> (a, b)) -> RenameM b -> RenameM (a, b)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> RenameM 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' <- a -> RenameM a
forall a. Rename a => a -> RenameM a
rename a
a
    b
b' <- b -> RenameM b
forall a. Rename a => a -> RenameM a
rename b
b
    c
c' <- c -> RenameM c
forall a. Rename a => a -> RenameM a
rename c
c
    (a, b, c) -> RenameM (a, b, c)
forall a. a -> RenameM a
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 = RenameM (Maybe a)
-> (a -> RenameM (Maybe a)) -> Maybe a -> RenameM (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> RenameM (Maybe a)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> RenameM a -> RenameM (Maybe a)
forall a b. (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (RenameM a -> RenameM (Maybe a))
-> (a -> RenameM a) -> a -> RenameM (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RenameM a
forall a. Rename a => a -> RenameM a
rename)

instance Rename Bool where
  rename :: Bool -> RenameM Bool
rename = Bool -> RenameM Bool
forall a. a -> RenameM a
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' <- VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
name
    Type
tp' <- Type -> RenameM Type
forall a. Rename a => a -> RenameM a
rename Type
tp
    Ident -> RenameM Ident
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ident -> RenameM Ident) -> Ident -> RenameM Ident
forall a b. (a -> b) -> a -> b
$ VName -> Type -> Ident
Ident VName
name' Type
tp'

-- | Rename variables in binding position.  The provided VNames are
-- associated with new, fresh names in the renaming environment.
renameBound :: [VName] -> RenameM a -> RenameM a
renameBound :: forall a. [VName] -> RenameM a -> RenameM a
renameBound [VName]
vars RenameM a
body = do
  [VName]
vars' <- (VName -> RenameM VName) -> [VName] -> RenameM [VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VName -> RenameM VName
forall (m :: * -> *). MonadFreshNames m => VName -> m VName
newName [VName]
vars
  -- This works because map union prefers elements from left
  -- operand.
  (RenameEnv -> RenameEnv) -> RenameM a -> RenameM a
forall a. (RenameEnv -> RenameEnv) -> RenameM a -> RenameM a
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 =
            M.fromList (zip vars vars')
              `M.union` envNameMap env
        }

-- | Rename some statements, then execute an action with the name
-- substitutions induced by the statements active.
renamingStms :: (Renameable rep) => Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms :: forall rep 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 Stms rep
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 Stms rep -> Maybe (Stm rep, Stms rep)
forall rep. 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') -> [VName] -> RenameM a -> RenameM a
forall a. [VName] -> RenameM a -> RenameM a
renameBound (Pat (LetDec rep) -> [VName]
forall dec. Pat dec -> [VName]
patNames (Pat (LetDec rep) -> [VName]) -> Pat (LetDec rep) -> [VName]
forall a b. (a -> b) -> a -> b
$ Stm rep -> Pat (LetDec rep)
forall rep. Stm rep -> Pat (LetDec rep)
stmPat Stm rep
stm) (RenameM a -> RenameM a) -> RenameM a -> RenameM a
forall a b. (a -> b) -> a -> b
$ do
        Stm rep
stm' <- Stm rep -> RenameM (Stm rep)
forall a. Rename a => a -> RenameM a
rename Stm rep
stm
        Stms rep -> Stms rep -> RenameM a
descend (Stms rep
stms' Stms rep -> Stms rep -> Stms rep
forall a. Semigroup a => a -> a -> a
<> Stm rep -> Stms rep
forall rep. 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, RetAls)]
ret [Param (FParamInfo rep)]
params Body rep
body) =
    [VName] -> RenameM (FunDef rep) -> RenameM (FunDef rep)
forall a. [VName] -> RenameM a -> RenameM a
renameBound ((Param (FParamInfo rep) -> VName)
-> [Param (FParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params) (RenameM (FunDef rep) -> RenameM (FunDef rep))
-> RenameM (FunDef rep) -> RenameM (FunDef rep)
forall a b. (a -> b) -> a -> b
$ do
      [Param (FParamInfo rep)]
params' <- (Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep)))
-> [Param (FParamInfo rep)] -> RenameM [Param (FParamInfo rep)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep))
forall a. Rename a => a -> RenameM a
rename [Param (FParamInfo rep)]
params
      Body rep
body' <- Body rep -> RenameM (Body rep)
forall a. Rename a => a -> RenameM a
rename Body rep
body
      [(RetType rep, RetAls)]
ret' <- ((RetType rep, RetAls) -> RenameM (RetType rep, RetAls))
-> [(RetType rep, RetAls)] -> RenameM [(RetType rep, RetAls)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((RetType rep -> RenameM (RetType rep))
-> (RetAls -> RenameM RetAls)
-> (RetType rep, RetAls)
-> RenameM (RetType rep, RetAls)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse RetType rep -> RenameM (RetType rep)
forall a. Rename a => a -> RenameM a
rename RetAls -> RenameM RetAls
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [(RetType rep, RetAls)]
ret
      FunDef rep -> RenameM (FunDef rep)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunDef rep -> RenameM (FunDef rep))
-> FunDef rep -> RenameM (FunDef rep)
forall a b. (a -> b) -> a -> b
$ Maybe EntryPoint
-> Attrs
-> Name
-> [(RetType rep, RetAls)]
-> [Param (FParamInfo rep)]
-> Body rep
-> FunDef rep
forall rep.
Maybe EntryPoint
-> Attrs
-> Name
-> [(RetType rep, RetAls)]
-> [FParam rep]
-> Body rep
-> FunDef rep
FunDef Maybe EntryPoint
entry Attrs
attrs Name
fname [(RetType rep, RetAls)]
ret' [Param (FParamInfo rep)]
params' Body rep
body'

instance Rename SubExp where
  rename :: SubExp -> RenameM SubExp
rename (Var VName
v) = VName -> SubExp
Var (VName -> SubExp) -> RenameM VName -> RenameM SubExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
v
  rename (Constant PrimValue
v) = SubExp -> RenameM SubExp
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubExp -> RenameM SubExp) -> SubExp -> RenameM SubExp
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) =
    Attrs -> VName -> dec -> Param dec
forall dec. Attrs -> VName -> dec -> Param dec
Param (Attrs -> VName -> dec -> Param dec)
-> RenameM Attrs -> RenameM (VName -> dec -> Param dec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Attrs -> RenameM Attrs
forall a. Rename a => a -> RenameM a
rename Attrs
attrs RenameM (VName -> dec -> Param dec)
-> RenameM VName -> RenameM (dec -> Param dec)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
name RenameM (dec -> Param dec) -> RenameM dec -> RenameM (Param dec)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> dec -> RenameM dec
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) = [PatElem dec] -> Pat dec
forall dec. [PatElem dec] -> Pat dec
Pat ([PatElem dec] -> Pat dec)
-> RenameM [PatElem dec] -> RenameM (Pat dec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PatElem dec] -> RenameM [PatElem dec]
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) = VName -> dec -> PatElem dec
forall dec. VName -> dec -> PatElem dec
PatElem (VName -> dec -> PatElem dec)
-> RenameM VName -> RenameM (dec -> PatElem dec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
ident RenameM (dec -> PatElem dec)
-> RenameM dec -> RenameM (PatElem dec)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> dec -> RenameM dec
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 ([VName] -> Certs) -> RenameM [VName] -> RenameM Certs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VName] -> RenameM [VName]
forall a. Rename a => a -> RenameM a
rename [VName]
cs

instance Rename Attrs where
  rename :: Attrs -> RenameM Attrs
rename = Attrs -> RenameM Attrs
forall a. a -> RenameM a
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) =
    Certs -> Attrs -> dec -> StmAux dec
forall dec. Certs -> Attrs -> dec -> StmAux dec
StmAux (Certs -> Attrs -> dec -> StmAux dec)
-> RenameM Certs -> RenameM (Attrs -> dec -> StmAux dec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Certs -> RenameM Certs
forall a. Rename a => a -> RenameM a
rename Certs
cs RenameM (Attrs -> dec -> StmAux dec)
-> RenameM Attrs -> RenameM (dec -> StmAux dec)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Attrs -> RenameM Attrs
forall a. Rename a => a -> RenameM a
rename Attrs
attrs RenameM (dec -> StmAux dec) -> RenameM dec -> RenameM (StmAux dec)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> dec -> RenameM dec
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 (Certs -> SubExp -> SubExpRes)
-> RenameM Certs -> RenameM (SubExp -> SubExpRes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Certs -> RenameM Certs
forall a. Rename a => a -> RenameM a
rename Certs
cs RenameM (SubExp -> SubExpRes)
-> RenameM SubExp -> RenameM SubExpRes
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SubExp -> RenameM SubExp
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' <- BodyDec rep -> RenameM (BodyDec rep)
forall a. Rename a => a -> RenameM a
rename BodyDec rep
dec
    Stms rep -> (Stms rep -> RenameM (Body rep)) -> RenameM (Body rep)
forall rep a.
Renameable rep =>
Stms rep -> (Stms rep -> RenameM a) -> RenameM a
renamingStms Stms rep
stms ((Stms rep -> RenameM (Body rep)) -> RenameM (Body rep))
-> (Stms rep -> RenameM (Body rep)) -> RenameM (Body rep)
forall a b. (a -> b) -> a -> b
$ \Stms rep
stms' ->
      BodyDec rep -> Stms rep -> Result -> Body rep
forall rep. BodyDec rep -> Stms rep -> Result -> Body rep
Body BodyDec rep
dec' Stms rep
stms' (Result -> Body rep) -> RenameM Result -> RenameM (Body rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> RenameM Result
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) = Pat (LetDec rep) -> StmAux (ExpDec rep) -> Exp rep -> Stm rep
forall rep.
Pat (LetDec rep) -> StmAux (ExpDec rep) -> Exp rep -> Stm rep
Let (Pat (LetDec rep) -> StmAux (ExpDec rep) -> Exp rep -> Stm rep)
-> RenameM (Pat (LetDec rep))
-> RenameM (StmAux (ExpDec rep) -> Exp rep -> Stm rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pat (LetDec rep) -> RenameM (Pat (LetDec rep))
forall a. Rename a => a -> RenameM a
rename Pat (LetDec rep)
pat RenameM (StmAux (ExpDec rep) -> Exp rep -> Stm rep)
-> RenameM (StmAux (ExpDec rep)) -> RenameM (Exp rep -> Stm rep)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StmAux (ExpDec rep) -> RenameM (StmAux (ExpDec rep))
forall a. Rename a => a -> RenameM a
rename StmAux (ExpDec rep)
dec RenameM (Exp rep -> Stm rep)
-> RenameM (Exp rep) -> RenameM (Stm rep)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp rep -> RenameM (Exp rep)
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) =
    [WithAccInput rep] -> Lambda rep -> Exp rep
forall rep. [WithAccInput rep] -> Lambda rep -> Exp rep
WithAcc ([WithAccInput rep] -> Lambda rep -> Exp rep)
-> RenameM [WithAccInput rep] -> RenameM (Lambda rep -> Exp rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithAccInput rep] -> RenameM [WithAccInput rep]
forall a. Rename a => a -> RenameM a
rename [WithAccInput rep]
inputs RenameM (Lambda rep -> Exp rep)
-> RenameM (Lambda rep) -> RenameM (Exp rep)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lambda rep -> RenameM (Lambda rep)
forall a. Rename a => a -> RenameM a
rename Lambda rep
lam
  rename (Loop [(Param (FParamInfo rep), SubExp)]
merge LoopForm
form Body rep
loopbody) = do
    let ([Param (FParamInfo rep)]
params, [SubExp]
args) = [(Param (FParamInfo rep), SubExp)]
-> ([Param (FParamInfo rep)], [SubExp])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo rep), SubExp)]
merge
    [SubExp]
args' <- (SubExp -> RenameM SubExp) -> [SubExp] -> RenameM [SubExp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SubExp -> RenameM SubExp
forall a. Rename a => a -> RenameM a
rename [SubExp]
args
    case LoopForm
form of
      -- It is important that 'i' is renamed before the loop_vars, as
      -- 'i' may be used in the annotations for loop_vars (e.g. index
      -- functions).
      ForLoop VName
i IntType
it SubExp
boundexp -> [VName] -> RenameM (Exp rep) -> RenameM (Exp rep)
forall a. [VName] -> RenameM a -> RenameM a
renameBound [VName
i] (RenameM (Exp rep) -> RenameM (Exp rep))
-> RenameM (Exp rep) -> RenameM (Exp rep)
forall a b. (a -> b) -> a -> b
$ do
        SubExp
boundexp' <- SubExp -> RenameM SubExp
forall a. Rename a => a -> RenameM a
rename SubExp
boundexp
        [VName] -> RenameM (Exp rep) -> RenameM (Exp rep)
forall a. [VName] -> RenameM a -> RenameM a
renameBound ((Param (FParamInfo rep) -> VName)
-> [Param (FParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params) (RenameM (Exp rep) -> RenameM (Exp rep))
-> RenameM (Exp rep) -> RenameM (Exp rep)
forall a b. (a -> b) -> a -> b
$ do
          [Param (FParamInfo rep)]
params' <- (Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep)))
-> [Param (FParamInfo rep)] -> RenameM [Param (FParamInfo rep)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep))
forall a. Rename a => a -> RenameM a
rename [Param (FParamInfo rep)]
params
          VName
i' <- VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
i
          Body rep
loopbody' <- Body rep -> RenameM (Body rep)
forall a. Rename a => a -> RenameM a
rename Body rep
loopbody
          Exp rep -> RenameM (Exp rep)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp rep -> RenameM (Exp rep)) -> Exp rep -> RenameM (Exp rep)
forall a b. (a -> b) -> a -> b
$
            [(Param (FParamInfo rep), SubExp)]
-> LoopForm -> Body rep -> Exp rep
forall rep.
[(FParam rep, SubExp)] -> LoopForm -> Body rep -> Exp rep
Loop
              ([Param (FParamInfo rep)]
-> [SubExp] -> [(Param (FParamInfo rep), SubExp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo rep)]
params' [SubExp]
args')
              (VName -> IntType -> SubExp -> LoopForm
ForLoop VName
i' IntType
it SubExp
boundexp')
              Body rep
loopbody'
      WhileLoop VName
cond ->
        [VName] -> RenameM (Exp rep) -> RenameM (Exp rep)
forall a. [VName] -> RenameM a -> RenameM a
renameBound ((Param (FParamInfo rep) -> VName)
-> [Param (FParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (FParamInfo rep)]
params) (RenameM (Exp rep) -> RenameM (Exp rep))
-> RenameM (Exp rep) -> RenameM (Exp rep)
forall a b. (a -> b) -> a -> b
$ do
          [Param (FParamInfo rep)]
params' <- (Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep)))
-> [Param (FParamInfo rep)] -> RenameM [Param (FParamInfo rep)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep))
forall a. Rename a => a -> RenameM a
rename [Param (FParamInfo rep)]
params
          Body rep
loopbody' <- Body rep -> RenameM (Body rep)
forall a. Rename a => a -> RenameM a
rename Body rep
loopbody
          VName
cond' <- VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
cond
          Exp rep -> RenameM (Exp rep)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp rep -> RenameM (Exp rep)) -> Exp rep -> RenameM (Exp rep)
forall a b. (a -> b) -> a -> b
$ [(Param (FParamInfo rep), SubExp)]
-> LoopForm -> Body rep -> Exp rep
forall rep.
[(FParam rep, SubExp)] -> LoopForm -> Body rep -> Exp rep
Loop ([Param (FParamInfo rep)]
-> [SubExp] -> [(Param (FParamInfo rep), SubExp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Param (FParamInfo rep)]
params' [SubExp]
args') (VName -> LoopForm
WhileLoop VName
cond') Body rep
loopbody'
  rename Exp rep
e = Mapper rep rep RenameM -> Exp rep -> RenameM (Exp rep)
forall (m :: * -> *) frep trep.
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 = (Body rep -> RenameM (Body rep))
-> Scope rep -> Body rep -> RenameM (Body rep)
forall a b. a -> b -> a
const Body rep -> RenameM (Body rep)
forall a. Rename a => a -> RenameM a
rename,
            mapOnSubExp :: SubExp -> RenameM SubExp
mapOnSubExp = SubExp -> RenameM SubExp
forall a. Rename a => a -> RenameM a
rename,
            mapOnVName :: VName -> RenameM VName
mapOnVName = VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename,
            mapOnRetType :: RetType rep -> RenameM (RetType rep)
mapOnRetType = RetType rep -> RenameM (RetType rep)
forall a. Rename a => a -> RenameM a
rename,
            mapOnBranchType :: BranchType rep -> RenameM (BranchType rep)
mapOnBranchType = BranchType rep -> RenameM (BranchType rep)
forall a. Rename a => a -> RenameM a
rename,
            mapOnFParam :: Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep))
mapOnFParam = Param (FParamInfo rep) -> RenameM (Param (FParamInfo rep))
forall a. Rename a => a -> RenameM a
rename,
            mapOnLParam :: Param (LParamInfo rep) -> RenameM (Param (LParamInfo rep))
mapOnLParam = Param (LParamInfo rep) -> RenameM (Param (LParamInfo rep))
forall a. Rename a => a -> RenameM a
rename,
            mapOnOp :: Op rep -> RenameM (Op rep)
mapOnOp = Op rep -> RenameM (Op rep)
forall a. Rename a => a -> RenameM a
rename
          }

instance Rename PrimType where
  rename :: PrimType -> RenameM PrimType
rename = PrimType -> RenameM PrimType
forall a. a -> RenameM a
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) = PrimType -> shape -> u -> TypeBase shape u
forall shape u. PrimType -> shape -> u -> TypeBase shape u
Array (PrimType -> shape -> u -> TypeBase shape u)
-> RenameM PrimType -> RenameM (shape -> u -> TypeBase shape u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimType -> RenameM PrimType
forall a. Rename a => a -> RenameM a
rename PrimType
et RenameM (shape -> u -> TypeBase shape u)
-> RenameM shape -> RenameM (u -> TypeBase shape u)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> shape -> RenameM shape
forall a. Rename a => a -> RenameM a
rename shape
size RenameM (u -> TypeBase shape u)
-> RenameM u -> RenameM (TypeBase shape u)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u -> RenameM u
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u
  rename (Prim PrimType
t) = TypeBase shape u -> RenameM (TypeBase shape u)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeBase shape u -> RenameM (TypeBase shape u))
-> TypeBase shape u -> RenameM (TypeBase shape u)
forall a b. (a -> b) -> a -> b
$ PrimType -> TypeBase shape u
forall shape u. PrimType -> TypeBase shape u
Prim PrimType
t
  rename (Mem Space
space) = TypeBase shape u -> RenameM (TypeBase shape u)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeBase shape u -> RenameM (TypeBase shape u))
-> TypeBase shape u -> RenameM (TypeBase shape u)
forall a b. (a -> b) -> a -> b
$ Space -> TypeBase shape u
forall shape u. Space -> TypeBase shape u
Mem Space
space
  rename (Acc VName
acc ShapeBase SubExp
ispace [Type]
ts u
u) =
    VName -> ShapeBase SubExp -> [Type] -> u -> TypeBase shape u
forall shape u.
VName -> ShapeBase SubExp -> [Type] -> u -> TypeBase shape u
Acc (VName -> ShapeBase SubExp -> [Type] -> u -> TypeBase shape u)
-> RenameM VName
-> RenameM (ShapeBase SubExp -> [Type] -> u -> TypeBase shape u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename VName
acc RenameM (ShapeBase SubExp -> [Type] -> u -> TypeBase shape u)
-> RenameM (ShapeBase SubExp)
-> RenameM ([Type] -> u -> TypeBase shape u)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShapeBase SubExp -> RenameM (ShapeBase SubExp)
forall a. Rename a => a -> RenameM a
rename ShapeBase SubExp
ispace RenameM ([Type] -> u -> TypeBase shape u)
-> RenameM [Type] -> RenameM (u -> TypeBase shape u)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Type] -> RenameM [Type]
forall a. Rename a => a -> RenameM a
rename [Type]
ts RenameM (u -> TypeBase shape u)
-> RenameM u -> RenameM (TypeBase shape u)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u -> RenameM u
forall a. a -> RenameM a
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 [Type]
ret Body rep
body) =
    [VName] -> RenameM (Lambda rep) -> RenameM (Lambda rep)
forall a. [VName] -> RenameM a -> RenameM a
renameBound ((Param (LParamInfo rep) -> VName)
-> [Param (LParamInfo rep)] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param (LParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName [Param (LParamInfo rep)]
params) (RenameM (Lambda rep) -> RenameM (Lambda rep))
-> RenameM (Lambda rep) -> RenameM (Lambda rep)
forall a b. (a -> b) -> a -> b
$
      [Param (LParamInfo rep)] -> [Type] -> Body rep -> Lambda rep
forall rep. [LParam rep] -> [Type] -> Body rep -> Lambda rep
Lambda ([Param (LParamInfo rep)] -> [Type] -> Body rep -> Lambda rep)
-> RenameM [Param (LParamInfo rep)]
-> RenameM ([Type] -> Body rep -> Lambda rep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Param (LParamInfo rep) -> RenameM (Param (LParamInfo rep)))
-> [Param (LParamInfo rep)] -> RenameM [Param (LParamInfo rep)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Param (LParamInfo rep) -> RenameM (Param (LParamInfo rep))
forall a. Rename a => a -> RenameM a
rename [Param (LParamInfo rep)]
params RenameM ([Type] -> Body rep -> Lambda rep)
-> RenameM [Type] -> RenameM (Body rep -> Lambda rep)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> RenameM Type) -> [Type] -> RenameM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> RenameM Type
forall a. Rename a => a -> RenameM a
rename [Type]
ret RenameM (Body rep -> Lambda rep)
-> RenameM (Body rep) -> RenameM (Lambda rep)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Body rep -> RenameM (Body rep)
forall a. Rename a => a -> RenameM a
rename Body rep
body

instance Rename Names where
  rename :: Names -> RenameM Names
rename = ([VName] -> Names) -> RenameM [VName] -> RenameM Names
forall a b. (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VName] -> Names
namesFromList (RenameM [VName] -> RenameM Names)
-> (Names -> RenameM [VName]) -> Names -> RenameM Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VName -> RenameM VName) -> [VName] -> RenameM [VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VName -> RenameM VName
forall a. Rename a => a -> RenameM a
rename ([VName] -> RenameM [VName])
-> (Names -> [VName]) -> Names -> RenameM [VName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> [VName]
namesToList

instance Rename Rank where
  rename :: Rank -> RenameM Rank
rename = Rank -> RenameM Rank
forall a. a -> RenameM a
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) = [d] -> ShapeBase d
forall d. [d] -> ShapeBase d
Shape ([d] -> ShapeBase d) -> RenameM [d] -> RenameM (ShapeBase d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (d -> RenameM d) -> [d] -> RenameM [d]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM d -> RenameM d
forall a. Rename a => a -> RenameM a
rename [d]
l

instance Rename ExtSize where
  rename :: ExtSize -> RenameM ExtSize
rename (Free SubExp
se) = SubExp -> ExtSize
forall a. a -> Ext a
Free (SubExp -> ExtSize) -> RenameM SubExp -> RenameM ExtSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubExp -> RenameM SubExp
forall a. Rename a => a -> RenameM a
rename SubExp
se
  rename (Ext Int
x) = ExtSize -> RenameM ExtSize
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtSize -> RenameM ExtSize) -> ExtSize -> RenameM ExtSize
forall a b. (a -> b) -> a -> b
$ Int -> ExtSize
forall a. Int -> Ext a
Ext Int
x

instance Rename () where
  rename :: () -> RenameM ()
rename = () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Rename (NoOp rep) where
  rename :: NoOp rep -> RenameM (NoOp rep)
rename NoOp rep
NoOp = NoOp rep -> RenameM (NoOp rep)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoOp rep
forall {k} (rep :: k). NoOp rep
NoOp

instance (Rename d) => Rename (DimIndex d) where
  rename :: DimIndex d -> RenameM (DimIndex d)
rename (DimFix d
i) = d -> DimIndex d
forall d. d -> DimIndex d
DimFix (d -> DimIndex d) -> RenameM d -> RenameM (DimIndex d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> RenameM d
forall a. Rename a => a -> RenameM a
rename d
i
  rename (DimSlice d
i d
n d
s) = d -> d -> d -> DimIndex d
forall d. d -> d -> d -> DimIndex d
DimSlice (d -> d -> d -> DimIndex d)
-> RenameM d -> RenameM (d -> d -> DimIndex d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> RenameM d
forall a. Rename a => a -> RenameM a
rename d
i RenameM (d -> d -> DimIndex d)
-> RenameM d -> RenameM (d -> DimIndex d)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> RenameM d
forall a. Rename a => a -> RenameM a
rename d
n RenameM (d -> DimIndex d) -> RenameM d -> RenameM (DimIndex d)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> RenameM d
forall a. Rename a => a -> RenameM a
rename d
s

-- | Representations in which all decorations are renameable.
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)
  )