-- |
-- Module      :  Cryptol.ModuleSystem.Renamer
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# 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     -- ^ The renamed module
  , RenamedModule -> NamingEnv
rmDefines  :: NamingEnv       -- ^ What this module defines
  , RenamedModule -> NamingEnv
rmInScope  :: NamingEnv       -- ^ What's in scope in this module
  , RenamedModule -> IfaceDecls
rmImported :: IfaceDecls      -- ^ Imported declarations
  }

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
                -- XXX: maybe we should keep the nested defines too?
                 }

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)
          -- record a use of top-level names to avoid
          -- unused name warnings
          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)

-- | Returns declarations with additional imports and the public module names
-- of this module and its children
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)


-- | Returns:
--
--    * Interfaces for imported things,
--    * Things defines in the module
--    * Renamed module
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
$
                          -- maybe we should allow for a warning
                          -- if a local name shadows an imported one?
        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
      -- Here we may need the constraints to validate the type
      -- (e.g., if the parameter is of type `Z a`)


      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]


-- | Returns:
--  * The public interface of the imported module
--  * Infromation about nested modules in this module
--  * New names introduced through this import
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)



--------------------------------------------------------------------------------
-- Compute names coming through `open` statements.

data OpenLoopState = OpenLoopState
  { OpenLoopState -> [ImportG PName]
unresolvedOpen  :: [ImportG PName]
  , OpenLoopState -> NamingEnv
scopeImports    :: NamingEnv    -- names from open/impot
  , OpenLoopState -> NamingEnv
scopeDefs       :: NamingEnv    -- names defined in this module
  , OpenLoopState -> NamingEnv
scopingRel      :: NamingEnv    -- defs + imports with shadowing
                                    -- (just a cache)
  , OpenLoopState -> Bool
openLoopChange  :: Bool
  }

-- | Processing of a single @open@ declaration
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
    {- Notes:
       * ambiguity will be reported later when we do the renaming
       * assumes scoping only grows, which should be true
       * we are not adding the names from *either* of the imports
         so this may give rise to undefined names, so we may want to
         suppress reporing undefined names if there ambiguities for
         module names.  Alternatively we could add the defitions from
         *all* options, but that might lead to spurious ambiguity errors.
    -}

{- | Complete the set of import using @open@ declarations.
This should terminate because on each iteration either @unresolvedOpen@
decreases or @openLoopChange@ remians @False@. We don't report errors
here, as they will be reported during renaming anyway. -}
openLoop ::
  NestedMods      {- ^ Definitions of all known nested modules  -} ->
  NamingEnv       {- ^ Definitions of the module (these shadow) -} ->
  [ImportG PName] {- ^ Open declarations                        -} ->
  NamingEnv       {- ^ Imported declarations                    -} ->
  NamingEnv       {- ^ Completed imports                        -}
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 ]
            -- XXX: we should store in scope somehwere if we want to browse
            -- nested modules properly
            (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')

            -- Record an additional use for each parameter since we checked
            -- earlier that all the parameters are used exactly once in the
            -- body of the signature.  This prevents incorret warnings
            -- about unused names.
            (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' }



-- | Try to resolve a name
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    -- for warning
             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    -- mark as used to avoid unused warnings
            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

-- | Resolve a name, and report error on failure
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
              -- name exists in a different namespace
              Namespace
actual : [Namespace]
_ -> RenamerError -> RenameM ()
record (Namespace -> Namespace -> Located PName -> RenamerError
WrongNamespace Namespace
expected Namespace
actual Located PName
nm)

              -- the value is just missing
              [] -> 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



-- | Assuming an error has been recorded already, construct a fake name that's
-- not expected to make it out of the renamer.
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))

-- | Rename a schema, assuming that none of its type variables are already in
-- scope.
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

-- | Rename a schema, assuming that the type variables have already been brought
-- into scope.
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)

-- | Rename a qualified thing.
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)


-- | Rename a binding.
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)
                 -- NOTE: renamePats will generate warnings,
                 -- so we don't need to trigger them again here.
                 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

-- NOTE: this only renames types within the pattern.
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

-- | Note that after this point the @->@ updates have an explicit function
-- and there are no more nested updates.
instance Rename UpdField where
  rename :: UpdField PName -> RenameM (UpdField Name)
rename (UpdField UpdHow
h [Located Selector]
ls Expr PName
e) =
    -- The plan:
    -- x =  e       ~~~>        x = e
    -- x -> e       ~~~>        x -> \x -> e
    -- x.y = e      ~~~>        x -> { _ | y = e }
    -- x.y -> e     ~~~>        x -> { _ | y -> 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'
                          -- NOTE: renameArm will generate shadowing warnings; we only
                          -- need to check for repeated names across multiple 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
                          -- NOTE: renamePats will generate warnings, so we don't
                          -- need to duplicate them here
                          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             -- ^ May contain infix expressions
         -> (Located Name,Fixity) -- ^ The operator to use
         -> Expr Name             -- ^ Will not contain infix expressions
         -> 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 -- FIXME: should we raise an error instead?

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
     -- NOTE: renameMatch will generate warnings, so we don't
     -- need to duplicate them here
     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

          -- NOTE: the inner environment shadows the outer one, for examples
          -- like this:
          --
          -- [ x | x <- xs, let x = 10 ]
          (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,[])

-- | The name environment generated by a single match.
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')

-- | Rename patterns, and collect the new environment that they introduce.
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')



-- | Rename patterns, and collect the new environment that they introduce.
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)
       -- XXX: for deps, we should record a use
       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

         -- The type is already bound, don't introduce anything.
         Just Name
_ -> [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ps

         Maybe Name
Nothing

           -- The type isn't bound, and has no parameters, so it names a portion
           -- of the type of the pattern.
           | [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)

           -- This references a type synonym that's not in scope. Record an
           -- error and continue with a made up name.
           | 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