-- |
-- 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 #-}
{-# Language OverloadedStrings #-}
module Cryptol.ModuleSystem.Renamer (
    NamingEnv(), shadowing
  , BindsNames, InModule(..)
  , shadowNames
  , Rename(..), runRenamer, RenameM()
  , RenamerError(..)
  , RenamerWarning(..)
  , renameVar
  , renameType
  , renameModule
  , renameTopDecls
  , RenamerInfo(..)
  , NameType(..)
  , RenamedModule(..)
  ) where

import Prelude ()
import Prelude.Compat

import Data.Either(partitionEithers)
import Data.Maybe(mapMaybe)
import Data.List(find,groupBy,sortBy)
import Data.Function(on)
import Data.Foldable(toList)
import Data.Map(Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Graph(SCC(..))
import Data.Graph.SCC(stronglyConnComp)
import MonadLib hiding (mapM, mapM_)


import Cryptol.ModuleSystem.Name
import Cryptol.ModuleSystem.Names
import Cryptol.ModuleSystem.NamingEnv
import Cryptol.ModuleSystem.Exports
import Cryptol.Parser.Position(Range)
import Cryptol.Parser.AST
import Cryptol.Parser.Selector(selName)
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.RecordMap
import Cryptol.Utils.Ident(allNamespaces,OrigName(..),modPathCommon,
                              undefinedModName)
import Cryptol.Utils.PP

import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Renamer.Error
import Cryptol.ModuleSystem.Binds
import Cryptol.ModuleSystem.Renamer.Monad
import Cryptol.ModuleSystem.Renamer.Imports
import Cryptol.ModuleSystem.Renamer.ImplicitImports


{-
The Renamer Algorithm
=====================

1. Add implicit imports for visible nested modules

2. Compute what each module defines   (see "Cryptol.ModuleSystem.Binds")
  - This assigns unique names to names introduces by various declarations
  - Here we detect repeated top-level definitions in a module.
  - Module instantiations also get a name, but are not yet resolved, so
    we don't know what's defined by them.
  - We do not generate unique names for functor parameters---those will
    be matched textually to the arguments when applied.
  - We *do* generate unique names for declarations in "signatures"
    * those are only really needed when renaming the signature (step 4)
      (e.g., to determine if a name refers to something declared in the
      signature or something else).
    * when validating a module against a signature the names of the declarations
      are matched textually, *not* using the unique names
      (e.g., `x` in a signature is matched with the thing named `x` in a module,
       even though these two `x`s will have different unique `id`s)


3. Resolve imports and instantiations (see "Cryptol.ModuleSystem.Imports")
  - Resolves names in submodule imports
  - Resolves functor instantiations:
    * generate new names for declarations in the functors.
    * this includes any nested modules, and things nested within them.
  - At this point we have enough information to know what's exported by
    each module.

4. Do the renaming (this module)
  - Using step 3 we compute the scoping environment for each module/signature
  - We traverse all declarations and replace the parser names with the
    corresponding names in scope:
    * Here we detect ambiguity and undefined errors
    * During this pass is also where we keep track of information of what
      names are used by declarations:
      - this is used to compute the dependencies between declarations
      - which are in turn used to order the declarations in dependency order
        * this is assumed by the TC
        * here we also report errors about invalid recursive dependencies
    * During this stage we also issue warning about unused type names
      (and we should probably do unused value names too one day)
  - During the rewriting we also do:
    - rebalance expression trees using the operator fixities
    - desugar record update notation
-}


-- | The result of renaming a module
data RenamedModule = RenamedModule
  { RenamedModule -> Module Name
rmModule   :: Module Name     -- ^ The renamed module
  , RenamedModule -> NamingEnv
rmDefines  :: NamingEnv       -- ^ What this module defines
  , RenamedModule -> IfaceDecls
rmImported :: IfaceDecls
    -- ^ Imported declarations.  This provides the types for external
    -- names (used by the type-checker).
  }

-- | Entry point. This is used for renaming a top-level module.
renameModule :: Module PName -> RenameM RenamedModule
renameModule :: Module PName -> RenameM RenamedModule
renameModule Module PName
m0 =
  do -- Step 1: add implicit imports
     let m :: Module PName
m = Module PName
m0 { mDef =
                    case mDef m0 of
                      NormalModule [TopDecl PName]
ds ->
                        [TopDecl PName] -> ModuleDefinition PName
forall name. [TopDecl name] -> ModuleDefinition name
NormalModule ([TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports [TopDecl PName]
ds)
                      FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
i -> Located (ImpName PName)
-> ModuleInstanceArgs PName
-> ModuleInstance PName
-> ModuleDefinition PName
forall name.
Located (ImpName name)
-> ModuleInstanceArgs name
-> ModuleInstance name
-> ModuleDefinition name
FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
i
                      InterfaceModule Signature PName
s -> Signature PName -> ModuleDefinition PName
forall name. Signature name -> ModuleDefinition name
InterfaceModule Signature PName
s
                 }

     -- Step 2: compute what's defined
     (TopDef
defs,[RenamerError]
errs) <- (Supply -> ((TopDef, [RenamerError]), Supply))
-> RenameM (TopDef, [RenamerError])
forall a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (ModBuilder TopDef -> Supply -> ((TopDef, [RenamerError]), Supply)
forall a. ModBuilder a -> Supply -> ((a, [RenamerError]), Supply)
modBuilder (Module PName -> ModBuilder TopDef
topModuleDefs Module PName
m))
     (RenamerError -> RenameM ()) -> [RenamerError] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerError -> RenameM ()
recordError [RenamerError]
errs

     -- Step 3: resolve imports
     ImpName Name -> Mod ()
extern       <- RenameM (ImpName Name -> Mod ())
getExternal
     Map (ImpName Name) ResolvedLocal
resolvedMods <- (Supply -> (Map (ImpName Name) ResolvedLocal, Supply))
-> RenameM (Map (ImpName Name) ResolvedLocal)
forall a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ((ImpName Name -> Mod ())
-> TopDef -> Supply -> (Map (ImpName Name) ResolvedLocal, Supply)
resolveImports ImpName Name -> Mod ()
extern TopDef
defs)

     let pathToName :: Map ModPath Name
pathToName = [(ModPath, Name)] -> Map ModPath Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModPath -> Ident -> ModPath
Nested (Name -> ModPath
nameModPath Name
x) (Name -> Ident
nameIdent Name
x), Name
x)
                                   | ImpNested Name
x <- Map (ImpName Name) ResolvedLocal -> [ImpName Name]
forall k a. Map k a -> [k]
Map.keys Map (ImpName Name) ResolvedLocal
resolvedMods ]


     let mname :: ImpName name
mname = ModName -> ImpName name
forall name. ModName -> ImpName name
ImpTop (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))

     Map (ImpName Name) ResolvedLocal
-> RenameM RenamedModule -> RenameM RenamedModule
forall a.
Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals Map (ImpName Name) ResolvedLocal
resolvedMods (RenameM RenamedModule -> RenameM RenamedModule)
-> RenameM RenamedModule -> RenameM RenamedModule
forall a b. (a -> b) -> a -> b
$
       Map ModPath Name -> RenameM RenamedModule -> RenameM RenamedModule
forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule Map ModPath Name
pathToName
       do (IfaceDecls
ifs,Module Name
m1) <- RenameM (Module Name) -> RenameM (IfaceDecls, Module Name)
forall a. RenameM a -> RenameM (IfaceDecls, a)
collectIfaceDeps (ImpName Name -> Module PName -> RenameM (Module Name)
forall mname.
ImpName Name -> ModuleG mname PName -> RenameM (ModuleG mname Name)
renameModule' ImpName Name
forall {name}. ImpName name
mname Module PName
m)
          NamingEnv
env <- ResolvedLocal -> NamingEnv
forall imps. ResolvedModule imps -> NamingEnv
rmodDefines (ResolvedLocal -> NamingEnv)
-> RenameM ResolvedLocal -> RenameM NamingEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved ImpName Name
forall {name}. ImpName name
mname
          RenamedModule -> RenameM RenamedModule
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RenamedModule
                 { rmModule :: Module Name
rmModule = Module Name
m1
                 , rmDefines :: NamingEnv
rmDefines = NamingEnv
env
                 , rmImported :: IfaceDecls
rmImported = IfaceDecls
ifs
                  -- XXX: maybe we should keep the nested defines too?
                 }





{- | Entry point. Rename a list of top-level declarations.
This is used for declaration that don't live in a module
(e.g., define on the command line.)

We assume that these declarations do not contain any nested modules.
-}
renameTopDecls ::
  ModName -> [TopDecl PName] -> RenameM (NamingEnv,[TopDecl Name])
renameTopDecls :: ModName -> [TopDecl PName] -> RenameM (NamingEnv, [TopDecl Name])
renameTopDecls ModName
m [TopDecl PName]
ds0 =

  do -- Step 1: add implicit imports
     let ds :: [TopDecl PName]
ds = [TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports [TopDecl PName]
ds0

     -- Step 2: compute what's defined
     (Mod ()
defs,[RenamerError]
errs) <- (Supply -> ((Mod (), [RenamerError]), Supply))
-> RenameM (Mod (), [RenamerError])
forall a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (ModBuilder (Mod ()) -> Supply -> ((Mod (), [RenamerError]), Supply)
forall a. ModBuilder a -> Supply -> ((a, [RenamerError]), Supply)
modBuilder (ModPath -> [TopDecl PName] -> ModBuilder (Mod ())
topDeclsDefs (ModName -> ModPath
TopModule ModName
m) [TopDecl PName]
ds))
     (RenamerError -> RenameM ()) -> [RenamerError] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerError -> RenameM ()
recordError [RenamerError]
errs

     -- Step 3: resolve imports
     ImpName Name -> Mod ()
extern       <- RenameM (ImpName Name -> Mod ())
getExternal
     Map (ImpName Name) ResolvedLocal
resolvedMods <- (Supply -> (Map (ImpName Name) ResolvedLocal, Supply))
-> RenameM (Map (ImpName Name) ResolvedLocal)
forall a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ((ImpName Name -> Mod ())
-> TopDef -> Supply -> (Map (ImpName Name) ResolvedLocal, Supply)
resolveImports ImpName Name -> Mod ()
extern (ModName -> Mod () -> TopDef
TopMod ModName
m Mod ()
defs))

     let pathToName :: Map ModPath Name
pathToName = [(ModPath, Name)] -> Map ModPath Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModPath -> Ident -> ModPath
Nested (Name -> ModPath
nameModPath Name
x) (Name -> Ident
nameIdent Name
x), Name
x)
                                   | ImpNested Name
x <- Map (ImpName Name) ResolvedLocal -> [ImpName Name]
forall k a. Map k a -> [k]
Map.keys Map (ImpName Name) ResolvedLocal
resolvedMods ]


     Map (ImpName Name) ResolvedLocal
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall a.
Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals Map (ImpName Name) ResolvedLocal
resolvedMods (RenameM (NamingEnv, [TopDecl Name])
 -> RenameM (NamingEnv, [TopDecl Name]))
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall a b. (a -> b) -> a -> b
$
      Map ModPath Name
