-- |
-- 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 -> NamingEnv
rmInScope  :: NamingEnv       -- ^ What's in scope in this module
  , 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 :: ModuleDefinition PName
mDef =
                    case forall mname name. ModuleG mname name -> ModuleDefinition name
mDef Module PName
m0 of
                      NormalModule [TopDecl PName]
ds ->
                        forall name. [TopDecl name] -> ModuleDefinition name
NormalModule ([TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports [TopDecl PName]
ds)
                      FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
i -> forall name.
Located (ImpName name)
-> ModuleInstanceArgs name
-> ModuleInstance name
-> ModuleDefinition name
FunctorInstance Located (ImpName PName)
f ModuleInstanceArgs PName
as ModuleInstance PName
i
                      InterfaceModule Signature PName
s -> forall name. Signature name -> ModuleDefinition name
InterfaceModule Signature PName
s
                 }

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

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

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


     let mname :: ImpName name
mname = forall name. ModName -> ImpName name
ImpTop (forall a. Located a -> a
thing (forall mname name. ModuleG mname name -> Located mname
mName Module PName
m))

     forall a.
Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals Map (ImpName Name) ResolvedLocal
resolvedMods forall a b. (a -> b) -> a -> b
$
       forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule Map ModPath Name
pathToName
       do (IfaceDecls
ifs,(NamingEnv
inScope,Module Name
m1)) <- forall a. RenameM a -> RenameM (IfaceDecls, a)
collectIfaceDeps (forall mname.
ImpName Name
-> ModuleG mname PName -> RenameM (NamingEnv, ModuleG mname Name)
renameModule' forall {name}. ImpName name
mname Module PName
m)
          NamingEnv
env <- forall imps. ResolvedModule imps -> NamingEnv
rmodDefines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM ResolvedLocal
lookupResolved forall {name}. ImpName name
mname
          forall (f :: * -> *) a. Applicative f => a -> f a
pure RenamedModule
                 { rmModule :: Module Name
rmModule = Module Name
m1
                 , rmDefines :: NamingEnv
rmDefines = NamingEnv
env
                 , rmInScope :: NamingEnv
rmInScope = NamingEnv
inScope
                 , rmImported :: IfaceDecls
rmImported = IfaceDecls
ifs
                  -- 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) <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. ModBuilder a -> Supply -> ((a, [RenamerError]), Supply)
modBuilder (ModPath -> [TopDecl PName] -> ModBuilder (Mod ())
topDeclsDefs (ModName -> ModPath
TopModule ModName
m) [TopDecl PName]
ds))
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerError -> RenameM ()
recordError [RenamerError]
errs

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

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


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

         -- we already checked for duplicates in Step 2
         [TopDecl Name]
ds1 <- forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env ([TopDecl PName] -> RenameM [TopDecl Name]
renameTopDecls' [TopDecl PName]
ds)
         -- record a use of top-level names to avoid
         -- unused name warnings
         let exports :: ExportSpec Name
exports = forall name. Ord name => [TopDecl name] -> ExportSpec name
exportedDecls [TopDecl Name]
ds1
         forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse (forall name. Namespace -> ExportSpec name -> Set name
exported Namespace
NSType ExportSpec Name
exports)

         forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,[TopDecl Name]
ds1)

--------------------------------------------------------------------------------
-- 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 (NamingEnv, ModuleG mname Name)
renameModule' :: forall mname.
ImpName Name
-> ModuleG mname PName -> RenameM (NamingEnv, ModuleG mname Name)
renameModule' ImpName Name
mname ModuleG mname PName
m =
  forall a. ModPath -> RenameM a -> RenameM a
setCurMod
    case ImpName Name
mname of
      ImpTop ModName
r    -> ModName -> ModPath
TopModule ModName
r
      ImpNested Name
r -> ModPath -> Ident -> ModPath
Nested (Name -> ModPath
nameModPath Name
r) (Name -> Ident
nameIdent Name
r)

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

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

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

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

         -- 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'  <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Located (ImpName PName)
f
              ModuleInstanceArgs Name
as' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ModuleInstanceArgs PName
as
              ModuleInstanceArgs Name -> RenameM ()
checkFunctorArgs ModuleInstanceArgs Name
as'

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

              {- Now we need to compute what's "in scope" of the instantiated
              module.  This is used when the module is loaded at the command
              line and users want to evalute things in the context of the
              module -}
              NamingEnv
fuEnv <- if ImpName Name -> Bool
isFakeName (forall a. Located a -> a
thing Located (ImpName Name)
f')
                          then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
                          else ImpName Name -> RenameM NamingEnv
lookupDefines (forall a. Located a -> a
thing Located (ImpName Name)
f')
              let ren :: Name -> Name
ren Name
x = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Name
x Name
x Map Name Name
imap

              -- XXX: This is not quite right as it only considers the things
              -- defined in the module to be in scope.  It misses things
              -- that are *imported* by the functor, in particular the Cryptol
              -- library
              -- is missing.  See #1455.
              NamingEnv
inScope <- forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone ((Name -> Name) -> NamingEnv -> NamingEnv
mapNamingEnv Name -> Name
ren NamingEnv
fuEnv)
                         RenameM NamingEnv
getNamingEnv

              forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
inScope, ModuleG mname PName
m { mDef :: ModuleDefinition Name
mDef = forall name.
Located (ImpName name)
-> ModuleInstanceArgs name
-> ModuleInstance name
-> ModuleDefinition name
FunctorInstance Located (ImpName Name)
f' ModuleInstanceArgs Name
as' Map Name Name
imap })

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


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

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

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

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



-- | 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) <- forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Decl PName]
ds)
     let toNode :: Decl Name -> ((Decl Name, DepName), DepName, [DepName])
toNode Decl Name
d = let x :: DepName
x = Name -> DepName
NamedThing (Decl Name -> Name
declName Decl Name
d)
                    in ((Decl Name
d,DepName
x), DepName
x, forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing
                            forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList
                            forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps)
         ordered :: [SCC (Decl Name, DepName)]
ordered = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (forall a b. (a -> b) -> [a] -> [b]
map Decl Name -> ((Decl Name, DepName), DepName, [DepName])
toNode [Decl Name]
ds1))
         fromSCC :: SCC (Decl name, DepName) -> RenameM [Decl name]
fromSCC SCC (Decl name, DepName)
x =
           case SCC (Decl name, DepName)
x of
             AcyclicSCC (Decl name
d,DepName
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl name
d]
             CyclicSCC [(Decl name, DepName)]
ds_xs ->
               let ([Decl name]
rds,[DepName]
xs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Decl name, DepName)]
ds_xs
               in case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall name. Decl name -> Maybe (Bind name)
validRecursiveD [Decl name]
rds of
                    Maybe [Bind name]
Nothing -> do RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
                                  forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl name]
rds
                    Just [Bind name]
bs ->
                      do [DepName] -> RenameM ()
checkSameModule [DepName]
xs
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall name. [Bind name] -> Decl name
DRec [Bind name]
bs]
     forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {name}. SCC (Decl name, DepName) -> RenameM [Decl name]
