Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module provides facilities for transforming Futhark programs such
that names are unique, via the renameProg
function.
Additionally, the module also supports adding integral "tags" to
names (incarnated as the ID
type), in order to support more
efficient comparisons and renamings. This is done by tagProg
.
The intent is that you call tagProg
once at some early stage,
then use renameProg
from then on. Functions are also provided
for removing the tags again from expressions, patterns and typs.
Synopsis
- renameProg :: (Renameable lore, MonadFreshNames m) => Prog lore -> m (Prog lore)
- renameExp :: (Renameable lore, MonadFreshNames m) => Exp lore -> m (Exp lore)
- renameStm :: (Renameable lore, MonadFreshNames m) => Stm lore -> m (Stm lore)
- renameBody :: (Renameable lore, MonadFreshNames m) => Body lore -> m (Body lore)
- renameLambda :: (Renameable lore, MonadFreshNames m) => Lambda lore -> m (Lambda lore)
- renameFun :: (Renameable lore, MonadFreshNames m) => FunDef lore -> m (FunDef lore)
- renamePattern :: (Rename attr, MonadFreshNames m) => PatternT attr -> m (PatternT attr)
- type RenameM = StateT VNameSource (Reader RenameEnv)
- substituteRename :: Substitute a => a -> RenameM a
- bindingForRename :: [VName] -> RenameM a -> RenameM a
- renamingStms :: Renameable lore => Stms lore -> (Stms lore -> RenameM a) -> RenameM a
- class Rename a where
- type Renameable lore = (Rename (LetAttr lore), Rename (ExpAttr lore), Rename (BodyAttr lore), Rename (FParamAttr lore), Rename (LParamAttr lore), Rename (RetType lore), Rename (BranchType lore), Rename (Op lore))
Renaming programs
renameProg :: (Renameable lore, MonadFreshNames m) => Prog lore -> m (Prog lore) Source #
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.
Renaming parts of a program.
renameExp :: (Renameable lore, MonadFreshNames m) => Exp lore -> m (Exp lore) Source #
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.
renameStm :: (Renameable lore, MonadFreshNames m) => Stm lore -> m (Stm lore) Source #
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.
renameBody :: (Renameable lore, MonadFreshNames m) => Body lore -> m (Body lore) Source #
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.
renameLambda :: (Renameable lore, MonadFreshNames m) => Lambda lore -> m (Lambda lore) Source #
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.
renameFun :: (Renameable lore, MonadFreshNames m) => FunDef lore -> m (FunDef lore) Source #
Rename bound variables such that each is unique. The semantics of the function 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.
renamePattern :: (Rename attr, MonadFreshNames m) => PatternT attr -> m (PatternT attr) Source #
Produce an equivalent pattern but with each pattern element given a new name.
Renaming annotations
type RenameM = StateT VNameSource (Reader RenameEnv) Source #
The monad in which renaming is performed.
substituteRename :: Substitute a => a -> RenameM a Source #
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.
bindingForRename :: [VName] -> RenameM a -> RenameM a Source #
Create a bunch of new names and bind them for substitution.
renamingStms :: Renameable lore => Stms lore -> (Stms lore -> RenameM a) -> RenameM a Source #
Rename some statements, then execute an action with the name substitutions induced by the statements active.
Members of class Rename
can be uniquely renamed.
rename :: a -> RenameM a Source #
Rename the given value such that it does not contain shadowing,
and has incorporated any substitutions present in the RenameM
environment.
Instances
type Renameable lore = (Rename (LetAttr lore), Rename (ExpAttr lore), Rename (BodyAttr lore), Rename (FParamAttr lore), Rename (LParamAttr lore), Rename (RetType lore), Rename (BranchType lore), Rename (Op lore)) Source #
Lores in which all annotations are renameable.