{-# Language RecordWildCards #-}
{-# Language FlexibleInstances #-}
{-# Language FlexibleContexts #-}
{-# Language BlockArguments #-}
{-# Language OverloadedStrings #-}
module Cryptol.ModuleSystem.Renamer (
NamingEnv(), shadowing
, BindsNames, InModule(..)
, shadowNames
, Rename(..), runRenamer, RenameM()
, RenamerError(..)
, RenamerWarning(..)
, renameVar
, renameType
, renameModule
, renameTopDecls
, RenamerInfo(..)
, NameType(..)
, RenamedModule(..)
) where
import Prelude ()
import Prelude.Compat
import Data.Either(partitionEithers)
import Data.Maybe(mapMaybe)
import Data.List(find,groupBy,sortBy)
import Data.Function(on)
import Data.Foldable(toList)
import Data.Map(Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Graph(SCC(..))
import Data.Graph.SCC(stronglyConnComp)
import MonadLib hiding (mapM, mapM_)
import Cryptol.ModuleSystem.Name
import Cryptol.ModuleSystem.Names
import Cryptol.ModuleSystem.NamingEnv
import Cryptol.ModuleSystem.Exports
import Cryptol.Parser.Position(Range)
import Cryptol.Parser.AST
import Cryptol.Parser.Selector(selName)
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.RecordMap
import Cryptol.Utils.Ident(allNamespaces,OrigName(..),modPathCommon,
undefinedModName)
import Cryptol.Utils.PP
import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Renamer.Error
import Cryptol.ModuleSystem.Binds
import Cryptol.ModuleSystem.Renamer.Monad
import Cryptol.ModuleSystem.Renamer.Imports
import Cryptol.ModuleSystem.Renamer.ImplicitImports
data RenamedModule = RenamedModule
{ RenamedModule -> Module Name
rmModule :: Module Name
, RenamedModule -> NamingEnv
rmDefines :: NamingEnv
, RenamedModule -> NamingEnv
rmInScope :: NamingEnv
, RenamedModule -> IfaceDecls
rmImported :: IfaceDecls
}
renameModule :: Module PName -> RenameM RenamedModule
renameModule :: Module PName -> RenameM RenamedModule
renameModule Module PName
m0 =
do
let m :: Module PName
m = Module PName
m0 { mDef :: ModuleDefinition PName
mDef =
case forall mname name. ModuleG mname name -> ModuleDefinition name
mDef Module PName
m0 of
NormalModule [TopDecl PName]
ds ->
forall name. [TopDecl name] -> ModuleDefinition name
NormalModule ([TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports [TopDecl PName]
ds)
FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
i -> forall name.
Located (ImpName name)
-> ModuleInstanceArgs name
-> ModuleInstance name
-> ModuleDefinition name
FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
i
InterfaceModule Signature PName
s -> forall name. Signature name -> ModuleDefinition name
InterfaceModule Signature PName
s
}
(TopDef
defs,[RenamerError]
errs) <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. ModBuilder a -> Supply -> ((a, [RenamerError]), Supply)
modBuilder (Module PName -> ModBuilder TopDef
topModuleDefs Module PName
m))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerError -> RenameM ()
recordError [RenamerError]
errs
ImpName Name -> Mod ()
extern <- RenameM (ImpName Name -> Mod ())
getExternal
Map (ImpName Name) ResolvedLocal
resolvedMods <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ((ImpName Name -> Mod ())
-> TopDef -> Supply -> (Map (ImpName Name) ResolvedLocal, Supply)
resolveImports ImpName Name -> Mod ()
extern TopDef
defs)
let pathToName :: Map ModPath Name
pathToName = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModPath -> Ident -> ModPath
Nested (Name -> ModPath
nameModPath Name
x) (Name -> Ident
nameIdent Name
x), Name
x)
| ImpNested Name
x <- forall k a. Map k a -> [k]
Map.keys Map (ImpName Name) ResolvedLocal
resolvedMods ]
let mname :: ImpName name
mname = forall name. ModName -> ImpName name
ImpTop (forall a. Located a -> a
thing (forall mname name. ModuleG mname name -> Located mname
mName Module PName
m))
forall a.
Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals Map (ImpName Name) ResolvedLocal
resolvedMods forall a b. (a -> b) -> a -> b
$
forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule Map ModPath Name
pathToName
do (IfaceDecls
ifs,(NamingEnv
inScope,Module Name
m1)) <- forall a. RenameM a -> RenameM (IfaceDecls, a)
collectIfaceDeps (forall mname.
ImpName Name
-> ModuleG mname PName -> RenameM (NamingEnv, ModuleG mname Name)
renameModule' forall {name}. ImpName name
mname Module PName
m)
NamingEnv
env <- forall imps. ResolvedModule imps -> NamingEnv
rmodDefines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved forall {name}. ImpName name
mname
forall (f :: * -> *) a. Applicative f => a -> f a
pure RenamedModule
{ rmModule :: Module Name
rmModule = Module Name
m1
, rmDefines :: NamingEnv
rmDefines = NamingEnv
env
, rmInScope :: NamingEnv
rmInScope = NamingEnv
inScope
, rmImported :: IfaceDecls
rmImported = IfaceDecls
ifs
}
renameTopDecls ::
ModName -> [TopDecl PName] -> RenameM (NamingEnv,[TopDecl Name])
renameTopDecls :: ModName -> [TopDecl PName] -> RenameM (NamingEnv, [TopDecl Name])
renameTopDecls ModName
m [TopDecl PName]
ds0 =
do
let ds :: [TopDecl PName]
ds = [TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports [TopDecl PName]
ds0
(Mod ()
defs,[RenamerError]
errs) <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. ModBuilder a -> Supply -> ((a, [RenamerError]), Supply)
modBuilder (ModPath -> [TopDecl PName] -> ModBuilder (Mod ())
topDeclsDefs (ModName -> ModPath
TopModule ModName
m) [TopDecl PName]
ds))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerError -> RenameM ()
recordError [RenamerError]
errs
ImpName Name -> Mod ()
extern <- RenameM (ImpName Name -> Mod ())
getExternal
Map (ImpName Name) ResolvedLocal
resolvedMods <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ((ImpName Name -> Mod ())
-> TopDef -> Supply -> (Map (ImpName Name) ResolvedLocal, Supply)
resolveImports ImpName Name -> Mod ()
extern (ModName -> Mod () -> TopDef
TopMod ModName
m Mod ()
defs))
let pathToName :: Map ModPath Name
pathToName = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModPath -> Ident -> ModPath
Nested (Name -> ModPath
nameModPath Name
x) (Name -> Ident
nameIdent Name
x), Name
x)
| ImpNested Name
x <- forall k a. Map k a -> [k]
Map.keys Map (ImpName Name) ResolvedLocal
resolvedMods ]
forall a.
Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals Map (ImpName Name) ResolvedLocal
resolvedMods forall a b. (a -> b) -> a -> b
$
forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule Map ModPath Name
pathToName
do NamingEnv
env <- forall imps. ResolvedModule imps -> NamingEnv
rmodDefines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved (forall name. ModName -> ImpName name
ImpTop ModName
m)
[TopDecl Name]
ds1 <- forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env ([TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds)
let exports :: ExportSpec Name
exports = forall name. Ord name => [TopDecl name] -> ExportSpec name
exportedDecls [TopDecl Name]
ds1
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse (forall name. Namespace -> ExportSpec name -> Set name
exported Namespace
NSType ExportSpec Name
exports)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,[TopDecl Name]
ds1)
class Rename f where
rename :: f PName -> RenameM (f Name)
renameModule' ::
ImpName Name ->
ModuleG mname PName ->
RenameM (NamingEnv, ModuleG mname Name)
renameModule' :: forall mname.
ImpName Name
-> ModuleG mname PName -> RenameM (NamingEnv, ModuleG mname Name)
renameModule' ImpName Name
mname ModuleG mname PName
m =
forall a. ModPath -> RenameM a -> RenameM a
setCurMod
case ImpName Name
mname of
ImpTop ModName
r -> ModName -> ModPath
TopModule ModName
r
ImpNested Name
r -> ModPath -> Ident -> ModPath
Nested (Name -> ModPath
nameModPath Name
r) (Name -> Ident
nameIdent Name
r)
do ResolvedLocal
resolved <- ImpName Name -> RenameM ResolvedLocal
lookupResolved ImpName Name
mname
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone (forall imps. ResolvedModule imps -> imps
rmodImports ResolvedLocal
resolved)
case forall mname name. ModuleG mname name -> ModuleDefinition name
mDef ModuleG mname PName
m of
NormalModule [TopDecl PName]
ds ->
do let env :: NamingEnv
env = forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedLocal
resolved
(NamingEnv
paramEnv,[RenModParam]
params) <-
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env
([ModParam PName] -> RenameM (NamingEnv, [RenModParam])
doModParams (forall mname name. ModuleG mname name -> [ModParam name]
mModParams ModuleG mname PName
m))
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap (NamingEnv
env forall a. Semigroup a => a -> a -> a
<> NamingEnv
paramEnv) forall a b. (a -> b) -> a -> b
$
forall a. [RenModParam] -> RenameM a -> RenameM a
setModParams [RenModParam]
params
do [TopDecl Name]
ds1 <- [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds
let exports :: ExportSpec Name
exports = forall name. Ord name => [TopDecl name] -> ExportSpec name
exportedDecls [TopDecl Name]
ds1
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse (forall name. Namespace -> ExportSpec name -> Set name
exported Namespace
NSType ExportSpec Name
exports)
NamingEnv
inScope <- RenameM NamingEnv
getNamingEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
inScope, ModuleG mname PName
m { mDef :: ModuleDefinition Name
mDef = forall name. [TopDecl name] -> ModuleDefinition name
NormalModule [TopDecl Name]
ds1 })
FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
_ ->
do Located (ImpName Name)
f' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ImpName PName)
f
ModuleInstanceArgs Name
as' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ModuleInstanceArgs PName
as
ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs ModuleInstanceArgs Name
as'
let l :: Maybe Range
l = forall a. a -> Maybe a
Just (forall a. Located a -> Range
srcRange Located (ImpName Name)
f')
Map Name Name
imap <- Maybe Range
-> Map Name Name
-> ImpName Name
-> ImpName Name
-> RenameM (Map Name Name)
mkInstMap Maybe Range
l forall a. Monoid a => a
mempty (forall a. Located a -> a
thing Located (ImpName Name)
f') ImpName Name
mname
NamingEnv
fuEnv <- if ImpName Name -> Bool
isFakeName (forall a. Located a -> a
thing Located (ImpName Name)
f')
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
else ImpName Name -> RenameM NamingEnv
lookupDefines (forall a. Located a -> a
thing Located (ImpName Name)
f')
let ren :: Name -> Name
ren Name
x = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Name
x Name
x Map Name Name
imap
NamingEnv
inScope <- forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone ((Name -> Name) -> NamingEnv -> NamingEnv
mapNamingEnv Name -> Name
ren NamingEnv
fuEnv)
RenameM NamingEnv
getNamingEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
inScope, ModuleG mname PName
m { mDef :: ModuleDefinition Name
mDef = forall name.
Located (ImpName name)
-> ModuleInstanceArgs name
-> ModuleInstance name
-> ModuleDefinition name
FunctorInstance Located (ImpName Name)
f' ModuleInstanceArgs Name
as' Map Name Name
imap })
InterfaceModule Signature PName
s ->
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone (forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedLocal
resolved)
do ModuleDefinition Name
d <- forall name. Signature name -> ModuleDefinition name
InterfaceModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> Signature PName -> RenameM (Signature Name)
renameIfaceModule ImpName Name
mname Signature PName
s
NamingEnv
inScope <- RenameM NamingEnv
getNamingEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
inScope, ModuleG mname PName
m { mDef :: ModuleDefinition Name
mDef = ModuleDefinition Name
d })
checkFunctorArgs :: ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs :: ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs ModuleInstanceArgs Name
args =
case ModuleInstanceArgs Name
args of
DefaultInstAnonArg {} ->
forall a. HasCallStack => String -> [String] -> a
panic String
"checkFunctorArgs" [String
"Nested DefaultInstAnonArg"]
DefaultInstArg Located (ModuleInstanceArg Name)
l -> Located (ModuleInstanceArg Name) -> RenameM ()
checkArg Located (ModuleInstanceArg Name)
l
NamedInstArgs [ModuleInstanceNamedArg Name]
as -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleInstanceNamedArg Name -> RenameM ()
checkNamedArg [ModuleInstanceNamedArg Name]
as
where
checkNamedArg :: ModuleInstanceNamedArg Name -> RenameM ()
checkNamedArg (ModuleInstanceNamedArg Located Ident
_ Located (ModuleInstanceArg Name)
l) = Located (ModuleInstanceArg Name) -> RenameM ()
checkArg Located (ModuleInstanceArg Name)
l
checkArg :: Located (ModuleInstanceArg Name) -> RenameM ()
checkArg Located (ModuleInstanceArg Name)
l =
case forall a. Located a -> a
thing Located (ModuleInstanceArg Name)
l of
ModuleArg ImpName Name
m
| ImpName Name -> Bool
isFakeName ImpName Name
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule (forall a. Located a -> Range
srcRange Located (ModuleInstanceArg Name)
l) ImpName Name
m ModKind
AModule
ParameterArg {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ModuleInstanceArg Name
AddParams -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mkInstMap :: Maybe Range -> Map Name Name -> ImpName Name -> ImpName Name ->
RenameM (Map Name Name)
mkInstMap :: Maybe Range
-> Map Name Name
-> ImpName Name
-> ImpName Name
-> RenameM (Map Name Name)
mkInstMap Maybe Range
checkFun Map Name Name
acc0 ImpName Name
ogname ImpName Name
iname
| ImpName Name -> Bool
isFakeName ImpName Name
ogname = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
| Bool
otherwise =
do case Maybe Range
checkFun of
Maybe Range
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Range
r -> Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule Range
r ImpName Name
ogname ModKind
AFunctor
(NamingEnv
onames,Set Name
osubs) <- ImpName Name -> RenameM (NamingEnv, Set Name)
lookupDefinesAndSubs ImpName Name
ogname
NamingEnv
inames <- ImpName Name -> RenameM NamingEnv
lookupDefines ImpName Name
iname
let mp :: Map Name Name
mp = NamingEnv -> NamingEnv -> Map Name Name
zipByTextName NamingEnv
onames NamingEnv
inames
subs :: [(ImpName Name, ImpName Name)]
subs = [ (forall name. name -> ImpName name
ImpNested Name
k, forall name. name -> ImpName name
ImpNested Name
v)
| Name
k <- forall a. Set a -> [a]
Set.toList Set Name
osubs, Just Name
v <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
k Map Name Name
mp]
]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Name Name
-> (ImpName Name, ImpName Name) -> RenameM (Map Name Name)
doSub (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Name Name
mp Map Name Name
acc0) [(ImpName Name, ImpName Name)]
subs
where
doSub :: Map Name Name
-> (ImpName Name, ImpName Name) -> RenameM (Map Name Name)
doSub Map Name Name
acc (ImpName Name
k,ImpName Name
v) = Maybe Range
-> Map Name Name
-> ImpName Name
-> ImpName Name
-> RenameM (Map Name Name)
mkInstMap forall a. Maybe a
Nothing Map Name Name
acc ImpName Name
k ImpName Name
v
renameDecls :: [Decl PName] -> RenameM [Decl Name]
renameDecls :: [Decl PName] -> RenameM [Decl Name]
renameDecls [Decl PName]
ds =
do ([Decl Name]
ds1,Map DepName (Set Name)
deps) <- forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Decl PName]
ds)
let toNode :: Decl Name -> ((Decl Name, DepName), DepName, [DepName])
toNode Decl Name
d = let x :: DepName
x = Name -> DepName
NamedThing (Decl Name -> Name
declName Decl Name
d)
in ((Decl Name
d,DepName
x), DepName
x, forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing
forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps)
ordered :: [SCC (Decl Name, DepName)]
ordered = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (forall a b. (a -> b) -> [a] -> [b]
map Decl Name -> ((Decl Name, DepName), DepName, [DepName])
toNode [Decl Name]
ds1))
fromSCC :: SCC (Decl name, DepName) -> RenameM [Decl name]
fromSCC SCC (Decl name, DepName)
x =
case SCC (Decl name, DepName)
x of
AcyclicSCC (Decl name
d,DepName
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl name
d]
CyclicSCC [(Decl name, DepName)]
ds_xs ->
let ([Decl name]
rds,[DepName]
xs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Decl name, DepName)]
ds_xs
in case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall name. Decl name -> Maybe (Bind name)
validRecursiveD [Decl name]
rds of
Maybe [Bind name]
Nothing -> do RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl name]
rds
Just [Bind name]
bs ->
do [DepName] -> RenameM ()
checkSameModule [DepName]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall name. [Bind name] -> Decl name
DRec [Bind name]
bs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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 {name}. SCC (Decl name, DepName) -> RenameM [Decl name]
fromSCC [SCC (Decl Name, DepName)]
ordered
renameSigDecls :: [SigDecl PName] -> RenameM [SigDecl Name]
renameSigDecls :: [SigDecl PName] -> RenameM [SigDecl Name]
renameSigDecls [SigDecl PName]
ds =
do ([SigDecl Name]
ds1,Map DepName (Set Name)
deps) <- forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [SigDecl PName]
ds)
let toNode :: SigDecl Name -> ((SigDecl Name, DepName), DepName, [DepName])
toNode SigDecl Name
d = let nm :: Name
nm = case SigDecl Name
d of
SigTySyn TySyn Name
ts Maybe Text
_ -> forall a. Located a -> a
thing (forall name. TySyn name -> Located name
tsName TySyn Name
ts)
SigPropSyn PropSyn Name
ps Maybe Text
_ -> forall a. Located a -> a
thing (forall name. PropSyn name -> Located name
psName PropSyn Name
ps)
x :: DepName
x = Name -> DepName
NamedThing Name
nm
in ((SigDecl Name
d,DepName
x), DepName
x, forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing
forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps)
ordered :: [SCC (SigDecl Name, DepName)]
ordered = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (forall a b. (a -> b) -> [a] -> [b]
map SigDecl Name -> ((SigDecl Name, DepName), DepName, [DepName])
toNode [SigDecl Name]
ds1))
fromSCC :: SCC (a, DepName) -> RenameM [a]
fromSCC SCC (a, DepName)
x =
case SCC (a, DepName)
x of
AcyclicSCC (a
d,DepName
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
d]
CyclicSCC [(a, DepName)]
ds_xs ->
do let ([a]
rds,[DepName]
xs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(a, DepName)]
ds_xs
RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
rds
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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}. SCC (a, DepName) -> RenameM [a]
fromSCC [SCC (SigDecl Name, DepName)]
ordered
validRecursiveD :: Decl name -> Maybe (Bind name)
validRecursiveD :: forall name. Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d =
case Decl name
d of
DBind Bind name
b -> forall a. a -> Maybe a
Just Bind name
b
DLocated Decl name
d' Range
_ -> forall name. Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d'
Decl name
_ -> forall a. Maybe a
Nothing
checkSameModule :: [DepName] -> RenameM ()
checkSameModule :: [DepName] -> RenameM ()
checkSameModule [DepName]
xs =
case [(Name, ModPath)]
ms of
(Name, ModPath)
a : [(Name, ModPath)]
as | let bad :: [Name]
bad = [ forall a b. (a, b) -> a
fst (Name, ModPath)
b | (Name, ModPath)
b <- [(Name, ModPath)]
as, forall a b. (a, b) -> b
snd (Name, ModPath)
a forall a. Eq a => a -> a -> Bool
/= forall a b. (a, b) -> b
snd (Name, ModPath)
b ]
, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
bad) ->
RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Name, ModPath)
a forall a. a -> [a] -> [a]
: [Name]
bad)
[(Name, ModPath)]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
ms :: [(Name, ModPath)]
ms = [ (Name
x,OrigName -> ModPath
ogModule OrigName
og)
| NamedThing Name
x <- [DepName]
xs, GlobalName NameSource
_ OrigName
og <- [ Name -> NameInfo
nameInfo Name
x ]
]
renameTopDecls' :: [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' :: [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds =
do
([TopDecl Name]
ds1,Map DepName (Set Name)
deps) <- forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TopDecl PName]
ds)
Map Name DepName
fromParams <- RenameM (Map Name DepName)
getNamesFromModParams
Map Ident DepName
localParams <- RenameM (Map Ident DepName)
getLocalModParamDeps
let rawDepsFor :: DepName -> Set Name
rawDepsFor DepName
x = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps
isTyParam :: Name -> Bool
isTyParam Name
x = Name -> Namespace
nameNamespace Name
x forall a. Eq a => a -> a -> Bool
== Namespace
NSType Bool -> Bool -> Bool
&& Name
x forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Name DepName
fromParams
([TopDecl Name]
noNameDs,[(TopDecl Name, DepName, [DepName])]
nameDs) = forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a b. (a -> b) -> [a] -> [b]
map TopDecl Name
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName [TopDecl Name]
ds1)
ctrs :: [DepName]
ctrs = [ DepName
nm | (TopDecl Name
_,nm :: DepName
nm@(ConstratintAt {}),[DepName]
_) <- [(TopDecl Name, DepName, [DepName])]
nameDs ]
indirect :: Map DepName DepName
indirect = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (DepName
y,DepName
x)
| (TopDecl Name
_,DepName
x,[DepName]
ys) <- [(TopDecl Name, DepName, [DepName])]
nameDs, DepName
y <- [DepName]
ys ]
mkDepName :: Name -> DepName
mkDepName Name
x = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x Map Name DepName
fromParams of
Just DepName
dn -> DepName
dn
Maybe DepName
Nothing -> Name -> DepName
NamedThing Name
x
depsFor :: DepName -> [DepName]
depsFor DepName
x =
[ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Name -> DepName
mkDepName Name
y) (Name -> DepName
NamedThing Name
y) Map DepName DepName
indirect
| Name
y <- forall a. Set a -> [a]
Set.toList (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps)
]
addCtr :: DepName -> DepName -> Maybe DepName
addCtr DepName
nm DepName
ctr =
case DepName
nm of
NamedThing Name
x
| Name -> Namespace
nameNamespace Name
x forall a. Eq a => a -> a -> Bool
== Namespace
NSType
, let ctrDeps :: Set Name
ctrDeps = DepName -> Set Name
rawDepsFor DepName
ctr
tyDeps :: Set Name
tyDeps = DepName -> Set Name
rawDepsFor DepName
nm
, Bool -> Bool
not (Name
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
ctrDeps)
, Bool -> Bool
not (forall a. Set a -> Bool
Set.null (forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
(forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
isTyParam Set Name
ctrDeps)
(forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
isTyParam Set Name
tyDeps)))
-> forall a. a -> Maybe a
Just DepName
ctr
DepName
_ -> forall a. Maybe a
Nothing
addCtrs :: (TopDecl name, DepName) -> [DepName]
addCtrs (TopDecl name
d,DepName
x)
| forall {name}. TopDecl name -> Bool
usesCtrs TopDecl name
d = [DepName]
ctrs
| Bool
otherwise = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DepName -> DepName -> Maybe DepName
addCtr DepName
x) [DepName]
ctrs
addModParams :: TopDecl name -> [DepName]
addModParams TopDecl name
d =
case TopDecl name
d of
DModule TopLevel (NestedModule name)
tl | NestedModule ModuleG name name
m <- forall a. TopLevel a -> a
tlValue TopLevel (NestedModule name)
tl
, FunctorInstance Located (ImpName name)
_ ModuleInstanceArgs name
as ModuleInstance name
_ <- forall mname name. ModuleG mname name -> ModuleDefinition name
mDef ModuleG name name
m ->
case ModuleInstanceArgs name
as of
DefaultInstArg Located (ModuleInstanceArg name)
arg -> forall {name}. Located (ModuleInstanceArg name) -> [DepName]
depsOfArg Located (ModuleInstanceArg name)
arg
NamedInstArgs [ModuleInstanceNamedArg name]
args -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {name}. ModuleInstanceNamedArg name -> [DepName]
depsOfNamedArg [ModuleInstanceNamedArg name]
args
DefaultInstAnonArg {} -> []
where depsOfNamedArg :: ModuleInstanceNamedArg name -> [DepName]
depsOfNamedArg (ModuleInstanceNamedArg Located Ident
_ Located (ModuleInstanceArg name)
a) = forall {name}. Located (ModuleInstanceArg name) -> [DepName]
depsOfArg Located (ModuleInstanceArg name)
a
depsOfArg :: Located (ModuleInstanceArg name) -> [DepName]
depsOfArg Located (ModuleInstanceArg name)
a = case forall a. Located a -> a
thing Located (ModuleInstanceArg name)
a of
ModuleInstanceArg name
AddParams -> []
ModuleArg {} -> []
ParameterArg Ident
p ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
p Map Ident DepName
localParams of
Just DepName
i -> [DepName
i]
Maybe DepName
Nothing -> []
TopDecl name
_ -> []
toNode :: (TopDecl name, DepName, c)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode (TopDecl name
d,DepName
x,c
_) = ((TopDecl name
d,DepName
x),DepName
x, forall {name}. (TopDecl name, DepName) -> [DepName]
addCtrs (TopDecl name
d,DepName
x) forall a. [a] -> [a] -> [a]
++
forall {name}. TopDecl name -> [DepName]
addModParams TopDecl name
d forall a. [a] -> [a] -> [a]
++
DepName -> [DepName]
depsFor DepName
x)
ordered :: [SCC (TopDecl Name, DepName)]
ordered = forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (forall a b. (a -> b) -> [a] -> [b]
map forall {name} {c}.
(TopDecl name, DepName, c)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode [(TopDecl Name, DepName, [DepName])]
nameDs)
fromSCC :: SCC (TopDecl name, DepName) -> RenameM [TopDecl name]
fromSCC SCC (TopDecl name, DepName)
x =
case SCC (TopDecl name, DepName)
x of
AcyclicSCC (TopDecl name
d,DepName
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopDecl name
d]
CyclicSCC [(TopDecl name, DepName)]
ds_xs ->
let ([TopDecl name]
rds,[DepName]
xs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(TopDecl name, DepName)]
ds_xs
in case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {name}. TopDecl name -> Maybe (Bind name)
valid [TopDecl name]
rds of
Maybe [Bind name]
Nothing -> do RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopDecl name]
rds
Just [Bind name]
bs ->
do [DepName] -> RenameM ()
checkSameModule [DepName]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall name. TopLevel (Decl name) -> TopDecl name
Decl TopLevel
{ tlDoc :: Maybe (Located Text)
tlDoc = forall a. Maybe a
Nothing
, tlExport :: ExportType
tlExport = ExportType
Public
, tlValue :: Decl name
tlValue = forall name. [Bind name] -> Decl name
DRec [Bind name]
bs
}]
where
valid :: TopDecl name -> Maybe (Bind name)
valid TopDecl name
d = case TopDecl name
d of
Decl TopLevel (Decl name)
tl -> forall name. Decl name -> Maybe (Bind name)
validRecursiveD (forall a. TopLevel a -> a
tlValue TopLevel (Decl name)
tl)
TopDecl name
_ -> forall a. Maybe a
Nothing
[[TopDecl Name]]
rds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {name}.
SCC (TopDecl name, DepName) -> RenameM [TopDecl name]
fromSCC [SCC (TopDecl Name, DepName)]
ordered
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([TopDecl Name]
noNameDsforall a. a -> [a] -> [a]
:[[TopDecl Name]]
rds))
where
usesCtrs :: TopDecl name -> Bool
usesCtrs TopDecl name
td =
case TopDecl name
td of
Decl TopLevel (Decl name)
tl -> forall {name}. Decl name -> Bool
isValDecl (forall a. TopLevel a -> a
tlValue TopLevel (Decl name)
tl)
DPrimType {} -> Bool
False
TDNewtype {} -> Bool
False
DParamDecl {} -> Bool
False
DInterfaceConstraint {} -> Bool
False
DModule TopLevel (NestedModule name)
tl -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TopDecl name -> Bool
usesCtrs (forall mname name. ModuleG mname name -> [TopDecl name]
mDecls ModuleG name name
m)
where NestedModule ModuleG name name
m = forall a. TopLevel a -> a
tlValue TopLevel (NestedModule name)
tl
DImport {} -> Bool
False
DModParam {} -> Bool
False
Include {} -> forall {a}. String -> a
bad String
"Include"
isValDecl :: Decl name -> Bool
isValDecl Decl name
d =
case Decl name
d of
DLocated Decl name
d' Range
_ -> Decl name -> Bool
isValDecl Decl name
d'
DBind {} -> Bool
True
DRec {} -> Bool
True
DType {} -> Bool
False
DProp {} -> Bool
False
DSignature {} -> forall {a}. String -> a
bad String
"DSignature"
DFixity {} -> forall {a}. String -> a
bad String
"DFixity"
DPragma {} -> forall {a}. String -> a
bad String
"DPragma"
DPatBind {} -> forall {a}. String -> a
bad String
"DPatBind"
bad :: String -> a
bad String
msg = forall a. HasCallStack => String -> [String] -> a
panic String
"renameTopDecls'" [String
msg]
declName :: Decl Name -> Name
declName :: Decl Name -> Name
declName Decl Name
decl =
case Decl Name
decl of
DLocated Decl Name
d Range
_ -> Decl Name -> Name
declName Decl Name
d
DBind Bind Name
b -> forall a. Located a -> a
thing (forall name. Bind name -> Located name
bName Bind Name
b)
DType (TySyn Located Name
x Maybe Fixity
_ [TParam Name]
_ Type Name
_) -> forall a. Located a -> a
thing Located Name
x
DProp (PropSyn Located Name
x Maybe Fixity
_ [TParam Name]
_ [Prop Name]
_) -> forall a. Located a -> a
thing Located Name
x
DSignature {} -> forall {a}. String -> a
bad String
"DSignature"
DFixity {} -> forall {a}. String -> a
bad String
"DFixity"
DPragma {} -> forall {a}. String -> a
bad String
"DPragma"
DPatBind {} -> forall {a}. String -> a
bad String
"DPatBind"
DRec {} -> forall {a}. String -> a
bad String
"DRec"
where
bad :: String -> a
bad String
x = forall a. HasCallStack => String -> [String] -> a
panic String
"declName" [String
x]
topDeclName ::
TopDecl Name ->
Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName :: TopDecl Name
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName TopDecl Name
topDecl =
case TopDecl Name
topDecl of
Decl TopLevel (Decl Name)
d -> forall {a}. Name -> Either a (TopDecl Name, DepName, [DepName])
hasName (Decl Name -> Name
declName (forall a. TopLevel a -> a
tlValue TopLevel (Decl Name)
d))
DPrimType TopLevel (PrimType Name)
d -> forall {a}. Name -> Either a (TopDecl Name, DepName, [DepName])
hasName (forall a. Located a -> a
thing (forall name. PrimType name -> Located name
primTName (forall a. TopLevel a -> a
tlValue TopLevel (PrimType Name)
d)))
TDNewtype TopLevel (Newtype Name)
d -> forall {a}.
Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' (forall a. Located a -> a
thing (forall name. Newtype name -> Located name
nName (forall a. TopLevel a -> a
tlValue TopLevel (Newtype Name)
d)))
[ forall name. Newtype name -> name
nConName (forall a. TopLevel a -> a
tlValue TopLevel (Newtype Name)
d) ]
DModule TopLevel (NestedModule Name)
d -> forall {a}. Name -> Either a (TopDecl Name, DepName, [DepName])
hasName (forall a. Located a -> a
thing (forall mname name. ModuleG mname name -> Located mname
mName ModuleG Name Name
m))
where NestedModule ModuleG Name Name
m = forall a. TopLevel a -> a
tlValue TopLevel (NestedModule Name)
d
DInterfaceConstraint Maybe Text
_ Located [Prop Name]
ds -> forall {b} {a} {a}. b -> Either a (TopDecl Name, b, [a])
special (Range -> DepName
ConstratintAt (forall a. Located a -> Range
srcRange Located [Prop Name]
ds))
DImport {} -> forall {b}. Either (TopDecl Name) b
noName
DModParam ModParam Name
m -> forall {b} {a} {a}. b -> Either a (TopDecl Name, b, [a])
special (Range -> Ident -> DepName
ModParamName (forall a. Located a -> Range
srcRange (forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam Name
m))
(forall name. ModParam name -> Ident
mpName ModParam Name
m))
Include {} -> forall {a}. String -> a
bad String
"Include"
DParamDecl {} -> forall {a}. String -> a
bad String
"DParamDecl"
where
noName :: Either (TopDecl Name) b
noName = forall a b. a -> Either a b
Left TopDecl Name
topDecl
hasName :: Name -> Either a (TopDecl Name, DepName, [DepName])
hasName Name
n = forall {a}.
Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' Name
n []
hasName' :: Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' Name
n [Name]
ms = forall a b. b -> Either a b
Right (TopDecl Name
topDecl, Name -> DepName
NamedThing Name
n, forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing [Name]
ms)
special :: b -> Either a (TopDecl Name, b, [a])
special b
x = forall a b. b -> Either a b
Right (TopDecl Name
topDecl, b
x, [])
bad :: String -> a
bad String
x = forall a. HasCallStack => String -> [String] -> a
panic String
"topDeclName" [String
x]
doModParam ::
ModParam PName ->
RenameM (NamingEnv, RenModParam)
doModParam :: ModParam PName -> RenameM (NamingEnv, RenModParam)
doModParam ModParam PName
mp =
do let sigName :: Located (ImpName PName)
sigName = forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp
loc :: Range
loc = forall a. Located a -> Range
srcRange Located (ImpName PName)
sigName
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
do ModPath
me <- RenameM ModPath
getCurMod
(ImpName Name
sigName',Bool
isFake) <-
case forall a. Located a -> a
thing Located (ImpName PName)
sigName of
ImpTop ModName
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModName -> ImpName name
ImpTop ModName
t, Bool
False)
ImpNested PName
n ->
do Maybe Name
mb <- NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
NameUse Namespace
NSModule PName
n
(Name
nm,Bool
isFake) <- case Maybe Name
mb of
Just Name
rnm -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
rnm,Bool
False)
Maybe Name
Nothing ->
do Name
rnm <- Namespace -> PName -> RenameM Name
reportUnboundName Namespace
NSModule PName
n
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
rnm,Bool
True)
case ModPath -> ModPath -> Maybe (ModPath, [Ident], [Ident])
modPathCommon ModPath
me (Name -> ModPath
nameModPath Name
nm) of
Just (ModPath
_,[],[Ident]
_) ->
RenamerError -> RenameM ()
recordError
([DepName] -> RenamerError
InvalidDependency [ModPath -> DepName
ModPath ModPath
me, Name -> DepName
NamedThing Name
nm])
Maybe (ModPath, [Ident], [Ident])
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. name -> ImpName name
ImpNested Name
nm, Bool
isFake)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFake
(Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule (forall a. Located a -> Range
srcRange Located (ImpName PName)
sigName) ImpName Name
sigName' ModKind
ASignature)
NamingEnv
sigEnv <- if Bool
isFake then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty else ImpName Name -> RenameM NamingEnv
lookupDefines ImpName Name
sigName'
let newP :: Name -> t m Name
newP Name
x = do Name
y <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
FreshM m =>
ModPath -> Ident -> Range -> Name -> m Name
newModParam ModPath
me (forall name. ModParam name -> Ident
mpName ModParam PName
mp) Range
loc Name
x)
forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
y Name
x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
y
(NamingEnv
newEnv',Map Name Name
nameMap) <- forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT forall k a. Map k a
Map.empty (forall (f :: * -> *).
Applicative f =>
(Name -> f Name) -> NamingEnv -> f NamingEnv
travNamingEnv forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadT t, FreshM m, StateM (t m) (Map Name Name)) =>
Name -> t m Name
newP NamingEnv
sigEnv)
let paramName :: Maybe ModName
paramName = forall name. ModParam name -> Maybe ModName
mpAs ModParam PName
mp
let newEnv :: NamingEnv
newEnv = case Maybe ModName
paramName of
Maybe ModName
Nothing -> NamingEnv
newEnv'
Just ModName
q -> ModName -> NamingEnv -> NamingEnv
qualify ModName
q NamingEnv
newEnv'
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( NamingEnv
newEnv
, RenModParam
{ renModParamName :: Ident
renModParamName = forall name. ModParam name -> Ident
mpName ModParam PName
mp
, renModParamRange :: Range
renModParamRange = Range
loc
, renModParamSig :: ImpName Name
renModParamSig = ImpName Name
sigName'
, renModParamInstance :: Map Name Name
renModParamInstance = Map Name Name
nameMap
}
)
doModParams :: [ModParam PName] -> RenameM (NamingEnv, [RenModParam])
doModParams :: [ModParam PName] -> RenameM (NamingEnv, [RenModParam])
doModParams [ModParam PName]
srcParams =
do ([NamingEnv]
paramEnvs,[RenModParam]
params) <- forall a b. [(a, b)] -> ([a], [b])
unzip 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 ModParam PName -> RenameM (NamingEnv, RenModParam)
doModParam [ModParam PName]
srcParams
let repeated :: [[RenModParam]]
repeated = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RenModParam -> Ident
renModParamName)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RenModParam -> Ident
renModParamName) [RenModParam]
params
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[RenModParam]]
repeated \[RenModParam]
ps ->
case [RenModParam]
ps of
[RenModParam
_] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
~(RenModParam
p : [RenModParam]
_) -> RenamerError -> RenameM ()
recordError (Ident -> [Range] -> RenamerError
MultipleModParams (RenModParam -> Ident
renModParamName RenModParam
p)
(forall a b. (a -> b) -> [a] -> [b]
map RenModParam -> Range
renModParamRange [RenModParam]
ps))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => [a] -> a
mconcat [NamingEnv]
paramEnvs,[RenModParam]
params)
rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated :: forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated a -> RenameM b
f Located a
loc = forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located a
loc forall a b. (a -> b) -> a -> b
$
do b
a' <- a -> RenameM b
f (forall a. Located a -> a
thing Located a
loc)
forall (m :: * -> *) a. Monad m => a -> m a
return Located a
loc { thing :: b
thing = b
a' }
instance Rename TopDecl where
rename :: TopDecl PName -> RenameM (TopDecl Name)
rename TopDecl PName
td =
case TopDecl PName
td of
Decl TopLevel (Decl PName)
d -> forall name. TopLevel (Decl name) -> TopDecl name
Decl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Decl PName)
d
DPrimType TopLevel (PrimType PName)
d -> forall name. TopLevel (PrimType name) -> TopDecl name
DPrimType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (PrimType PName)
d
TDNewtype TopLevel (Newtype PName)
n -> forall name. TopLevel (Newtype name) -> TopDecl name
TDNewtype forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Newtype PName)
n
Include Located String
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall name. Located String -> TopDecl name
Include Located String
n)
DModule TopLevel (NestedModule PName)
m -> forall name. TopLevel (NestedModule name) -> TopDecl name
DModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (NestedModule PName)
m
DImport Located (ImportG (ImpName PName))
li -> forall name. Located (ImportG (ImpName name)) -> TopDecl name
DImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
renI Located (ImportG (ImpName PName))
li
DModParam ModParam PName
mp -> forall name. ModParam name -> TopDecl name
DModParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ModParam PName
mp
DInterfaceConstraint Maybe Text
d Located [Prop PName]
ds ->
forall a. DepName -> RenameM a -> RenameM a
depsOf (Range -> DepName
ConstratintAt (forall a. Located a -> Range
srcRange Located [Prop PName]
ds))
(forall name. Maybe Text -> Located [Prop name] -> TopDecl name
DInterfaceConstraint Maybe Text
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Located [Prop PName]
ds)
DParamDecl {} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [String
"DParamDecl"]
renI :: Located (ImportG (ImpName PName)) ->
RenameM (Located (ImportG (ImpName Name)))
renI :: Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
renI Located (ImportG (ImpName PName))
li =
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc (forall a. Located a -> Range
srcRange Located (ImportG (ImpName PName))
li)
do ImpName Name
m <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall mname. ImportG mname -> mname
iModule ImportG (ImpName PName)
i)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ImpName Name -> Bool
isFakeName ImpName Name
m) (Range -> ImpName Name -> RenameM ()
recordImport (forall a. Located a -> Range
srcRange Located (ImportG (ImpName PName))
li) ImpName Name
m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located (ImportG (ImpName PName))
li { thing :: ImportG (ImpName Name)
thing = ImportG (ImpName PName)
i { iModule :: ImpName Name
iModule = ImpName Name
m } }
where
i :: ImportG (ImpName PName)
i = forall a. Located a -> a
thing Located (ImportG (ImpName PName))
li
instance Rename ModParam where
rename :: ModParam PName -> RenameM (ModParam Name)
rename ModParam PName
mp =
do Located (ImpName Name)
x <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Range -> Ident -> DepName
ModParamName (forall a. Located a -> Range
srcRange (forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp)) (forall name. ModParam name -> Ident
mpName ModParam PName
mp))
do Map Name Name
ren <- RenModParam -> Map Name Name
renModParamInstance forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> RenameM RenModParam
getModParam (forall name. ModParam name -> Ident
mpName ModParam PName
mp)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse [ Name
s | Name
t <- forall k a. Map k a -> [k]
Map.keys Map Name Name
ren, Name -> Namespace
nameNamespace Name
t forall a. Eq a => a -> a -> Bool
== Namespace
NSType
, Name
s <- [Name
t,Name
t] ]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModParam PName
mp { mpSignature :: Located (ImpName Name)
mpSignature = Located (ImpName Name)
x, mpRenaming :: Map Name Name
mpRenaming = Map Name Name
ren }
renameIfaceModule :: ImpName Name -> Signature PName -> RenameM (Signature Name)
renameIfaceModule :: ImpName Name -> Signature PName -> RenameM (Signature Name)
renameIfaceModule ImpName Name
nm Signature PName
sig =
do NamingEnv
env <- forall imps. ResolvedModule imps -> NamingEnv
rmodDefines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved ImpName Name
nm
let depName :: DepName
depName = case ImpName Name
nm of
ImpNested Name
n -> Name -> DepName
NamedThing Name
n
ImpTop ModName
t -> ModPath -> DepName
ModPath (ModName -> ModPath
TopModule ModName
t)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap NamingEnv
env forall a b. (a -> b) -> a -> b
$
forall a. DepName -> RenameM a -> RenameM a
depsOf DepName
depName
do [Located (ImportG (ImpName Name))]
imps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
renI (forall name. Signature name -> [Located (ImportG (ImpName name))]
sigImports Signature PName
sig)
[ParameterType Name]
tps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. Signature name -> [ParameterType name]
sigTypeParams Signature PName
sig)
[SigDecl Name]
ds <- [SigDecl PName] -> RenameM [SigDecl Name]
renameSigDecls (forall name. Signature name -> [SigDecl name]
sigDecls Signature PName
sig)
[Located (Prop Name)]
cts <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (forall name. Signature name -> [Located (Prop name)]
sigConstraints Signature PName
sig)
[ParameterFun Name]
fun <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. Signature name -> [ParameterFun name]
sigFunParams Signature PName
sig)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ParameterType Name]
tps \ParameterType Name
tp -> Name -> RenameM ()
recordUse (forall a. Located a -> a
thing (forall name. ParameterType name -> Located name
ptName ParameterType Name
tp))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SigDecl Name]
ds \SigDecl Name
d -> Name -> RenameM ()
recordUse forall a b. (a -> b) -> a -> b
$ case SigDecl Name
d of
SigTySyn TySyn Name
ts Maybe Text
_ -> forall a. Located a -> a
thing (forall name. TySyn name -> Located name
tsName TySyn Name
ts)
SigPropSyn PropSyn Name
ps Maybe Text
_ -> forall a. Located a -> a
thing (forall name. PropSyn name -> Located name
psName PropSyn Name
ps)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature
{ sigImports :: [Located (ImportG (ImpName Name))]
sigImports = [Located (ImportG (ImpName Name))]
imps
, sigTypeParams :: [ParameterType Name]
sigTypeParams = [ParameterType Name]
tps
, sigDecls :: [SigDecl Name]
sigDecls = [SigDecl Name]
ds
, sigConstraints :: [Located (Prop Name)]
sigConstraints = [Located (Prop Name)]
cts
, sigFunParams :: [ParameterFun Name]
sigFunParams = [ParameterFun Name]
fun
}
instance Rename ImpName where
rename :: ImpName PName -> RenameM (ImpName Name)
rename ImpName PName
i =
case ImpName PName
i of
ImpTop ModName
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModName -> ImpName name
ImpTop ModName
m)
ImpNested PName
m -> forall name. name -> ImpName name
ImpNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
NameUse Namespace
NSModule PName
m
instance Rename ModuleInstanceArgs where
rename :: ModuleInstanceArgs PName -> RenameM (ModuleInstanceArgs Name)
rename ModuleInstanceArgs PName
args =
case ModuleInstanceArgs PName
args of
DefaultInstArg Located (ModuleInstanceArg PName)
a -> forall name.
Located (ModuleInstanceArg name) -> ModuleInstanceArgs name
DefaultInstArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ModuleInstanceArg PName)
a
NamedInstArgs [ModuleInstanceNamedArg PName]
xs -> forall name.
[ModuleInstanceNamedArg name] -> ModuleInstanceArgs name
NamedInstArgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [ModuleInstanceNamedArg PName]
xs
DefaultInstAnonArg {} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [String
"DefaultInstAnonArg"]
instance Rename ModuleInstanceNamedArg where
rename :: ModuleInstanceNamedArg PName
-> RenameM (ModuleInstanceNamedArg Name)
rename (ModuleInstanceNamedArg Located Ident
x Located (ModuleInstanceArg PName)
m) =
forall name.
Located Ident
-> Located (ModuleInstanceArg name) -> ModuleInstanceNamedArg name
ModuleInstanceNamedArg Located Ident
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ModuleInstanceArg PName)
m
instance Rename ModuleInstanceArg where
rename :: ModuleInstanceArg PName -> RenameM (ModuleInstanceArg Name)
rename ModuleInstanceArg PName
arg =
case ModuleInstanceArg PName
arg of
ModuleArg ImpName PName
m -> forall name. ImpName name -> ModuleInstanceArg name
ModuleArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ImpName PName
m
ParameterArg Ident
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. Ident -> ModuleInstanceArg name
ParameterArg Ident
a)
ModuleInstanceArg PName
AddParams -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall name. ModuleInstanceArg name
AddParams
instance Rename NestedModule where
rename :: NestedModule PName -> RenameM (NestedModule Name)
rename (NestedModule ModuleG PName PName
m) =
do let lnm :: Located PName
lnm = forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m
nm :: PName
nm = forall a. Located a -> a
thing Located PName
lnm
Name
n <- NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
NameBind Namespace
NSModule PName
nm
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing Name
n)
do
let m' :: ModuleG (ImpName PName) PName
m' = ModuleG PName PName
m { mName :: Located (ImpName PName)
mName = forall name. name -> ImpName name
ImpNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m }
(NamingEnv
_inScope,ModuleG (ImpName PName) Name
m1) <- forall mname.
ImpName Name
-> ModuleG mname PName -> RenameM (NamingEnv, ModuleG mname Name)
renameModule' (forall name. name -> ImpName name
ImpNested Name
n) ModuleG (ImpName PName) PName
m'
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModuleG name name -> NestedModule name
NestedModule ModuleG (ImpName PName) Name
m1 { mName :: Located Name
mName = Located PName
lnm { thing :: Name
thing = Name
n } })
instance Rename PrimType where
rename :: PrimType PName -> RenameM (PrimType Name)
rename PrimType PName
pt =
do Located Name
x <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (forall name. PrimType name -> Located name
primTName PrimType PName
pt)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
x))
do let ([TParam PName]
as,[Prop PName]
ps) = forall name. PrimType name -> ([TParam name], [Prop name])
primTCts PrimType PName
pt
(NamingEnv
_,([TParam Name], [Prop Name])
cts) <- forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
as [Prop PName]
ps forall a b. (a -> b) -> a -> b
$ \[TParam Name]
as' [Prop Name]
ps' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TParam Name]
as',[Prop Name]
ps')
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name -> RenameM ()
recordUse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. TParam n -> n
tpName) (forall a b. (a, b) -> a
fst ([TParam Name], [Prop Name])
cts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType PName
pt { primTCts :: ([TParam Name], [Prop Name])
primTCts = ([TParam Name], [Prop Name])
cts, primTName :: Located Name
primTName = Located Name
x }
instance Rename ParameterType where
rename :: ParameterType PName -> RenameM (ParameterType Name)
rename ParameterType PName
a =
do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (forall name. ParameterType name -> Located name
ptName ParameterType PName
a)
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterType PName
a { ptName :: Located Name
ptName = Located Name
n' }
instance Rename ParameterFun where
rename :: ParameterFun PName -> RenameM (ParameterFun Name)
rename ParameterFun PName
a =
do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) (forall name. ParameterFun name -> Located name
pfName ParameterFun PName
a)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
n'))
do (NamingEnv, Schema Name)
sig' <- Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (forall name. ParameterFun name -> Schema name
pfSchema ParameterFun PName
a)
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterFun PName
a { pfName :: Located Name
pfName = Located Name
n', pfSchema :: Schema Name
pfSchema = forall a b. (a, b) -> b
snd (NamingEnv, Schema Name)
sig' }
instance Rename SigDecl where
rename :: SigDecl PName -> RenameM (SigDecl Name)
rename SigDecl PName
decl =
case SigDecl PName
decl of
SigTySyn TySyn PName
ts Maybe Text
mb -> forall name. TySyn name -> Maybe Text -> SigDecl name
SigTySyn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TySyn PName
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mb
SigPropSyn PropSyn PName
ps Maybe Text
mb -> forall name. PropSyn name -> Maybe Text -> SigDecl name
SigPropSyn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename PropSyn PName
ps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mb
instance Rename Decl where
rename :: Decl PName -> RenameM (Decl Name)
rename Decl PName
d = case Decl PName
d of
DBind Bind PName
b -> forall name. Bind name -> Decl name
DBind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b
DType TySyn PName
syn -> forall name. TySyn name -> Decl name
DType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TySyn PName
syn
DProp PropSyn PName
syn -> forall name. PropSyn name -> Decl name
DProp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename PropSyn PName
syn
DLocated Decl PName
d' Range
r -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
forall a b. (a -> b) -> a -> b
$ forall name. Decl name -> Range -> Decl name
DLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Decl PName
d' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r
DFixity{} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DFixity" ]
DSignature {} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DSignature" ]
DPragma {} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DPragma" ]
DPatBind {} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DPatBind " ]
DRec {} -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DRec" ]
instance Rename Newtype where
rename :: Newtype PName -> RenameM (Newtype Name)
rename Newtype PName
n =
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall name. Newtype name -> [TParam name]
nParams Newtype PName
n) forall a b. (a -> b) -> a -> b
$
do Located Name
nameT <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (forall name. Newtype name -> Located name
nName Newtype PName
n)
Name
nameC <- NameType -> PName -> RenameM Name
renameVar NameType
NameBind (forall name. Newtype name -> name
nConName Newtype PName
n)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing Name
nameC) (Name -> RenameM ()
addDep (forall a. Located a -> a
thing Located Name
nameT))
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
nameT)) forall a b. (a -> b) -> a -> b
$
do [TParam Name]
ps' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. Newtype name -> [TParam name]
nParams Newtype PName
n)
RecordMap Ident (Range, Type Name)
body' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (forall name. Newtype name -> Rec (Type name)
nBody Newtype PName
n)
forall (m :: * -> *) a. Monad m => a -> m a
return Newtype { nName :: Located Name
nName = Located Name
nameT
, nConName :: Name
nConName = Name
nameC
, nParams :: [TParam Name]
nParams = [TParam Name]
ps'
, nBody :: RecordMap Ident (Range, Type Name)
nBody = RecordMap Ident (Range, Type Name)
body' }
resolveNameMaybe :: NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe :: NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
nt Namespace
expected PName
qn =
do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
let lkpIn :: Namespace -> Maybe Names
lkpIn Namespace
here = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
use :: Name -> RenameM ()
use = case Namespace
expected of
Namespace
NSType -> Name -> RenameM ()
recordUse
Namespace
_ -> forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
case Namespace -> Maybe Names
lkpIn Namespace
expected of
Just Names
xs ->
case Names
xs of
One Name
n ->
do case NameType
nt of
NameType
NameBind -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
NameType
NameUse -> Name -> RenameM ()
addDep Name
n
Name -> RenameM ()
use Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Name
n)
Ambig Set Name
symSet ->
do let syms :: [Name]
syms = forall a. Set a -> [a]
Set.toList Set Name
symSet
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
use [Name]
syms
Located PName
n <- forall a. a -> RenameM (Located a)
located PName
qn
RenamerError -> RenameM ()
recordError (Located PName -> [Name] -> RenamerError
MultipleSyms Located PName
n [Name]
syms)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a. [a] -> a
head [Name]
syms))
Maybe Names
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
reportUnboundName :: Namespace -> PName -> RenameM Name
reportUnboundName :: Namespace -> PName -> RenameM Name
reportUnboundName Namespace
expected PName
qn =
do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
let lkpIn :: Namespace -> Maybe Names
lkpIn Namespace
here = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
others :: [Namespace]
others = [ Namespace
ns | Namespace
ns <- [Namespace]
allNamespaces
, Namespace
ns forall a. Eq a => a -> a -> Bool
/= Namespace
expected
, Just Names
_ <- [Namespace -> Maybe Names
lkpIn Namespace
ns] ]
Located PName
nm <- forall a. a -> RenameM (Located a)
located PName
qn
case [Namespace]
others of
Namespace
actual : [Namespace]
_ -> RenamerError -> RenameM ()
recordError (Namespace -> Namespace -> Located PName -> RenamerError
WrongNamespace Namespace
expected Namespace
actual Located PName
nm)
[] -> RenamerError -> RenameM ()
recordError (Namespace -> Located PName -> RenamerError
UnboundName Namespace
expected Located PName
nm)
Namespace -> PName -> RenameM Name
mkFakeName Namespace
expected PName
qn
isFakeName :: ImpName Name -> Bool
isFakeName :: ImpName Name -> Bool
isFakeName ImpName Name
m =
case ImpName Name
m of
ImpTop ModName
x -> ModName
x forall a. Eq a => a -> a -> Bool
== ModName
undefinedModName
ImpNested Name
x ->
case Name -> Maybe ModName
nameTopModuleMaybe Name
x of
Just ModName
y -> ModName
y forall a. Eq a => a -> a -> Bool
== ModName
undefinedModName
Maybe ModName
Nothing -> Bool
False
resolveName :: NameType -> Namespace -> PName -> RenameM Name
resolveName :: NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
nt Namespace
expected PName
qn =
do Maybe Name
mb <- NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
nt Namespace
expected PName
qn
case Maybe Name
mb of
Just Name
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
Maybe Name
Nothing -> Namespace -> PName -> RenameM Name
reportUnboundName Namespace
expected PName
qn
renameVar :: NameType -> PName -> RenameM Name
renameVar :: NameType -> PName -> RenameM Name
renameVar NameType
nt = NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
nt Namespace
NSValue
renameType :: NameType -> PName -> RenameM Name
renameType :: NameType -> PName -> RenameM Name
renameType NameType
nt = NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
nt Namespace
NSType
mkFakeName :: Namespace -> PName -> RenameM Name
mkFakeName :: Namespace -> PName -> RenameM Name
mkFakeName Namespace
ns PName
pn =
do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace
-> ModPath
-> NameSource
-> Ident
-> Maybe Fixity
-> Range
-> Supply
-> (Name, Supply)
mkDeclared Namespace
ns (ModName -> ModPath
TopModule ModName
undefinedModName)
NameSource
SystemName (PName -> Ident
getIdent PName
pn) forall a. Maybe a
Nothing (RO -> Range
roLoc RO
ro))
instance Rename Schema where
rename :: Schema PName -> RenameM (Schema Name)
rename Schema PName
s = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema Schema PName
s
renameSchema :: Schema PName -> RenameM (NamingEnv,Schema Name)
renameSchema :: Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (Forall [TParam PName]
ps [Prop PName]
p Type PName
ty Maybe Range
loc) =
forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
ps [Prop PName]
p forall a b. (a -> b) -> a -> b
$ \[TParam Name]
ps' [Prop Name]
p' ->
do Type Name
ty' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall n.
[TParam n] -> [Prop n] -> Type n -> Maybe Range -> Schema n
Forall [TParam Name]
ps' [Prop Name]
p' Type Name
ty' Maybe Range
loc)
renameQual :: [TParam PName] -> [Prop PName] ->
([TParam Name] -> [Prop Name] -> RenameM a) ->
RenameM (NamingEnv, a)
renameQual :: forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
as [Prop PName]
ps [TParam Name] -> [Prop Name] -> RenameM a
k =
do NamingEnv
env <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf [TParam PName]
as)
a
res <- forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env forall a b. (a -> b) -> a -> b
$ do [TParam Name]
as' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
as
[Prop Name]
ps' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
ps
[TParam Name] -> [Prop Name] -> RenameM a
k [TParam Name]
as' [Prop Name]
ps'
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,a
res)
instance Rename TParam where
rename :: TParam PName -> RenameM (TParam Name)
rename TParam { Maybe Range
Maybe Kind
PName
tpRange :: forall n. TParam n -> Maybe Range
tpKind :: forall n. TParam n -> Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpName :: PName
tpName :: forall n. TParam n -> n
.. } =
do Name
n <- NameType -> PName -> RenameM Name
renameType NameType
NameBind PName
tpName
forall (m :: * -> *) a. Monad m => a -> m a
return TParam { tpName :: Name
tpName = Name
n, Maybe Range
Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
.. }
instance Rename Prop where
rename :: Prop PName -> RenameM (Prop Name)
rename (CType Type PName
t) = forall n. Type n -> Prop n
CType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t
instance Rename Type where
rename :: Type PName -> RenameM (Type Name)
rename Type PName
ty0 =
case Type PName
ty0 of
TFun Type PName
a Type PName
b -> forall n. Type n -> Type n -> Type n
TFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
TSeq Type PName
n Type PName
a -> forall n. Type n -> Type n -> Type n
TSeq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
n forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
Type PName
TBit -> forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Type n
TBit
TNum Integer
c -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Integer -> Type n
TNum Integer
c)
TChar Char
c -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Char -> Type n
TChar Char
c)
TUser PName
qn [Type PName]
ps -> forall n. n -> [Type n] -> Type n
TUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> PName -> RenameM Name
renameType NameType
NameUse PName
qn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
ps
TTyApp [Named (Type PName)]
fs -> forall n. [Named (Type n)] -> Type n
TTyApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) [Named (Type PName)]
fs
TRecord Rec (Type PName)
fs -> forall n. Rec (Type n) -> Type n
TRecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Type PName)
fs
TTuple [Type PName]
fs -> forall n. [Type n] -> Type n
TTuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
fs
Type PName
TWild -> forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Type n
TWild
TLocated Type PName
t' Range
r -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r (forall n. Type n -> Range -> Type n
TLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r)
TParens Type PName
t' Maybe Kind
k -> (forall n. Type n -> Maybe Kind -> Type n
`TParens` Maybe Kind
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t'
TInfix Type PName
a Located PName
o Fixity
_ Type PName
b -> do (Located Name, Fixity)
o' <- Located PName -> RenameM (Located Name, Fixity)
renameTypeOp Located PName
o
Type Name
a' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
Type Name
b' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
a' (Located Name, Fixity)
o' Type Name
b'
mkTInfix ::
Type Name -> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix :: Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix t :: Type Name
t@(TInfix Type Name
x Located Name
o1 Fixity
f1 Type Name
y) op :: (Located Name, Fixity)
op@(Located Name
o2,Fixity
f2) Type Name
z =
case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
FixityCmp
FCLeft -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o2 Fixity
f2 Type Name
z)
FixityCmp
FCRight -> do Type Name
r <- Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
y (Located Name, Fixity)
op Type Name
z
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
x Located Name
o1 Fixity
f1 Type Name
r)
FixityCmp
FCError -> do RenamerError -> RenameM ()
recordError (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o2 Fixity
f2 Type Name
z)
mkTInfix (TLocated Type Name
t' Range
_) (Located Name, Fixity)
op Type Name
z =
Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
t' (Located Name, Fixity)
op Type Name
z
mkTInfix Type Name
t (Located Name
o,Fixity
f) Type Name
z =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o Fixity
f Type Name
z)
instance Rename Bind where
rename :: Bind PName -> RenameM (Bind Name)
rename Bind PName
b =
do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) (forall name. Bind name -> Located name
bName Bind PName
b)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
n'))
do Maybe (NamingEnv, Schema Name)
mbSig <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (forall name. Bind name -> Maybe (Schema name)
bSignature Bind PName
b)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig) forall a b. (a -> b) -> a -> b
$
do (NamingEnv
patEnv,[Pattern Name]
pats') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats (forall name. Bind name -> [Pattern name]
bParams Bind PName
b)
Located (BindDef Name)
e' <- forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
patEnv (forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. Bind name -> Located (BindDef name)
bDef Bind PName
b))
forall (m :: * -> *) a. Monad m => a -> m a
return Bind PName
b { bName :: Located Name
bName = Located Name
n'
, bParams :: [Pattern Name]
bParams = [Pattern Name]
pats'
, bDef :: Located (BindDef Name)
bDef = Located (BindDef Name)
e'
, bSignature :: Maybe (Schema Name)
bSignature = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig
, bPragmas :: [Pragma]
bPragmas = forall name. Bind name -> [Pragma]
bPragmas Bind PName
b
}
instance Rename BindDef where
rename :: BindDef PName -> RenameM (BindDef Name)
rename BindDef PName
DPrim = forall (m :: * -> *) a. Monad m => a -> m a
return forall name. BindDef name
DPrim
rename BindDef PName
DForeign = forall (m :: * -> *) a. Monad m => a -> m a
return forall name. BindDef name
DForeign
rename (DExpr Expr PName
e) = forall name. Expr name -> BindDef name
DExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
rename (DPropGuards [PropGuardCase PName]
cases) = forall name. [PropGuardCase name] -> BindDef name
DPropGuards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [PropGuardCase PName]
cases
instance Rename PropGuardCase where
rename :: PropGuardCase PName -> RenameM (PropGuardCase Name)
rename PropGuardCase PName
g = forall name.
[Located (Prop name)] -> Expr name -> PropGuardCase name
PropGuardCase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (forall name. PropGuardCase name -> [Located (Prop name)]
pgcProps PropGuardCase PName
g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. PropGuardCase name -> Expr name
pgcExpr PropGuardCase PName
g)
instance Rename Pattern where
rename :: Pattern PName -> RenameM (Pattern Name)
rename Pattern PName
p = case Pattern PName
p of
PVar Located PName
lv -> forall n. Located n -> Pattern n
PVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) Located PName
lv
Pattern PName
PWild -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall n. Pattern n
PWild
PTuple [Pattern PName]
ps -> forall n. [Pattern n] -> Pattern n
PTuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
ps
PRecord Rec (Pattern PName)
nps -> forall n. Rec (Pattern n) -> Pattern n
PRecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Pattern PName)
nps
PList [Pattern PName]
elems -> forall n. [Pattern n] -> Pattern n
PList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
elems
PTyped Pattern PName
p' Type PName
t -> forall n. Pattern n -> Type n -> Pattern n
PTyped forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t
PSplit Pattern PName
l Pattern PName
r -> forall n. Pattern n -> Pattern n -> Pattern n
PSplit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
r
PLocated Pattern PName
p' Range
loc -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
forall a b. (a -> b) -> a -> b
$ forall n. Pattern n -> Range -> Pattern n
PLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
loc
instance Rename UpdField where
rename :: UpdField PName -> RenameM (UpdField Name)
rename (UpdField UpdHow
h [Located Selector]
ls Expr PName
e) =
case [Located Selector]
ls of
Located Selector
l : [Located Selector]
more ->
case [Located Selector]
more of
[] -> case UpdHow
h of
UpdHow
UpdSet -> forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdSet [Located Selector
l] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
UpdHow
UpdFun -> forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
EFun forall n. FunDesc n
emptyFunDesc [forall n. Located n -> Pattern n
PVar Located PName
p] Expr PName
e)
where
p :: Located PName
p = Ident -> PName
UnQual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Ident
selName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> a
last [Located Selector]
ls
[Located Selector]
_ -> forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd forall a. Maybe a
Nothing [ forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
h [Located Selector]
more Expr PName
e])
[] -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename@UpdField" [ String
"Empty label list." ]
instance Rename FunDesc where
rename :: FunDesc PName -> RenameM (FunDesc Name)
rename (FunDesc Maybe PName
nm Int
offset) =
do Maybe Name
nm' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) Maybe PName
nm
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall n. Maybe n -> Int -> FunDesc n
FunDesc Maybe Name
nm' Int
offset)
instance Rename Expr where
rename :: Expr PName -> RenameM (Expr Name)
rename Expr PName
expr = case Expr PName
expr of
EVar PName
n -> forall n. n -> Expr n
EVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> PName -> RenameM Name
renameVar NameType
NameUse PName
n
ELit Literal
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Literal -> Expr n
ELit Literal
l)
EGenerate Expr PName
e -> forall n. Expr n -> Expr n
EGenerate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
ETuple [Expr PName]
es -> forall n. [Expr n] -> Expr n
ETuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
ERecord Rec (Expr PName)
fs -> forall n. Rec (Expr n) -> Expr n
ERecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Expr PName)
fs
ESel Expr PName
e' Selector
s -> forall n. Expr n -> Selector -> Expr n
ESel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
EUpd Maybe (Expr PName)
mb [UpdField PName]
fs -> do [UpdField PName] -> RenameM ()
checkLabels [UpdField PName]
fs
forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
mb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [UpdField PName]
fs
EList [Expr PName]
es -> forall n. [Expr n] -> Expr n
EList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
EFromTo Type PName
s Maybe (Type PName)
n Type PName
e Maybe (Type PName)
t -> forall n.
Type n -> Maybe (Type n) -> Type n -> Maybe (Type n) -> Expr n
EFromTo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
n
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
EFromToBy Bool
isStrict Type PName
s Type PName
e Type PName
b Maybe (Type PName)
t ->
forall n.
Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToBy Bool
isStrict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
EFromToDownBy Bool
isStrict Type PName
s Type PName
e Type PName
b Maybe (Type PName)
t ->
forall n.
Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToDownBy Bool
isStrict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
EFromToLessThan Type PName
s Type PName
e Maybe (Type PName)
t ->
forall n. Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToLessThan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
EInfFrom Expr PName
a Maybe (Expr PName)
b -> forall n. Expr n -> Maybe (Expr n) -> Expr n
EInfFromforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
b
EComp Expr PName
e' [[Match PName]]
bs -> do [(NamingEnv, [Match Name])]
arms' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [[Match PName]]
bs
let ([NamingEnv]
envs,[[Match Name]]
bs') = forall a b. [(a, b)] -> ([a], [b])
unzip [(NamingEnv, [Match Name])]
arms'
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap [NamingEnv]
envs (forall n. Expr n -> [[Match n]] -> Expr n
EComp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Match Name]]
bs')
EApp Expr PName
f Expr PName
x -> forall n. Expr n -> Expr n -> Expr n
EApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
EAppT Expr PName
f [TypeInst PName]
ti -> forall n. Expr n -> [TypeInst n] -> Expr n
EAppT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TypeInst PName]
ti
EIf Expr PName
b Expr PName
t Expr PName
f -> forall n. Expr n -> Expr n -> Expr n -> Expr n
EIf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f
EWhere Expr PName
e' [Decl PName]
ds -> forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe ModPath -> a -> InModule a
InModule forall a. Maybe a
Nothing) [Decl PName]
ds) forall a b. (a -> b) -> a -> b
$
forall n. Expr n -> [Decl n] -> Expr n
EWhere forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Decl PName] -> RenameM [Decl Name]
renameDecls [Decl PName]
ds
ETyped Expr PName
e' Type PName
ty -> forall n. Expr n -> Type n -> Expr n
ETyped forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
ETypeVal Type PName
ty -> forall n. Type n -> Expr n
ETypeValforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
EFun FunDesc PName
desc [Pattern PName]
ps Expr PName
e' -> do FunDesc Name
desc' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename FunDesc PName
desc
(NamingEnv
env,[Pattern Name]
ps') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats [Pattern PName]
ps
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env (forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
EFun FunDesc Name
desc' [Pattern Name]
ps' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e')
ELocated Expr PName
e' Range
r -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
forall a b. (a -> b) -> a -> b
$ forall n. Expr n -> Range -> Expr n
ELocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r
ESplit Expr PName
e -> forall n. Expr n -> Expr n
ESplit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
EParens Expr PName
p -> forall n. Expr n -> Expr n
EParens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
p
EInfix Expr PName
x Located PName
y Fixity
_ Expr PName
z -> do (Located Name, Fixity)
op <- Located PName -> RenameM (Located Name, Fixity)
renameOp Located PName
y
Expr Name
x' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
Expr Name
z' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
z
Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
x' (Located Name, Fixity)
op Expr Name
z'
EPrefix PrefixOp
op Expr PName
e -> forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
checkLabels :: [UpdField PName] -> RenameM ()
checkLabels :: [UpdField PName] -> RenameM ()
checkLabels = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {n}. UpdField n -> [Located Selector]
labs
where
labs :: UpdField n -> [Located Selector]
labs (UpdField UpdHow
_ [Located Selector]
ls Expr n
_) = [Located Selector]
ls
check :: [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check [[Located Selector]]
done [Located Selector]
l =
do case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
l) [[Located Selector]]
done of
Just [Located Selector]
l' -> RenamerError -> RenameM ()
recordError (Located [Selector] -> Located [Selector] -> RenamerError
OverlappingRecordUpdate (forall {b}. [Located b] -> Located [b]
reLoc [Located Selector]
l) (forall {b}. [Located b] -> Located [b]
reLoc [Located Selector]
l'))
Maybe [Located Selector]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Located Selector]
l forall a. a -> [a] -> [a]
: [[Located Selector]]
done)
overlap :: [Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
xs [Located Selector]
ys =
case ([Located Selector]
xs,[Located Selector]
ys) of
([],[Located Selector]
_) -> Bool
True
([Located Selector]
_, []) -> Bool
True
(Located Selector
x : [Located Selector]
xs', Located Selector
y : [Located Selector]
ys') -> Located Selector -> Located Selector -> Bool
same Located Selector
x Located Selector
y Bool -> Bool -> Bool
&& [Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
xs' [Located Selector]
ys'
same :: Located Selector -> Located Selector -> Bool
same Located Selector
x Located Selector
y =
case (forall a. Located a -> a
thing Located Selector
x, forall a. Located a -> a
thing Located Selector
y) of
(TupleSel Int
a Maybe Int
_, TupleSel Int
b Maybe Int
_) -> Int
a forall a. Eq a => a -> a -> Bool
== Int
b
(ListSel Int
a Maybe Int
_, ListSel Int
b Maybe Int
_) -> Int
a forall a. Eq a => a -> a -> Bool
== Int
b
(RecordSel Ident
a Maybe [Ident]
_, RecordSel Ident
b Maybe [Ident]
_) -> Ident
a forall a. Eq a => a -> a -> Bool
== Ident
b
(Selector, Selector)
_ -> Bool
False
reLoc :: [Located b] -> Located [b]
reLoc [Located b]
xs = (forall a. [a] -> a
head [Located b]
xs) { thing :: [b]
thing = forall a b. (a -> b) -> [a] -> [b]
map forall a. Located a -> a
thing [Located b]
xs }
mkEInfix :: Expr Name
-> (Located Name,Fixity)
-> Expr Name
-> RenameM (Expr Name)
mkEInfix :: Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix e :: Expr Name
e@(EInfix Expr Name
x Located Name
o1 Fixity
f1 Expr Name
y) op :: (Located Name, Fixity)
op@(Located Name
o2,Fixity
f2) Expr Name
z =
case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
FixityCmp
FCLeft -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)
FixityCmp
FCRight -> do Expr Name
r <- Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
y (Located Name, Fixity)
op Expr Name
z
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
x Located Name
o1 Fixity
f1 Expr Name
r)
FixityCmp
FCError -> do RenamerError -> RenameM ()
recordError (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)
mkEInfix e :: Expr Name
e@(EPrefix PrefixOp
o1 Expr Name
x) op :: (Located Name, Fixity)
op@(Located Name
o2, Fixity
f2) Expr Name
y =
case Fixity -> Fixity -> FixityCmp
compareFixity (PrefixOp -> Fixity
prefixFixity PrefixOp
o1) Fixity
f2 of
FixityCmp
FCRight -> do
let warning :: RenamerWarning
warning = PrefixOp
-> Expr Name
-> Located Name
-> Fixity
-> Expr Name
-> RenamerWarning
PrefixAssocChanged PrefixOp
o1 Expr Name
x Located Name
o2 Fixity
f2 Expr Name
y
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ (\RW
rw -> RW
rw {rwWarnings :: [RenamerWarning]
rwWarnings = RenamerWarning
warning forall a. a -> [a] -> [a]
: RW -> [RenamerWarning]
rwWarnings RW
rw})
Expr Name
r <- Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
x (Located Name, Fixity)
op Expr Name
y
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
o1 Expr Name
r)
FixityCmp
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
y)
mkEInfix (ELocated Expr Name
e' Range
_) (Located Name, Fixity)
op Expr Name
z =
Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
e' (Located Name, Fixity)
op Expr Name
z
mkEInfix Expr Name
e (Located Name
o,Fixity
f) Expr Name
z =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o Fixity
f Expr Name
z)
renameOp :: Located PName -> RenameM (Located Name, Fixity)
renameOp :: Located PName -> RenameM (Located Name, Fixity)
renameOp Located PName
ln =
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln forall a b. (a -> b) -> a -> b
$
do Name
n <- NameType -> PName -> RenameM Name
renameVar NameType
NameUse (forall a. Located a -> a
thing Located PName
ln)
Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing :: Name
thing = Name
n }, Fixity
fixity)
renameTypeOp :: Located PName -> RenameM (Located Name, Fixity)
renameTypeOp :: Located PName -> RenameM (Located Name, Fixity)
renameTypeOp Located PName
ln =
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln forall a b. (a -> b) -> a -> b
$
do Name
n <- NameType -> PName -> RenameM Name
renameType NameType
NameUse (forall a. Located a -> a
thing Located PName
ln)
Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing :: Name
thing = Name
n }, Fixity
fixity)
lookupFixity :: Name -> RenameM Fixity
lookupFixity :: Name -> RenameM Fixity
lookupFixity Name
n =
case Name -> Maybe Fixity
nameFixity Name
n of
Just Fixity
fixity -> forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
fixity
Maybe Fixity
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
defaultFixity
instance Rename TypeInst where
rename :: TypeInst PName -> RenameM (TypeInst Name)
rename TypeInst PName
ti = case TypeInst PName
ti of
NamedInst Named (Type PName)
nty -> forall name. Named (Type name) -> TypeInst name
NamedInst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Named (Type PName)
nty
PosInst Type PName
ty -> forall name. Type name -> TypeInst name
PosInst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
renameArm :: [Match PName] -> RenameM (NamingEnv,[Match Name])
renameArm :: [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm (Match PName
m:[Match PName]
ms) =
do (NamingEnv
me,Match Name
m') <- Match PName -> RenameM (NamingEnv, Match Name)
renameMatch Match PName
m
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
me forall a b. (a -> b) -> a -> b
$
do (NamingEnv
env,[Match Name]
rest) <- [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [Match PName]
ms
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
me, Match Name
m'forall a. a -> [a] -> [a]
:[Match Name]
rest)
renameArm [] =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty,[])
renameMatch :: Match PName -> RenameM (NamingEnv,Match Name)
renameMatch :: Match PName -> RenameM (NamingEnv, Match Name)
renameMatch (Match Pattern PName
p Expr PName
e) =
do (NamingEnv
pe,Pattern Name
p') <- Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat Pattern PName
p
Expr Name
e' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe,forall name. Pattern name -> Expr name -> Match name
Match Pattern Name
p' Expr Name
e')
renameMatch (MatchLet Bind PName
b) =
do NamingEnv
be <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf (forall a. Maybe ModPath -> a -> InModule a
InModule forall a. Maybe a
Nothing Bind PName
b))
Bind Name
b' <- forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
be (forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
be,forall name. Bind name -> Match name
MatchLet Bind Name
b')
renamePat :: Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat :: Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat Pattern PName
p =
do NamingEnv
pe <- Pattern PName -> RenameM NamingEnv
patternEnv Pattern PName
p
Pattern Name
p' <- forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe, Pattern Name
p')
renamePats :: [Pattern PName] -> RenameM (NamingEnv,[Pattern Name])
renamePats :: [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats = [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop
where
loop :: [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop [Pattern PName]
ps = case [Pattern PName]
ps of
Pattern PName
p:[Pattern PName]
rest -> do
NamingEnv
pe <- Pattern PName -> RenameM NamingEnv
patternEnv Pattern PName
p
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe forall a b. (a -> b) -> a -> b
$
do Pattern Name
p' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p
(NamingEnv
env',[Pattern Name]
rest') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop [Pattern PName]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
env', Pattern Name
p'forall a. a -> [a] -> [a]
:[Pattern Name]
rest')
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, [])
patternEnv :: Pattern PName -> RenameM NamingEnv
patternEnv :: Pattern PName -> RenameM NamingEnv
patternEnv = Pattern PName -> RenameM NamingEnv
go
where
go :: Pattern PName -> RenameM NamingEnv
go (PVar Located { Range
PName
thing :: PName
srcRange :: Range
srcRange :: forall a. Located a -> Range
thing :: forall a. Located a -> a
.. }) =
do Name
n <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSValue (PName -> Ident
getIdent PName
thing) Range
srcRange)
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSValue PName
thing Name
n)
go Pattern PName
PWild = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
go (PTuple [Pattern PName]
ps) = [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
go (PRecord Rec (Pattern PName)
fs) = [Pattern PName] -> RenameM NamingEnv
bindVars (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall a b. RecordMap a b -> [b]
recordElements Rec (Pattern PName)
fs))
go (PList [Pattern PName]
ps) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern PName -> RenameM NamingEnv
go [Pattern PName]
ps
go (PTyped Pattern PName
p Type PName
ty) = Pattern PName -> RenameM NamingEnv
go Pattern PName
p forall a. Monoid a => a -> a -> a
`mappend` Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
go (PSplit Pattern PName
a Pattern PName
b) = Pattern PName -> RenameM NamingEnv
go Pattern PName
a forall a. Monoid a => a -> a -> a
`mappend` Pattern PName -> RenameM NamingEnv
go Pattern PName
b
go (PLocated Pattern PName
p Range
loc) = forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc (Pattern PName -> RenameM NamingEnv
go Pattern PName
p)
bindVars :: [Pattern PName] -> RenameM NamingEnv
bindVars [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
bindVars (Pattern PName
p:[Pattern PName]
ps) =
do NamingEnv
env <- Pattern PName -> RenameM NamingEnv
go Pattern PName
p
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env forall a b. (a -> b) -> a -> b
$
do NamingEnv
rest <- [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
rest)
typeEnv :: Type PName -> RenameM NamingEnv
typeEnv (TFun Type PName
a Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]
typeEnv (TSeq Type PName
a Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]
typeEnv Type PName
TBit = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
typeEnv TNum{} = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
typeEnv TChar{} = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
typeEnv (TUser PName
pn [Type PName]
ps) =
do Maybe Name
mb <- NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
NameUse Namespace
NSType PName
pn
case Maybe Name
mb of
Just Name
_ -> [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ps
Maybe Name
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type PName]
ps ->
do Range
loc <- RenameM Range
curLoc
Name
n <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType PName
pn Name
n)
| Bool
otherwise ->
do Range
loc <- RenameM Range
curLoc
RenamerError -> RenameM ()
recordError (Namespace -> Located PName -> RenamerError
UnboundName Namespace
NSType (forall a. Range -> a -> Located a
Located Range
loc PName
pn))
Name
n <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType PName
pn Name
n)
typeEnv (TRecord Rec (Type PName)
fs) = [Type PName] -> RenameM NamingEnv
bindTypes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall a b. RecordMap a b -> [b]
recordElements Rec (Type PName)
fs))
typeEnv (TTyApp [Named (Type PName)]
fs) = [Type PName] -> RenameM NamingEnv
bindTypes (forall a b. (a -> b) -> [a] -> [b]
map forall a. Named a -> a
value [Named (Type PName)]
fs)
typeEnv (TTuple [Type PName]
ts) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
typeEnv Type PName
TWild = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
typeEnv (TLocated Type PName
ty Range
loc) = forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc (Type PName -> RenameM NamingEnv
typeEnv Type PName
ty)
typeEnv (TParens Type PName
ty Maybe Kind
_) = Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
typeEnv (TInfix Type PName
a Located PName
_ Fixity
_ Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]
bindTypes :: [Type PName] -> RenameM NamingEnv
bindTypes [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
bindTypes (Type PName
t:[Type PName]
ts) =
do NamingEnv
env' <- Type PName -> RenameM NamingEnv
typeEnv Type PName
t
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env' forall a b. (a -> b) -> a -> b
$
do NamingEnv
res <- [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env' forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
res)
instance Rename Match where
rename :: Match PName -> RenameM (Match Name)
rename Match PName
m = case Match PName
m of
Match Pattern PName
p Expr PName
e -> forall name. Pattern name -> Expr name -> Match name
Match forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
MatchLet Bind PName
b -> forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall a. Maybe ModPath -> a -> InModule a
InModule forall a. Maybe a
Nothing Bind PName
b) (forall name. Bind name -> Match name
MatchLet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)
instance Rename TySyn where
rename :: TySyn PName -> RenameM (TySyn Name)
rename (TySyn Located PName
n Maybe Fixity
f [TParam PName]
ps Type PName
ty) =
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps
do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) Located PName
n
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
n')) forall a b. (a -> b) -> a -> b
$
forall n.
Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
TySyn Located Name
n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
instance Rename PropSyn where
rename :: PropSyn PName -> RenameM (PropSyn Name)
rename (PropSyn Located PName
n Maybe Fixity
f [TParam PName]
ps [Prop PName]
cs) =
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps
do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) Located PName
n
forall n.
Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
PropSyn Located Name
n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
cs
instance PP RenamedModule where
ppPrec :: Int -> RenamedModule -> Doc
ppPrec Int
_ RenamedModule
rn = (PPCfg -> PPCfg) -> Doc -> Doc
updPPCfg (\PPCfg
cfg -> PPCfg
cfg { ppcfgShowNameUniques :: Bool
ppcfgShowNameUniques = Bool
True }) Doc
doc
where
doc :: Doc
doc =
[Doc] -> Doc
vcat [ Doc
"// --- Defines -----------------------------"
, forall a. PP a => a -> Doc
pp (RenamedModule -> NamingEnv
rmDefines RenamedModule
rn)
, Doc
"// --- In scope ----------------------------"
, forall a. PP a => a -> Doc
pp (RenamedModule -> NamingEnv
rmInScope RenamedModule
rn)
, Doc
"// -- Module -------------------------------"
, forall a. PP a => a -> Doc
pp (RenamedModule -> Module Name
rmModule RenamedModule
rn)
, Doc
"// -----------------------------------------"
]