fromSCC [SCC (Decl Name, DepName)]
ordered

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

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



validRecursiveD :: Decl name -> Maybe (Bind name)
validRecursiveD :: forall name. Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d =
  case Decl name
d of
    DBind Bind name
b       -> forall a. a -> Maybe a
Just Bind name
b
    DLocated Decl name
d' Range
_ -> forall name. Decl name -> Maybe (Bind name)
validRecursiveD Decl name
d'
    Decl name
_             -> forall a. Maybe a
Nothing

checkSameModule :: [DepName] -> RenameM ()
checkSameModule :: [DepName] -> RenameM ()
checkSameModule [DepName]
xs =
  case [(Name, ModPath)]
ms of
    (Name, ModPath)
a : [(Name, ModPath)]
as | let bad :: [Name]
bad = [ forall a b. (a, b) -> a
fst (Name, ModPath)
b | (Name, ModPath)
b <- [(Name, ModPath)]
as, forall a b. (a, b) -> b
snd (Name, ModPath)
a forall a. Eq a => a -> a -> Bool
/= forall a b. (a, b) -> b
snd (Name, ModPath)
b ]
           , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
bad) ->
              RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Name -> DepName
NamedThing forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Name, ModPath)
a forall a. a -> [a] -> [a]
: [Name]
bad)
    [(Name, ModPath)]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
  ms :: [(Name, ModPath)]
ms = [ (Name
x,OrigName -> ModPath
ogModule OrigName
og)
       | NamedThing Name
x <- [DepName]
xs, GlobalName NameSource
_ OrigName
og <- [ Name -> NameInfo
nameInfo Name
x ]
       ]



{- 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) <- forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TopDecl PName]
ds)

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

     let rawDepsFor :: DepName -> Set Name
rawDepsFor DepName
x = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty DepName
x Map DepName (Set Name)
deps

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


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

         {- 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 forall a. Eq a => a -> a -> Bool
== Namespace
NSType
                , let ctrDeps :: Set Name
ctrDeps = DepName -> Set Name
rawDepsFor DepName
ctr
                      tyDeps :: Set Name
tyDeps  = DepName -> Set Name
rawDepsFor DepName
nm
                , Bool -> Bool
not (Name
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
ctrDeps)
                , Bool -> Bool
not (forall a. Set a -> Bool
Set.null (forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
                                      (forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
isTyParam Set Name
ctrDeps)
                                      (forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
isTyParam Set Name
tyDeps)))
                  -> forall a. a -> Maybe a
Just DepName
ctr
              DepName
_ -> forall a. Maybe a
Nothing

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

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

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

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

         ordered :: [SCC (TopDecl Name, DepName)]
ordered = forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (forall a b. (a -> b) -> [a] -> [b]
map forall {name} {c}.
(TopDecl name, DepName, c)
-> ((TopDecl name, DepName), DepName, [DepName])
toNode [(TopDecl Name, DepName, [DepName])]
nameDs)
         fromSCC :: SCC (TopDecl name, DepName) -> RenameM [TopDecl name]
fromSCC SCC (TopDecl name, DepName)
x =
            case SCC (TopDecl name, DepName)
x of
              AcyclicSCC (TopDecl name
d,DepName
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopDecl name
d]
              CyclicSCC [(TopDecl name, DepName)]
ds_xs ->
                let ([TopDecl name]
rds,[DepName]
xs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(TopDecl name, DepName)]
ds_xs
                in case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {name}. TopDecl name -> Maybe (Bind name)
valid [TopDecl name]
rds of
                     Maybe [Bind name]
Nothing -> do RenamerError -> RenameM ()
recordError ([DepName] -> RenamerError
InvalidDependency [DepName]
xs)
                                   forall (f :: * -> *) a. Applicative f => a -> f a
pure [TopDecl name]
rds
                     Just [Bind name]
bs ->
                       do [DepName] -> RenameM ()
checkSameModule [DepName]
xs
                          forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall name. TopLevel (Decl name) -> TopDecl name
Decl TopLevel
                                       { tlDoc :: Maybe (Located Text)
tlDoc = forall a. Maybe a
Nothing
                                       , tlExport :: ExportType
tlExport = ExportType
Public
                                       , tlValue :: Decl name
tlValue = forall name. [Bind name] -> Decl name
DRec [Bind name]
bs
                                       }]
                where
                valid :: TopDecl name -> Maybe (Bind name)
valid TopDecl name
d = case TopDecl name
d of
                            Decl TopLevel (Decl name)
tl -> forall name. Decl name -> Maybe (Bind name)
validRecursiveD (forall a. TopLevel a -> a
tlValue TopLevel (Decl name)
tl)
                            TopDecl name
_       -> forall a. Maybe a
Nothing
     [[TopDecl Name]]
rds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {name}.
SCC (TopDecl name, DepName) -> RenameM [TopDecl name]
fromSCC [SCC (TopDecl Name, DepName)]
ordered
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([TopDecl Name]
noNameDsforall a. a -> [a] -> [a]
:[[TopDecl Name]]
rds))
  where

  -- 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                 -> forall {name}. Decl name -> Bool
isValDecl (forall a. TopLevel a -> a
tlValue TopLevel (Decl name)
tl)
      DPrimType {}            -> Bool
False
      TDNewtype {}            -> Bool
False
      DParamDecl {}           -> Bool
False
      DInterfaceConstraint {} -> Bool
False


      DModule TopLevel (NestedModule name)
tl              -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TopDecl name -> Bool
usesCtrs (forall mname name. ModuleG mname name -> [TopDecl name]
mDecls ModuleG name name
m)
        where NestedModule ModuleG name name
m = forall a. TopLevel a -> a
tlValue TopLevel (NestedModule name)
tl
      DImport {}              -> Bool
False
      DModParam {}            -> Bool
False    -- no definitions here
      Include {}              -> forall {a}. String -> a
bad String
"Include"

  isValDecl :: Decl name -> Bool
isValDecl Decl name
d =
    case Decl name
d of
      DLocated Decl name
d' Range
_ -> Decl name -> Bool
isValDecl Decl name
d'
      DBind {}      -> Bool
True
      DRec {}       -> Bool
True

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

      DSignature {}       -> forall {a}. String -> a
bad String
"DSignature"
      DFixity {}          -> forall {a}. String -> a
bad String
"DFixity"
      DPragma {}          -> forall {a}. String -> a
bad String
"DPragma"
      DPatBind {}         -> forall {a}. String -> a
bad String
"DPatBind"

  bad :: String -> a
bad String
msg = forall a. HasCallStack => String -> [String] -> a
panic String
"renameTopDecls'" [String
msg]


declName :: Decl Name -> Name
declName :: Decl Name -> Name
declName Decl Name
decl =
  case Decl Name
decl of
    DLocated Decl Name
d Range
_            -> Decl Name -> Name
declName Decl Name
d
    DBind Bind Name
