{-# Language RecordWildCards #-}
{-# Language FlexibleInstances #-}
{-# Language FlexibleContexts #-}
{-# Language BlockArguments #-}
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(fromJust)
import Data.List(find,foldl')
import Data.Foldable(toList)
import Data.Map.Strict(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.NamingEnv
import Cryptol.ModuleSystem.Exports
import Cryptol.Parser.Position(getLoc)
import Cryptol.Parser.AST
import Cryptol.Parser.Selector(selName)
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.RecordMap
import Cryptol.Utils.Ident(allNamespaces,packModName)
import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Renamer.Error
import Cryptol.ModuleSystem.Renamer.Monad
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 { mDecls :: [TopDecl PName]
mDecls = ([[Ident]], [TopDecl PName]) -> [TopDecl PName]
forall a b. (a, b) -> b
snd ([TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports (Module PName -> [TopDecl PName]
forall mname name. ModuleG mname name -> [TopDecl name]
mDecls Module PName
m0)) }
NamingEnv
env <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Module PName -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf Module PName
m)
NestedMods
nested <- (Supply -> (NestedMods, Supply)) -> RenameM NestedMods
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (NamingEnv -> Module PName -> Supply -> (NestedMods, Supply)
collectNestedModules NamingEnv
env Module PName
m)
Map ModPath Name -> RenameM RenamedModule -> RenameM RenamedModule
forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule (NestedMods -> Map ModPath Name
nestedModuleNames NestedMods
nested)
do (IfaceDecls
ifs,(NamingEnv
inScope,Module Name
m1)) <- RenameM (NamingEnv, Module Name)
-> RenameM (IfaceDecls, (NamingEnv, Module Name))
forall a. RenameM a -> RenameM (IfaceDecls, a)
collectIfaceDeps
(RenameM (NamingEnv, Module Name)
-> RenameM (IfaceDecls, (NamingEnv, Module Name)))
-> RenameM (NamingEnv, Module Name)
-> RenameM (IfaceDecls, (NamingEnv, Module Name))
forall a b. (a -> b) -> a -> b
$ NestedMods
-> NamingEnv
-> ModPath
-> Module PName
-> RenameM (NamingEnv, Module Name)
forall mname.
NestedMods
-> NamingEnv
-> ModPath
-> ModuleG mname PName
-> RenameM (NamingEnv, ModuleG mname Name)
renameModule' NestedMods
nested NamingEnv
env (ModName -> ModPath
TopModule (Located ModName -> ModName
forall a. Located a -> a
thing (Module PName -> Located ModName
forall mname name. ModuleG mname name -> Located mname
mName Module PName
m))) Module PName
m
RenamedModule -> RenameM RenamedModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure RenamedModule :: Module Name
-> NamingEnv -> NamingEnv -> IfaceDecls -> RenamedModule
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 = ([[Ident]], [TopDecl PName]) -> [TopDecl PName]
forall a b. (a, b) -> b
snd ([TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports [TopDecl PName]
ds0)
let mpath :: ModPath
mpath = ModName -> ModPath
TopModule ModName
m
NamingEnv
env <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ([InModule (TopDecl PName)] -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf ((TopDecl PName -> InModule (TopDecl PName))
-> [TopDecl PName] -> [InModule (TopDecl PName)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe ModPath -> TopDecl PName -> InModule (TopDecl PName)
forall a. Maybe ModPath -> a -> InModule a
InModule (ModPath -> Maybe ModPath
forall a. a -> Maybe a
Just ModPath
mpath)) [TopDecl PName]
ds))
NestedMods
nested <- (Supply -> (NestedMods, Supply)) -> RenameM NestedMods
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (NamingEnv
-> ModName -> [TopDecl PName] -> Supply -> (NestedMods, Supply)
collectNestedModulesDecls NamingEnv
env ModName
m [TopDecl PName]
ds)
Map ModPath Name
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule (NestedMods -> Map ModPath Name
nestedModuleNames NestedMods
nested)
do [TopDecl Name]
ds1 <- EnvCheck
-> NamingEnv -> RenameM [TopDecl Name] -> RenameM [TopDecl Name]
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap NamingEnv
env
((NestedMods, ModPath) -> [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' (NestedMods
nested,ModPath
mpath) [TopDecl PName]
ds)
let exports :: [ExportSpec Name]
exports = (TopDecl Name -> [ExportSpec Name])
-> [TopDecl Name] -> [ExportSpec Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TopDecl Name -> [ExportSpec Name]
forall name. Ord name => TopDecl name -> [ExportSpec name]
exportedNames [TopDecl Name]
ds1
(Name -> RenameM ()) -> Set Name -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse ((ExportSpec Name -> Set Name) -> [ExportSpec Name] -> Set Name
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Namespace -> ExportSpec Name -> Set Name
forall name. Namespace -> ExportSpec name -> Set name
exported Namespace
NSType) [ExportSpec Name]
exports)
(NamingEnv, [TopDecl Name]) -> RenameM (NamingEnv, [TopDecl Name])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,[TopDecl Name]
ds1)
addImplicitNestedImports ::
[TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports :: [TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports [TopDecl PName]
decls = ([[[Ident]]] -> [[Ident]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Ident]]]
exportedMods, [[TopDecl PName]] -> [TopDecl PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TopDecl PName]]
newDecls [TopDecl PName] -> [TopDecl PName] -> [TopDecl PName]
forall a. [a] -> [a] -> [a]
++ [TopDecl PName]
other)
where
([TopLevel (NestedModule PName)]
mods,[TopDecl PName]
other) = (TopDecl PName
-> ([TopLevel (NestedModule PName)], [TopDecl PName])
-> ([TopLevel (NestedModule PName)], [TopDecl PName]))
-> ([TopLevel (NestedModule PName)], [TopDecl PName])
-> [TopDecl PName]
-> ([TopLevel (NestedModule PName)], [TopDecl PName])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TopDecl PName
-> ([TopLevel (NestedModule PName)], [TopDecl PName])
-> ([TopLevel (NestedModule PName)], [TopDecl PName])
forall name.
TopDecl name
-> ([TopLevel (NestedModule name)], [TopDecl name])
-> ([TopLevel (NestedModule name)], [TopDecl name])
classify ([], []) [TopDecl PName]
decls
([[TopDecl PName]]
newDecls,[[[Ident]]]
exportedMods) = [([TopDecl PName], [[Ident]])] -> ([[TopDecl PName]], [[[Ident]]])
forall a b. [(a, b)] -> ([a], [b])
unzip ((TopLevel (NestedModule PName) -> ([TopDecl PName], [[Ident]]))
-> [TopLevel (NestedModule PName)]
-> [([TopDecl PName], [[Ident]])]
forall a b. (a -> b) -> [a] -> [b]
map TopLevel (NestedModule PName) -> ([TopDecl PName], [[Ident]])
processModule [TopLevel (NestedModule PName)]
mods)
processModule :: TopLevel (NestedModule PName) -> ([TopDecl PName], [[Ident]])
processModule TopLevel (NestedModule PName)
m =
let NestedModule ModuleG PName PName
m1 = TopLevel (NestedModule PName) -> NestedModule PName
forall a. TopLevel a -> a
tlValue TopLevel (NestedModule PName)
m
([[Ident]]
childExs, [TopDecl PName]
ds1) = [TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports (ModuleG PName PName -> [TopDecl PName]
forall mname name. ModuleG mname name -> [TopDecl name]
mDecls ModuleG PName PName
m1)
mname :: Ident
mname = PName -> Ident
getIdent (Located PName -> PName
forall a. Located a -> a
thing (ModuleG PName PName -> Located PName
forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m1))
imps :: [[Ident]]
imps = ([Ident] -> [Ident]) -> [[Ident]] -> [[Ident]]
forall a b. (a -> b) -> [a] -> [b]
map (Ident
mname Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:) ([] [Ident] -> [[Ident]] -> [[Ident]]
forall a. a -> [a] -> [a]
: [[Ident]]
childExs)
isToName :: [Ident] -> PName
isToName [Ident]
is = case [Ident]
is of
[Ident
i] -> Ident -> PName
mkUnqual Ident
i
[Ident]
_ -> ModName -> Ident -> PName
mkQual ([Ident] -> ModName
isToQual ([Ident] -> [Ident]
forall a. [a] -> [a]
init [Ident]
is)) ([Ident] -> Ident
forall a. [a] -> a
last [Ident]
is)
isToQual :: [Ident] -> ModName
isToQual [Ident]
is = [Text] -> ModName
packModName ((Ident -> Text) -> [Ident] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Text
identText [Ident]
is)
mkImp :: [Ident] -> TopDecl PName
mkImp [Ident]
xs = Located (ImportG (ImpName PName)) -> TopDecl PName
forall name. Located (ImportG (ImpName name)) -> TopDecl name
DImport
Located :: forall a. Range -> a -> Located a
Located
{ srcRange :: Range
srcRange = Located PName -> Range
forall a. Located a -> Range
srcRange (ModuleG PName PName -> Located PName
forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m1)
, thing :: ImportG (ImpName PName)
thing = Import :: forall mname.
mname -> Maybe ModName -> Maybe ImportSpec -> ImportG mname
Import
{ iModule :: ImpName PName
iModule = PName -> ImpName PName
forall name. name -> ImpName name
ImpNested ([Ident] -> PName
isToName [Ident]
xs)
, iAs :: Maybe ModName
iAs = ModName -> Maybe ModName
forall a. a -> Maybe a
Just ([Ident] -> ModName
isToQual [Ident]
xs)
, iSpec :: Maybe ImportSpec
iSpec = Maybe ImportSpec
forall a. Maybe a
Nothing
}
}
in ( TopLevel (NestedModule PName) -> TopDecl PName
forall name. TopLevel (NestedModule name) -> TopDecl name
DModule TopLevel (NestedModule PName)
m { tlValue :: NestedModule PName
tlValue = ModuleG PName PName -> NestedModule PName
forall name. ModuleG name name -> NestedModule name
NestedModule ModuleG PName PName
m1 { mDecls :: [TopDecl PName]
mDecls = [TopDecl PName]
ds1 } }
TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
: ([Ident] -> TopDecl PName) -> [[Ident]] -> [TopDecl PName]
forall a b. (a -> b) -> [a] -> [b]
map [Ident] -> TopDecl PName
mkImp [[Ident]]
imps
, case TopLevel (NestedModule PName) -> ExportType
forall a. TopLevel a -> ExportType
tlExport TopLevel (NestedModule PName)
m of
ExportType
Public -> [[Ident]]
imps
ExportType
Private -> []
)
classify :: TopDecl name
-> ([TopLevel (NestedModule name)], [TopDecl name])
-> ([TopLevel (NestedModule name)], [TopDecl name])
classify TopDecl name
d ([TopLevel (NestedModule name)]
ms,[TopDecl name]
ds) =
case TopDecl name
d of
DModule TopLevel (NestedModule name)
tl -> (TopLevel (NestedModule name)
tl TopLevel (NestedModule name)
-> [TopLevel (NestedModule name)] -> [TopLevel (NestedModule name)]
forall a. a -> [a] -> [a]
: [TopLevel (NestedModule name)]
ms, [TopDecl name]
ds)
TopDecl name
_ -> ([TopLevel (NestedModule name)]
ms, TopDecl name
d TopDecl name -> [TopDecl name] -> [TopDecl name]
forall a. a -> [a] -> [a]
: [TopDecl name]
ds)
nestedModuleNames :: NestedMods -> Map ModPath Name
nestedModuleNames :: NestedMods -> Map ModPath Name
nestedModuleNames NestedMods
mp = [(ModPath, Name)] -> Map ModPath Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Name -> (ModPath, Name)) -> [Name] -> [(ModPath, Name)]
forall a b. (a -> b) -> [a] -> [b]
map Name -> (ModPath, Name)
entry (NestedMods -> [Name]
forall k a. Map k a -> [k]
Map.keys NestedMods
mp))
where
entry :: Name -> (ModPath, Name)
entry Name
n = case Name -> NameInfo
nameInfo Name
n of
Declared ModPath
p NameSource
_ -> (ModPath -> Ident -> ModPath
Nested ModPath
p (Name -> Ident
nameIdent Name
n),Name
n)
NameInfo
_ -> String -> [String] -> (ModPath, Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"nestedModuleName" [ String
"Not a top-level name" ]
class Rename f where
rename :: f PName -> RenameM (f Name)
renameModule' ::
NestedMods -> NamingEnv -> ModPath -> ModuleG mname PName ->
RenameM (NamingEnv, ModuleG mname Name)
renameModule' :: NestedMods
-> NamingEnv
-> ModPath
-> ModuleG mname PName
-> RenameM (NamingEnv, ModuleG mname Name)
renameModule' NestedMods
thisNested NamingEnv
env ModPath
mpath ModuleG mname PName
m =
ModPath
-> RenameM (NamingEnv, ModuleG mname Name)
-> RenameM (NamingEnv, ModuleG mname Name)
forall a. ModPath -> RenameM a -> RenameM a
setCurMod ModPath
mpath
do (NestedMods
moreNested,NamingEnv
imps) <- [(NestedMods, NamingEnv)] -> (NestedMods, NamingEnv)
forall a. Monoid a => [a] -> a
mconcat ([(NestedMods, NamingEnv)] -> (NestedMods, NamingEnv))
-> RenameM [(NestedMods, NamingEnv)]
-> RenameM (NestedMods, NamingEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located Import -> RenameM (NestedMods, NamingEnv))
-> [Located Import] -> RenameM [(NestedMods, NamingEnv)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located Import -> RenameM (NestedMods, NamingEnv)
doImport (ModuleG mname PName -> [Located Import]
forall mname name. ModuleG mname name -> [Located Import]
mImports ModuleG mname PName
m)
let allNested :: NestedMods
allNested = NestedMods -> NestedMods -> NestedMods
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union NestedMods
moreNested NestedMods
thisNested
openDs :: [ImportG PName]
openDs = (Located (ImportG PName) -> ImportG PName)
-> [Located (ImportG PName)] -> [ImportG PName]
forall a b. (a -> b) -> [a] -> [b]
map Located (ImportG PName) -> ImportG PName
forall a. Located a -> a
thing (ModuleG mname PName -> [Located (ImportG PName)]
forall mname name. ModuleG mname name -> [Located (ImportG name)]
mSubmoduleImports ModuleG mname PName
m)
allImps :: NamingEnv
allImps = NestedMods
-> NamingEnv -> [ImportG PName] -> NamingEnv -> NamingEnv
openLoop NestedMods
allNested NamingEnv
env [ImportG PName]
openDs NamingEnv
imps
(NamingEnv
inScope,[TopDecl Name]
decls') <-
EnvCheck
-> NamingEnv
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
allImps (RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name]))
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall a b. (a -> b) -> a -> b
$
EnvCheck
-> NamingEnv
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap NamingEnv
env (RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name]))
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall a b. (a -> b) -> a -> b
$
do NamingEnv
inScope <- RenameM NamingEnv
getNamingEnv
[TopDecl Name]
ds <- (NestedMods, ModPath) -> [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' (NestedMods
allNested,ModPath
mpath) (ModuleG mname PName -> [TopDecl PName]
forall mname name. ModuleG mname name -> [TopDecl name]
mDecls ModuleG mname PName
m)
(NamingEnv, [TopDecl Name]) -> RenameM (NamingEnv, [TopDecl Name])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
inScope, [TopDecl Name]
ds)
let m1 :: ModuleG mname Name
m1 = ModuleG mname PName
m { mDecls :: [TopDecl Name]
mDecls = [TopDecl Name]
decls' }
exports :: ExportSpec Name
exports = ModuleG mname Name -> ExportSpec Name
forall name mname.
Ord name =>
ModuleG mname name -> ExportSpec name
modExports ModuleG mname Name
m1
(Name -> RenameM ()) -> Set Name -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse (Namespace -> ExportSpec Name -> Set Name
forall name. Namespace -> ExportSpec name -> Set name
exported Namespace
NSType ExportSpec Name
exports)
(NamingEnv, ModuleG mname Name)
-> RenameM (NamingEnv, ModuleG mname Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
inScope, ModuleG mname Name
m1)
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) <- RenameM [Decl Name]
-> RenameM ([Decl Name], Map DepName (Set Name))
forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup ((Decl PName -> RenameM (Decl Name))
-> [Decl PName] -> RenameM [Decl Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Decl PName -> RenameM (Decl Name)
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, (Name -> DepName) -> [Name] -> [DepName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing
([Name] -> [DepName]) -> [Name] -> [DepName]
forall a b. (a -> b) -> a -> b
$ Set Name -> [Name]
forall a. Set a -> [a]
Set.toList
(Set Name -> [Name]) -> Set Name -> [Name]
forall a b. (a -> b) -> a -> b
$ Set Name -> DepName -> Map DepName (Set Name) -> Set Name
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set Name
forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps)
ordered :: [SCC (Decl Name, DepName)]
ordered = [SCC (Decl Name, DepName)] -> [SCC (Decl Name, DepName)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([((Decl Name, DepName), DepName, [DepName])]
-> [SCC (Decl Name, DepName)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ((Decl Name -> ((Decl Name, DepName), DepName, [DepName]))
-> [Decl Name] -> [((Decl Name, DepName), DepName, [DepName])]
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
_) -> [Decl name] -> RenameM [Decl name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl name
d]
CyclicSCC [(Decl name, DepName)]
ds_xs ->
let ([Decl name]
rds,[DepName]
xs) = [(Decl name, DepName)] -> ([Decl name], [DepName])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Decl name, DepName)]
ds_xs
in case (Decl name -> Maybe (Bind name))
-> [Decl name] -> Maybe [Bind name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl name -> Maybe (Bind name)
forall name. Decl name -> Maybe (Bind name)
validRecursiveD [Decl name]
rds of
Maybe [Bind name]
Nothing -> do RenamerError -> RenameM ()
record ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
[Decl name] -> RenameM [Decl name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl name]
rds
Just [Bind name]
bs ->
do [DepName] -> RenameM ()
checkSameModule [DepName]
xs
[Decl name] -> RenameM [Decl name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Bind name] -> Decl name
forall name. [Bind name] -> Decl name
DRec [Bind name]
bs]
[[Decl Name]] -> [Decl Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Decl Name]] -> [Decl Name])
-> RenameM [[Decl Name]] -> RenameM [Decl Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SCC (Decl Name, DepName) -> RenameM [Decl Name])
-> [SCC (Decl Name, DepName)] -> RenameM [[Decl Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SCC (Decl Name, DepName) -> RenameM [Decl Name]
forall name. SCC (Decl name, DepName) -> RenameM [Decl name]
fromSCC [SCC (Decl Name, DepName)]
ordered
validRecursiveD :: Decl name -> Maybe (Bind name)
validRecursiveD :: Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d =
case Decl name
d of
DBind Bind name
b -> Bind name -> Maybe (Bind name)
forall a. a -> Maybe a
Just Bind name
b
DLocated Decl name
d' Range
_ -> Decl name -> Maybe (Bind name)
forall name. Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d'
Decl name
_ -> Maybe (Bind 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 = [ (Name, ModPath) -> Name
forall a b. (a, b) -> a
fst (Name, ModPath)
b | (Name, ModPath)
b <- [(Name, ModPath)]
as, (Name, ModPath) -> ModPath
forall a b. (a, b) -> b
snd (Name, ModPath)
a ModPath -> ModPath -> Bool
forall a. Eq a => a -> a -> Bool
/= (Name, ModPath) -> ModPath
forall a b. (a, b) -> b
snd (Name, ModPath)
b ]
, Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
bad) ->
RenamerError -> RenameM ()
record (RenamerError -> RenameM ()) -> RenamerError -> RenameM ()
forall a b. (a -> b) -> a -> b
$ [DepName] -> RenamerError
InvalidDependency ([DepName] -> RenamerError) -> [DepName] -> RenamerError
forall a b. (a -> b) -> a -> b
$ (Name -> DepName) -> [Name] -> [DepName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing ([Name] -> [DepName]) -> [Name] -> [DepName]
forall a b. (a -> b) -> a -> b
$ (Name, ModPath) -> Name
forall a b. (a, b) -> a
fst (Name, ModPath)
a Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
bad
[(Name, ModPath)]
_ -> () -> RenameM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
ms :: [(Name, ModPath)]
ms = [ (Name
x,ModPath
p) | NamedThing Name
x <- [DepName]
xs, Declared ModPath
p NameSource
_ <- [ Name -> NameInfo
nameInfo Name
x ] ]
renameTopDecls' ::
(NestedMods,ModPath) -> [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' :: (NestedMods, ModPath) -> [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' (NestedMods, ModPath)
info [TopDecl PName]
ds =
do ([TopDecl Name]
ds1,Map DepName (Set Name)
deps) <- RenameM [TopDecl Name]
-> RenameM ([TopDecl Name], Map DepName (Set Name))
forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup ((TopDecl PName -> RenameM (TopDecl Name))
-> [TopDecl PName] -> RenameM [TopDecl Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((NestedMods, ModPath) -> TopDecl PName -> RenameM (TopDecl Name)
forall (f :: * -> *).
Rename (WithMods f) =>
(NestedMods, ModPath) -> f PName -> RenameM (f Name)
renameWithMods (NestedMods, ModPath)
info) [TopDecl PName]
ds)
let ([TopDecl Name]
noNameDs,[(TopDecl Name, DepName)]
nameDs) = [Either (TopDecl Name) (TopDecl Name, DepName)]
-> ([TopDecl Name], [(TopDecl Name, DepName)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((TopDecl Name -> Either (TopDecl Name) (TopDecl Name, DepName))
-> [TopDecl Name]
-> [Either (TopDecl Name) (TopDecl Name, DepName)]
forall a b. (a -> b) -> [a] -> [b]
map TopDecl Name -> Either (TopDecl Name) (TopDecl Name, DepName)
topDeclName [TopDecl Name]
ds1)
ctrs :: [DepName]
ctrs = [ DepName
nm | (TopDecl Name
_,nm :: DepName
nm@(ConstratintAt {})) <- [(TopDecl Name, DepName)]
nameDs ]
toNode :: (TopDecl name, DepName)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode (TopDecl name
d,DepName
x) = ((TopDecl name
d,DepName
x),DepName
x, (if TopDecl name -> Bool
forall name. TopDecl name -> Bool
usesCtrs TopDecl name
d then [DepName]
ctrs else []) [DepName] -> [DepName] -> [DepName]
forall a. [a] -> [a] -> [a]
++
(Name -> DepName) -> [Name] -> [DepName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing
( Set Name -> [Name]
forall a. Set a -> [a]
Set.toList
( Set Name -> DepName -> Map DepName (Set Name) -> Set Name
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set Name
forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps) ))
ordered :: [SCC (TopDecl Name, DepName)]
ordered = [((TopDecl Name, DepName), DepName, [DepName])]
-> [SCC (TopDecl Name, DepName)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (((TopDecl Name, DepName)
-> ((TopDecl Name, DepName), DepName, [DepName]))
-> [(TopDecl Name, DepName)]
-> [((TopDecl Name, DepName), DepName, [DepName])]
forall a b. (a -> b) -> [a] -> [b]
map (TopDecl Name, DepName)
-> ((TopDecl Name, DepName), DepName, [DepName])
forall name.
(TopDecl name, DepName)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode [(TopDecl Name, 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
_) -> [TopDecl name] -> RenameM [TopDecl name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopDecl name
d]
CyclicSCC [(TopDecl name, DepName)]
ds_xs ->
let ([TopDecl name]
rds,[DepName]
xs) = [(TopDecl name, DepName)] -> ([TopDecl name], [DepName])
forall a b. [(a, b)] -> ([a], [b])
unzip [(TopDecl name, DepName)]
ds_xs
in case (TopDecl name -> Maybe (Bind name))
-> [TopDecl name] -> Maybe [Bind name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TopDecl name -> Maybe (Bind name)
forall name. TopDecl name -> Maybe (Bind name)
valid [TopDecl name]
rds of
Maybe [Bind name]
Nothing -> do RenamerError -> RenameM ()
record ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
[TopDecl name] -> RenameM [TopDecl name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopDecl name]
rds
Just [Bind name]
bs ->
do [DepName] -> RenameM ()
checkSameModule [DepName]
xs
[TopDecl name] -> RenameM [TopDecl name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopLevel (Decl name) -> TopDecl name
forall name. TopLevel (Decl name) -> TopDecl name
Decl TopLevel :: forall a. ExportType -> Maybe (Located Text) -> a -> TopLevel a
TopLevel
{ tlDoc :: Maybe (Located Text)
tlDoc = Maybe (Located Text)
forall a. Maybe a
Nothing
, tlExport :: ExportType
tlExport = ExportType
Public
, tlValue :: Decl name
tlValue = [Bind name] -> Decl name
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 -> Decl name -> Maybe (Bind name)
forall name. Decl name -> Maybe (Bind name)
validRecursiveD (TopLevel (Decl name) -> Decl name
forall a. TopLevel a -> a
tlValue TopLevel (Decl name)
tl)
TopDecl name
_ -> Maybe (Bind name)
forall a. Maybe a
Nothing
[[TopDecl Name]]
rds <- (SCC (TopDecl Name, DepName) -> RenameM [TopDecl Name])
-> [SCC (TopDecl Name, DepName)] -> RenameM [[TopDecl Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SCC (TopDecl Name, DepName) -> RenameM [TopDecl Name]
forall name. SCC (TopDecl name, DepName) -> RenameM [TopDecl name]
fromSCC [SCC (TopDecl Name, DepName)]
ordered
[TopDecl Name] -> RenameM [TopDecl Name]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[TopDecl Name]] -> [TopDecl Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([TopDecl Name]
noNameDs[TopDecl Name] -> [[TopDecl Name]] -> [[TopDecl Name]]
forall 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 -> Decl name -> Bool
forall name. Decl name -> Bool
isValDecl (TopLevel (Decl name) -> Decl name
forall a. TopLevel a -> a
tlValue TopLevel (Decl name)
tl)
DPrimType {} -> Bool
False
TDNewtype {} -> Bool
False
DParameterType {} -> Bool
False
DParameterConstraint {} -> Bool
False
DParameterFun {} -> Bool
True
DModule TopLevel (NestedModule name)
tl -> (TopDecl name -> Bool) -> [TopDecl name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TopDecl name -> Bool
usesCtrs (ModuleG name name -> [TopDecl name]
forall mname name. ModuleG mname name -> [TopDecl name]
mDecls ModuleG name name
m)
where NestedModule ModuleG name name
m = TopLevel (NestedModule name) -> NestedModule name
forall a. TopLevel a -> a
tlValue TopLevel (NestedModule name)
tl
DImport {} -> Bool
False
Include {} -> String -> Bool
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
DType {} -> Bool
False
DProp {} -> Bool
False
DRec {} -> Bool
True
DSignature {} -> String -> Bool
forall a. String -> a
bad String
"DSignature"
DFixity {} -> String -> Bool
forall a. String -> a
bad String
"DFixity"
DPragma {} -> String -> Bool
forall a. String -> a
bad String
"DPragma"
DPatBind {} -> String -> Bool
forall a. String -> a
bad String
"DPatBind"
bad :: String -> a
bad String
msg = String -> [String] -> a
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 -> Located Name -> Name
forall a. Located a -> a
thing (Bind Name -> Located Name
forall name. Bind name -> Located name
bName Bind Name
b)
DType (TySyn Located Name
x Maybe Fixity
_ [TParam Name]
_ Type Name
_) -> Located Name -> Name
forall a. Located a -> a
thing Located Name
x
DProp (PropSyn Located Name
x Maybe Fixity
_ [TParam Name]
_ [Prop Name]
_) -> Located Name -> Name
forall a. Located a -> a
thing Located Name
x
DSignature {} -> String -> Name
forall a. String -> a
bad String
"DSignature"
DFixity {} -> String -> Name
forall a. String -> a
bad String
"DFixity"
DPragma {} -> String -> Name
forall a. String -> a
bad String
"DPragma"
DPatBind {} -> String -> Name
forall a. String -> a
bad String
"DPatBind"
DRec {} -> String -> Name
forall a. String -> a
bad String
"DRec"
where
bad :: String -> a
bad String
x = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"declName" [String
x]
topDeclName :: TopDecl Name -> Either (TopDecl Name) (TopDecl Name, DepName)
topDeclName :: TopDecl Name -> Either (TopDecl Name) (TopDecl Name, DepName)
topDeclName TopDecl Name
topDecl =
case TopDecl Name
topDecl of
Decl TopLevel (Decl Name)
d -> Name -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. Name -> Either a (TopDecl Name, DepName)
hasName (Decl Name -> Name
declName (TopLevel (Decl Name) -> Decl Name
forall a. TopLevel a -> a
tlValue TopLevel (Decl Name)
d))
DPrimType TopLevel (PrimType Name)
d -> Name -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. Name -> Either a (TopDecl Name, DepName)
hasName (Located Name -> Name
forall a. Located a -> a
thing (PrimType Name -> Located Name
forall name. PrimType name -> Located name
primTName (TopLevel (PrimType Name) -> PrimType Name
forall a. TopLevel a -> a
tlValue TopLevel (PrimType Name)
d)))
TDNewtype TopLevel (Newtype Name)
d -> Name -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. Name -> Either a (TopDecl Name, DepName)
hasName (Located Name -> Name
forall a. Located a -> a
thing (Newtype Name -> Located Name
forall name. Newtype name -> Located name
nName (TopLevel (Newtype Name) -> Newtype Name
forall a. TopLevel a -> a
tlValue TopLevel (Newtype Name)
d)))
DParameterType ParameterType Name
d -> Name -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. Name -> Either a (TopDecl Name, DepName)
hasName (Located Name -> Name
forall a. Located a -> a
thing (ParameterType Name -> Located Name
forall name. ParameterType name -> Located name
ptName ParameterType Name
d))
DParameterFun ParameterFun Name
d -> Name -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. Name -> Either a (TopDecl Name, DepName)
hasName (Located Name -> Name
forall a. Located a -> a
thing (ParameterFun Name -> Located Name
forall name. ParameterFun name -> Located name
pfName ParameterFun Name
d))
DModule TopLevel (NestedModule Name)
d -> Name -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. Name -> Either a (TopDecl Name, DepName)
hasName (Located Name -> Name
forall a. Located a -> a
thing (ModuleG Name Name -> Located Name
forall mname name. ModuleG mname name -> Located mname
mName ModuleG Name Name
m))
where NestedModule ModuleG Name Name
m = TopLevel (NestedModule Name) -> NestedModule Name
forall a. TopLevel a -> a
tlValue TopLevel (NestedModule Name)
d
DParameterConstraint [Located (Prop Name)]
ds ->
case [Located (Prop Name)]
ds of
[] -> Either (TopDecl Name) (TopDecl Name, DepName)
forall b. Either (TopDecl Name) b
noName
[Located (Prop Name)]
_ -> (TopDecl Name, DepName)
-> Either (TopDecl Name) (TopDecl Name, DepName)
forall a b. b -> Either a b
Right (TopDecl Name
topDecl, Range -> DepName
ConstratintAt (Maybe Range -> Range
forall a. HasCallStack => Maybe a -> a
fromJust ([Located (Prop Name)] -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc [Located (Prop Name)]
ds)))
DImport {} -> Either (TopDecl Name) (TopDecl Name, DepName)
forall b. Either (TopDecl Name) b
noName
Include {} -> String -> Either (TopDecl Name) (TopDecl Name, DepName)
forall a. String -> a
bad String
"Include"
where
noName :: Either (TopDecl Name) b
noName = TopDecl Name -> Either (TopDecl Name) b
forall a b. a -> Either a b
Left TopDecl Name
topDecl
hasName :: Name -> Either a (TopDecl Name, DepName)
hasName Name
n = (TopDecl Name, DepName) -> Either a (TopDecl Name, DepName)
forall a b. b -> Either a b
Right (TopDecl Name
topDecl, Name -> DepName
NamedThing Name
n)
bad :: String -> a
bad String
x = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"topDeclName" [String
x]
doImport :: Located Import -> RenameM (NestedMods, NamingEnv)
doImport :: Located Import -> RenameM (NestedMods, NamingEnv)
doImport Located Import
li =
do let i :: Import
i = Located Import -> Import
forall a. Located a -> a
thing Located Import
li
IfaceDecls
decls <- Import -> RenameM IfaceDecls
lookupImport Import
i
let declsOf :: IfaceG mname -> NamingEnv
declsOf = IfaceDecls -> NamingEnv
unqualifiedEnv (IfaceDecls -> NamingEnv)
-> (IfaceG mname -> IfaceDecls) -> IfaceG mname -> NamingEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceG mname -> IfaceDecls
forall mname. IfaceG mname -> IfaceDecls
ifPublic
nested :: NestedMods
nested = IfaceG Name -> NamingEnv
forall mname. IfaceG mname -> NamingEnv
declsOf (IfaceG Name -> NamingEnv) -> Map Name (IfaceG Name) -> NestedMods
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceDecls -> Map Name (IfaceG Name)
ifModules IfaceDecls
decls
(NestedMods, NamingEnv) -> RenameM (NestedMods, NamingEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NestedMods
nested, Import -> IfaceDecls -> NamingEnv
interpImportIface Import
i IfaceDecls
decls)
data OpenLoopState = OpenLoopState
{ OpenLoopState -> [ImportG PName]
unresolvedOpen :: [ImportG PName]
, OpenLoopState -> NamingEnv
scopeImports :: NamingEnv
, OpenLoopState -> NamingEnv
scopeDefs :: NamingEnv
, OpenLoopState -> NamingEnv
scopingRel :: NamingEnv
, OpenLoopState -> Bool
openLoopChange :: Bool
}
processOpen :: NestedMods -> OpenLoopState -> ImportG PName -> OpenLoopState
processOpen :: NestedMods -> OpenLoopState -> ImportG PName -> OpenLoopState
processOpen NestedMods
modEnvs OpenLoopState
s ImportG PName
o =
case Namespace -> PName -> NamingEnv -> [Name]
lookupNS Namespace
NSModule (ImportG PName -> PName
forall mname. ImportG mname -> mname
iModule ImportG PName
o) (OpenLoopState -> NamingEnv
scopingRel OpenLoopState
s) of
[] -> OpenLoopState
s { unresolvedOpen :: [ImportG PName]
unresolvedOpen = ImportG PName
o ImportG PName -> [ImportG PName] -> [ImportG PName]
forall a. a -> [a] -> [a]
: OpenLoopState -> [ImportG PName]
unresolvedOpen OpenLoopState
s }
[Name
n] ->
case Name -> NestedMods -> Maybe NamingEnv
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n NestedMods
modEnvs of
Maybe NamingEnv
Nothing -> String -> [String] -> OpenLoopState
forall a. HasCallStack => String -> [String] -> a
panic String
"openLoop" [ String
"Missing defintion for module", Name -> String
forall a. Show a => a -> String
show Name
n ]
Just NamingEnv
def ->
let new :: NamingEnv
new = ImportG PName -> NamingEnv -> NamingEnv
forall name. ImportG name -> NamingEnv -> NamingEnv
interpImportEnv ImportG PName
o NamingEnv
def
newImps :: NamingEnv
newImps = NamingEnv
new NamingEnv -> NamingEnv -> NamingEnv
forall a. Semigroup a => a -> a -> a
<> OpenLoopState -> NamingEnv
scopeImports OpenLoopState
s
in OpenLoopState
s { scopeImports :: NamingEnv
scopeImports = NamingEnv
newImps
, scopingRel :: NamingEnv
scopingRel = OpenLoopState -> NamingEnv
scopeDefs OpenLoopState
s NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
newImps
, openLoopChange :: Bool
openLoopChange = Bool
True
}
[Name]
_ -> OpenLoopState
s
openLoop ::
NestedMods ->
NamingEnv ->
[ImportG PName] ->
NamingEnv ->
NamingEnv
openLoop :: NestedMods
-> NamingEnv -> [ImportG PName] -> NamingEnv -> NamingEnv
openLoop NestedMods
modEnvs NamingEnv
defs [ImportG PName]
os NamingEnv
imps =
OpenLoopState -> NamingEnv
scopingRel (OpenLoopState -> NamingEnv) -> OpenLoopState -> NamingEnv
forall a b. (a -> b) -> a -> b
$ OpenLoopState -> OpenLoopState
loop OpenLoopState :: [ImportG PName]
-> NamingEnv -> NamingEnv -> NamingEnv -> Bool -> OpenLoopState
OpenLoopState
{ unresolvedOpen :: [ImportG PName]
unresolvedOpen = [ImportG PName]
os
, scopeImports :: NamingEnv
scopeImports = NamingEnv
imps
, scopeDefs :: NamingEnv
scopeDefs = NamingEnv
defs
, scopingRel :: NamingEnv
scopingRel = NamingEnv
defs NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
imps
, openLoopChange :: Bool
openLoopChange = Bool
True
}
where
loop :: OpenLoopState -> OpenLoopState
loop OpenLoopState
s
| OpenLoopState -> Bool
openLoopChange OpenLoopState
s =
OpenLoopState -> OpenLoopState
loop (OpenLoopState -> OpenLoopState) -> OpenLoopState -> OpenLoopState
forall a b. (a -> b) -> a -> b
$ (OpenLoopState -> ImportG PName -> OpenLoopState)
-> OpenLoopState -> [ImportG PName] -> OpenLoopState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (NestedMods -> OpenLoopState -> ImportG PName -> OpenLoopState
processOpen NestedMods
modEnvs)
OpenLoopState
s { unresolvedOpen :: [ImportG PName]
unresolvedOpen = [], openLoopChange :: Bool
openLoopChange = Bool
False }
(OpenLoopState -> [ImportG PName]
unresolvedOpen OpenLoopState
s)
| Bool
otherwise = OpenLoopState
s
data WithMods f n = WithMods (NestedMods,ModPath) (f n)
forgetMods :: WithMods f n -> f n
forgetMods :: WithMods f n -> f n
forgetMods (WithMods (NestedMods, ModPath)
_ f n
td) = f n
td
renameWithMods ::
Rename (WithMods f) => (NestedMods,ModPath) -> f PName -> RenameM (f Name)
renameWithMods :: (NestedMods, ModPath) -> f PName -> RenameM (f Name)
renameWithMods (NestedMods, ModPath)
info f PName
m = WithMods f Name -> f Name
forall (f :: * -> *) n. WithMods f n -> f n
forgetMods (WithMods f Name -> f Name)
-> RenameM (WithMods f Name) -> RenameM (f Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithMods f PName -> RenameM (WithMods f Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ((NestedMods, ModPath) -> f PName -> WithMods f PName
forall (f :: * -> *) n.
(NestedMods, ModPath) -> f n -> WithMods f n
WithMods (NestedMods, ModPath)
info f PName
m)
instance Rename (WithMods TopDecl) where
rename :: WithMods TopDecl PName -> RenameM (WithMods TopDecl Name)
rename (WithMods (NestedMods, ModPath)
info TopDecl PName
td) = (NestedMods, ModPath) -> TopDecl Name -> WithMods TopDecl Name
forall (f :: * -> *) n.
(NestedMods, ModPath) -> f n -> WithMods f n
WithMods (NestedMods, ModPath)
info (TopDecl Name -> WithMods TopDecl Name)
-> RenameM (TopDecl Name) -> RenameM (WithMods TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case TopDecl PName
td of
Decl TopLevel (Decl PName)
d -> TopLevel (Decl Name) -> TopDecl Name
forall name. TopLevel (Decl name) -> TopDecl name
Decl (TopLevel (Decl Name) -> TopDecl Name)
-> RenameM (TopLevel (Decl Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl PName -> RenameM (Decl Name))
-> TopLevel (Decl PName) -> RenameM (TopLevel (Decl Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Decl PName -> RenameM (Decl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Decl PName)
d
DPrimType TopLevel (PrimType PName)
d -> TopLevel (PrimType Name) -> TopDecl Name
forall name. TopLevel (PrimType name) -> TopDecl name
DPrimType (TopLevel (PrimType Name) -> TopDecl Name)
-> RenameM (TopLevel (PrimType Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimType PName -> RenameM (PrimType Name))
-> TopLevel (PrimType PName) -> RenameM (TopLevel (PrimType Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PrimType PName -> RenameM (PrimType Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (PrimType PName)
d
TDNewtype TopLevel (Newtype PName)
n -> TopLevel (Newtype Name) -> TopDecl Name
forall name. TopLevel (Newtype name) -> TopDecl name
TDNewtype (TopLevel (Newtype Name) -> TopDecl Name)
-> RenameM (TopLevel (Newtype Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Newtype PName -> RenameM (Newtype Name))
-> TopLevel (Newtype PName) -> RenameM (TopLevel (Newtype Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Newtype PName -> RenameM (Newtype Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Newtype PName)
n
Include Located String
n -> TopDecl Name -> RenameM (TopDecl Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located String -> TopDecl Name
forall name. Located String -> TopDecl name
Include Located String
n)
DParameterFun ParameterFun PName
f -> ParameterFun Name -> TopDecl Name
forall name. ParameterFun name -> TopDecl name
DParameterFun (ParameterFun Name -> TopDecl Name)
-> RenameM (ParameterFun Name) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterFun PName -> RenameM (ParameterFun Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ParameterFun PName
f
DParameterType ParameterType PName
f -> ParameterType Name -> TopDecl Name
forall name. ParameterType name -> TopDecl name
DParameterType (ParameterType Name -> TopDecl Name)
-> RenameM (ParameterType Name) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterType PName -> RenameM (ParameterType Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ParameterType PName
f
DParameterConstraint [Located (Prop PName)]
ds ->
case [Located (Prop PName)]
ds of
[] -> TopDecl Name -> RenameM (TopDecl Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Located (Prop Name)] -> TopDecl Name
forall name. [Located (Prop name)] -> TopDecl name
DParameterConstraint [])
[Located (Prop PName)]
_ -> DepName -> RenameM (TopDecl Name) -> RenameM (TopDecl Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Range -> DepName
ConstratintAt (Maybe Range -> Range
forall a. HasCallStack => Maybe a -> a
fromJust ([Located (Prop PName)] -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc [Located (Prop PName)]
ds)))
(RenameM (TopDecl Name) -> RenameM (TopDecl Name))
-> RenameM (TopDecl Name) -> RenameM (TopDecl Name)
forall a b. (a -> b) -> a -> b
$ [Located (Prop Name)] -> TopDecl Name
forall name. [Located (Prop name)] -> TopDecl name
DParameterConstraint ([Located (Prop Name)] -> TopDecl Name)
-> RenameM [Located (Prop Name)] -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located (Prop PName) -> RenameM (Located (Prop Name)))
-> [Located (Prop PName)] -> RenameM [Located (Prop Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Prop PName) -> RenameM (Located (Prop Name))
forall (f :: * -> *).
Rename f =>
Located (f PName) -> RenameM (Located (f Name))
renameLocated [Located (Prop PName)]
ds
DModule TopLevel (NestedModule PName)
m -> TopLevel (NestedModule Name) -> TopDecl Name
forall name. TopLevel (NestedModule name) -> TopDecl name
DModule (TopLevel (NestedModule Name) -> TopDecl Name)
-> RenameM (TopLevel (NestedModule Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NestedModule PName -> RenameM (NestedModule Name))
-> TopLevel (NestedModule PName)
-> RenameM (TopLevel (NestedModule Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((NestedMods, ModPath)
-> NestedModule PName -> RenameM (NestedModule Name)
forall (f :: * -> *).
Rename (WithMods f) =>
(NestedMods, ModPath) -> f PName -> RenameM (f Name)
renameWithMods (NestedMods, ModPath)
info) TopLevel (NestedModule PName)
m
DImport Located (ImportG (ImpName PName))
li -> Located (ImportG (ImpName Name)) -> TopDecl Name
forall name. Located (ImportG (ImpName name)) -> TopDecl name
DImport (Located (ImportG (ImpName Name)) -> TopDecl Name)
-> RenameM (Located (ImportG (ImpName Name)))
-> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportG (ImpName PName) -> RenameM (ImportG (ImpName Name)))
-> Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ImportG (ImpName PName) -> RenameM (ImportG (ImpName Name))
forall (f :: * -> *).
Rename f =>
ImportG (f PName) -> RenameM (ImportG (f Name))
renI Located (ImportG (ImpName PName))
li
where
renI :: ImportG (f PName) -> RenameM (ImportG (f Name))
renI ImportG (f PName)
i = do f Name
m <- f PName -> RenameM (f Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (ImportG (f PName) -> f PName
forall mname. ImportG mname -> mname
iModule ImportG (f PName)
i)
ImportG (f Name) -> RenameM (ImportG (f Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportG (f PName)
i { iModule :: f Name
iModule = f Name
m }
instance Rename ImpName where
rename :: ImpName PName -> RenameM (ImpName Name)
rename ImpName PName
i =
case ImpName PName
i of
ImpTop ModName
m -> ImpName Name -> RenameM (ImpName Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModName -> ImpName Name
forall name. ModName -> ImpName name
ImpTop ModName
m)
ImpNested PName
m -> Name -> ImpName Name
forall name. name -> ImpName name
ImpNested (Name -> ImpName Name) -> RenameM Name -> RenameM (ImpName Name)
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 (WithMods NestedModule) where
rename :: WithMods NestedModule PName -> RenameM (WithMods NestedModule Name)
rename (WithMods (NestedMods, ModPath)
info (NestedModule ModuleG PName PName
m)) = (NestedMods, ModPath)
-> NestedModule Name -> WithMods NestedModule Name
forall (f :: * -> *) n.
(NestedMods, ModPath) -> f n -> WithMods f n
WithMods (NestedMods, ModPath)
info (NestedModule Name -> WithMods NestedModule Name)
-> RenameM (NestedModule Name)
-> RenameM (WithMods NestedModule Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
do let (NestedMods
nested,ModPath
mpath) = (NestedMods, ModPath)
info
lnm :: Located PName
lnm = ModuleG PName PName -> Located PName
forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m
nm :: PName
nm = Located PName -> PName
forall a. Located a -> a
thing Located PName
lnm
newMPath :: ModPath
newMPath = ModPath -> Ident -> ModPath
Nested ModPath
mpath (PName -> Ident
getIdent PName
nm)
Name
n <- NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
NameBind Namespace
NSModule PName
nm
DepName
-> RenameM (NestedModule Name) -> RenameM (NestedModule Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing Name
n)
do let env :: NamingEnv
env = case Name -> NestedMods -> Maybe NamingEnv
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n ((NestedMods, ModPath) -> NestedMods
forall a b. (a, b) -> a
fst (NestedMods, ModPath)
info) of
Just NamingEnv
defs -> NamingEnv
defs
Maybe NamingEnv
Nothing -> String -> [String] -> NamingEnv
forall a. HasCallStack => String -> [String] -> a
panic String
"rename"
[ String
"Missing environment for nested module", Name -> String
forall a. Show a => a -> String
show Name
n ]
(NamingEnv
_inScope,ModuleG PName Name
m1) <- NestedMods
-> NamingEnv
-> ModPath
-> ModuleG PName PName
-> RenameM (NamingEnv, ModuleG PName Name)
forall mname.
NestedMods
-> NamingEnv
-> ModPath
-> ModuleG mname PName
-> RenameM (NamingEnv, ModuleG mname Name)
renameModule' NestedMods
nested NamingEnv
env ModPath
newMPath ModuleG PName PName
m
NestedModule Name -> RenameM (NestedModule Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleG Name Name -> NestedModule Name
forall name. ModuleG name name -> NestedModule name
NestedModule ModuleG PName Name
m1 { mName :: Located Name
mName = Located PName
lnm { thing :: Name
thing = Name
n } })
renameLocated :: Rename f => Located (f PName) -> RenameM (Located (f Name))
renameLocated :: Located (f PName) -> RenameM (Located (f Name))
renameLocated Located (f PName)
x =
do f Name
y <- f PName -> RenameM (f Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Located (f PName) -> f PName
forall a. Located a -> a
thing Located (f PName)
x)
Located (f Name) -> RenameM (Located (f Name))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (f PName)
x { thing :: f Name
thing = f Name
y }
instance Rename PrimType where
rename :: PrimType PName -> RenameM (PrimType Name)
rename PrimType PName
pt =
do Located Name
x <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (PrimType PName -> Located PName
forall name. PrimType name -> Located name
primTName PrimType PName
pt)
DepName -> RenameM (PrimType Name) -> RenameM (PrimType Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
x))
do let ([TParam PName]
as,[Prop PName]
ps) = PrimType PName -> ([TParam PName], [Prop PName])
forall name. PrimType name -> ([TParam name], [Prop name])
primTCts PrimType PName
pt
(NamingEnv
_,([TParam Name], [Prop Name])
cts) <- [TParam PName]
-> [Prop PName]
-> ([TParam Name]
-> [Prop Name] -> RenameM ([TParam Name], [Prop Name]))
-> RenameM (NamingEnv, ([TParam Name], [Prop Name]))
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 ([TParam Name], [Prop Name]))
-> RenameM (NamingEnv, ([TParam Name], [Prop Name])))
-> ([TParam Name]
-> [Prop Name] -> RenameM ([TParam Name], [Prop Name]))
-> RenameM (NamingEnv, ([TParam Name], [Prop Name]))
forall a b. (a -> b) -> a -> b
$ \[TParam Name]
as' [Prop Name]
ps' -> ([TParam Name], [Prop Name])
-> RenameM ([TParam Name], [Prop Name])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TParam Name]
as',[Prop Name]
ps')
(TParam Name -> RenameM ()) -> [TParam Name] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name -> RenameM ()
recordUse (Name -> RenameM ())
-> (TParam Name -> Name) -> TParam Name -> RenameM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TParam Name -> Name
forall n. TParam n -> n
tpName) (([TParam Name], [Prop Name]) -> [TParam Name]
forall a b. (a, b) -> a
fst ([TParam Name], [Prop Name])
cts)
PrimType Name -> RenameM (PrimType Name)
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' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (ParameterType PName -> Located PName
forall name. ParameterType name -> Located name
ptName ParameterType PName
a)
ParameterType Name -> RenameM (ParameterType Name)
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' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) (ParameterFun PName -> Located PName
forall name. ParameterFun name -> Located name
pfName ParameterFun PName
a)
DepName
-> RenameM (ParameterFun Name) -> RenameM (ParameterFun Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
n'))
do (NamingEnv, Schema Name)
sig' <- Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (ParameterFun PName -> Schema PName
forall name. ParameterFun name -> Schema name
pfSchema ParameterFun PName
a)
ParameterFun Name -> RenameM (ParameterFun Name)
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterFun PName
a { pfName :: Located Name
pfName = Located Name
n', pfSchema :: Schema Name
pfSchema = (NamingEnv, Schema Name) -> Schema Name
forall a b. (a, b) -> b
snd (NamingEnv, Schema Name)
sig' }
rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated a -> RenameM b
f Located a
loc = Located a -> RenameM (Located b) -> RenameM (Located b)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located a
loc (RenameM (Located b) -> RenameM (Located b))
-> RenameM (Located b) -> RenameM (Located b)
forall a b. (a -> b) -> a -> b
$
do b
a' <- a -> RenameM b
f (Located a -> a
forall a. Located a -> a
thing Located a
loc)
Located b -> RenameM (Located b)
forall (m :: * -> *) a. Monad m => a -> m a
return Located a
loc { thing :: b
thing = b
a' }
instance Rename Decl where
rename :: Decl PName -> RenameM (Decl Name)
rename Decl PName
d = case Decl PName
d of
DBind Bind PName
b -> Bind Name -> Decl Name
forall name. Bind name -> Decl name
DBind (Bind Name -> Decl Name)
-> RenameM (Bind Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bind PName -> RenameM (Bind Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b
DType TySyn PName
syn -> TySyn Name -> Decl Name
forall name. TySyn name -> Decl name
DType (TySyn Name -> Decl Name)
-> RenameM (TySyn Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TySyn PName -> RenameM (TySyn Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TySyn PName
syn
DProp PropSyn PName
syn -> PropSyn Name -> Decl Name
forall name. PropSyn name -> Decl name
DProp (PropSyn Name -> Decl Name)
-> RenameM (PropSyn Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropSyn PName -> RenameM (PropSyn Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename PropSyn PName
syn
DLocated Decl PName
d' Range
r -> Range -> RenameM (Decl Name) -> RenameM (Decl Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
(RenameM (Decl Name) -> RenameM (Decl Name))
-> RenameM (Decl Name) -> RenameM (Decl Name)
forall a b. (a -> b) -> a -> b
$ Decl Name -> Range -> Decl Name
forall name. Decl name -> Range -> Decl name
DLocated (Decl Name -> Range -> Decl Name)
-> RenameM (Decl Name) -> RenameM (Range -> Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decl PName -> RenameM (Decl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Decl PName
d' RenameM (Range -> Decl Name)
-> RenameM Range -> RenameM (Decl Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r
DFixity{} -> String -> [String] -> RenameM (Decl Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"renaem" [ String
"DFixity" ]
DSignature {} -> String -> [String] -> RenameM (Decl Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DSignature" ]
DPragma {} -> String -> [String] -> RenameM (Decl Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DPragma" ]
DPatBind {} -> String -> [String] -> RenameM (Decl Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DPatBind " ]
DRec {} -> String -> [String] -> RenameM (Decl Name)
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 =
[TParam PName] -> RenameM (Newtype Name) -> RenameM (Newtype Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (Newtype PName -> [TParam PName]
forall name. Newtype name -> [TParam name]
nParams Newtype PName
n) (RenameM (Newtype Name) -> RenameM (Newtype Name))
-> RenameM (Newtype Name) -> RenameM (Newtype Name)
forall a b. (a -> b) -> a -> b
$
do Located Name
name' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (Newtype PName -> Located PName
forall name. Newtype name -> Located name
nName Newtype PName
n)
DepName -> RenameM (Newtype Name) -> RenameM (Newtype Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
name')) (RenameM (Newtype Name) -> RenameM (Newtype Name))
-> RenameM (Newtype Name) -> RenameM (Newtype Name)
forall a b. (a -> b) -> a -> b
$
do [TParam Name]
ps' <- (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Newtype PName -> [TParam PName]
forall name. Newtype name -> [TParam name]
nParams Newtype PName
n)
RecordMap Ident (Range, Type Name)
body' <- ((Range, Type PName) -> RenameM (Range, Type Name))
-> RecordMap Ident (Range, Type PName)
-> RenameM (RecordMap Ident (Range, Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type Name))
-> (Range, Type PName) -> RenameM (Range, Type Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (Newtype PName -> RecordMap Ident (Range, Type PName)
forall name. Newtype name -> Rec (Type name)
nBody Newtype PName
n)
Newtype Name -> RenameM (Newtype Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Newtype :: forall name.
Located name -> [TParam name] -> Rec (Type name) -> Newtype name
Newtype { nName :: Located Name
nName = Located Name
name'
, 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 <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
let lkpIn :: Namespace -> Maybe [Name]
lkpIn Namespace
here = PName -> Map PName [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName [Name]
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
use :: Name -> RenameM ()
use = case Namespace
expected of
Namespace
NSType -> Name -> RenameM ()
recordUse
Namespace
_ -> RenameM () -> Name -> RenameM ()
forall a b. a -> b -> a
const (() -> RenameM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
case Namespace -> Maybe [Name]
lkpIn Namespace
expected of
Just [Name
n] ->
do case NameType
nt of
NameType
NameBind -> () -> RenameM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
NameType
NameUse -> Name -> RenameM ()
addDep Name
n
Name -> RenameM ()
use Name
n
Maybe Name -> RenameM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n)
Just [] -> String -> [String] -> RenameM (Maybe Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"Renamer" [String
"Invalid expression renaming environment"]
Just [Name]
syms ->
do (Name -> RenameM ()) -> [Name] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
use [Name]
syms
Located PName
n <- PName -> RenameM (Located PName)
forall a. a -> RenameM (Located a)
located PName
qn
RenamerError -> RenameM ()
record (Located PName -> [Name] -> RenamerError
MultipleSyms Located PName
n [Name]
syms)
Maybe Name -> RenameM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just ([Name] -> Name
forall a. [a] -> a
head [Name]
syms))
Maybe [Name]
Nothing -> Maybe Name -> RenameM (Maybe Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Name
forall a. Maybe a
Nothing
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 -> Name -> RenameM Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
Maybe Name
Nothing ->
do RO
ro <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
let lkpIn :: Namespace -> Maybe [Name]
lkpIn Namespace
here = PName -> Map PName [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName [Name]
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
others :: [Namespace]
others = [ Namespace
ns | Namespace
ns <- [Namespace]
allNamespaces
, Namespace
ns Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
/= Namespace
expected
, Just [Name]
_ <- [Namespace -> Maybe [Name]
lkpIn Namespace
ns] ]
Located PName
nm <- PName -> RenameM (Located PName)
forall a. a -> RenameM (Located a)
located PName
qn
case [Namespace]
others of
Namespace
actual : [Namespace]
_ -> RenamerError -> RenameM ()
record (Namespace -> Namespace -> Located PName -> RenamerError
WrongNamespace Namespace
expected Namespace
actual Located PName
nm)
[] -> RenamerError -> RenameM ()
record (Namespace -> Located PName -> RenamerError
UnboundName Namespace
expected Located PName
nm)
Namespace -> PName -> RenameM Name
mkFakeName 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 <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
(Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkParameter Namespace
ns (PName -> Ident
getIdent PName
pn) (RO -> Range
roLoc RO
ro))
instance Rename Schema where
rename :: Schema PName -> RenameM (Schema Name)
rename Schema PName
s = (NamingEnv, Schema Name) -> Schema Name
forall a b. (a, b) -> b
snd ((NamingEnv, Schema Name) -> Schema Name)
-> RenameM (NamingEnv, Schema Name) -> RenameM (Schema Name)
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) =
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM (Schema Name))
-> RenameM (NamingEnv, Schema Name)
forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
ps [Prop PName]
p (([TParam Name] -> [Prop Name] -> RenameM (Schema Name))
-> RenameM (NamingEnv, Schema Name))
-> ([TParam Name] -> [Prop Name] -> RenameM (Schema Name))
-> RenameM (NamingEnv, Schema Name)
forall a b. (a -> b) -> a -> b
$ \[TParam Name]
ps' [Prop Name]
p' ->
do Type Name
ty' <- Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
Schema Name -> RenameM (Schema Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TParam Name]
-> [Prop Name] -> Type Name -> Maybe Range -> Schema Name
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 :: [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 <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ([TParam PName] -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf [TParam PName]
as)
a
res <- NamingEnv -> RenameM a -> RenameM a
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env (RenameM a -> RenameM a) -> RenameM a -> RenameM a
forall a b. (a -> b) -> a -> b
$ do [TParam Name]
as' <- (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
as
[Prop Name]
ps' <- (Prop PName -> RenameM (Prop Name))
-> [Prop PName] -> RenameM [Prop Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Prop PName -> RenameM (Prop Name)
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'
(NamingEnv, a) -> RenameM (NamingEnv, a)
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
TParam Name -> RenameM (TParam Name)
forall (m :: * -> *) a. Monad m => a -> m a
return TParam :: forall n. n -> Maybe Kind -> Maybe Range -> TParam n
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) = Type Name -> Prop Name
forall n. Type n -> Prop n
CType (Type Name -> Prop Name)
-> RenameM (Type Name) -> RenameM (Prop Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
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 -> Type Name -> Type Name -> Type Name
forall n. Type n -> Type n -> Type n
TFun (Type Name -> Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a RenameM (Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
TSeq Type PName
n Type PName
a -> Type Name -> Type Name -> Type Name
forall n. Type n -> Type n -> Type n
TSeq (Type Name -> Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
n RenameM (Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
Type PName
TBit -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Type Name
forall n. Type n
TBit
TNum Integer
c -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Type Name
forall n. Integer -> Type n
TNum Integer
c)
TChar Char
c -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Type Name
forall n. Char -> Type n
TChar Char
c)
TUser PName
qn [Type PName]
ps -> Name -> [Type Name] -> Type Name
forall n. n -> [Type n] -> Type n
TUser (Name -> [Type Name] -> Type Name)
-> RenameM Name -> RenameM ([Type Name] -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> PName -> RenameM Name
renameType NameType
NameUse PName
qn RenameM ([Type Name] -> Type Name)
-> RenameM [Type Name] -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> [Type PName] -> RenameM [Type Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
ps
TTyApp [Named (Type PName)]
fs -> [Named (Type Name)] -> Type Name
forall n. [Named (Type n)] -> Type n
TTyApp ([Named (Type Name)] -> Type Name)
-> RenameM [Named (Type Name)] -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Named (Type PName) -> RenameM (Named (Type Name)))
-> [Named (Type PName)] -> RenameM [Named (Type Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type Name))
-> Named (Type PName) -> RenameM (Named (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) [Named (Type PName)]
fs
TRecord RecordMap Ident (Range, Type PName)
fs -> RecordMap Ident (Range, Type Name) -> Type Name
forall n. Rec (Type n) -> Type n
TRecord (RecordMap Ident (Range, Type Name) -> Type Name)
-> RenameM (RecordMap Ident (Range, Type Name))
-> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Range, Type PName) -> RenameM (Range, Type Name))
-> RecordMap Ident (Range, Type PName)
-> RenameM (RecordMap Ident (Range, Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type Name))
-> (Range, Type PName) -> RenameM (Range, Type Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) RecordMap Ident (Range, Type PName)
fs
TTuple [Type PName]
fs -> [Type Name] -> Type Name
forall n. [Type n] -> Type n
TTuple ([Type Name] -> Type Name)
-> RenameM [Type Name] -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type PName -> RenameM (Type Name))
-> [Type PName] -> RenameM [Type Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
fs
Type PName
TWild -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Type Name
forall n. Type n
TWild
TLocated Type PName
t' Range
r -> Range -> RenameM (Type Name) -> RenameM (Type Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r (Type Name -> Range -> Type Name
forall n. Type n -> Range -> Type n
TLocated (Type Name -> Range -> Type Name)
-> RenameM (Type Name) -> RenameM (Range -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t' RenameM (Range -> Type Name)
-> RenameM Range -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r)
TParens Type PName
t' -> Type Name -> Type Name
forall n. Type n -> Type n
TParens (Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
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' <- Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
Type Name
b' <- Type PName -> RenameM (Type Name)
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 -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
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
Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
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 ()
record (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
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 =
Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
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' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) (Bind PName -> Located PName
forall name. Bind name -> Located name
bName Bind PName
b)
DepName -> RenameM (Bind Name) -> RenameM (Bind Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
n'))
do Maybe (NamingEnv, Schema Name)
mbSig <- (Schema PName -> RenameM (NamingEnv, Schema Name))
-> Maybe (Schema PName) -> RenameM (Maybe (NamingEnv, Schema Name))
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 (Bind PName -> Maybe (Schema PName)
forall name. Bind name -> Maybe (Schema name)
bSignature Bind PName
b)
Maybe NamingEnv -> RenameM (Bind Name) -> RenameM (Bind Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames ((NamingEnv, Schema Name) -> NamingEnv
forall a b. (a, b) -> a
fst ((NamingEnv, Schema Name) -> NamingEnv)
-> Maybe (NamingEnv, Schema Name) -> Maybe NamingEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig) (RenameM (Bind Name) -> RenameM (Bind Name))
-> RenameM (Bind Name) -> RenameM (Bind Name)
forall a b. (a -> b) -> a -> b
$
do (NamingEnv
patEnv,[Pattern Name]
pats') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats (Bind PName -> [Pattern PName]
forall name. Bind name -> [Pattern name]
bParams Bind PName
b)
Located (BindDef Name)
e' <- EnvCheck
-> NamingEnv
-> RenameM (Located (BindDef Name))
-> RenameM (Located (BindDef Name))
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
patEnv ((BindDef PName -> RenameM (BindDef Name))
-> Located (BindDef PName) -> RenameM (Located (BindDef Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated BindDef PName -> RenameM (BindDef Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Bind PName -> Located (BindDef PName)
forall name. Bind name -> Located (BindDef name)
bDef Bind PName
b))
Bind Name -> RenameM (Bind Name)
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 = (NamingEnv, Schema Name) -> Schema Name
forall a b. (a, b) -> b
snd ((NamingEnv, Schema Name) -> Schema Name)
-> Maybe (NamingEnv, Schema Name) -> Maybe (Schema Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig
, bPragmas :: [Pragma]
bPragmas = Bind PName -> [Pragma]
forall name. Bind name -> [Pragma]
bPragmas Bind PName
b
}
instance Rename BindDef where
rename :: BindDef PName -> RenameM (BindDef Name)
rename BindDef PName
DPrim = BindDef Name -> RenameM (BindDef Name)
forall (m :: * -> *) a. Monad m => a -> m a
return BindDef Name
forall name. BindDef name
DPrim
rename (DExpr Expr PName
e) = Expr Name -> BindDef Name
forall name. Expr name -> BindDef name
DExpr (Expr Name -> BindDef Name)
-> RenameM (Expr Name) -> RenameM (BindDef Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
instance Rename Pattern where
rename :: Pattern PName -> RenameM (Pattern Name)
rename Pattern PName
p = case Pattern PName
p of
PVar Located PName
lv -> Located Name -> Pattern Name
forall n. Located n -> Pattern n
PVar (Located Name -> Pattern Name)
-> RenameM (Located Name) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
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 -> Pattern Name -> RenameM (Pattern Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern Name
forall n. Pattern n
PWild
PTuple [Pattern PName]
ps -> [Pattern Name] -> Pattern Name
forall n. [Pattern n] -> Pattern n
PTuple ([Pattern Name] -> Pattern Name)
-> RenameM [Pattern Name] -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern PName -> RenameM (Pattern Name))
-> [Pattern PName] -> RenameM [Pattern Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
ps
PRecord Rec (Pattern PName)
nps -> Rec (Pattern Name) -> Pattern Name
forall n. Rec (Pattern n) -> Pattern n
PRecord (Rec (Pattern Name) -> Pattern Name)
-> RenameM (Rec (Pattern Name)) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Range, Pattern PName) -> RenameM (Range, Pattern Name))
-> Rec (Pattern PName) -> RenameM (Rec (Pattern Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Pattern PName -> RenameM (Pattern Name))
-> (Range, Pattern PName) -> RenameM (Range, Pattern Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Pattern PName)
nps
PList [Pattern PName]
elems -> [Pattern Name] -> Pattern Name
forall n. [Pattern n] -> Pattern n
PList ([Pattern Name] -> Pattern Name)
-> RenameM [Pattern Name] -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern PName -> RenameM (Pattern Name))
-> [Pattern PName] -> RenameM [Pattern Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
elems
PTyped Pattern PName
p' Type PName
t -> Pattern Name -> Type Name -> Pattern Name
forall n. Pattern n -> Type n -> Pattern n
PTyped (Pattern Name -> Type Name -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Type Name -> Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p' RenameM (Type Name -> Pattern Name)
-> RenameM (Type Name) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t
PSplit Pattern PName
l Pattern PName
r -> Pattern Name -> Pattern Name -> Pattern Name
forall n. Pattern n -> Pattern n -> Pattern n
PSplit (Pattern Name -> Pattern Name -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Pattern Name -> Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
l RenameM (Pattern Name -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
r
PLocated Pattern PName
p' Range
loc -> Range -> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
(RenameM (Pattern Name) -> RenameM (Pattern Name))
-> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall a b. (a -> b) -> a -> b
$ Pattern Name -> Range -> Pattern Name
forall n. Pattern n -> Range -> Pattern n
PLocated (Pattern Name -> Range -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Range -> Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p' RenameM (Range -> Pattern Name)
-> RenameM Range -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
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 -> UpdHow -> [Located Selector] -> Expr Name -> UpdField Name
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdSet [Located Selector
l] (Expr Name -> UpdField Name)
-> RenameM (Expr Name) -> RenameM (UpdField Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
UpdHow
UpdFun -> UpdHow -> [Located Selector] -> Expr Name -> UpdField Name
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] (Expr Name -> UpdField Name)
-> RenameM (Expr Name) -> RenameM (UpdField Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (FunDesc PName -> [Pattern PName] -> Expr PName -> Expr PName
forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
EFun FunDesc PName
forall n. FunDesc n
emptyFunDesc [Located PName -> Pattern PName
forall n. Located n -> Pattern n
PVar Located PName
p] Expr PName
e)
where
p :: Located PName
p = Ident -> PName
UnQual (Ident -> PName) -> (Selector -> Ident) -> Selector -> PName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Ident
selName (Selector -> PName) -> Located Selector -> Located PName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located Selector] -> Located Selector
forall a. [a] -> a
last [Located Selector]
ls
[Located Selector]
_ -> UpdHow -> [Located Selector] -> Expr Name -> UpdField Name
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] (Expr Name -> UpdField Name)
-> RenameM (Expr Name) -> RenameM (UpdField Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Maybe (Expr PName) -> [UpdField PName] -> Expr PName
forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd Maybe (Expr PName)
forall a. Maybe a
Nothing [ UpdHow -> [Located Selector] -> Expr PName -> UpdField PName
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
h [Located Selector]
more Expr PName
e])
[] -> String -> [String] -> RenameM (UpdField Name)
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' <- (PName -> RenameM Name) -> Maybe PName -> RenameM (Maybe Name)
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
FunDesc Name -> RenameM (FunDesc Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> Int -> FunDesc Name
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 -> Name -> Expr Name
forall n. n -> Expr n
EVar (Name -> Expr Name) -> RenameM Name -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> PName -> RenameM Name
renameVar NameType
NameUse PName
n
ELit Literal
l -> Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> Expr Name
forall n. Literal -> Expr n
ELit Literal
l)
ENeg Expr PName
e -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
ENeg (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
EComplement Expr PName
e -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
EComplement
(Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
EGenerate Expr PName
e -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
EGenerate
(Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
ETuple [Expr PName]
es -> [Expr Name] -> Expr Name
forall n. [Expr n] -> Expr n
ETuple ([Expr Name] -> Expr Name)
-> RenameM [Expr Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> RenameM (Expr Name))
-> [Expr PName] -> RenameM [Expr Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
ERecord Rec (Expr PName)
fs -> Rec (Expr Name) -> Expr Name
forall n. Rec (Expr n) -> Expr n
ERecord (Rec (Expr Name) -> Expr Name)
-> RenameM (Rec (Expr Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Range, Expr PName) -> RenameM (Range, Expr Name))
-> Rec (Expr PName) -> RenameM (Rec (Expr Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr PName -> RenameM (Expr Name))
-> (Range, Expr PName) -> RenameM (Range, Expr Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Expr PName)
fs
ESel Expr PName
e' Selector
s -> Expr Name -> Selector -> Expr Name
forall n. Expr n -> Selector -> Expr n
ESel (Expr Name -> Selector -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Selector -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM (Selector -> Expr Name)
-> RenameM Selector -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> RenameM Selector
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
Maybe (Expr Name) -> [UpdField Name] -> Expr Name
forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd (Maybe (Expr Name) -> [UpdField Name] -> Expr Name)
-> RenameM (Maybe (Expr Name))
-> RenameM ([UpdField Name] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> RenameM (Expr Name))
-> Maybe (Expr PName) -> RenameM (Maybe (Expr Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
mb RenameM ([UpdField Name] -> Expr Name)
-> RenameM [UpdField Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UpdField PName -> RenameM (UpdField Name))
-> [UpdField PName] -> RenameM [UpdField Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UpdField PName -> RenameM (UpdField Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [UpdField PName]
fs
EList [Expr PName]
es -> [Expr Name] -> Expr Name
forall n. [Expr n] -> Expr n
EList ([Expr Name] -> Expr Name)
-> RenameM [Expr Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> RenameM (Expr Name))
-> [Expr PName] -> RenameM [Expr Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
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 -> Type Name
-> Maybe (Type Name) -> Type Name -> Maybe (Type Name) -> Expr Name
forall n.
Type n -> Maybe (Type n) -> Type n -> Maybe (Type n) -> Expr n
EFromTo (Type Name
-> Maybe (Type Name)
-> Type Name
-> Maybe (Type Name)
-> Expr Name)
-> RenameM (Type Name)
-> RenameM
(Maybe (Type Name) -> Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
RenameM
(Maybe (Type Name) -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name))
-> RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
n
RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name) -> RenameM (Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
RenameM (Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
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 ->
Bool
-> Type Name
-> Type Name
-> Type Name
-> Maybe (Type Name)
-> Expr Name
forall n.
Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToBy Bool
isStrict
(Type Name
-> Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name)
-> RenameM
(Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
RenameM (Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name)
-> RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name) -> RenameM (Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
RenameM (Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
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 ->
Bool
-> Type Name
-> Type Name
-> Type Name
-> Maybe (Type Name)
-> Expr Name
forall n.
Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToDownBy Bool
isStrict
(Type Name
-> Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name)
-> RenameM
(Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
RenameM (Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name)
-> RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name) -> RenameM (Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
RenameM (Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
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 ->
Type Name -> Type Name -> Maybe (Type Name) -> Expr Name
forall n. Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToLessThan (Type Name -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name)
-> RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name) -> RenameM (Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
RenameM (Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
EInfFrom Expr PName
a Maybe (Expr PName)
b -> Expr Name -> Maybe (Expr Name) -> Expr Name
forall n. Expr n -> Maybe (Expr n) -> Expr n
EInfFrom(Expr Name -> Maybe (Expr Name) -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Maybe (Expr Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
a RenameM (Maybe (Expr Name) -> Expr Name)
-> RenameM (Maybe (Expr Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr PName -> RenameM (Expr Name))
-> Maybe (Expr PName) -> RenameM (Maybe (Expr Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
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' <- ([Match PName] -> RenameM (NamingEnv, [Match Name]))
-> [[Match PName]] -> RenameM [(NamingEnv, [Match Name])]
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') = [(NamingEnv, [Match Name])] -> ([NamingEnv], [[Match Name]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(NamingEnv, [Match Name])]
arms'
EnvCheck
-> [NamingEnv] -> RenameM (Expr Name) -> RenameM (Expr Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap [NamingEnv]
envs (Expr Name -> [[Match Name]] -> Expr Name
forall n. Expr n -> [[Match n]] -> Expr n
EComp (Expr Name -> [[Match Name]] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([[Match Name]] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM ([[Match Name]] -> Expr Name)
-> RenameM [[Match Name]] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Match Name]] -> RenameM [[Match Name]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Match Name]]
bs')
EApp Expr PName
f Expr PName
x -> Expr Name -> Expr Name -> Expr Name
forall n. Expr n -> Expr n -> Expr n
EApp (Expr Name -> Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f RenameM (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
EAppT Expr PName
f [TypeInst PName]
ti -> Expr Name -> [TypeInst Name] -> Expr Name
forall n. Expr n -> [TypeInst n] -> Expr n
EAppT (Expr Name -> [TypeInst Name] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([TypeInst Name] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f RenameM ([TypeInst Name] -> Expr Name)
-> RenameM [TypeInst Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeInst PName -> RenameM (TypeInst Name))
-> [TypeInst PName] -> RenameM [TypeInst Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeInst PName -> RenameM (TypeInst Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TypeInst PName]
ti
EIf Expr PName
b Expr PName
t Expr PName
f -> Expr Name -> Expr Name -> Expr Name -> Expr Name
forall n. Expr n -> Expr n -> Expr n -> Expr n
EIf (Expr Name -> Expr Name -> Expr Name -> Expr Name)
-> RenameM (Expr Name)
-> RenameM (Expr Name -> Expr Name -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
b RenameM (Expr Name -> Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
t RenameM (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f
EWhere Expr PName
e' [Decl PName]
ds -> [InModule (Decl PName)]
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames ((Decl PName -> InModule (Decl PName))
-> [Decl PName] -> [InModule (Decl PName)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe ModPath -> Decl PName -> InModule (Decl PName)
forall a. Maybe ModPath -> a -> InModule a
InModule Maybe ModPath
forall a. Maybe a
Nothing) [Decl PName]
ds) (RenameM (Expr Name) -> RenameM (Expr Name))
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall a b. (a -> b) -> a -> b
$
Expr Name -> [Decl Name] -> Expr Name
forall n. Expr n -> [Decl n] -> Expr n
EWhere (Expr Name -> [Decl Name] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([Decl Name] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM ([Decl Name] -> Expr Name)
-> RenameM [Decl Name] -> RenameM (Expr Name)
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 -> Expr Name -> Type Name -> Expr Name
forall n. Expr n -> Type n -> Expr n
ETyped (Expr Name -> Type Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Type Name -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM (Type Name -> Expr Name)
-> RenameM (Type Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
ETypeVal Type PName
ty -> Type Name -> Expr Name
forall n. Type n -> Expr n
ETypeVal(Type Name -> Expr Name)
-> RenameM (Type Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
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' <- FunDesc PName -> RenameM (FunDesc Name)
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
EnvCheck -> NamingEnv -> RenameM (Expr Name) -> RenameM (Expr Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env (FunDesc Name -> [Pattern Name] -> Expr Name -> Expr Name
forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
EFun FunDesc Name
desc' [Pattern Name]
ps' (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e')
ELocated Expr PName
e' Range
r -> Range -> RenameM (Expr Name) -> RenameM (Expr Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
(RenameM (Expr Name) -> RenameM (Expr Name))
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall a b. (a -> b) -> a -> b
$ Expr Name -> Range -> Expr Name
forall n. Expr n -> Range -> Expr n
ELocated (Expr Name -> Range -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Range -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM (Range -> Expr Name)
-> RenameM Range -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r
ESplit Expr PName
e -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
ESplit (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
EParens Expr PName
p -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
EParens (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
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' <- Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
Expr Name
z' <- Expr PName -> RenameM (Expr Name)
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'
checkLabels :: [UpdField PName] -> RenameM ()
checkLabels :: [UpdField PName] -> RenameM ()
checkLabels = ([[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]])
-> [[Located Selector]] -> [[Located Selector]] -> RenameM ()
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 [] ([[Located Selector]] -> RenameM ())
-> ([UpdField PName] -> [[Located Selector]])
-> [UpdField PName]
-> RenameM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdField PName -> [Located Selector])
-> [UpdField PName] -> [[Located Selector]]
forall a b. (a -> b) -> [a] -> [b]
map UpdField PName -> [Located Selector]
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 ([Located Selector] -> Bool)
-> [[Located Selector]] -> Maybe [Located Selector]
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 ()
record (Located [Selector] -> Located [Selector] -> RenamerError
OverlappingRecordUpdate ([Located Selector] -> Located [Selector]
forall b. [Located b] -> Located [b]
reLoc [Located Selector]
l) ([Located Selector] -> Located [Selector]
forall b. [Located b] -> Located [b]
reLoc [Located Selector]
l'))
Maybe [Located Selector]
Nothing -> () -> RenameM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[[Located Selector]] -> RenameM [[Located Selector]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Located Selector]
l [Located Selector] -> [[Located Selector]] -> [[Located Selector]]
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 (Located Selector -> Selector
forall a. Located a -> a
thing Located Selector
x, Located Selector -> Selector
forall a. Located a -> a
thing Located Selector
y) of
(TupleSel Int
a Maybe Int
_, TupleSel Int
b Maybe Int
_) -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
(ListSel Int
a Maybe Int
_, ListSel Int
b Maybe Int
_) -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
(RecordSel Ident
a Maybe [Ident]
_, RecordSel Ident
b Maybe [Ident]
_) -> Ident
a Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
b
(Selector, Selector)
_ -> Bool
False
reLoc :: [Located b] -> Located [b]
reLoc [Located b]
xs = ([Located b] -> Located b
forall a. [a] -> a
head [Located b]
xs) { thing :: [b]
thing = (Located b -> b) -> [Located b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Located b -> b
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 -> Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
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
Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
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 ()
record (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)
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 =
Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
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 =
Located PName
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln (RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity))
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall a b. (a -> b) -> a -> b
$
do Name
n <- NameType -> PName -> RenameM Name
renameVar NameType
NameUse (Located PName -> PName
forall a. Located a -> a
thing Located PName
ln)
Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
(Located Name, Fixity) -> RenameM (Located Name, Fixity)
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 =
Located PName
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln (RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity))
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall a b. (a -> b) -> a -> b
$
do Name
n <- NameType -> PName -> RenameM Name
renameType NameType
NameUse (Located PName -> PName
forall a. Located a -> a
thing Located PName
ln)
Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
(Located Name, Fixity) -> RenameM (Located Name, Fixity)
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 -> Fixity -> RenameM Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
fixity
Maybe Fixity
Nothing -> Fixity -> RenameM Fixity
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 -> Named (Type Name) -> TypeInst Name
forall name. Named (Type name) -> TypeInst name
NamedInst (Named (Type Name) -> TypeInst Name)
-> RenameM (Named (Type Name)) -> RenameM (TypeInst Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type PName -> RenameM (Type Name))
-> Named (Type PName) -> RenameM (Named (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Named (Type PName)
nty
PosInst Type PName
ty -> Type Name -> TypeInst Name
forall name. Type name -> TypeInst name
PosInst (Type Name -> TypeInst Name)
-> RenameM (Type Name) -> RenameM (TypeInst Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
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
EnvCheck
-> NamingEnv
-> RenameM (NamingEnv, [Match Name])
-> RenameM (NamingEnv, [Match Name])
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
me (RenameM (NamingEnv, [Match Name])
-> RenameM (NamingEnv, [Match Name]))
-> RenameM (NamingEnv, [Match Name])
-> RenameM (NamingEnv, [Match Name])
forall a b. (a -> b) -> a -> b
$
do (NamingEnv
env,[Match Name]
rest) <- [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [Match PName]
ms
(NamingEnv, [Match Name]) -> RenameM (NamingEnv, [Match Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
me, Match Name
m'Match Name -> [Match Name] -> [Match Name]
forall a. a -> [a] -> [a]
:[Match Name]
rest)
renameArm [] =
(NamingEnv, [Match Name]) -> RenameM (NamingEnv, [Match Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
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' <- Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
(NamingEnv, Match Name) -> RenameM (NamingEnv, Match Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe,Pattern Name -> Expr Name -> Match Name
forall name. Pattern name -> Expr name -> Match name
Match Pattern Name
p' Expr Name
e')
renameMatch (MatchLet Bind PName
b) =
do NamingEnv
be <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (InModule (Bind PName) -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf (Maybe ModPath -> Bind PName -> InModule (Bind PName)
forall a. Maybe ModPath -> a -> InModule a
InModule Maybe ModPath
forall a. Maybe a
Nothing Bind PName
b))
Bind Name
b' <- NamingEnv -> RenameM (Bind Name) -> RenameM (Bind Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
be (Bind PName -> RenameM (Bind Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)
(NamingEnv, Match Name) -> RenameM (NamingEnv, Match Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
be,Bind Name -> Match Name
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' <- NamingEnv -> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p)
(NamingEnv, Pattern Name) -> RenameM (NamingEnv, Pattern Name)
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
NamingEnv
-> RenameM (NamingEnv, [Pattern Name])
-> RenameM (NamingEnv, [Pattern Name])
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (RenameM (NamingEnv, [Pattern Name])
-> RenameM (NamingEnv, [Pattern Name]))
-> RenameM (NamingEnv, [Pattern Name])
-> RenameM (NamingEnv, [Pattern Name])
forall a b. (a -> b) -> a -> b
$
do Pattern Name
p' <- Pattern PName -> RenameM (Pattern Name)
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
(NamingEnv, [Pattern Name]) -> RenameM (NamingEnv, [Pattern Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe NamingEnv -> NamingEnv -> NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
env', Pattern Name
p'Pattern Name -> [Pattern Name] -> [Pattern Name]
forall a. a -> [a] -> [a]
:[Pattern Name]
rest')
[] -> (NamingEnv, [Pattern Name]) -> RenameM (NamingEnv, [Pattern Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
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 <- (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkParameter Namespace
NSValue (PName -> Ident
getIdent PName
thing) Range
srcRange)
NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Name -> NamingEnv
singletonE PName
thing Name
n)
go Pattern PName
PWild = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
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 (((Range, Pattern PName) -> Pattern PName)
-> [(Range, Pattern PName)] -> [Pattern PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range, Pattern PName) -> Pattern PName
forall a b. (a, b) -> b
snd (Rec (Pattern PName) -> [(Range, Pattern PName)]
forall a b. RecordMap a b -> [b]
recordElements Rec (Pattern PName)
fs))
go (PList [Pattern PName]
ps) = (Pattern PName -> RenameM NamingEnv)
-> [Pattern PName] -> RenameM NamingEnv
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 RenameM NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
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 RenameM NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` Pattern PName -> RenameM NamingEnv
go Pattern PName
b
go (PLocated Pattern PName
p Range
loc) = Range -> RenameM NamingEnv -> RenameM NamingEnv
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 [] = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
bindVars (Pattern PName
p:[Pattern PName]
ps) =
do NamingEnv
env <- Pattern PName -> RenameM NamingEnv
go Pattern PName
p
NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env (RenameM NamingEnv -> RenameM NamingEnv)
-> RenameM NamingEnv -> RenameM NamingEnv
forall a b. (a -> b) -> a -> b
$
do NamingEnv
rest <- [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
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 = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
typeEnv TNum{} = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
typeEnv TChar{} = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
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
| [Type PName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type PName]
ps ->
do Range
loc <- RenameM Range
curLoc
Name
n <- (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkParameter Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Name -> NamingEnv
singletonT PName
pn Name
n)
| Bool
otherwise ->
do Range
loc <- RenameM Range
curLoc
RenamerError -> RenameM ()
record (Namespace -> Located PName -> RenamerError
UnboundName Namespace
NSType (Range -> PName -> Located PName
forall a. Range -> a -> Located a
Located Range
loc PName
pn))
Name
n <- (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkParameter Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Name -> NamingEnv
singletonT PName
pn Name
n)
typeEnv (TRecord RecordMap Ident (Range, Type PName)
fs) = [Type PName] -> RenameM NamingEnv
bindTypes (((Range, Type PName) -> Type PName)
-> [(Range, Type PName)] -> [Type PName]
forall a b. (a -> b) -> [a] -> [b]
map (Range, Type PName) -> Type PName
forall a b. (a, b) -> b
snd (RecordMap Ident (Range, Type PName) -> [(Range, Type PName)]
forall a b. RecordMap a b -> [b]
recordElements RecordMap Ident (Range, Type PName)
fs))
typeEnv (TTyApp [Named (Type PName)]
fs) = [Type PName] -> RenameM NamingEnv
bindTypes ((Named (Type PName) -> Type PName)
-> [Named (Type PName)] -> [Type PName]
forall a b. (a -> b) -> [a] -> [b]
map Named (Type PName) -> Type PName
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 = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
typeEnv (TLocated Type PName
ty Range
loc) = Range -> RenameM NamingEnv -> RenameM NamingEnv
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) = 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 [] = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
bindTypes (Type PName
t:[Type PName]
ts) =
do NamingEnv
env' <- Type PName -> RenameM NamingEnv
typeEnv Type PName
t
NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env' (RenameM NamingEnv -> RenameM NamingEnv)
-> RenameM NamingEnv -> RenameM NamingEnv
forall a b. (a -> b) -> a -> b
$
do NamingEnv
res <- [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env' NamingEnv -> NamingEnv -> NamingEnv
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 -> Pattern Name -> Expr Name -> Match Name
forall name. Pattern name -> Expr name -> Match name
Match (Pattern Name -> Expr Name -> Match Name)
-> RenameM (Pattern Name) -> RenameM (Expr Name -> Match Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p RenameM (Expr Name -> Match Name)
-> RenameM (Expr Name) -> RenameM (Match Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
MatchLet Bind PName
b -> InModule (Bind PName)
-> RenameM (Match Name) -> RenameM (Match Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (Maybe ModPath -> Bind PName -> InModule (Bind PName)
forall a. Maybe ModPath -> a -> InModule a
InModule Maybe ModPath
forall a. Maybe a
Nothing Bind PName
b) (Bind Name -> Match Name
forall name. Bind name -> Match name
MatchLet (Bind Name -> Match Name)
-> RenameM (Bind Name) -> RenameM (Match Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bind PName -> RenameM (Bind Name)
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) =
[TParam PName] -> RenameM (TySyn Name) -> RenameM (TySyn Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps
do Located Name
n' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) Located PName
n
DepName -> RenameM (TySyn Name) -> RenameM (TySyn Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
n')) (RenameM (TySyn Name) -> RenameM (TySyn Name))
-> RenameM (TySyn Name) -> RenameM (TySyn Name)
forall a b. (a -> b) -> a -> b
$
Located Name
-> Maybe Fixity -> [TParam Name] -> Type Name -> TySyn Name
forall n.
Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
TySyn Located Name
n' (Maybe Fixity -> [TParam Name] -> Type Name -> TySyn Name)
-> RenameM (Maybe Fixity)
-> RenameM ([TParam Name] -> Type Name -> TySyn Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Fixity -> RenameM (Maybe Fixity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f RenameM ([TParam Name] -> Type Name -> TySyn Name)
-> RenameM [TParam Name] -> RenameM (Type Name -> TySyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps RenameM (Type Name -> TySyn Name)
-> RenameM (Type Name) -> RenameM (TySyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
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) =
[TParam PName] -> RenameM (PropSyn Name) -> RenameM (PropSyn Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps
do Located Name
n' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) Located PName
n
Located Name
-> Maybe Fixity -> [TParam Name] -> [Prop Name] -> PropSyn Name
forall n.
Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
PropSyn Located Name
n' (Maybe Fixity -> [TParam Name] -> [Prop Name] -> PropSyn Name)
-> RenameM (Maybe Fixity)
-> RenameM ([TParam Name] -> [Prop Name] -> PropSyn Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Fixity -> RenameM (Maybe Fixity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f RenameM ([TParam Name] -> [Prop Name] -> PropSyn Name)
-> RenameM [TParam Name] -> RenameM ([Prop Name] -> PropSyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps RenameM ([Prop Name] -> PropSyn Name)
-> RenameM [Prop Name] -> RenameM (PropSyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Prop PName -> RenameM (Prop Name))
-> [Prop PName] -> RenameM [Prop Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
cs