-> RenameM (NamingEnv, [TopDecl Name])
-> RenameM (NamingEnv, [TopDecl Name])
forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule Map ModPath Name
pathToName
      do NamingEnv
env    <- ResolvedLocal -> NamingEnv
forall imps. ResolvedModule imps -> NamingEnv
rmodDefines (ResolvedLocal -> NamingEnv)
-> RenameM ResolvedLocal -> RenameM NamingEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved (ModName -> ImpName Name
forall name. ModName -> ImpName name
ImpTop ModName
m)

         -- we already checked for duplicates in Step 2
         [TopDecl Name]
ds1 <- EnvCheck
-> NamingEnv -> RenameM [TopDecl Name] -> RenameM [TopDecl Name]
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env ([TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds)
         -- record a use of top-level names to avoid
         -- unused name warnings
         let exports :: ExportSpec Name
exports = [TopDecl Name] -> ExportSpec Name
forall name. Ord name => [TopDecl name] -> ExportSpec name
exportedDecls [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 (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 a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,[TopDecl Name]
ds1)

--------------------------------------------------------------------------------
-- Stuff below is related to Step 4 of the algorithm.


class Rename f where
  rename :: f PName -> RenameM (f Name)


-- | This is used for both top-level and nested modules.
-- Returns:
--
--    * Things defined in the module
--    * Renamed module
renameModule' ::
  ImpName Name {- ^ Resolved name for this module -} ->
  ModuleG mname PName ->
  RenameM (ModuleG mname Name)
renameModule' :: forall mname.
ImpName Name -> ModuleG mname PName -> RenameM (ModuleG mname Name)
renameModule' ImpName Name
mname ModuleG mname PName
m =
  ModPath
-> RenameM (ModuleG mname Name) -> RenameM (ModuleG mname Name)
forall a. ModPath -> RenameM a -> RenameM a
setCurMod (ImpName Name -> ModPath
impNameModPath ImpName Name
mname)

  do ResolvedLocal
resolved <- ImpName Name -> RenameM ResolvedLocal
lookupResolved ImpName Name
mname
     EnvCheck
-> NamingEnv
-> RenameM (ModuleG mname Name)
-> RenameM (ModuleG mname Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone (ResolvedLocal -> NamingEnv
forall imps. ResolvedModule imps -> imps
rmodImports ResolvedLocal
resolved)

       case ModuleG mname PName -> ModuleDefinition PName
forall mname name. ModuleG mname name -> ModuleDefinition name
mDef ModuleG mname PName
m of

         NormalModule [TopDecl PName]
ds ->
            do let env :: NamingEnv
env = ResolvedLocal -> NamingEnv
forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedLocal
resolved
               (NamingEnv
paramEnv,[RenModParam]
params) <-
                   EnvCheck
-> NamingEnv
-> RenameM (NamingEnv, [RenModParam])
-> RenameM (NamingEnv, [RenModParam])
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env
                      ([ModParam PName] -> RenameM (NamingEnv, [RenModParam])
doModParams (ModuleG mname PName -> [ModParam PName]
forall mname name. ModuleG mname name -> [ModParam name]
mModParams ModuleG mname PName
m))

               -- we check that defined names and ones that came
               -- from parameters do not clash, as this would be
               -- very confusing.
               EnvCheck
-> NamingEnv
-> RenameM (ModuleG mname Name)
-> RenameM (ModuleG mname Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
forall a. Semigroup a => a -> a -> a
<> NamingEnv
paramEnv) (RenameM (ModuleG mname Name) -> RenameM (ModuleG mname Name))
-> RenameM (ModuleG mname Name) -> RenameM (ModuleG mname Name)
forall a b. (a -> b) -> a -> b
$
                  [RenModParam]
-> RenameM (ModuleG mname Name) -> RenameM (ModuleG mname Name)
forall a. [RenModParam] -> RenameM a -> RenameM a
setModParams [RenModParam]
params
                  do [TopDecl Name]
ds1 <- [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds
                     let exports :: ExportSpec Name
exports = [TopDecl Name] -> ExportSpec Name
forall name. Ord name => [TopDecl name] -> ExportSpec name
exportedDecls [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 (Namespace -> ExportSpec Name -> Set Name
forall name. Namespace -> ExportSpec name -> Set name
exported Namespace
NSType ExportSpec Name
exports)
                     NamingEnv
inScope <- RenameM NamingEnv
getNamingEnv
                     ModuleG mname Name -> RenameM (ModuleG mname Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleG mname PName
m { mDef = NormalModule ds1, mInScope = inScope }

         -- The things defined by this module are the *results*
         -- of the instantiation, so we should *not* add them
         -- in scope when resolving.
         FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
_ ->
           do Located (ImpName Name)
f'  <- (ImpName PName -> RenameM (ImpName Name))
-> Located (ImpName PName) -> RenameM (Located (ImpName Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated ImpName PName -> RenameM (ImpName Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ImpName PName)
f
              ModuleInstanceArgs Name
as' <- ModuleInstanceArgs PName -> RenameM (ModuleInstanceArgs Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ModuleInstanceArgs PName
as
              ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs ModuleInstanceArgs Name
as'

              let l :: Maybe Range
l = Range -> Maybe Range
forall a. a -> Maybe a
Just (Located (ImpName Name) -> Range
forall a. Located a -> Range
srcRange Located (ImpName Name)
f')
              Map Name Name
imap <- Maybe Range
-> Map Name Name
-> ImpName Name
-> ImpName Name
-> RenameM (Map Name Name)
mkInstMap Maybe Range
l Map Name Name
forall a. Monoid a => a
mempty (Located (ImpName Name) -> ImpName Name
forall a. Located a -> a
thing Located (ImpName Name)
f') ImpName Name
mname

              -- This inScope is incomplete; it only contains names from the
              -- enclosing scope, but we also want the names in scope from the
              -- functor, for ease of testing at the command line. We will fix
              -- this up in doFunctorInst in the typechecker, because right now
              -- we don't have access yet to the inScope of the functor.
              NamingEnv
inScope <- RenameM NamingEnv
getNamingEnv

              ModuleG mname Name -> RenameM (ModuleG mname Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleG mname PName
m { mDef = FunctorInstance f' as' imap, mInScope = inScope }

         InterfaceModule Signature PName
s ->
           EnvCheck
-> NamingEnv
-> RenameM (ModuleG mname Name)
-> RenameM (ModuleG mname Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone (ResolvedLocal -> NamingEnv
forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedLocal
resolved)
             do ModuleDefinition Name
d <- Signature Name -> ModuleDefinition Name
forall name. Signature name -> ModuleDefinition name
InterfaceModule (Signature Name -> ModuleDefinition Name)
-> RenameM (Signature Name) -> RenameM (ModuleDefinition Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> Signature PName -> RenameM (Signature Name)
renameIfaceModule ImpName Name
mname Signature PName
s
                NamingEnv
inScope <- RenameM NamingEnv
getNamingEnv
                ModuleG mname Name -> RenameM (ModuleG mname Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleG mname PName
m { mDef = d, mInScope = inScope }


checkFunctorArgs :: ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs :: ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs ModuleInstanceArgs Name
args =
  case ModuleInstanceArgs Name
args of
    DefaultInstAnonArg {} ->
      String -> [String] -> RenameM ()
forall a. HasCallStack => String -> [String] -> a
panic String
"checkFunctorArgs" [String
"Nested DefaultInstAnonArg"]
    DefaultInstArg Located (ModuleInstanceArg Name)
l -> Located (ModuleInstanceArg Name) -> RenameM ()
checkArg Located (ModuleInstanceArg Name)
l
    NamedInstArgs [ModuleInstanceNamedArg Name]
as -> (ModuleInstanceNamedArg Name -> RenameM ())
-> [ModuleInstanceNamedArg Name] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleInstanceNamedArg Name -> RenameM ()
checkNamedArg [ModuleInstanceNamedArg Name]
as
  where
  checkNamedArg :: ModuleInstanceNamedArg Name -> RenameM ()
checkNamedArg (ModuleInstanceNamedArg Located Ident
_ Located (ModuleInstanceArg Name)
l) = Located (ModuleInstanceArg Name) -> RenameM ()
checkArg Located (ModuleInstanceArg Name)
l

  checkArg :: Located (ModuleInstanceArg Name) -> RenameM ()
checkArg Located (ModuleInstanceArg Name)
l =
      case Located (ModuleInstanceArg Name) -> ModuleInstanceArg Name
forall a. Located a -> a
thing Located (ModuleInstanceArg Name)
l of
        ModuleArg ImpName Name
m
          | ImpName Name -> Bool
isFakeName ImpName Name
m -> () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise    -> Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule (Located (ModuleInstanceArg Name) -> Range
forall a. Located a -> Range
srcRange Located (ModuleInstanceArg Name)
l) ImpName Name
m ModKind
AModule
        ParameterArg {} -> () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- we check these in the type checker
        ModuleInstanceArg Name
AddParams -> () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

mkInstMap :: Maybe Range -> Map Name Name -> ImpName Name -> ImpName Name ->
  RenameM (Map Name Name)
mkInstMap :: Maybe Range
-> Map Name Name
-> ImpName Name
-> ImpName Name
-> RenameM (Map Name Name)
mkInstMap Maybe Range
checkFun Map Name Name
acc0 ImpName Name
ogname ImpName Name
iname
  | ImpName Name -> Bool
isFakeName ImpName Name
ogname = Map Name Name -> RenameM (Map Name Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Name Name
forall k a. Map k a
Map.empty
  | Bool
otherwise =
  do case Maybe Range
checkFun of
       Maybe Range
Nothing -> () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       Just Range
r  -> Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule Range
r ImpName Name
ogname ModKind
AFunctor
     (NamingEnv
onames,Set Name
osubs) <- ImpName Name -> RenameM (NamingEnv, Set Name)
lookupDefinesAndSubs ImpName Name
ogname
     NamingEnv
inames         <- ImpName Name -> RenameM NamingEnv
lookupDefines ImpName Name
iname
     let mp :: Map Name Name
mp   = NamingEnv -> NamingEnv -> Map Name Name
zipByTextName NamingEnv
onames NamingEnv
inames
         subs :: [(ImpName Name, ImpName Name)]
subs = [ (Name -> ImpName Name
forall name. name -> ImpName name
ImpNested Name
k, Name -> ImpName Name
forall name. name -> ImpName name
ImpNested Name
v)
                | Name
k <- Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
osubs, Just Name
v <- [Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
k Map Name Name
mp]
                ]
     (Map Name Name
 -> (ImpName Name, ImpName Name) -> RenameM (Map Name Name))
-> Map Name Name
-> [(ImpName Name, ImpName Name)]
-> RenameM (Map Name Name)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Name Name
-> (ImpName Name, ImpName Name) -> RenameM (Map Name Name)
doSub (Map Name Name -> Map Name Name -> Map Name Name
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Name Name
mp Map Name Name
acc0) [(ImpName Name, ImpName Name)]
subs

  where
  doSub :: Map Name Name
-> (ImpName Name, ImpName Name) -> RenameM (Map Name Name)
doSub Map Name Name
acc (ImpName Name
k,ImpName Name
v) = Maybe Range
-> Map Name Name
-> ImpName Name
-> ImpName Name
-> RenameM (Map Name Name)
mkInstMap Maybe Range
forall a. Maybe a
Nothing Map Name Name
acc ImpName Name
k ImpName Name
v



-- | This is used to rename local declarations (e.g. `where`)
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a. [a] -> [a]
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 a. a -> RenameM a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
                                  [Decl name] -> RenameM [Decl name]
forall a. a -> RenameM a
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 a. a -> RenameM a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SCC (Decl Name, DepName) -> RenameM [Decl Name]
forall {name}. SCC (Decl name, DepName) -> RenameM [Decl name]
fromSCC [SCC (Decl Name, DepName)]
ordered

-- | Rename declarations in a signature (i.e., type/prop synonyms)
renameSigDecls :: [SigDecl PName] -> RenameM [SigDecl Name]
renameSigDecls :: [SigDecl PName] -> RenameM [SigDecl Name]
renameSigDecls [SigDecl PName]
ds =
  do ([SigDecl Name]
ds1,Map DepName (Set Name)
deps) <- RenameM [SigDecl Name]
-> RenameM ([SigDecl Name], Map DepName (Set Name))
forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup ((SigDecl PName -> RenameM (SigDecl Name))
-> [SigDecl PName] -> RenameM [SigDecl Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse SigDecl PName -> RenameM (SigDecl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [SigDecl PName]
ds)
     let toNode :: SigDecl Name -> ((SigDecl Name, DepName), DepName, [DepName])
toNode SigDecl Name
d = let nm :: Name
nm = case SigDecl Name
d of
                               SigTySyn TySyn Name
ts Maybe Text
_   -> Located Name -> Name
forall a. Located a -> a
thing (TySyn Name -> Located Name
forall name. TySyn name -> Located name
tsName TySyn Name
ts)
                               SigPropSyn PropSyn Name
ps Maybe Text
_ -> Located Name -> Name
forall a. Located a -> a
thing (PropSyn Name -> Located Name
forall name. PropSyn name -> Located name
psName PropSyn Name
ps)
                        x :: DepName
x = Name -> DepName
NamedThing Name
nm
                    in ((SigDecl Name
d,DepName
x), DepName
x, (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 (SigDecl Name, DepName)]
ordered = [SCC (SigDecl Name, DepName)] -> [SCC (SigDecl Name, DepName)]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([((SigDecl Name, DepName), DepName, [DepName])]
-> [SCC (SigDecl Name, DepName)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ((SigDecl Name -> ((SigDecl Name, DepName), DepName, [DepName]))
-> [SigDecl Name]
-> [((SigDecl Name, DepName), DepName, [DepName])]
forall a b. (a -> b) -> [a] -> [b]
map SigDecl Name -> ((SigDecl Name, DepName), DepName, [DepName])
toNode [SigDecl Name]
ds1))
         fromSCC :: SCC (a, DepName) -> RenameM [a]
fromSCC SCC (a, DepName)
x =
           case SCC (a, DepName)
x of
             AcyclicSCC (a
d,DepName
_) -> [a] -> RenameM [a]
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
d]
             CyclicSCC [(a, DepName)]
ds_xs ->
               do let ([a]
rds,[DepName]
xs) = [(a, DepName)] -> ([a], [DepName])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, DepName)]
ds_xs
                  RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
                  [a] -> RenameM [a]
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
rds

     [[SigDecl Name]] -> [SigDecl Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SigDecl Name]] -> [SigDecl Name])
-> RenameM [[SigDecl Name]] -> RenameM [SigDecl Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SCC (SigDecl Name, DepName) -> RenameM [SigDecl Name])
-> [SCC (SigDecl Name, DepName)] -> RenameM [[SigDecl Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SCC (SigDecl Name, DepName) -> RenameM [SigDecl Name]
forall {a}. SCC (a, DepName) -> RenameM [a]
fromSCC [SCC (SigDecl Name, DepName)]
ordered



validRecursiveD :: Decl name -> Maybe (Bind name)
validRecursiveD :: forall name. Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d =
  case Decl name
d of
    DBind Bind name
b       -> 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
bad) ->
              RenamerError -> RenameM ()
recordError ([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 a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
  ms :: [(Name, ModPath)]
ms = [ (Name
x,OrigName -> ModPath
ogModule OrigName
og)
       | NamedThing Name
x <- [DepName]
xs, GlobalName NameSource
_ OrigName
og <- [ Name -> NameInfo
nameInfo Name
x ]
       ]



{- NOTE: Dependencies on Top Level Constraints
   ===========================================

For the new module system, things using a parameter depend on the parameter
declaration (i.e., `import signature`), which depends on the signature,
so dependencies on constraints in there should be OK.

However, we'd like to have a mechanism for declaring top level constraints in
a functor, that can impose constraints across types from *different*
parameters.  For the moment, we reuse `parameter type constraint C` for this.

Such constraints need to be:
  1. After the signature import
  2. After any type synonyms/newtypes using the parameters
  3. Before any value or type declarations that need to use the parameters.

Note that type declarations used by a constraint cannot use the constraint,
so they need to be well formed without it.

For other types, we use the following rule to determine if they use a
constraint:

  If:
    1. We have a constraint and type declaration
    2. They both mention the same type parameter
    3. There is no explicit dependency of the constraint on the DECL
  Then:
    The type declaration depends on the constraint.

Example:

  type T = 10             // Does not depend on anything so can go first

  signature A where
    type n : #

  import signature A     // Depends on A, so need to be after A

  parameter type constraint n > T
                        // Depends on the import (for @n@) and T

  type Q = [n-T]        // Depends on the top-level constraint
-}



-- This assumes imports have already been processed
renameTopDecls' :: [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' :: [TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds =
  do -- rename and compute what names we depend on
     ([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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse TopDecl PName -> RenameM (TopDecl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TopDecl PName]
ds)

     Map Name DepName
fromParams <- RenameM (Map Name DepName)
getNamesFromModParams
     Map Ident DepName
localParams <- RenameM (Map Ident DepName)
getLocalModParamDeps

     let rawDepsFor :: DepName -> Set Name
rawDepsFor DepName
x = 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

         isTyParam :: Name -> Bool
isTyParam Name
x = Name -> Namespace
nameNamespace Name
x Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Namespace
NSType Bool -> Bool -> Bool
&& Name
x Name -> Map Name DepName -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Name DepName
fromParams


         ([TopDecl Name]
noNameDs,[(TopDecl Name, DepName, [DepName])]
nameDs) = [Either (TopDecl Name) (TopDecl Name, DepName, [DepName])]
-> ([TopDecl Name], [(TopDecl Name, DepName, [DepName])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((TopDecl Name
 -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName]))
-> [TopDecl Name]
-> [Either (TopDecl Name) (TopDecl Name, DepName, [DepName])]
forall a b. (a -> b) -> [a] -> [b]
map TopDecl Name
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName [TopDecl Name]
ds1)
         ctrs :: [DepName]
ctrs = [ DepName
nm | (TopDecl Name
_,nm :: DepName
nm@(ConstratintAt {}),[DepName]
_) <- [(TopDecl Name, DepName, [DepName])]
nameDs ]
         indirect :: Map DepName DepName
indirect = [(DepName, DepName)] -> Map DepName DepName
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (DepName
y,DepName
x)
                                 | (TopDecl Name
_,DepName
x,[DepName]
ys) <- [(TopDecl Name, DepName, [DepName])]
nameDs, DepName
y <- [DepName]
ys ]
         mkDepName :: Name -> DepName
mkDepName Name
x = case Name -> Map Name DepName -> Maybe DepName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x Map Name DepName
fromParams of
                         Just DepName
dn -> DepName
dn
                         Maybe DepName
Nothing -> Name -> DepName
NamedThing Name
x
         depsFor :: DepName -> [DepName]
depsFor DepName
x =
           [ DepName -> DepName -> Map DepName DepName -> DepName
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Name -> DepName
mkDepName Name
y) (Name -> DepName
NamedThing Name
y) Map DepName DepName
indirect
           | Name
y <- 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)
           ]

         {- See [NOTE: Dependencies on Top Level Constraints] -}
         addCtr :: DepName -> DepName -> Maybe DepName
addCtr DepName
nm DepName
ctr =
            case DepName
nm of
              NamedThing Name
x
                | Name -> Namespace
nameNamespace Name
x Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Namespace
NSType
                , let ctrDeps :: Set Name
ctrDeps = DepName -> Set Name
rawDepsFor DepName
ctr
                      tyDeps :: Set Name
tyDeps  = DepName -> Set Name
rawDepsFor DepName
nm
                , Bool -> Bool
not (Name
x Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
ctrDeps)
                , Bool -> Bool
not (Set Name -> Bool
forall a. Set a -> Bool
Set.null (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
                                      ((Name -> Bool) -> Set Name -> Set Name
forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
isTyParam Set Name
ctrDeps)
                                      ((Name -> Bool) -> Set Name -> Set Name
forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
isTyParam Set Name
tyDeps)))
                  -> DepName -> Maybe DepName
forall a. a -> Maybe a
Just DepName
ctr
              DepName
_ -> Maybe DepName
forall a. Maybe a
Nothing

         addCtrs :: (TopDecl name, DepName) -> [DepName]
addCtrs (TopDecl name
d,DepName
x)
          | TopDecl name -> Bool
forall {name}. TopDecl name -> Bool
usesCtrs TopDecl name
d = [DepName]
ctrs
          | Bool
otherwise  = (DepName -> Maybe DepName) -> [DepName] -> [DepName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DepName -> DepName -> Maybe DepName
addCtr DepName
x) [DepName]
ctrs

         addModParams :: TopDecl name -> [DepName]
addModParams TopDecl name
d =
           case TopDecl name
d of
             DModule TopLevel (NestedModule name)
tl | NestedModule ModuleG name name
m <- TopLevel (NestedModule name) -> NestedModule name
forall a. TopLevel a -> a
tlValue TopLevel (NestedModule name)
tl
                        , FunctorInstance Located (ImpName name)
_ ModuleInstanceArgs name
as ModuleInstance name
_ <- ModuleG name name -> ModuleDefinition name
forall mname name. ModuleG mname name -> ModuleDefinition name
mDef ModuleG name name
m ->
               case ModuleInstanceArgs name
as of
                  DefaultInstArg Located (ModuleInstanceArg name)
arg -> Located (ModuleInstanceArg name) -> [DepName]
forall {name}. Located (ModuleInstanceArg name) -> [DepName]
depsOfArg Located (ModuleInstanceArg name)
arg
                  NamedInstArgs [ModuleInstanceNamedArg name]
args -> (ModuleInstanceNamedArg name -> [DepName])
-> [ModuleInstanceNamedArg name] -> [DepName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModuleInstanceNamedArg name -> [DepName]
forall {name}. ModuleInstanceNamedArg name -> [DepName]
depsOfNamedArg [ModuleInstanceNamedArg name]
args
                  DefaultInstAnonArg {} -> []

               where depsOfNamedArg :: ModuleInstanceNamedArg name -> [DepName]
depsOfNamedArg (ModuleInstanceNamedArg Located Ident
_ Located (ModuleInstanceArg name)
a) = Located (ModuleInstanceArg name) -> [DepName]
forall {name}. Located (ModuleInstanceArg name) -> [DepName]
depsOfArg Located (ModuleInstanceArg name)
a
                     depsOfArg :: Located (ModuleInstanceArg name) -> [DepName]
depsOfArg Located (ModuleInstanceArg name)
a = case Located (ModuleInstanceArg name) -> ModuleInstanceArg name
forall a. Located a -> a
thing Located (ModuleInstanceArg name)
a of
                                     ModuleInstanceArg name
AddParams -> []
                                     ModuleArg {} -> []
                                     ParameterArg Ident
p ->
                                       case Ident -> Map Ident DepName -> Maybe DepName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
p Map Ident DepName
localParams of
                                         Just DepName
i -> [DepName
i]
                                         Maybe DepName
Nothing -> []
             TopDecl name
_ -> []

         toNode :: (TopDecl name, DepName, c)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode (TopDecl name
d,DepName
x,c
_) = ((TopDecl name
d,DepName
x),DepName
x, (TopDecl name, DepName) -> [DepName]
forall {name}. (TopDecl name, DepName) -> [DepName]
addCtrs (TopDecl name
d,DepName
x) [DepName] -> [DepName] -> [DepName]
forall a. [a] -> [a] -> [a]
++
                                    TopDecl name -> [DepName]
forall {name}. TopDecl name -> [DepName]
addModParams TopDecl name
d [DepName] -> [DepName] -> [DepName]
forall a. [a] -> [a] -> [a]
++
                                    DepName -> [DepName]
depsFor DepName
x)

         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, [DepName])
 -> ((TopDecl Name, DepName), DepName, [DepName]))
-> [(TopDecl Name, DepName, [DepName])]
-> [((TopDecl Name, DepName), DepName, [DepName])]
forall a b. (a -> b) -> [a] -> [b]
map (TopDecl Name, DepName, [DepName])
-> ((TopDecl Name, DepName), DepName, [DepName])
forall {name} {c}.
(TopDecl name, DepName, c)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode [(TopDecl Name, DepName, [DepName])]
nameDs)
         fromSCC :: SCC (TopDecl name, DepName) -> RenameM [TopDecl name]
fromSCC SCC (TopDecl name, DepName)
x =
            case SCC (TopDecl name, DepName)
x of
              AcyclicSCC (TopDecl name
d,DepName
_) -> [TopDecl name] -> RenameM [TopDecl name]
forall a. a -> RenameM a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
                                   [TopDecl name] -> RenameM [TopDecl name]
forall a. a -> RenameM a
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 a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopLevel (Decl name) -> TopDecl name
forall name. TopLevel (Decl name) -> TopDecl name
Decl 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> RenameM a
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

  -- This indicates if a declaration might depend on the constraints in scope.
  -- Since uses of constraints are not implicitly named, value declarations
  -- are assumed to potentially use the constraints.

  -- XXX: This is inaccurate, and *I think* it amounts to checking that something
  -- is in the value namespace.   Perhaps the rule should be that a value
  -- depends on a parameter constraint if it mentions at least one
  -- type parameter somewhere.

  -- XXX: Besides, types might need constraints for well-formedness...
  -- This is just bogus
  -- Although not that type/prop synonyms may be defined wherever as they
  -- keep the validity constraints they need and emit them at the *use* sites.
  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
      TDEnum {}               -> Bool
False
      DParamDecl {}           -> Bool
False
      DInterfaceConstraint {} -> Bool
False


      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
      DModParam {}            -> Bool
False    -- no definitions here
      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
      DRec {}       -> Bool
True

      DType {}      -> Bool
False
      DProp {}      -> Bool
False

      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, [DepName])
topDeclName :: TopDecl Name
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName TopDecl Name
topDecl =
  case TopDecl Name
topDecl of
    Decl TopLevel (Decl Name)
d                  -> Name -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {a}. Name -> Either a (TopDecl Name, DepName, [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, [DepName])
forall {a}. Name -> Either a (TopDecl Name, DepName, [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
-> [Name]
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {a}.
Name -> [Name] -> Either a (TopDecl Name, DepName, [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)))
                                        [ Newtype Name -> Name
forall name. Newtype name -> name
nConName (TopLevel (Newtype Name) -> Newtype Name
forall a. TopLevel a -> a
tlValue TopLevel (Newtype Name)
d) ]
    TDEnum TopLevel (EnumDecl Name)
d                -> Name
-> [Name]
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {a}.
Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' (Located Name -> Name
forall a. Located a -> a
thing (EnumDecl Name -> Located Name
forall name. EnumDecl name -> Located name
eName (TopLevel (EnumDecl Name) -> EnumDecl Name
forall a. TopLevel a -> a
tlValue TopLevel (EnumDecl Name)
d)))
                                        ((TopLevel (EnumCon Name) -> Name)
-> [TopLevel (EnumCon Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> Name
forall a. Located a -> a
thing (Located Name -> Name)
-> (TopLevel (EnumCon Name) -> Located Name)
-> TopLevel (EnumCon Name)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumCon Name -> Located Name
forall name. EnumCon name -> Located name
ecName (EnumCon Name -> Located Name)
-> (TopLevel (EnumCon Name) -> EnumCon Name)
-> TopLevel (EnumCon Name)
-> Located Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevel (EnumCon Name) -> EnumCon Name
forall a. TopLevel a -> a
tlValue)
                                             (EnumDecl Name -> [TopLevel (EnumCon Name)]
forall name. EnumDecl name -> [TopLevel (EnumCon name)]
eCons (TopLevel (EnumDecl Name) -> EnumDecl Name
forall a. TopLevel a -> a
tlValue TopLevel (EnumDecl Name)
d)))
    DModule TopLevel (NestedModule Name)
d               -> Name -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {a}. Name -> Either a (TopDecl Name, DepName, [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

    DInterfaceConstraint Maybe Text
_ Located [Prop Name]
ds -> DepName -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {b} {a} {a}. b -> Either a (TopDecl Name, b, [a])
special (Range -> DepName
ConstratintAt (Located [Prop Name] -> Range
forall a. Located a -> Range
srcRange Located [Prop Name]
ds))

    DImport {}              -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {b}. Either (TopDecl Name) b
noName

    DModParam ModParam Name
m             -> DepName -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {b} {a} {a}. b -> Either a (TopDecl Name, b, [a])
special (Range -> Ident -> DepName
ModParamName (Located (ImpName Name) -> Range
forall a. Located a -> Range
srcRange (ModParam Name -> Located (ImpName Name)
forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam Name
m))
                                                     (ModParam Name -> Ident
forall name. ModParam name -> Ident
mpName ModParam Name
m))

    Include {}              -> String -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {a}. String -> a
bad String
"Include"
    DParamDecl {}           -> String -> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
forall {a}. String -> a
bad String
"DParamDecl"
  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, [DepName])
hasName Name
n = Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
forall {a}.
Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' Name
n []
  hasName' :: Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' Name
n [Name]
ms = (TopDecl Name, DepName, [DepName])
-> Either a (TopDecl Name, DepName, [DepName])
forall a b. b -> Either a b
Right (TopDecl Name
topDecl, Name -> DepName
NamedThing Name
n, (Name -> DepName) -> [Name] -> [DepName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing [Name]
ms)
  special :: b -> Either a (TopDecl Name, b, [a])
special b
x = (TopDecl Name, b, [a]) -> Either a (TopDecl Name, b, [a])
forall a b. b -> Either a b
Right (TopDecl Name
topDecl, b
x, [])
  bad :: String -> a
bad String
x     = String -> [String] -> a
forall a. HasCallStack => String -> [String] -> a
panic String
"topDeclName" [String
x]




{- | Compute the names introduced by a module parameter.
This should be run in a context containing everything that's in scope
except for the module parameters.  We don't need to compute a fixed point here
because the signatures (and hence module parameters) cannot contain signatures.

The resulting naming environment contains the new names introduced by this
parameter.
-}
doModParam ::
  ModParam PName ->
  RenameM (NamingEnv, RenModParam)
doModParam :: ModParam PName -> RenameM (NamingEnv, RenModParam)
doModParam ModParam PName
mp =
  do let sigName :: Located (ImpName PName)
sigName = ModParam PName -> Located (ImpName PName)
forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp
         loc :: Range
loc     = Located (ImpName PName) -> Range
forall a. Located a -> Range
srcRange Located (ImpName PName)
sigName
     Range
-> RenameM (NamingEnv, RenModParam)
-> RenameM (NamingEnv, RenModParam)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
       do ModPath
me <- RenameM ModPath
getCurMod

          (ImpName Name
sigName',Bool
isFake) <-
             case Located (ImpName PName) -> ImpName PName
forall a. Located a -> a
thing Located (ImpName PName)
sigName of
               ImpTop ModName
t -> (ImpName Name, Bool) -> RenameM (ImpName Name, Bool)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModName -> ImpName Name
forall name. ModName -> ImpName name
ImpTop ModName
t, Bool
False)
                -- XXX: should we record a dependency here?
                -- Not sure what the dependencies are for..

               ImpNested PName
n ->
                 do Maybe Name
mb <- NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
NameUse Namespace
NSModule PName
n
                    (Name
nm,Bool
isFake) <- case Maybe Name
mb of
                                     Just Name
rnm -> (Name, Bool) -> RenameM (Name, Bool)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
rnm,Bool
False)
                                     Maybe Name
Nothing ->
                                       do Name
rnm <- Namespace -> PName -> RenameM Name
reportUnboundName Namespace
NSModule PName
n
                                          (Name, Bool) -> RenameM (Name, Bool)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
rnm,Bool
True)
                    case ModPath -> ModPath -> Maybe (ModPath, [Ident], [Ident])
modPathCommon ModPath
me (Name -> ModPath
nameModPath Name
nm) of
                      Just (ModPath
_,[],[Ident]
_) ->
                        RenamerError -> RenameM ()
recordError
                           ([DepName] -> RenamerError
InvalidDependency [ModPath -> DepName
ModPath ModPath
me, Name -> DepName
NamedThing Name
nm])
                      Maybe (ModPath, [Ident], [Ident])
_ -> () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    (ImpName Name, Bool) -> RenameM (ImpName Name, Bool)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> ImpName Name
forall name. name -> ImpName name
ImpNested Name
nm, Bool
isFake)

          Bool -> RenameM () -> RenameM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFake
            (Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule (Located (ImpName PName) -> Range
forall a. Located a -> Range
srcRange Located (ImpName PName)
sigName) ImpName Name
sigName' ModKind
ASignature)
          NamingEnv
sigEnv <- if Bool
isFake then NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingEnv
forall a. Monoid a => a
mempty else ImpName Name -> RenameM NamingEnv
lookupDefines ImpName Name
sigName'


          {- XXX: It seems a bit odd to use "newModParam" for the names to
             be used for the instantiated type synonyms,
             but what other name could we use? -}
          let newP :: Name -> t m Name
newP Name
x = do Name
y <- m Name -> t m Name
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (ModPath -> Ident -> Range -> Name -> m Name
forall (m :: * -> *).
FreshM m =>
ModPath -> Ident -> Range -> Name -> m Name
newModParam ModPath
me (ModParam PName -> Ident
forall name. ModParam name -> Ident
mpName ModParam PName
mp) Range
loc Name
x)
                          (Map Name Name -> Map Name Name) -> t m ()
forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ (Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
y Name
x)
                          Name -> t m Name
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
y
          (NamingEnv
newEnv',Map Name Name
nameMap) <- Map Name Name
-> StateT (Map Name Name) RenameM NamingEnv
-> RenameM (NamingEnv, Map Name Name)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT Map Name Name
forall k a. Map k a
Map.empty ((Name -> StateT (Map Name Name) RenameM Name)
-> NamingEnv -> StateT (Map Name Name) RenameM NamingEnv
forall (f :: * -> *).
Applicative f =>
(Name -> f Name) -> NamingEnv -> f NamingEnv
travNamingEnv Name -> StateT (Map Name Name) RenameM Name
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadT t, FreshM m, StateM (t m) (Map Name Name)) =>
Name -> t m Name
newP NamingEnv
sigEnv)
          let paramName :: Maybe ModName
paramName = ModParam PName -> Maybe ModName
forall name. ModParam name -> Maybe ModName
mpAs ModParam PName
mp
          let newEnv :: NamingEnv
newEnv = case Maybe ModName
paramName of
                         Maybe ModName
Nothing -> NamingEnv
newEnv'
                         Just ModName
q  -> ModName -> NamingEnv -> NamingEnv
qualify ModName
q NamingEnv
newEnv'
          (NamingEnv, RenModParam) -> RenameM (NamingEnv, RenModParam)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( NamingEnv
newEnv
               , RenModParam
                 { renModParamName :: Ident
renModParamName     = ModParam PName -> Ident
forall name. ModParam name -> Ident
mpName ModParam PName
mp
                 , renModParamRange :: Range
renModParamRange    = Range
loc
                 , renModParamSig :: ImpName Name
renModParamSig      = ImpName Name
sigName'
                 , renModParamInstance :: Map Name Name
renModParamInstance = Map Name Name
nameMap
                 }
               )

{- | Process the parameters of a module.
Should be executed in a context where everything's already in the context,
except the module parameters.
-}
doModParams :: [ModParam PName] -> RenameM (NamingEnv, [RenModParam])
doModParams :: [ModParam PName] -> RenameM (NamingEnv, [RenModParam])
doModParams [ModParam PName]
srcParams =
  do ([NamingEnv]
paramEnvs,[RenModParam]
params) <- [(NamingEnv, RenModParam)] -> ([NamingEnv], [RenModParam])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(NamingEnv, RenModParam)] -> ([NamingEnv], [RenModParam]))
-> RenameM [(NamingEnv, RenModParam)]
-> RenameM ([NamingEnv], [RenModParam])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModParam PName -> RenameM (NamingEnv, RenModParam))
-> [ModParam PName] -> RenameM [(NamingEnv, RenModParam)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ModParam PName -> RenameM (NamingEnv, RenModParam)
doModParam  [ModParam PName]
srcParams

     let repeated :: [[RenModParam]]
repeated = (RenModParam -> RenModParam -> Bool)
-> [RenModParam] -> [[RenModParam]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Ident -> Ident -> Bool)
-> (RenModParam -> Ident) -> RenModParam -> RenModParam -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RenModParam -> Ident
renModParamName)
                  ([RenModParam] -> [[RenModParam]])
-> [RenModParam] -> [[RenModParam]]
forall a b. (a -> b) -> a -> b
$ (RenModParam -> RenModParam -> Ordering)
-> [RenModParam] -> [RenModParam]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Ident -> Ident -> Ordering)
-> (RenModParam -> Ident) -> RenModParam -> RenModParam -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RenModParam -> Ident
renModParamName) [RenModParam]
params

     [[RenModParam]] -> ([RenModParam] -> RenameM ()) -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[RenModParam]]
repeated \[RenModParam]
ps ->
       case [RenModParam]
ps of
         [] -> String -> [String] -> RenameM ()
forall a. HasCallStack => String -> [String] -> a
panic String
"doModParams" [String
"[]"]
         [RenModParam
_]      -> () -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
         (RenModParam
p : [RenModParam]
_) -> RenamerError -> RenameM ()
recordError (Ident -> [Range] -> RenamerError
MultipleModParams (RenModParam -> Ident
renModParamName RenModParam
p)
                                                   ((RenModParam -> Range) -> [RenModParam] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map RenModParam -> Range
renModParamRange [RenModParam]
ps))

     (NamingEnv, [RenModParam]) -> RenameM (NamingEnv, [RenModParam])
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NamingEnv] -> NamingEnv
forall a. Monoid a => [a] -> a
mconcat [NamingEnv]
paramEnvs,[RenModParam]
params)




--------------------------------------------------------------------------------

rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated :: forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated a -> RenameM b
f Located a
loc = 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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return Located a
loc { thing = a' }






instance Rename TopDecl where
  rename :: TopDecl PName -> RenameM (TopDecl Name)
rename TopDecl PName
td =
    case TopDecl PName
td of
      Decl TopLevel (Decl PName)
d            -> 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopLevel a -> f (TopLevel 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopLevel a -> f (TopLevel 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopLevel a -> f (TopLevel b)
traverse Newtype PName -> RenameM (Newtype Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Newtype PName)
n
      TDEnum TopLevel (EnumDecl PName)
n          -> TopLevel (EnumDecl Name) -> TopDecl Name
forall name. TopLevel (EnumDecl name) -> TopDecl name
TDEnum    (TopLevel (EnumDecl Name) -> TopDecl Name)
-> RenameM (TopLevel (EnumDecl Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EnumDecl PName -> RenameM (EnumDecl Name))
-> TopLevel (EnumDecl PName) -> RenameM (TopLevel (EnumDecl Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopLevel a -> f (TopLevel b)
traverse EnumDecl PName -> RenameM (EnumDecl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (EnumDecl PName)
n
      Include Located String
n         -> TopDecl Name -> RenameM (TopDecl Name)
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located String -> TopDecl Name
forall name. Located String -> TopDecl name
Include Located String
n)
      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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TopLevel a -> f (TopLevel b)
traverse NestedModule PName -> RenameM (NestedModule Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename 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
<$> Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
renI Located (ImportG (ImpName PName))
li
      DModParam ModParam PName
mp -> ModParam Name -> TopDecl Name
forall name. ModParam name -> TopDecl name
DModParam (ModParam Name -> TopDecl Name)
-> RenameM (ModParam Name) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModParam PName -> RenameM (ModParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ModParam PName
mp
      DInterfaceConstraint Maybe Text
d Located [Prop PName]
ds ->
        DepName -> RenameM (TopDecl Name) -> RenameM (TopDecl Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Range -> DepName
ConstratintAt (Located [Prop PName] -> Range
forall a. Located a -> Range
srcRange Located [Prop PName]
ds))
        (Maybe Text -> Located [Prop Name] -> TopDecl Name
forall name. Maybe Text -> Located [Prop name] -> TopDecl name
DInterfaceConstraint Maybe Text
d (Located [Prop Name] -> TopDecl Name)
-> RenameM (Located [Prop Name]) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Prop PName] -> RenameM [Prop Name])
-> Located [Prop PName] -> RenameM (Located [Prop Name])
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated ((Prop PName -> RenameM (Prop Name))
-> [Prop PName] -> RenameM [Prop Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Located [Prop PName]
ds)
      DParamDecl {} -> String -> [String] -> RenameM (TopDecl Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [String
"DParamDecl"]



renI :: Located (ImportG (ImpName PName)) ->
        RenameM (Located (ImportG (ImpName Name)))
renI :: Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
renI Located (ImportG (ImpName PName))
li =
  Range
-> RenameM (Located (ImportG (ImpName Name)))
-> RenameM (Located (ImportG (ImpName Name)))
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc (Located (ImportG (ImpName PName)) -> Range
forall a. Located a -> Range
srcRange Located (ImportG (ImpName PName))
li)
  do ImpName Name
m <- ImpName PName -> RenameM (ImpName Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (ImportG (ImpName PName) -> ImpName PName
forall mname. ImportG mname -> mname
iModule ImportG (ImpName PName)
i)
     Bool -> RenameM () -> RenameM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ImpName Name -> Bool
isFakeName ImpName Name
m) (Range -> ImpName Name -> RenameM ()
recordImport (Located (ImportG (ImpName PName)) -> Range
forall a. Located a -> Range
srcRange Located (ImportG (ImpName PName))
li) ImpName Name
m)
     Located (ImportG (ImpName Name))
-> RenameM (Located (ImportG (ImpName Name)))
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located (ImportG (ImpName PName))
li { thing = i { iModule = m } }
  where
  i :: ImportG (ImpName PName)
i = Located (ImportG (ImpName PName)) -> ImportG (ImpName PName)
forall a. Located a -> a
thing Located (ImportG (ImpName PName))
li


instance Rename ModParam where
  rename :: ModParam PName -> RenameM (ModParam Name)
rename ModParam PName
mp =
    do Located (ImpName Name)
x   <- (ImpName PName -> RenameM (ImpName Name))
-> Located (ImpName PName) -> RenameM (Located (ImpName Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated ImpName PName -> RenameM (ImpName Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (ModParam PName -> Located (ImpName PName)
forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp)
       DepName -> RenameM (ModParam Name) -> RenameM (ModParam Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Range -> Ident -> DepName
ModParamName (Located (ImpName PName) -> Range
forall a. Located a -> Range
srcRange (ModParam PName -> Located (ImpName PName)
forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp)) (ModParam PName -> Ident
forall name. ModParam name -> Ident
mpName ModParam PName
mp))
         do Map Name Name
ren <- RenModParam -> Map Name Name
renModParamInstance (RenModParam -> Map Name Name)
-> RenameM RenModParam -> RenameM (Map Name Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> RenameM RenModParam
getModParam (ModParam PName -> Ident
forall name. ModParam name -> Ident
mpName ModParam PName
mp)

            {- Here we add 2 "uses" to all type-level names introduced,
               so that we don't get unused warnings for type parameters.
             -}
            (Name -> RenameM ()) -> [Name] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse [ Name
s | Name
t <- Map Name Name -> [Name]
forall k a. Map k a -> [k]
Map.keys Map Name Name
ren, Name -> Namespace
nameNamespace Name
t Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Namespace
NSType
                                , Name
s <- [Name
t,Name
t] ]

            ModParam Name -> RenameM (ModParam Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModParam PName
mp { mpSignature = x, mpRenaming = ren }


renameIfaceModule :: ImpName Name -> Signature PName -> RenameM (Signature Name)
renameIfaceModule :: ImpName Name -> Signature PName -> RenameM (Signature Name)
renameIfaceModule ImpName Name
nm Signature PName
sig =
  do NamingEnv
env <- ResolvedLocal -> NamingEnv
forall imps. ResolvedModule imps -> NamingEnv
rmodDefines (ResolvedLocal -> NamingEnv)
-> RenameM ResolvedLocal -> RenameM NamingEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved ImpName Name
nm
     let depName :: DepName
depName = case ImpName Name
nm of
                     ImpNested Name
n -> Name -> DepName
NamedThing Name
n
                     ImpTop ModName
t    -> ModPath -> DepName
ModPath (ModName -> ModPath
TopModule ModName
t)
     EnvCheck
-> NamingEnv
-> RenameM (Signature Name)
-> RenameM (Signature Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap NamingEnv
env (RenameM (Signature Name) -> RenameM (Signature Name))
-> RenameM (Signature Name) -> RenameM (Signature Name)
forall a b. (a -> b) -> a -> b
$
        DepName -> RenameM (Signature Name) -> RenameM (Signature Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf DepName
depName
        do [Located (ImportG (ImpName Name))]
imps <- (Located (ImportG (ImpName PName))
 -> RenameM (Located (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Located (ImportG (ImpName PName))
-> RenameM (Located (ImportG (ImpName Name)))
renI (Signature PName -> [Located (ImportG (ImpName PName))]
forall name. Signature name -> [Located (ImportG (ImpName name))]
sigImports Signature PName
sig)
           [ParameterType Name]
tps <- (ParameterType PName -> RenameM (ParameterType Name))
-> [ParameterType PName] -> RenameM [ParameterType Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ParameterType PName -> RenameM (ParameterType Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Signature PName -> [ParameterType PName]
forall name. Signature name -> [ParameterType name]
sigTypeParams Signature PName
sig)

           [SigDecl Name]
ds  <- [SigDecl PName] -> RenameM [SigDecl Name]
renameSigDecls (Signature PName -> [SigDecl PName]
forall name. Signature name -> [SigDecl name]
sigDecls Signature PName
sig)
           [Located (Prop Name)]
cts <- (Located (Prop PName) -> RenameM (Located (Prop Name)))
-> [Located (Prop PName)] -> RenameM [Located (Prop Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Prop PName -> RenameM (Prop Name))
-> Located (Prop PName) -> RenameM (Located (Prop Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (Signature PName -> [Located (Prop PName)]
forall name. Signature name -> [Located (Prop name)]
sigConstraints Signature PName
sig)
           [ParameterFun Name]
fun <- (ParameterFun PName -> RenameM (ParameterFun Name))
-> [ParameterFun PName] -> RenameM [ParameterFun Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ParameterFun PName -> RenameM (ParameterFun Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Signature PName -> [ParameterFun PName]
forall name. Signature name -> [ParameterFun name]
sigFunParams Signature PName
sig)

           -- we record a use here to avoid getting a warning in interfaces
           -- that declare only types, and so appear "unused".
           [ParameterType Name]
-> (ParameterType Name -> RenameM ()) -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ParameterType Name]
tps \ParameterType Name
tp -> Name -> RenameM ()
recordUse (Located Name -> Name
forall a. Located a -> a
thing (ParameterType Name -> Located Name
forall name. ParameterType name -> Located name
ptName ParameterType Name
tp))
           [SigDecl Name] -> (SigDecl Name -> RenameM ()) -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SigDecl Name]
ds  \SigDecl Name
d  -> Name -> RenameM ()
recordUse (Name -> RenameM ()) -> Name -> RenameM ()
forall a b. (a -> b) -> a -> b
$ case SigDecl Name
d of
                                          SigTySyn TySyn Name
ts Maybe Text
_ -> Located Name -> Name
forall a. Located a -> a
thing (TySyn Name -> Located Name
forall name. TySyn name -> Located name
tsName TySyn Name
ts)
                                          SigPropSyn PropSyn Name
ps Maybe Text
_ -> Located Name -> Name
forall a. Located a -> a
thing (PropSyn Name -> Located Name
forall name. PropSyn name -> Located name
psName PropSyn Name
ps)

           Signature Name -> RenameM (Signature Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature
                  { sigImports :: [Located (ImportG (ImpName Name))]
sigImports      = [Located (ImportG (ImpName Name))]
imps
                  , sigTypeParams :: [ParameterType Name]
sigTypeParams   = [ParameterType Name]
tps
                  , sigDecls :: [SigDecl Name]
sigDecls        = [SigDecl Name]
ds
                  , sigConstraints :: [Located (Prop Name)]
sigConstraints  = [Located (Prop Name)]
cts
                  , sigFunParams :: [ParameterFun Name]
sigFunParams    = [ParameterFun Name]
fun
                  }

instance Rename ImpName where
  rename :: ImpName PName -> RenameM (ImpName Name)
rename ImpName PName
i =
    case ImpName PName
i of
      ImpTop ModName
m -> ImpName Name -> RenameM (ImpName Name)
forall a. a -> RenameM a
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 ModuleInstanceArgs where
  rename :: ModuleInstanceArgs PName -> RenameM (ModuleInstanceArgs Name)
rename ModuleInstanceArgs PName
args =
    case ModuleInstanceArgs PName
args of
      DefaultInstArg Located (ModuleInstanceArg PName)
a -> Located (ModuleInstanceArg Name) -> ModuleInstanceArgs Name
forall name.
Located (ModuleInstanceArg name) -> ModuleInstanceArgs name
DefaultInstArg (Located (ModuleInstanceArg Name) -> ModuleInstanceArgs Name)
-> RenameM (Located (ModuleInstanceArg Name))
-> RenameM (ModuleInstanceArgs Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleInstanceArg PName -> RenameM (ModuleInstanceArg Name))
-> Located (ModuleInstanceArg PName)
-> RenameM (Located (ModuleInstanceArg Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated ModuleInstanceArg PName -> RenameM (ModuleInstanceArg Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ModuleInstanceArg PName)
a
      NamedInstArgs [ModuleInstanceNamedArg PName]
xs -> [ModuleInstanceNamedArg Name] -> ModuleInstanceArgs Name
forall name.
[ModuleInstanceNamedArg name] -> ModuleInstanceArgs name
NamedInstArgs  ([ModuleInstanceNamedArg Name] -> ModuleInstanceArgs Name)
-> RenameM [ModuleInstanceNamedArg Name]
-> RenameM (ModuleInstanceArgs Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleInstanceNamedArg PName
 -> RenameM (ModuleInstanceNamedArg Name))
-> [ModuleInstanceNamedArg PName]
-> RenameM [ModuleInstanceNamedArg Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ModuleInstanceNamedArg PName
-> RenameM (ModuleInstanceNamedArg Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [ModuleInstanceNamedArg PName]
xs
      DefaultInstAnonArg {} -> String -> [String] -> RenameM (ModuleInstanceArgs Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [String
"DefaultInstAnonArg"]

instance Rename ModuleInstanceNamedArg where
  rename :: ModuleInstanceNamedArg PName
-> RenameM (ModuleInstanceNamedArg Name)
rename (ModuleInstanceNamedArg Located Ident
x Located (ModuleInstanceArg PName)
m) =
    Located Ident
-> Located (ModuleInstanceArg Name) -> ModuleInstanceNamedArg Name
forall name.
Located Ident
-> Located (ModuleInstanceArg name) -> ModuleInstanceNamedArg name
ModuleInstanceNamedArg Located Ident
x (Located (ModuleInstanceArg Name) -> ModuleInstanceNamedArg Name)
-> RenameM (Located (ModuleInstanceArg Name))
-> RenameM (ModuleInstanceNamedArg Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleInstanceArg PName -> RenameM (ModuleInstanceArg Name))
-> Located (ModuleInstanceArg PName)
-> RenameM (Located (ModuleInstanceArg Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated ModuleInstanceArg PName -> RenameM (ModuleInstanceArg Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ModuleInstanceArg PName)
m

instance Rename ModuleInstanceArg where
  rename :: ModuleInstanceArg PName -> RenameM (ModuleInstanceArg Name)
rename ModuleInstanceArg PName
arg =
    case ModuleInstanceArg PName
arg of
      ModuleArg ImpName PName
m -> ImpName Name -> ModuleInstanceArg Name
forall name. ImpName name -> ModuleInstanceArg name
ModuleArg (ImpName Name -> ModuleInstanceArg Name)
-> RenameM (ImpName Name) -> RenameM (ModuleInstanceArg Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName PName -> RenameM (ImpName Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ImpName PName
m
      ParameterArg Ident
a -> ModuleInstanceArg Name -> RenameM (ModuleInstanceArg Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ident -> ModuleInstanceArg Name
forall name. Ident -> ModuleInstanceArg name
ParameterArg Ident
a)
      ModuleInstanceArg PName
AddParams -> ModuleInstanceArg Name -> RenameM (ModuleInstanceArg Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleInstanceArg Name
forall name. ModuleInstanceArg name
AddParams

instance Rename NestedModule where
  rename :: NestedModule PName -> RenameM (NestedModule Name)
rename (NestedModule ModuleG PName PName
m) =
    do let lnm :: Located PName
lnm            = 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
       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 m' :: ModuleG (ImpName PName) PName
m' = ModuleG PName PName
m { mName = ImpNested <$> mName m }
            ModuleG (ImpName PName) Name
m1 <- ImpName Name
-> ModuleG (ImpName PName) PName
-> RenameM (ModuleG (ImpName PName) Name)
forall mname.
ImpName Name -> ModuleG mname PName -> RenameM (ModuleG mname Name)
renameModule' (Name -> ImpName Name
forall name. name -> ImpName name
ImpNested Name
n) ModuleG (ImpName PName) PName
m'
            NestedModule Name -> RenameM (NestedModule Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleG Name Name -> NestedModule Name
forall name. ModuleG name name -> NestedModule name
NestedModule ModuleG (ImpName PName) Name
m1 { mName = lnm { thing = n } })


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 a. a -> RenameM a
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 incorrect 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 a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType PName
pt { primTCts = cts, primTName = 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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterType PName
a { ptName = 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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterFun PName
a { pfName = n', pfSchema = snd sig' }

instance Rename SigDecl where
  rename :: SigDecl PName -> RenameM (SigDecl Name)
rename SigDecl PName
decl =
    case SigDecl PName
decl of
      SigTySyn TySyn PName
ts Maybe Text
mb   -> TySyn Name -> Maybe Text -> SigDecl Name
forall name. TySyn name -> Maybe Text -> SigDecl name
SigTySyn      (TySyn Name -> Maybe Text -> SigDecl Name)
-> RenameM (TySyn Name) -> RenameM (Maybe Text -> SigDecl 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
ts RenameM (Maybe Text -> SigDecl Name)
-> RenameM (Maybe Text) -> RenameM (SigDecl Name)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> RenameM (Maybe Text)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mb
      SigPropSyn PropSyn PName
ps Maybe Text
mb -> PropSyn Name -> Maybe Text -> SigDecl Name
forall name. PropSyn name -> Maybe Text -> SigDecl name
SigPropSyn    (PropSyn Name -> Maybe Text -> SigDecl Name)
-> RenameM (PropSyn Name) -> RenameM (Maybe Text -> SigDecl 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
ps RenameM (Maybe Text -> SigDecl Name)
-> RenameM (Maybe Text) -> RenameM (SigDecl Name)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> RenameM (Maybe Text)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mb

instance Rename Decl where
  rename :: Decl PName -> RenameM (Decl Name)
rename Decl PName
d      = case Decl PName
d of
    DBind Bind PName
b           -> 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall a. a -> RenameM a
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
"rename" [ 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
nameT <- (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)
       Name
nameC <- NameType -> PName -> RenameM Name
renameCon NameType
NameBind (Newtype PName -> PName
forall name. Newtype name -> name
nConName Newtype PName
n)

       DepName -> RenameM () -> RenameM ()
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing Name
nameC) (Name -> RenameM ()
addDep (Located Name -> Name
forall a. Located a -> a
thing Located Name
nameT))

       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
nameT)) (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordMap Ident a -> f (RecordMap Ident 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Range, a) -> f (Range, 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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return Newtype { nName :: Located Name
nName   = Located Name
nameT
                           , nConName :: Name
nConName = Name
nameC
                           , nParams :: [TParam Name]
nParams = [TParam Name]
ps'
                           , nBody :: RecordMap Ident (Range, Type Name)
nBody   = RecordMap Ident (Range, Type Name)
body' }

instance Rename EnumDecl where
  rename :: EnumDecl PName -> RenameM (EnumDecl Name)
rename EnumDecl PName
n =
    [TParam PName]
-> RenameM (EnumDecl Name) -> RenameM (EnumDecl Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (EnumDecl PName -> [TParam PName]
forall name. EnumDecl name -> [TParam name]
eParams EnumDecl PName
n) (RenameM (EnumDecl Name) -> RenameM (EnumDecl Name))
-> RenameM (EnumDecl Name) -> RenameM (EnumDecl Name)
forall a b. (a -> b) -> a -> b
$
    do Located Name
nameT  <- (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) (EnumDecl PName -> Located PName
forall name. EnumDecl name -> Located name
eName EnumDecl PName
n)
       [(Located Name, TopLevel (EnumCon PName))]
nameCs <- [TopLevel (EnumCon PName)]
-> (TopLevel (EnumCon PName)
    -> RenameM (Located Name, TopLevel (EnumCon PName)))
-> RenameM [(Located Name, TopLevel (EnumCon PName))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (EnumDecl PName -> [TopLevel (EnumCon PName)]
forall name. EnumDecl name -> [TopLevel (EnumCon name)]
eCons EnumDecl PName
n) \TopLevel (EnumCon PName)
tlEc ->
                   do let con :: EnumCon PName
con = TopLevel (EnumCon PName) -> EnumCon PName
forall a. TopLevel a -> a
tlValue TopLevel (EnumCon PName)
tlEc
                      Located Name
nameC <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameCon NameType
NameBind) (EnumCon PName -> Located PName
forall name. EnumCon name -> Located name
ecName EnumCon PName
con)
                      DepName -> RenameM () -> RenameM ()
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
nameC)) (Name -> RenameM ()
addDep (Located Name -> Name
forall a. Located a -> a
thing Located Name
nameT))
                      (Located Name, TopLevel (EnumCon PName))
-> RenameM (Located Name, TopLevel (EnumCon PName))
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Located Name
nameC,TopLevel (EnumCon PName)
tlEc)
       DepName -> RenameM (EnumDecl Name) -> RenameM (EnumDecl Name)
forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (Located Name -> Name
forall a. Located a -> a
thing Located Name
nameT)) (RenameM (EnumDecl Name) -> RenameM (EnumDecl Name))
-> RenameM (EnumDecl Name) -> RenameM (EnumDecl 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (EnumDecl PName -> [TParam PName]
forall name. EnumDecl name -> [TParam name]
eParams EnumDecl PName
n)
            [TopLevel (EnumCon Name)]
cons <- [(Located Name, TopLevel (EnumCon PName))]
-> ((Located Name, TopLevel (EnumCon PName))
    -> RenameM (TopLevel (EnumCon Name)))
-> RenameM [TopLevel (EnumCon Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Located Name, TopLevel (EnumCon PName))]
nameCs \(Located Name
c,TopLevel (EnumCon PName)
tlEc) ->
                     do [Type Name]
ts' <- (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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (EnumCon PName -> [Type PName]
forall name. EnumCon name -> [Type name]
ecFields (TopLevel (EnumCon PName) -> EnumCon PName
forall a. TopLevel a -> a
tlValue TopLevel (EnumCon PName)
tlEc))
                        let con :: EnumCon Name
con = EnumCon { ecName :: Located Name
ecName = Located Name
c, ecFields :: [Type Name]
ecFields = [Type Name]
ts' }
                        TopLevel (EnumCon Name) -> RenameM (TopLevel (EnumCon Name))
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TopLevel (EnumCon PName)
tlEc { tlValue = con }
            EnumDecl Name -> RenameM (EnumDecl Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EnumDecl { eName :: Located Name
eName = Located Name
nameT
                          , eParams :: [TParam Name]
eParams = [TParam Name]
ps'
                          , eCons :: [TopLevel (EnumCon Name)]
eCons = [TopLevel (EnumCon Name)]
cons
                          }

-- | Try to resolve a name.
-- SPECIAL CASE: if we have a NameUse for NSValue, we also look in NSConstructor
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 Names
lkpIn Namespace
here = PName -> Map PName Names -> Maybe Names
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
         use :: Name -> RenameM ()
use = case Namespace
expected of
                 Namespace
NSType -> Name -> RenameM ()
recordUse
                 Namespace
_      -> RenameM () -> Name -> RenameM ()
forall a b. a -> b -> a
const (() -> RenameM ()
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
         checkCon :: Maybe Names
checkCon = case (NameType
nt,Namespace
expected) of
                      (NameType
NameUse, Namespace
NSValue) -> Namespace -> Maybe Names
lkpIn Namespace
NSConstructor
                      (NameType, Namespace)
_ -> Maybe Names
forall a. Maybe a
Nothing
         found :: Maybe Names
found = case (Namespace -> Maybe Names
lkpIn Namespace
expected, Maybe Names
checkCon) of
                   (Just Names
a, Just Names
b) -> Names -> Maybe Names
forall a. a -> Maybe a
Just (Names
a Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Names
b)
                   (Maybe Names
Nothing, Maybe Names
y)     -> Maybe Names
y
                   (Maybe Names
x, Maybe Names
Nothing)     -> Maybe Names
x
     case Maybe Names
found of
       Just Names
xs ->
         case Names
xs of
          One Name
n ->
            do case NameType
nt of
                 NameType
NameBind -> () -> RenameM ()
forall a. a -> RenameM a
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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n)
          Ambig Set Name
symSet ->
            do let syms :: [Name]
syms = Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
symSet
               (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 ()
recordError (Located PName -> [Name] -> RenamerError
MultipleSyms Located PName
n [Name]
syms)
               Maybe Name -> RenameM (Maybe Name)
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just ([Name] -> Name
forall a. HasCallStack => [a] -> a
head [Name]
syms))

       Maybe Names
Nothing -> Maybe Name -> RenameM (Maybe Name)
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Name
forall a. Maybe a
Nothing

reportUnboundName :: Namespace -> PName -> RenameM Name
reportUnboundName :: Namespace -> PName -> RenameM Name
reportUnboundName 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 Names
lkpIn Namespace
here = PName -> Map PName Names -> Maybe Names
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
         others :: [Namespace]
others     = [ Namespace
ns | Namespace
ns <- [Namespace]
allNamespaces
                           , Namespace
ns Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
/= Namespace
expected
                           , Just Names
_ <- [Namespace -> Maybe Names
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 ()
recordError (Namespace -> Namespace -> Located PName -> RenamerError
WrongNamespace Namespace
expected Namespace
actual Located PName
nm)

       -- the value is just missing
       [] -> RenamerError -> RenameM ()
recordError (Namespace -> Located PName -> RenamerError
UnboundName Namespace
expected Located PName
nm)

     Namespace -> PName -> RenameM Name
mkFakeName Namespace
expected PName
qn

isFakeName :: ImpName Name -> Bool
isFakeName :: ImpName Name -> Bool
isFakeName ImpName Name
m =
  case ImpName Name
m of
    ImpTop ModName
x -> ModName
x ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
undefinedModName
    ImpNested Name
x ->
      case Name -> Maybe ModName
nameTopModuleMaybe Name
x of
        Just ModName
y  -> ModName
y ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
undefinedModName
        Maybe ModName
Nothing -> Bool
False


-- | 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 a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
       Maybe Name
Nothing -> Namespace -> PName -> RenameM Name
reportUnboundName Namespace
expected PName
qn


renameVar :: NameType -> PName -> RenameM Name
renameVar :: NameType -> PName -> RenameM Name
renameVar NameType
nt = NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
nt Namespace
NSValue

renameCon :: NameType -> PName -> RenameM Name
renameCon :: NameType -> PName -> RenameM Name
renameCon NameType
nt = NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
nt Namespace
NSConstructor

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 a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace
-> ModPath
-> NameSource
-> Ident
-> Maybe Fixity
-> Range
-> Supply
-> (Name, Supply)
mkDeclared Namespace
ns (ModName -> ModPath
TopModule ModName
undefinedModName)
                               NameSource
SystemName (PName -> Ident
getIdent PName
pn) Maybe Fixity
forall a. Maybe a
Nothing (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 a b. (a -> b) -> RenameM a -> RenameM b
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 a. a -> RenameM a
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 :: forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
as [Prop PName]
ps [TParam Name] -> [Prop Name] -> RenameM a
k =
  do NamingEnv
env <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall a. (Supply -> (a, Supply)) -> RenameM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a. a -> RenameM 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
tpName :: forall n. TParam n -> n
tpName :: PName
tpKind :: Maybe Kind
tpRange :: Maybe Range
tpKind :: forall n. TParam n -> Maybe Kind
tpRange :: forall n. TParam n -> Maybe Range
.. } =
    do Name
n <- NameType -> PName -> RenameM Name
renameType NameType
NameBind PName
tpName
       TParam Name -> RenameM (TParam Name)
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return TParam { tpName :: Name
tpName = Name
n, Maybe Range
Maybe Kind
tpKind :: Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpRange :: Maybe Range
.. }

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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a. a -> RenameM a
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 a. a -> RenameM a
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 a. a -> RenameM a
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named a -> f (Named 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordMap Ident a -> f (RecordMap Ident 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Range, a) -> f (Range, 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a. a -> RenameM a
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r)
      TParens Type PName
t' Maybe Kind
k   -> (Type Name -> Maybe Kind -> Type Name
forall n. Type n -> Maybe Kind -> Type n
`TParens` Maybe Kind
k) (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 a. a -> RenameM a
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 a. a -> RenameM a
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 ()
recordError (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
                  Type Name -> RenameM (Type Name)
forall a. a -> RenameM a
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 a. a -> RenameM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bind PName
b { bName      = n'
                          , bParams    = pats'
                          , bDef       = e'
                          , bSignature = snd `fmap` mbSig
                          , bPragmas   = bPragmas b
                          }

instance Rename BindDef where
  rename :: BindDef PName -> RenameM (BindDef Name)
rename BindDef PName
DPrim        = BindDef Name -> RenameM (BindDef Name)
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return BindDef Name
forall name. BindDef name
DPrim
  rename (DForeign Maybe (BindImpl PName)
i) = Maybe (BindImpl Name) -> BindDef Name
forall name. Maybe (BindImpl name) -> BindDef name
DForeign (Maybe (BindImpl Name) -> BindDef Name)
-> RenameM (Maybe (BindImpl Name)) -> RenameM (BindDef Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BindImpl PName -> RenameM (BindImpl Name))
-> Maybe (BindImpl PName) -> RenameM (Maybe (BindImpl Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse BindImpl PName -> RenameM (BindImpl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (BindImpl PName)
i
  rename (DImpl BindImpl PName
i)    = BindImpl Name -> BindDef Name
forall name. BindImpl name -> BindDef name
DImpl (BindImpl Name -> BindDef Name)
-> RenameM (BindImpl Name) -> RenameM (BindDef Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BindImpl PName -> RenameM (BindImpl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename BindImpl PName
i

instance Rename BindImpl where
  rename :: BindImpl PName -> RenameM (BindImpl Name)
rename (DExpr Expr PName
e) = Expr Name -> BindImpl Name
forall name. Expr name -> BindImpl name
DExpr (Expr Name -> BindImpl Name)
-> RenameM (Expr Name) -> RenameM (BindImpl 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
  rename (DPropGuards [PropGuardCase PName]
cases) = [PropGuardCase Name] -> BindImpl Name
forall name. [PropGuardCase name] -> BindImpl name
DPropGuards ([PropGuardCase Name] -> BindImpl Name)
-> RenameM [PropGuardCase Name] -> RenameM (BindImpl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PropGuardCase PName -> RenameM (PropGuardCase Name))
-> [PropGuardCase PName] -> RenameM [PropGuardCase Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse PropGuardCase PName -> RenameM (PropGuardCase Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [PropGuardCase PName]
cases

instance Rename PropGuardCase where
  rename :: PropGuardCase PName -> RenameM (PropGuardCase Name)
rename PropGuardCase PName
g = [Located (Prop Name)] -> Expr Name -> PropGuardCase Name
forall name.
[Located (Prop name)] -> Expr name -> PropGuardCase name
PropGuardCase ([Located (Prop Name)] -> Expr Name -> PropGuardCase Name)
-> RenameM [Located (Prop Name)]
-> RenameM (Expr Name -> PropGuardCase 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 :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Prop PName -> RenameM (Prop Name))
-> Located (Prop PName) -> RenameM (Located (Prop Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (PropGuardCase PName -> [Located (Prop PName)]
forall name. PropGuardCase name -> [Located (Prop name)]
pgcProps PropGuardCase PName
g)
                           RenameM (Expr Name -> PropGuardCase Name)
-> RenameM (Expr Name) -> RenameM (PropGuardCase Name)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 (PropGuardCase PName -> Expr PName
forall name. PropGuardCase name -> Expr name
pgcExpr PropGuardCase PName
g)

instance Rename Pattern where
  rename :: Pattern PName -> RenameM (Pattern Name)
rename Pattern PName
p      = case Pattern PName
p of
    PVar Located PName
lv         -> 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
    PCon Located PName
c [Pattern PName]
ps       -> Located Name -> [Pattern Name] -> Pattern Name
forall n. Located n -> [Pattern n] -> Pattern n
PCon (Located Name -> [Pattern Name] -> Pattern Name)
-> RenameM (Located Name)
-> RenameM ([Pattern Name] -> 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
renameCon NameType
NameUse)  Located PName
c
                            RenameM ([Pattern Name] -> Pattern Name)
-> RenameM [Pattern Name] -> RenameM (Pattern Name)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
ps
    Pattern PName
PWild           -> Pattern Name -> RenameM (Pattern Name)
forall a. a -> RenameM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordMap Ident a -> f (RecordMap Ident 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Range, a) -> f (Range, 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall a. a -> RenameM a
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. HasCallStack => [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (NameType -> PName -> RenameM Name
renameVar NameType
NameBind)  Maybe PName
nm
       FunDesc Name -> RenameM (FunDesc Name)
forall a. a -> RenameM a
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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> Expr Name
forall n. Literal -> Expr n
ELit Literal
l)
    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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordMap Ident a -> f (RecordMap Ident 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Range, a) -> f (Range, 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> RenameM Selector
forall a. a -> RenameM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Match Name]] -> RenameM [[Match Name]]
forall a. a -> RenameM a
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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
    ECase Expr PName
e [CaseAlt PName]
as      -> Expr Name -> [CaseAlt Name] -> Expr Name
forall n. Expr n -> [CaseAlt n] -> Expr n
ECase   (Expr Name -> [CaseAlt Name] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([CaseAlt 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 ([CaseAlt Name] -> Expr Name)
-> RenameM [CaseAlt Name] -> RenameM (Expr Name)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CaseAlt PName -> RenameM (CaseAlt Name))
-> [CaseAlt PName] -> RenameM [CaseAlt Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CaseAlt PName -> RenameM (CaseAlt Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [CaseAlt PName]
as
    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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall a. a -> RenameM a
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'
    EPrefix PrefixOp
op Expr PName
e    -> PrefixOp -> Expr Name -> Expr Name
forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
op (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


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 ()
recordError (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 a. a -> RenameM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       [[Located Selector]] -> RenameM [[Located Selector]]
forall a. a -> RenameM a
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. HasCallStack => [a] -> a
head [Located b]
xs) { thing = map thing 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 a. a -> RenameM a
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 a. a -> RenameM a
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 ()
recordError (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
                   Expr Name -> RenameM (Expr Name)
forall a. a -> RenameM a
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 e :: Expr Name
e@(EPrefix PrefixOp
o1 Expr Name
x) op :: (Located Name, Fixity)
op@(Located Name
o2, Fixity
f2) Expr Name
y =
  case Fixity -> Fixity -> FixityCmp
compareFixity (PrefixOp -> Fixity
prefixFixity PrefixOp
o1) Fixity
f2 of
    FixityCmp
FCRight -> do
      let warning :: RenamerWarning
warning = PrefixOp
-> Expr Name
-> Located Name
-> Fixity
-> Expr Name
-> RenamerWarning
PrefixAssocChanged PrefixOp
o1 Expr Name
x Located Name
o2 Fixity
f2 Expr Name
y
      ReaderT RO (StateT RW Lift) () -> RenameM ()
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (ReaderT RO (StateT RW Lift) () -> RenameM ())
-> ReaderT RO (StateT RW Lift) () -> RenameM ()
forall a b. (a -> b) -> a -> b
$ (RW -> RW) -> ReaderT RO (StateT RW Lift) ()
forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ (\RW
rw -> RW
rw {rwWarnings = warning : rwWarnings rw})
      Expr Name
r <- Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
x (Located Name, Fixity)
op Expr Name
y
      Expr Name -> RenameM (Expr Name)
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrefixOp -> Expr Name -> Expr Name
forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
o1 Expr Name
r)

    -- Even if the fixities conflict, we make the prefix operator take
    -- precedence.
    FixityCmp
_ -> Expr Name -> RenameM (Expr Name)
forall a. a -> RenameM a
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
y)

-- Note that for prefix operator on RHS of infix operator we make the prefix
-- operator always have precedence, so we allow a * -b instead of requiring
-- a * (-b).

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 a. a -> RenameM a
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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing = 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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing = 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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
fixity
    Maybe Fixity
Nothing     -> Fixity -> RenameM Fixity
forall a. a -> RenameM a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named a -> f (Named 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 a. a -> RenameM a
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 a. a -> RenameM a
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 a. a -> RenameM a
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 a. (Supply -> (a, Supply)) -> RenameM a
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 a. a -> RenameM a
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 a. a -> RenameM a
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 a. a -> RenameM a
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 a. a -> RenameM a
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 :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
srcRange :: Range
thing :: PName
.. }) =
    do Name
n <- (Supply -> (Name, Supply)) -> RenameM Name
forall a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSValue (PName -> Ident
getIdent PName
thing) Range
srcRange)
       -- XXX: for deps, we should record a use
       NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSValue PName
thing Name
n)
  go (PCon Located PName
_ [Pattern PName]
ps)      = [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
  go Pattern PName
PWild            = NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
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 a b. (a -> b) -> [a] -> [b]
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 m a. Monoid m => (a -> m) -> [a] -> m
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 a. a -> RenameM a
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 a. a -> RenameM a
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 a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  typeEnv TNum{}     = NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  typeEnv TChar{}    = NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
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 a. [a] -> 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 a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
                NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType 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 ()
recordError (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 a. (Supply -> (a, Supply)) -> RenameM a
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
                NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType 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 a. a -> RenameM a
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 Maybe Kind
_)    = Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
  typeEnv (TInfix Type PName
a Located PName
_ Fixity
_ Type PName
b)  = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]

  bindTypes :: [Type PName] -> RenameM NamingEnv
bindTypes [] = NamingEnv -> RenameM NamingEnv
forall a. a -> RenameM a
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 a. a -> RenameM a
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 CaseAlt where
  rename :: CaseAlt PName -> RenameM (CaseAlt Name)
rename (CaseAlt Pattern PName
p Expr PName
e) = Pattern PName -> RenameM (CaseAlt Name) -> RenameM (CaseAlt Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames Pattern PName
p (Pattern Name -> Expr Name -> CaseAlt Name
forall n. Pattern n -> Expr n -> CaseAlt n
CaseAlt (Pattern Name -> Expr Name -> CaseAlt Name)
-> RenameM (Pattern Name) -> RenameM (Expr Name -> CaseAlt 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 -> CaseAlt Name)
-> RenameM (Expr Name) -> RenameM (CaseAlt Name)
forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)

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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a. a -> RenameM a
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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 a. a -> RenameM a
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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. RenameM (a -> b) -> RenameM a -> RenameM b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
cs

--------------------------------------------------------------------------------

instance PP RenamedModule where
  ppPrec :: Int -> RenamedModule -> Doc
ppPrec Int
_ RenamedModule
rn = (PPCfg -> PPCfg) -> Doc -> Doc
updPPCfg (\PPCfg
cfg -> PPCfg
cfg { ppcfgShowNameUniques = True }) Doc
doc
    where
    doc :: Doc
doc =
      [Doc] -> Doc
vcat [ Doc
"// --- Defines -----------------------------"
           , NamingEnv -> Doc
forall a. PP a => a -> Doc
pp (RenamedModule -> NamingEnv
rmDefines RenamedModule
rn)
           , Doc
"// -- Module -------------------------------"
           , Module Name -> Doc
forall a. PP a => a -> Doc
pp (RenamedModule -> Module Name
rmModule RenamedModule
rn)
           , Doc
"// -----------------------------------------"
           ]