b                 -> forall a. Located a -> a
thing (forall name. Bind name -> Located name
bName Bind Name
b)
    DType (TySyn Located Name
x Maybe Fixity
_ [TParam Name]
_ Type Name
_)   -> forall a. Located a -> a
thing Located Name
x
    DProp (PropSyn Located Name
x Maybe Fixity
_ [TParam Name]
_ [Prop Name]
_) -> forall a. Located a -> a
thing Located Name
x

    DSignature {}           -> forall {a}. String -> a
bad String
"DSignature"
    DFixity {}              -> forall {a}. String -> a
bad String
"DFixity"
    DPragma {}              -> forall {a}. String -> a
bad String
"DPragma"
    DPatBind {}             -> forall {a}. String -> a
bad String
"DPatBind"
    DRec {}                 -> forall {a}. String -> a
bad String
"DRec"
  where
  bad :: String -> a
bad String
x = forall a. HasCallStack => String -> [String] -> a
panic String
"declName" [String
x]

topDeclName ::
  TopDecl Name ->
  Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName :: TopDecl Name
-> Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
topDeclName TopDecl Name
topDecl =
  case TopDecl Name
topDecl of
    Decl TopLevel (Decl Name)
d                  -> forall {a}. Name -> Either a (TopDecl Name, DepName, [DepName])
hasName (Decl Name -> Name
declName (forall a. TopLevel a -> a
tlValue TopLevel (Decl Name)
d))
    DPrimType TopLevel (PrimType Name)
d             -> forall {a}. Name -> Either a (TopDecl Name, DepName, [DepName])
hasName (forall a. Located a -> a
thing (forall name. PrimType name -> Located name
primTName (forall a. TopLevel a -> a
tlValue TopLevel (PrimType Name)
d)))
    TDNewtype TopLevel (Newtype Name)
d             -> forall {a}.
Name -> [Name] -> Either a (TopDecl Name, DepName, [DepName])
hasName' (forall a. Located a -> a
thing (forall name. Newtype name -> Located name
nName (forall a. TopLevel a -> a
tlValue TopLevel (Newtype Name)
d)))
                                        [ forall name. Newtype name -> name
nConName (forall a. TopLevel a -> a
tlValue TopLevel (Newtype Name)
d) ]
    DModule TopLevel (NestedModule Name)
d               -> forall {a}. Name -> Either a (TopDecl Name, DepName, [DepName])
hasName (forall a. Located a -> a
thing (forall mname name. ModuleG mname name -> Located mname
mName ModuleG Name Name
m))
      where NestedModule ModuleG Name Name
m = forall a. TopLevel a -> a
tlValue TopLevel (NestedModule Name)
d

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

    DImport {}              -> forall {b}. Either (TopDecl Name) b
noName

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

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




{- | 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 = forall name. ModParam name -> Located (ImpName name)
mpSignature ModParam PName
mp
         loc :: Range
loc     = forall a. Located a -> Range
srcRange Located (ImpName PName)
sigName
     forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
       do ModPath
me <- RenameM ModPath
getCurMod

          (ImpName Name
sigName',Bool
isFake) <-
             case forall a. Located a -> a
thing Located (ImpName PName)
sigName of
               ImpTop ModName
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModName -> ImpName name
ImpTop ModName
t, Bool
False)
                -- 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
rnm,Bool
False)
                                     Maybe Name
Nothing ->
                                       do Name
rnm <- Namespace -> PName -> RenameM Name
reportUnboundName Namespace
NSModule PName
n
                                          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
rnm,Bool
True)
                    case ModPath -> ModPath -> Maybe (ModPath, [Ident], [Ident])
modPathCommon ModPath
me (Name -> ModPath
nameModPath Name
nm) of
                      Just (ModPath
_,[],[Ident]
_) ->
                        RenamerError -> RenameM ()
recordError
                           ([DepName] -> RenamerError
InvalidDependency [ModPath -> DepName
ModPath ModPath
me, Name -> DepName
NamedThing Name
nm])
                      Maybe (ModPath, [Ident], [Ident])
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. name -> ImpName name
ImpNested Name
nm, Bool
isFake)

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


          {- 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
FreshM m =>
ModPath -> Ident -> Range -> Name -> m Name
newModParam ModPath
me (forall name. ModParam name -> Ident
mpName ModParam PName
mp) Range
loc Name
x)
                          forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
y Name
x)
                          forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
y
          (NamingEnv
newEnv',Map Name Name
nameMap) <- forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT forall k a. Map k a
Map.empty (forall (f :: * -> *).
Applicative f =>
(Name -> f Name) -> NamingEnv -> f NamingEnv
travNamingEnv forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadT t, FreshM m, StateM (t m) (Map Name Name)) =>
Name -> t m Name
newP NamingEnv
sigEnv)
          let paramName :: Maybe ModName
paramName = forall name. ModParam name -> Maybe ModName
mpAs ModParam PName
mp
          let newEnv :: NamingEnv
newEnv = case Maybe ModName
paramName of
                         Maybe ModName
Nothing -> NamingEnv
newEnv'
                         Just ModName
q  -> ModName -> NamingEnv -> NamingEnv
qualify ModName
q NamingEnv
newEnv'
          forall (f :: * -> *) a. Applicative f => a -> f a
pure ( NamingEnv
newEnv
               , RenModParam
                 { renModParamName :: Ident
renModParamName     = forall name. ModParam name -> Ident
mpName ModParam PName
mp
                 , renModParamRange :: Range
renModParamRange    = Range
loc
                 , renModParamSig :: ImpName Name
renModParamSig      = ImpName Name
sigName'
                 , renModParamInstance :: Map Name Name
renModParamInstance = Map Name Name
nameMap
                 }
               )

{- | 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) <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ModParam PName -> RenameM (NamingEnv, RenModParam)
doModParam  [ModParam PName]
srcParams

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

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

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




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

rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated :: forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated a -> RenameM b
f Located a
loc = forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located a
loc forall a b. (a -> b) -> a -> b
$
  do b
a' <- a -> RenameM b
f (forall a. Located a -> a
thing Located a
loc)
     forall (m :: * -> *) a. Monad m => a -> m a
return Located a
loc { thing :: b
thing = b
a' }






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



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


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

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

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


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

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

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

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

instance Rename ImpName where
  rename :: ImpName PName -> RenameM (ImpName Name)
rename ImpName PName
i =
    case ImpName PName
i of
      ImpTop ModName
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModName -> ImpName name
ImpTop ModName
m)
      ImpNested PName
m -> forall name. name -> ImpName name
ImpNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
NameUse Namespace
NSModule PName
m

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

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

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

instance Rename NestedModule where
  rename :: NestedModule PName -> RenameM (NestedModule Name)
rename (NestedModule ModuleG PName PName
m) =
    do let lnm :: Located PName
lnm            = forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m
           nm :: PName
nm             = forall a. Located a -> a
thing Located PName
lnm
       Name
n   <- NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
NameBind Namespace
NSModule PName
nm
       forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing Name
n)
         do -- XXX: we should store in scope somewhere if we want to browse
            -- nested modules properly
            let m' :: ModuleG (ImpName PName) PName
m' = ModuleG PName PName
m { mName :: Located (ImpName PName)
mName = forall name. name -> ImpName name
ImpNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m }
            (NamingEnv
_inScope,ModuleG (ImpName PName) Name
m1) <- forall mname.
ImpName Name
-> ModuleG mname PName -> RenameM (NamingEnv, ModuleG mname Name)
renameModule' (forall name. name -> ImpName name
ImpNested Name
n) ModuleG (ImpName PName) PName
m'
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModuleG name name -> NestedModule name
NestedModule ModuleG (ImpName PName) Name
m1 { mName :: Located Name
mName = Located PName
lnm { thing :: Name
thing = Name
n } })


instance Rename PrimType where
  rename :: PrimType PName -> RenameM (PrimType Name)
rename PrimType PName
pt =
    do Located Name
x <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (forall name. PrimType name -> Located name
primTName PrimType PName
pt)
       forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
x))
         do let ([TParam PName]
as,[Prop PName]
ps) = forall name. PrimType name -> ([TParam name], [Prop name])
primTCts PrimType PName
pt
            (NamingEnv
_,([TParam Name], [Prop Name])
cts) <- forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
as [Prop PName]
ps forall a b. (a -> b) -> a -> b
$ \[TParam Name]
as' [Prop Name]
ps' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TParam Name]
as',[Prop Name]
ps')

            -- 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.
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name -> RenameM ()
recordUse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. TParam n -> n
tpName) (forall a b. (a, b) -> a
fst ([TParam Name], [Prop Name])
cts)

            forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType PName
pt { primTCts :: ([TParam Name], [Prop Name])
primTCts = ([TParam Name], [Prop Name])
cts, primTName :: Located Name
primTName = Located Name
x }

instance Rename ParameterType where
  rename :: ParameterType PName -> RenameM (ParameterType Name)
rename ParameterType PName
a =
    do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (forall name. ParameterType name -> Located name
ptName ParameterType PName
a)
       forall (m :: * -> *) a. Monad m => a -> m a
return ParameterType PName
a { ptName :: Located Name
ptName = Located Name
n' }

instance Rename ParameterFun where
  rename :: ParameterFun PName -> RenameM (ParameterFun Name)
rename ParameterFun PName
a =
    do Located Name
n'   <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) (forall name. ParameterFun name -> Located name
pfName ParameterFun PName
a)
       forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
n'))
         do (NamingEnv, Schema Name)
sig' <- Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (forall name. ParameterFun name -> Schema name
pfSchema ParameterFun PName
a)
            forall (m :: * -> *) a. Monad m => a -> m a
return ParameterFun PName
a { pfName :: Located Name
pfName = Located Name
n', pfSchema :: Schema Name
pfSchema = forall a b. (a, b) -> b
snd (NamingEnv, Schema Name)
sig' }

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

instance Rename Decl where
  rename :: Decl PName -> RenameM (Decl Name)
rename Decl PName
d      = case Decl PName
d of
    DBind Bind PName
b           -> forall name. Bind name -> Decl name
DBind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b

    DType TySyn PName
syn         -> forall name. TySyn name -> Decl name
DType         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TySyn PName
syn
    DProp PropSyn PName
syn         -> forall name. PropSyn name -> Decl name
DProp         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename PropSyn PName
syn
    DLocated Decl PName
d' Range
r     -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
                       forall a b. (a -> b) -> a -> b
$ forall name. Decl name -> Range -> Decl name
DLocated      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Decl PName
d'  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r

    DFixity{}         -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DFixity" ]
    DSignature {}     -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DSignature" ]
    DPragma  {}       -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DPragma" ]
    DPatBind {}       -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DPatBind " ]
    DRec {}           -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename" [ String
"DRec" ]



instance Rename Newtype where
  rename :: Newtype PName -> RenameM (Newtype Name)
rename Newtype PName
n      =
    forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall name. Newtype name -> [TParam name]
nParams Newtype PName
n) forall a b. (a -> b) -> a -> b
$
    do Located Name
nameT <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) (forall name. Newtype name -> Located name
nName Newtype PName
n)
       Name
nameC <- NameType -> PName -> RenameM Name
renameVar  NameType
NameBind (forall name. Newtype name -> name
nConName Newtype PName
n)

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

       forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
nameT)) forall a b. (a -> b) -> a -> b
$
         do [TParam Name]
ps'   <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. Newtype name -> [TParam name]
nParams Newtype PName
n)
            RecordMap Ident (Range, Type Name)
body' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (forall name. Newtype name -> Rec (Type name)
nBody Newtype PName
n)
            forall (m :: * -> *) a. Monad m => a -> m a
return Newtype { nName :: Located Name
nName   = Located Name
nameT
                           , nConName :: Name
nConName = Name
nameC
                           , nParams :: [TParam Name]
nParams = [TParam Name]
ps'
                           , nBody :: RecordMap Ident (Range, Type Name)
nBody   = RecordMap Ident (Range, Type Name)
body' }



-- | Try to resolve a name
resolveNameMaybe :: NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe :: NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
nt Namespace
expected PName
qn =
  do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     let lkpIn :: Namespace -> Maybe Names
lkpIn Namespace
here = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
         use :: Name -> RenameM ()
use = case Namespace
expected of
                 Namespace
NSType -> Name -> RenameM ()
recordUse
                 Namespace
_      -> forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
     case Namespace -> Maybe Names
lkpIn Namespace
expected of
       Just Names
xs ->
         case Names
xs of
          One Name
n ->
            do case NameType
nt of
                 NameType
NameBind -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                 NameType
NameUse  -> Name -> RenameM ()
addDep Name
n
               Name -> RenameM ()
use Name
n    -- for warning
               forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Name
n)
          Ambig Set Name
symSet ->
            do let syms :: [Name]
syms = forall a. Set a -> [a]
Set.toList Set Name
symSet
               forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
use [Name]
syms    -- mark as used to avoid unused warnings
               Located PName
n <- forall a. a -> RenameM (Located a)
located PName
qn
               RenamerError -> RenameM ()
recordError (Located PName -> [Name] -> RenamerError
MultipleSyms Located PName
n [Name]
syms)
               forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a. [a] -> a
head [Name]
syms))

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

reportUnboundName :: Namespace -> PName -> RenameM Name
reportUnboundName :: Namespace -> PName -> RenameM Name
reportUnboundName Namespace
expected PName
qn =
  do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     let lkpIn :: Namespace -> Maybe Names
lkpIn Namespace
here = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
here (RO -> NamingEnv
roNames RO
ro))
         others :: [Namespace]
others     = [ Namespace
ns | Namespace
ns <- [Namespace]
allNamespaces
                           , Namespace
ns forall a. Eq a => a -> a -> Bool
/= Namespace
expected
                           , Just Names
_ <- [Namespace -> Maybe Names
lkpIn Namespace
ns] ]
     Located PName
nm <- forall a. a -> RenameM (Located a)
located PName
qn
     case [Namespace]
others of
       -- 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 forall a. Eq a => a -> a -> Bool
== ModName
undefinedModName
    ImpNested Name
x ->
      case Name -> Maybe ModName
nameTopModuleMaybe Name
x of
        Just ModName
y  -> ModName
y forall a. Eq a => a -> a -> Bool
== ModName
undefinedModName
        Maybe ModName
Nothing -> Bool
False


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


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

renameType :: NameType -> PName -> RenameM Name
renameType :: NameType -> PName -> RenameM Name
renameType NameType
nt = NameType -> Namespace -> PName -> RenameM Name
resolveName NameType
nt Namespace
NSType



-- | 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 <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace
-> ModPath
-> NameSource
-> Ident
-> Maybe Fixity
-> Range
-> Supply
-> (Name, Supply)
mkDeclared Namespace
ns (ModName -> ModPath
TopModule ModName
undefinedModName)
                               NameSource
SystemName (PName -> Ident
getIdent PName
pn) forall a. Maybe a
Nothing (RO -> Range
roLoc RO
ro))

-- | 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 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema Schema PName
s

-- | 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) =
  forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
ps [Prop PName]
p forall a b. (a -> b) -> a -> b
$ \[TParam Name]
ps' [Prop Name]
p' ->
    do Type Name
ty' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
       forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall n.
[TParam n] -> [Prop n] -> Type n -> Maybe Range -> Schema n
Forall [TParam Name]
ps' [Prop Name]
p' Type Name
ty' Maybe Range
loc)

-- | 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 <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf [TParam PName]
as)
     a
res <- forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env forall a b. (a -> b) -> a -> b
$ do [TParam Name]
as' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
as
                                 [Prop Name]
ps' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
ps
                                 [TParam Name] -> [Prop Name] -> RenameM a
k [TParam Name]
as' [Prop Name]
ps'
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,a
res)

instance Rename TParam where
  rename :: TParam PName -> RenameM (TParam Name)
rename TParam { Maybe Range
Maybe Kind
PName
tpRange :: forall n. TParam n -> Maybe Range
tpKind :: forall n. TParam n -> Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpName :: PName
tpName :: forall n. TParam n -> n
.. } =
    do Name
n <- NameType -> PName -> RenameM Name
renameType NameType
NameBind PName
tpName
       forall (m :: * -> *) a. Monad m => a -> m a
return TParam { tpName :: Name
tpName = Name
n, Maybe Range
Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
.. }

instance Rename Prop where
  rename :: Prop PName -> RenameM (Prop Name)
rename (CType Type PName
t) = forall n. Type n -> Prop n
CType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t


instance Rename Type where
  rename :: Type PName -> RenameM (Type Name)
rename Type PName
ty0 =
    case Type PName
ty0 of
      TFun Type PName
a Type PName
b       -> forall n. Type n -> Type n -> Type n
TFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
      TSeq Type PName
n Type PName
a       -> forall n. Type n -> Type n -> Type n
TSeq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
n forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
      Type PName
TBit           -> forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Type n
TBit
      TNum Integer
c         -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Integer -> Type n
TNum Integer
c)
      TChar Char
c        -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Char -> Type n
TChar Char
c)
      TUser PName
qn [Type PName]
ps    -> forall n. n -> [Type n] -> Type n
TUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> PName -> RenameM Name
renameType NameType
NameUse PName
qn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
ps
      TTyApp [Named (Type PName)]
fs      -> forall n. [Named (Type n)] -> Type n
TTyApp   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) [Named (Type PName)]
fs
      TRecord Rec (Type PName)
fs     -> forall n. Rec (Type n) -> Type n
TRecord  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Type PName)
fs
      TTuple [Type PName]
fs      -> forall n. [Type n] -> Type n
TTuple   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
fs
      Type PName
TWild          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall n. Type n
TWild
      TLocated Type PName
t' Range
r  -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r (forall n. Type n -> Range -> Type n
TLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r)
      TParens Type PName
t' Maybe Kind
k   -> (forall n. Type n -> Maybe Kind -> Type n
`TParens` Maybe Kind
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t'
      TInfix Type PName
a Located PName
o Fixity
_ Type PName
b -> do (Located Name, Fixity)
o' <- Located PName -> RenameM (Located Name, Fixity)
renameTypeOp Located PName
o
                           Type Name
a' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
                           Type Name
b' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
                           Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
a' (Located Name, Fixity)
o' Type Name
b'

mkTInfix ::
  Type Name -> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)

mkTInfix :: Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix t :: Type Name
t@(TInfix Type Name
x Located Name
o1 Fixity
f1 Type Name
y) op :: (Located Name, Fixity)
op@(Located Name
o2,Fixity
f2) Type Name
z =
  case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
    FixityCmp
FCLeft  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o2 Fixity
f2 Type Name
z)
    FixityCmp
FCRight -> do Type Name
r <- Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
y (Located Name, Fixity)
op Type Name
z
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
x Located Name
o1 Fixity
f1 Type Name
r)
    FixityCmp
FCError -> do RenamerError -> RenameM ()
recordError (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o2 Fixity
f2 Type Name
z)

mkTInfix (TLocated Type Name
t' Range
_) (Located Name, Fixity)
op Type Name
z =
  Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
t' (Located Name, Fixity)
op Type Name
z

mkTInfix Type Name
t (Located Name
o,Fixity
f) Type Name
z =
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o Fixity
f Type Name
z)


-- | Rename a binding.
instance Rename Bind where
  rename :: Bind PName -> RenameM (Bind Name)
rename Bind PName
b =
    do Located Name
n'    <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) (forall name. Bind name -> Located name
bName Bind PName
b)
       forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
n'))
         do Maybe (NamingEnv, Schema Name)
mbSig <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (forall name. Bind name -> Maybe (Schema name)
bSignature Bind PName
b)
            forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig) forall a b. (a -> b) -> a -> b
$
              do (NamingEnv
patEnv,[Pattern Name]
pats') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats (forall name. Bind name -> [Pattern name]
bParams Bind PName
b)
                 -- NOTE: renamePats will generate warnings,
                 -- so we don't need to trigger them again here.
                 Located (BindDef Name)
e' <- forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
patEnv (forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall name. Bind name -> Located (BindDef name)
bDef Bind PName
b))
                 forall (m :: * -> *) a. Monad m => a -> m a
return Bind PName
b { bName :: Located Name
bName      = Located Name
n'
                          , bParams :: [Pattern Name]
bParams    = [Pattern Name]
pats'
                          , bDef :: Located (BindDef Name)
bDef       = Located (BindDef Name)
e'
                          , bSignature :: Maybe (Schema Name)
bSignature = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig
                          , bPragmas :: [Pragma]
bPragmas   = forall name. Bind name -> [Pragma]
bPragmas Bind PName
b
                          }

instance Rename BindDef where
  rename :: BindDef PName -> RenameM (BindDef Name)
rename BindDef PName
DPrim     = forall (m :: * -> *) a. Monad m => a -> m a
return forall name. BindDef name
DPrim
  rename BindDef PName
DForeign  = forall (m :: * -> *) a. Monad m => a -> m a
return forall name. BindDef name
DForeign
  rename (DExpr Expr PName
e) = forall name. Expr name -> BindDef name
DExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
  rename (DPropGuards [PropGuardCase PName]
cases) = forall name. [PropGuardCase name] -> BindDef name
DPropGuards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [PropGuardCase PName]
cases

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

-- NOTE: this only renames types within the pattern.
instance Rename Pattern where
  rename :: Pattern PName -> RenameM (Pattern Name)
rename Pattern PName
p      = case Pattern PName
p of
    PVar Located PName
lv         -> forall n. Located n -> Pattern n
PVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameVar NameType
NameBind) Located PName
lv
    Pattern PName
PWild           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall n. Pattern n
PWild
    PTuple [Pattern PName]
ps       -> forall n. [Pattern n] -> Pattern n
PTuple   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
ps
    PRecord Rec (Pattern PName)
nps     -> forall n. Rec (Pattern n) -> Pattern n
PRecord  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Pattern PName)
nps
    PList [Pattern PName]
elems     -> forall n. [Pattern n] -> Pattern n
PList    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
elems
    PTyped Pattern PName
p' Type PName
t     -> forall n. Pattern n -> Type n -> Pattern n
PTyped   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p'    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t
    PSplit Pattern PName
l Pattern PName
r      -> forall n. Pattern n -> Pattern n -> Pattern n
PSplit   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
l     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
r
    PLocated Pattern PName
p' Range
loc -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
                     forall a b. (a -> b) -> a -> b
$ forall n. Pattern n -> Range -> Pattern n
PLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p'    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
loc

-- | 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 -> forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdSet [Located Selector
l] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
                 UpdHow
UpdFun -> forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                        forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
EFun forall n. FunDesc n
emptyFunDesc [forall n. Located n -> Pattern n
PVar Located PName
p] Expr PName
e)
                       where
                       p :: Located PName
p = Ident -> PName
UnQual forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Ident
selName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> a
last [Located Selector]
ls
         [Located Selector]
_ -> forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd forall a. Maybe a
Nothing [ forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
h [Located Selector]
more Expr PName
e])
      [] -> forall a. HasCallStack => String -> [String] -> a
panic String
"rename@UpdField" [ String
"Empty label list." ]


instance Rename FunDesc where
  rename :: FunDesc PName -> RenameM (FunDesc Name)
rename (FunDesc Maybe PName
nm Int
offset) =
    do Maybe Name
nm' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NameType -> PName -> RenameM Name
renameVar NameType
NameBind)  Maybe PName
nm
       forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall n. Maybe n -> Int -> FunDesc n
FunDesc Maybe Name
nm' Int
offset)

instance Rename Expr where
  rename :: Expr PName -> RenameM (Expr Name)
rename Expr PName
expr = case Expr PName
expr of
    EVar PName
n          -> forall n. n -> Expr n
EVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameType -> PName -> RenameM Name
renameVar NameType
NameUse PName
n
    ELit Literal
l          -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Literal -> Expr n
ELit Literal
l)
    EGenerate Expr PName
e     -> forall n. Expr n -> Expr n
EGenerate
                               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    ETuple [Expr PName]
es       -> forall n. [Expr n] -> Expr n
ETuple  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
    ERecord Rec (Expr PName)
fs      -> forall n. Rec (Expr n) -> Expr n
ERecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Expr PName)
fs
    ESel Expr PName
e' Selector
s       -> forall n. Expr n -> Selector -> Expr n
ESel    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
    EUpd Maybe (Expr PName)
mb [UpdField PName]
fs      -> do [UpdField PName] -> RenameM ()
checkLabels [UpdField PName]
fs
                          forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
mb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [UpdField PName]
fs
    EList [Expr PName]
es        -> forall n. [Expr n] -> Expr n
EList   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
    EFromTo Type PName
s Maybe (Type PName)
n Type PName
e Maybe (Type PName)
t -> forall n.
Type n -> Maybe (Type n) -> Type n -> Maybe (Type n) -> Expr n
EFromTo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
n
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
    EFromToBy Bool
isStrict Type PName
s Type PName
e Type PName
b Maybe (Type PName)
t ->
                       forall n.
Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToBy Bool
isStrict
                                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
    EFromToDownBy Bool
isStrict Type PName
s Type PName
e Type PName
b Maybe (Type PName)
t ->
                       forall n.
Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToDownBy Bool
isStrict
                                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
    EFromToLessThan Type PName
s Type PName
e Maybe (Type PName)
t ->
                       forall n. Type n -> Type n -> Maybe (Type n) -> Expr n
EFromToLessThan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
    EInfFrom Expr PName
a Maybe (Expr PName)
b    -> forall n. Expr n -> Maybe (Expr n) -> Expr n
EInfFromforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
a  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
b
    EComp Expr PName
e' [[Match PName]]
bs     -> do [(NamingEnv, [Match Name])]
arms' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [[Match PName]]
bs
                          let ([NamingEnv]
envs,[[Match Name]]
bs') = forall a b. [(a, b)] -> ([a], [b])
unzip [(NamingEnv, [Match Name])]
arms'
                          -- NOTE: renameArm will generate shadowing warnings; we only
                          -- need to check for repeated names across multiple arms
                          forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap [NamingEnv]
envs (forall n. Expr n -> [[Match n]] -> Expr n
EComp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Match Name]]
bs')
    EApp Expr PName
f Expr PName
x        -> forall n. Expr n -> Expr n -> Expr n
EApp    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
    EAppT Expr PName
f [TypeInst PName]
ti      -> forall n. Expr n -> [TypeInst n] -> Expr n
EAppT   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TypeInst PName]
ti
    EIf Expr PName
b Expr PName
t Expr PName
f       -> forall n. Expr n -> Expr n -> Expr n -> Expr n
EIf     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
b  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
t  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f
    EWhere Expr PName
e' [Decl PName]
ds    -> forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe ModPath -> a -> InModule a
InModule forall a. Maybe a
Nothing) [Decl PName]
ds) forall a b. (a -> b) -> a -> b
$
                          forall n. Expr n -> [Decl n] -> Expr n
EWhere forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Decl PName] -> RenameM [Decl Name]
renameDecls [Decl PName]
ds
    ETyped Expr PName
e' Type PName
ty    -> forall n. Expr n -> Type n -> Expr n
ETyped  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
    ETypeVal Type PName
ty     -> forall n. Type n -> Expr n
ETypeValforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
    EFun FunDesc PName
desc [Pattern PName]
ps Expr PName
e' -> do FunDesc Name
desc' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename FunDesc PName
desc
                          (NamingEnv
env,[Pattern Name]
ps') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats [Pattern PName]
ps
                          -- NOTE: renamePats will generate warnings, so we don't
                          -- need to duplicate them here
                          forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env (forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
EFun FunDesc Name
desc' [Pattern Name]
ps' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e')
    ELocated Expr PName
e' Range
r   -> forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
                     forall a b. (a -> b) -> a -> b
$ forall n. Expr n -> Range -> Expr n
ELocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r

    ESplit Expr PName
e        -> forall n. Expr n -> Expr n
ESplit  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    EParens Expr PName
p       -> forall n. Expr n -> Expr n
EParens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
p
    EInfix Expr PName
x Located PName
y Fixity
_ Expr PName
z  -> do (Located Name, Fixity)
op <- Located PName -> RenameM (Located Name, Fixity)
renameOp Located PName
y
                          Expr Name
x' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
                          Expr Name
z' <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
z
                          Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
x' (Located Name, Fixity)
op Expr Name
z'
    EPrefix PrefixOp
op Expr PName
e    -> forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e


checkLabels :: [UpdField PName] -> RenameM ()
checkLabels :: [UpdField PName] -> RenameM ()
checkLabels = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {n}. UpdField n -> [Located Selector]
labs
  where
  labs :: UpdField n -> [Located Selector]
labs (UpdField UpdHow
_ [Located Selector]
ls Expr n
_) = [Located Selector]
ls

  check :: [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check [[Located Selector]]
done [Located Selector]
l =
    do case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
l) [[Located Selector]]
done of
         Just [Located Selector]
l' -> RenamerError -> RenameM ()
recordError (Located [Selector] -> Located [Selector] -> RenamerError
OverlappingRecordUpdate (forall {b}. [Located b] -> Located [b]
reLoc [Located Selector]
l) (forall {b}. [Located b] -> Located [b]
reLoc [Located Selector]
l'))
         Maybe [Located Selector]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Located Selector]
l forall a. a -> [a] -> [a]
: [[Located Selector]]
done)

  overlap :: [Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
xs [Located Selector]
ys =
    case ([Located Selector]
xs,[Located Selector]
ys) of
      ([],[Located Selector]
_)  -> Bool
True
      ([Located Selector]
_, []) -> Bool
True
      (Located Selector
x : [Located Selector]
xs', Located Selector
y : [Located Selector]
ys') -> Located Selector -> Located Selector -> Bool
same Located Selector
x Located Selector
y Bool -> Bool -> Bool
&& [Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
xs' [Located Selector]
ys'

  same :: Located Selector -> Located Selector -> Bool
same Located Selector
x Located Selector
y =
    case (forall a. Located a -> a
thing Located Selector
x, forall a. Located a -> a
thing Located Selector
y) of
      (TupleSel Int
a Maybe Int
_, TupleSel Int
b Maybe Int
_)   -> Int
a forall a. Eq a => a -> a -> Bool
== Int
b
      (ListSel  Int
a Maybe Int
_, ListSel  Int
b Maybe Int
_)   -> Int
a forall a. Eq a => a -> a -> Bool
== Int
b
      (RecordSel Ident
a Maybe [Ident]
_, RecordSel Ident
b Maybe [Ident]
_) -> Ident
a forall a. Eq a => a -> a -> Bool
== Ident
b
      (Selector, Selector)
_                              -> Bool
False

  reLoc :: [Located b] -> Located [b]
reLoc [Located b]
xs = (forall a. [a] -> a
head [Located b]
xs) { thing :: [b]
thing = forall a b. (a -> b) -> [a] -> [b]
map forall a. Located a -> a
thing [Located b]
xs }


mkEInfix :: Expr Name             -- ^ 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)

     FixityCmp
FCRight -> do Expr Name
r <- Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
y (Located Name, Fixity)
op Expr Name
z
                   forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
x Located Name
o1 Fixity
f1 Expr Name
r)

     FixityCmp
FCError -> do RenamerError -> RenameM ()
recordError (Located Name -> Fixity -> Located Name -> Fixity -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
                   forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)

mkEInfix e :: Expr Name
e@(EPrefix PrefixOp
o1 Expr Name
x) op :: (Located Name, Fixity)
op@(Located Name
o2, Fixity
f2) Expr Name
y =
  case Fixity -> Fixity -> FixityCmp
compareFixity (PrefixOp -> Fixity
prefixFixity PrefixOp
o1) Fixity
f2 of
    FixityCmp
FCRight -> do
      let warning :: RenamerWarning
warning = PrefixOp
-> Expr Name
-> Located Name
-> Fixity
-> Expr Name
-> RenamerWarning
PrefixAssocChanged PrefixOp
o1 Expr Name
x Located Name
o2 Fixity
f2 Expr Name
y
      forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ (\RW
rw -> RW
rw {rwWarnings :: [RenamerWarning]
rwWarnings = RenamerWarning
warning forall a. a -> [a] -> [a]
: RW -> [RenamerWarning]
rwWarnings RW
rw})
      Expr Name
r <- Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
x (Located Name, Fixity)
op Expr Name
y
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. PrefixOp -> Expr n -> Expr n
EPrefix PrefixOp
o1 Expr Name
r)

    -- Even if the fixities conflict, we make the prefix operator take
    -- precedence.
    FixityCmp
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
y)

-- 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 =
     forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o Fixity
f Expr Name
z)


renameOp :: Located PName -> RenameM (Located Name, Fixity)
renameOp :: Located PName -> RenameM (Located Name, Fixity)
renameOp Located PName
ln =
  forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln forall a b. (a -> b) -> a -> b
$
  do Name
n <- NameType -> PName -> RenameM Name
renameVar NameType
NameUse (forall a. Located a -> a
thing Located PName
ln)
     Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
     forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing :: Name
thing = Name
n }, Fixity
fixity)

renameTypeOp :: Located PName -> RenameM (Located Name, Fixity)
renameTypeOp :: Located PName -> RenameM (Located Name, Fixity)
renameTypeOp Located PName
ln =
  forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln forall a b. (a -> b) -> a -> b
$
  do Name
n <- NameType -> PName -> RenameM Name
renameType NameType
NameUse (forall a. Located a -> a
thing Located PName
ln)
     Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
     forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing :: Name
thing = Name
n }, Fixity
fixity)

lookupFixity :: Name -> RenameM Fixity
lookupFixity :: Name -> RenameM Fixity
lookupFixity Name
n =
  case Name -> Maybe Fixity
nameFixity Name
n of
    Just Fixity
fixity -> forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
fixity
    Maybe Fixity
Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
defaultFixity -- 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 -> forall name. Named (Type name) -> TypeInst name
NamedInst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Named (Type PName)
nty
    PosInst Type PName
ty    -> forall name. Type name -> TypeInst name
PosInst   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty

renameArm :: [Match PName] -> RenameM (NamingEnv,[Match Name])

renameArm :: [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm (Match PName
m:[Match PName]
ms) =
  do (NamingEnv
me,Match Name
m') <- Match PName -> RenameM (NamingEnv, Match Name)
renameMatch Match PName
m
     -- NOTE: renameMatch will generate warnings, so we don't
     -- need to duplicate them here
     forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
me forall a b. (a -> b) -> a -> b
$
       do (NamingEnv
env,[Match Name]
rest) <- [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [Match PName]
ms

          -- NOTE: the inner environment shadows the outer one, for examples
          -- like this:
          --
          -- [ x | x <- xs, let x = 10 ]
          forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
me, Match Name
m'forall a. a -> [a] -> [a]
:[Match Name]
rest)

renameArm [] =
     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty,[])

-- | 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'      <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
     forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe,forall name. Pattern name -> Expr name -> Match name
Match Pattern Name
p' Expr Name
e')

renameMatch (MatchLet Bind PName
b) =
  do NamingEnv
be <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf (forall a. Maybe ModPath -> a -> InModule a
InModule forall a. Maybe a
Nothing Bind PName
b))
     Bind Name
b' <- forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
be (forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)
     forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
be,forall name. Bind name -> Match name
MatchLet Bind Name
b')

-- | 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' <- forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p)
     forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe, Pattern Name
p')



-- | 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
      forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe forall a b. (a -> b) -> a -> b
$
        do Pattern Name
p'           <- forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p
           (NamingEnv
env',[Pattern Name]
rest') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop [Pattern PName]
rest
           forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
env', Pattern Name
p'forall a. a -> [a] -> [a]
:[Pattern Name]
rest')

    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, [])

patternEnv :: Pattern PName -> RenameM NamingEnv
patternEnv :: Pattern PName -> RenameM NamingEnv
patternEnv  = Pattern PName -> RenameM NamingEnv
go
  where
  go :: Pattern PName -> RenameM NamingEnv
go (PVar Located { Range
PName
thing :: PName
srcRange :: Range
srcRange :: forall a. Located a -> Range
thing :: forall a. Located a -> a
.. }) =
    do Name
n <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSValue (PName -> Ident
getIdent PName
thing) Range
srcRange)
       -- XXX: for deps, we should record a use
       forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSValue PName
thing Name
n)

  go Pattern PName
PWild            = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  go (PTuple [Pattern PName]
ps)      = [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
  go (PRecord Rec (Pattern PName)
fs)     = [Pattern PName] -> RenameM NamingEnv
bindVars (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall a b. RecordMap a b -> [b]
recordElements Rec (Pattern PName)
fs))
  go (PList [Pattern PName]
ps)       = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern PName -> RenameM NamingEnv
go [Pattern PName]
ps
  go (PTyped Pattern PName
p Type PName
ty)    = Pattern PName -> RenameM NamingEnv
go Pattern PName
p forall a. Monoid a => a -> a -> a
`mappend` Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
  go (PSplit Pattern PName
a Pattern PName
b)     = Pattern PName -> RenameM NamingEnv
go Pattern PName
a forall a. Monoid a => a -> a -> a
`mappend` Pattern PName -> RenameM NamingEnv
go Pattern PName
b
  go (PLocated Pattern PName
p Range
loc) = forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc (Pattern PName -> RenameM NamingEnv
go Pattern PName
p)

  bindVars :: [Pattern PName] -> RenameM NamingEnv
bindVars []     = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  bindVars (Pattern PName
p:[Pattern PName]
ps) =
    do NamingEnv
env <- Pattern PName -> RenameM NamingEnv
go Pattern PName
p
       forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env forall a b. (a -> b) -> a -> b
$
         do NamingEnv
rest <- [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
            forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
rest)


  typeEnv :: Type PName -> RenameM NamingEnv
typeEnv (TFun Type PName
a Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]
  typeEnv (TSeq Type PName
a Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]

  typeEnv Type PName
TBit       = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  typeEnv TNum{}     = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  typeEnv TChar{}    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

  typeEnv (TUser PName
pn [Type PName]
ps) =
    do Maybe Name
mb <- NameType -> Namespace -> PName -> RenameM (Maybe Name)
resolveNameMaybe NameType
NameUse Namespace
NSType PName
pn
       case Maybe Name
mb of

         -- 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.
           | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type PName]
ps ->
             do Range
loc <- RenameM Range
curLoc
                Name
n   <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
                forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType PName
pn Name
n)

           -- 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 (forall a. Range -> a -> Located a
Located Range
loc PName
pn))
                Name
n   <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Namespace -> Ident -> Range -> Supply -> (Name, Supply)
mkLocal Namespace
NSType (PName -> Ident
getIdent PName
pn) Range
loc)
                forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType PName
pn Name
n)

  typeEnv (TRecord Rec (Type PName)
fs)      = [Type PName] -> RenameM NamingEnv
bindTypes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall a b. RecordMap a b -> [b]
recordElements Rec (Type PName)
fs))
  typeEnv (TTyApp [Named (Type PName)]
fs)       = [Type PName] -> RenameM NamingEnv
bindTypes (forall a b. (a -> b) -> [a] -> [b]
map forall a. Named a -> a
value [Named (Type PName)]
fs)
  typeEnv (TTuple [Type PName]
ts)       = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
  typeEnv Type PName
TWild             = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  typeEnv (TLocated Type PName
ty Range
loc) = forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc (Type PName -> RenameM NamingEnv
typeEnv Type PName
ty)
  typeEnv (TParens Type PName
ty Maybe Kind
_)    = Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
  typeEnv (TInfix Type PName
a Located PName
_ Fixity
_ Type PName
b)  = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]

  bindTypes :: [Type PName] -> RenameM NamingEnv
bindTypes [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  bindTypes (Type PName
t:[Type PName]
ts) =
    do NamingEnv
env' <- Type PName -> RenameM NamingEnv
typeEnv Type PName
t
       forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env' forall a b. (a -> b) -> a -> b
$
         do NamingEnv
res <- [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
            forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env' forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
res)


instance Rename Match where
  rename :: Match PName -> RenameM (Match Name)
rename Match PName
m = case Match PName
m of
    Match Pattern PName
p Expr PName
e  ->                  forall name. Pattern name -> Expr name -> Match name
Match    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    MatchLet Bind PName
b -> forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (forall a. Maybe ModPath -> a -> InModule a
InModule forall a. Maybe a
Nothing Bind PName
b) (forall name. Bind name -> Match name
MatchLet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)

instance Rename TySyn where
  rename :: TySyn PName -> RenameM (TySyn Name)
rename (TySyn Located PName
n Maybe Fixity
f [TParam PName]
ps Type PName
ty) =
    forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps
    do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) Located PName
n
       forall a. DepName -> RenameM a -> RenameM a
depsOf (Name -> DepName
NamedThing (forall a. Located a -> a
thing Located Name
n')) forall a b. (a -> b) -> a -> b
$
         forall n.
Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
TySyn Located Name
n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty

instance Rename PropSyn where
  rename :: PropSyn PName -> RenameM (PropSyn Name)
rename (PropSyn Located PName
n Maybe Fixity
f [TParam PName]
ps [Prop PName]
cs) =
    forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps
    do Located Name
n' <- forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated (NameType -> PName -> RenameM Name
renameType NameType
NameBind) Located PName
n
       forall n.
Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
PropSyn Located Name
n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
cs

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

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