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

{-# Language RecordWildCards #-}
{-# Language FlexibleContexts #-}
{-# Language BlockArguments #-}
{-# Language OverloadedStrings #-}
module Cryptol.ModuleSystem.Renamer.Monad where

import Data.List(sort,foldl')
import           Data.Set(Set)
import qualified Data.Set as Set
import           Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import qualified Data.Semigroup as S
import           MonadLib hiding (mapM, mapM_)

import Prelude ()
import Prelude.Compat

import Cryptol.Utils.PP(pp)
import Cryptol.Utils.Panic(panic)
import Cryptol.Utils.Ident(modPathCommon,OrigName(..),OrigSource(..))
import Cryptol.ModuleSystem.Name
import Cryptol.ModuleSystem.NamingEnv
import Cryptol.ModuleSystem.Binds
import Cryptol.ModuleSystem.Interface
import Cryptol.Parser.AST
import Cryptol.TypeCheck.AST(ModParamNames)
import Cryptol.Parser.Position

import Cryptol.ModuleSystem.Renamer.Error
import Cryptol.ModuleSystem.Renamer.Imports
  (ResolvedLocal,rmodKind,rmodDefines,rmodNested)

-- | Indicates if a name is in a binding poisition or a use site
data NameType = NameBind | NameUse

-- | Information needed to do some renaming.
data RenamerInfo = RenamerInfo
  { RenamerInfo -> Supply
renSupply   :: Supply     -- ^ Use to make new names
  , RenamerInfo -> ModPath
renContext  :: ModPath    -- ^ We are renaming things in here
  , RenamerInfo -> NamingEnv
renEnv      :: NamingEnv  -- ^ This is what's in scope
  , RenamerInfo -> Map ModName (Either ModParamNames Iface)
renIfaces   :: Map ModName (Either ModParamNames Iface)
    -- ^ External modules
  }

newtype RenameM a = RenameM { forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM :: ReaderT RO (StateT RW Lift) a }

data RO = RO
  { RO -> Range
roLoc       :: Range
  , RO -> NamingEnv
roNames     :: NamingEnv
  , RO -> Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
roExternal  :: Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
    -- ^ Externally loaded modules. `Mod` is defined in 'Cryptol.Renamer.Binds'.

  , RO -> ModPath
roCurMod    :: ModPath               -- ^ Current module we are working on

  , RO -> Map ModPath Name
roNestedMods :: Map ModPath Name
    {- ^ Maps module paths to the actual name for it.   This is used
         for dependency tracking, to find the name of a containing module.
         See the note on `addDep`. -}

  , RO -> Map (ImpName Name) ResolvedLocal
roResolvedModules :: Map (ImpName Name) ResolvedLocal
    -- ^ Info about locally defined modules

  , RO -> Map Ident RenModParam
roModParams :: Map Ident RenModParam
    {- ^ Module parameters.  These are used when rename the module parameters,
       and only refer to the parameters of the current module (i.e., no
       outer parameters as those are not needed) -}

  , RO -> Map Name DepName
roFromModParam :: Map Name DepName
    -- ^ Keeps track of which names were introduce by module parameters
    -- and which one.  The `DepName` is always a `ModParamName`.
  }

data RW = RW
  { RW -> [RenamerWarning]
rwWarnings      :: ![RenamerWarning]
  , RW -> Set RenamerError
rwErrors        :: !(Set RenamerError)
  , RW -> Supply
rwSupply        :: !Supply
  , RW -> Map Name Int
rwNameUseCount  :: !(Map Name Int)
    -- ^ How many times did we refer to each name.
    -- Used to generate warnings for unused definitions.

  , RW -> Set Name
rwCurrentDeps     :: Set Name
    -- ^ keeps track of names *used* by something.
    -- see 'depsOf'

  , RW -> Map DepName (Set Name)
rwDepGraph        :: Map DepName (Set Name)
    -- ^ keeps track of the dependencies for things.
    -- see 'depsOf'

  , RW -> IfaceDecls
rwExternalDeps  :: !IfaceDecls
    -- ^ Info about imported things, from external modules
  }



data RenModParam = RenModParam
  { RenModParam -> Ident
renModParamName      :: Ident
  , RenModParam -> Range
renModParamRange     :: Range
  , RenModParam -> ImpName Name
renModParamSig       :: ImpName Name
  , RenModParam -> Map Name Name
renModParamInstance  :: Map Name Name
    {- ^ Maps names that come into scope through this parameter
         to the names in the *module interface*.
         This is for functors, NOT functor instantantiations. -}
  }




instance S.Semigroup a => S.Semigroup (RenameM a) where
  {-# INLINE (<>) #-}
  RenameM a
a <> :: RenameM a -> RenameM a -> RenameM a
<> RenameM a
b =
    do a
x <- RenameM a
a
       a
y <- RenameM a
b
       forall (m :: * -> *) a. Monad m => a -> m a
return (a
x forall a. Semigroup a => a -> a -> a
S.<> a
y)

instance (S.Semigroup a, Monoid a) => Monoid (RenameM a) where
  {-# INLINE mempty #-}
  mempty :: RenameM a
mempty = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

  {-# INLINE mappend #-}
  mappend :: RenameM a -> RenameM a -> RenameM a
mappend = forall a. Semigroup a => a -> a -> a
(S.<>)

instance Functor RenameM where
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> RenameM a -> RenameM b
fmap a -> b
f RenameM a
m      = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m))

instance Applicative RenameM where
  {-# INLINE pure #-}
  pure :: forall a. a -> RenameM a
pure a
x        = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

  {-# INLINE (<*>) #-}
  RenameM (a -> b)
l <*> :: forall a b. RenameM (a -> b) -> RenameM a -> RenameM b
<*> RenameM a
r       = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM (a -> b)
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
r)

instance Monad RenameM where
  {-# INLINE return #-}
  return :: forall a. a -> RenameM a
return        = forall (f :: * -> *) a. Applicative f => a -> f a
pure

  {-# INLINE (>>=) #-}
  RenameM a
m >>= :: forall a b. RenameM a -> (a -> RenameM b) -> RenameM b
>>= a -> RenameM b
k       = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RenameM b
k)

instance FreshM RenameM where
  liftSupply :: forall a. (Supply -> (a, Supply)) -> RenameM a
liftSupply Supply -> (a, Supply)
f = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets forall a b. (a -> b) -> a -> b
$ \ RW { [RenamerWarning]
Map Name Int
Map DepName (Set Name)
Set Name
Set RenamerError
Supply
IfaceDecls
rwExternalDeps :: IfaceDecls
rwDepGraph :: Map DepName (Set Name)
rwCurrentDeps :: Set Name
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwErrors :: Set RenamerError
rwWarnings :: [RenamerWarning]
rwExternalDeps :: RW -> IfaceDecls
rwDepGraph :: RW -> Map DepName (Set Name)
rwCurrentDeps :: RW -> Set Name
rwNameUseCount :: RW -> Map Name Int
rwSupply :: RW -> Supply
rwErrors :: RW -> Set RenamerError
rwWarnings :: RW -> [RenamerWarning]
.. } ->
    let (a
a,Supply
s') = Supply -> (a, Supply)
f Supply
rwSupply
        rw' :: RW
rw'    = RW { rwSupply :: Supply
rwSupply = Supply
s', [RenamerWarning]
Map Name Int
Map DepName (Set Name)
Set Name
Set RenamerError
IfaceDecls
rwExternalDeps :: IfaceDecls
rwDepGraph :: Map DepName (Set Name)
rwCurrentDeps :: Set Name
rwNameUseCount :: Map Name Int
rwErrors :: Set RenamerError
rwWarnings :: [RenamerWarning]
rwExternalDeps :: IfaceDecls
rwDepGraph :: Map DepName (Set Name)
rwCurrentDeps :: Set Name
rwNameUseCount :: Map Name Int
rwErrors :: Set RenamerError
rwWarnings :: [RenamerWarning]
.. }
     in a
a seq :: forall a b. a -> b -> b
`seq` RW
rw' seq :: forall a b. a -> b -> b
`seq` (a
a, RW
rw')


runRenamer :: RenamerInfo -> RenameM a
           -> ( Either [RenamerError] (a,Supply)
              , [RenamerWarning]
              )
runRenamer :: forall a.
RenamerInfo
-> RenameM a
-> (Either [RenamerError] (a, Supply), [RenamerWarning])
runRenamer RenamerInfo
info RenameM a
m = (Either [RenamerError] (a, Supply)
res, [RenamerWarning]
warns)
  where
  warns :: [RenamerWarning]
warns = forall a. Ord a => [a] -> [a]
sort (RW -> [RenamerWarning]
rwWarnings RW
rw forall a. [a] -> [a] -> [a]
++ ModPath -> NamingEnv -> RW -> [RenamerWarning]
warnUnused (RenamerInfo -> ModPath
renContext RenamerInfo
info) (RenamerInfo -> NamingEnv
renEnv RenamerInfo
info) RW
rw)

  (a
a,RW
rw) = forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m) RO
ro
                              RW { rwErrors :: Set RenamerError
rwErrors   = forall a. Set a
Set.empty
                                 , rwWarnings :: [RenamerWarning]
rwWarnings = []
                                 , rwSupply :: Supply
rwSupply   = RenamerInfo -> Supply
renSupply RenamerInfo
info
                                 , rwNameUseCount :: Map Name Int
rwNameUseCount = forall k a. Map k a
Map.empty
                                 , rwExternalDeps :: IfaceDecls
rwExternalDeps = forall a. Monoid a => a
mempty
                                 , rwCurrentDeps :: Set Name
rwCurrentDeps = forall a. Set a
Set.empty
                                 , rwDepGraph :: Map DepName (Set Name)
rwDepGraph = forall k a. Map k a
Map.empty
                                 }

  ro :: RO
ro = RO { roLoc :: Range
roLoc   = Range
emptyRange
          , roNames :: NamingEnv
roNames = RenamerInfo -> NamingEnv
renEnv RenamerInfo
info
          , roExternal :: Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
roExternal = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey forall {name}.
ModName
-> Either ModParamNames (IfaceG name)
-> (Maybe (IfaceG name), Map (ImpName Name) (Mod ()))
toModMap (RenamerInfo -> Map ModName (Either ModParamNames Iface)
renIfaces RenamerInfo
info)
          , roCurMod :: ModPath
roCurMod = RenamerInfo -> ModPath
renContext RenamerInfo
info
          , roNestedMods :: Map ModPath Name
roNestedMods = forall k a. Map k a
Map.empty
          , roResolvedModules :: Map (ImpName Name) ResolvedLocal
roResolvedModules = forall a. Monoid a => a
mempty
          , roModParams :: Map Ident RenModParam
roModParams = forall a. Monoid a => a
mempty
          , roFromModParam :: Map Name DepName
roFromModParam = forall a. Monoid a => a
mempty
          }

  res :: Either [RenamerError] (a, Supply)
res | forall a. Set a -> Bool
Set.null (RW -> Set RenamerError
rwErrors RW
rw) = forall a b. b -> Either a b
Right (a
a,RW -> Supply
rwSupply RW
rw)
      | Bool
otherwise              = forall a b. a -> Either a b
Left (forall a. Set a -> [a]
Set.toList (RW -> Set RenamerError
rwErrors RW
rw))

  toModMap :: ModName
-> Either ModParamNames (IfaceG name)
-> (Maybe (IfaceG name), Map (ImpName Name) (Mod ()))
toModMap ModName
t Either ModParamNames (IfaceG name)
ent =
    case Either ModParamNames (IfaceG name)
ent of
      Left ModParamNames
ps -> (forall a. Maybe a
Nothing, forall k a. k -> a -> Map k a
Map.singleton (forall name. ModName -> ImpName name
ImpTop ModName
t) (ModParamNames -> Mod ()
ifaceSigToMod ModParamNames
ps))
      Right IfaceG name
i -> (forall a. a -> Maybe a
Just IfaceG name
i, ImpName Name
-> Mod ()
-> Map (ImpName Name) (Mod ())
-> Map (ImpName Name) (Mod ())
modToMap (forall name. ModName -> ImpName name
ImpTop ModName
t) (forall name. IfaceG name -> Mod ()
ifaceToMod IfaceG name
i) forall a. Monoid a => a
mempty)



setCurMod :: ModPath -> RenameM a -> RenameM a
setCurMod :: forall a. ModPath -> RenameM a -> RenameM a
setCurMod ModPath
mpath (RenameM ReaderT RO (StateT RW Lift) a
m) =
  forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. RunReaderM m r => (r -> r) -> m a -> m a
mapReader (\RO
ro -> RO
ro { roCurMod :: ModPath
roCurMod = ModPath
mpath }) ReaderT RO (StateT RW Lift) a
m

getCurMod :: RenameM ModPath
getCurMod :: RenameM ModPath
getCurMod = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. ReaderM m r => (r -> a) -> m a
asks RO -> ModPath
roCurMod

getNamingEnv :: RenameM NamingEnv
getNamingEnv :: RenameM NamingEnv
getNamingEnv = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall (m :: * -> *) r a. ReaderM m r => (r -> a) -> m a
asks RO -> NamingEnv
roNames)

setResolvedLocals :: Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals :: forall a.
Map (ImpName Name) ResolvedLocal -> RenameM a -> RenameM a
setResolvedLocals Map (ImpName Name) ResolvedLocal
mp (RenameM ReaderT RO (StateT RW Lift) a
m) =
  forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. RunReaderM m r => (r -> r) -> m a -> m a
mapReader (\RO
ro -> RO
ro { roResolvedModules :: Map (ImpName Name) ResolvedLocal
roResolvedModules = Map (ImpName Name) ResolvedLocal
mp }) ReaderT RO (StateT RW Lift) a
m

lookupResolved :: ImpName Name -> RenameM ResolvedLocal
lookupResolved :: ImpName Name -> RenameM ResolvedLocal
lookupResolved ImpName Name
nm =
  do Map (ImpName Name) ResolvedLocal
mp <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> Map (ImpName Name) ResolvedLocal
roResolvedModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)
     forall (f :: * -> *) a. Applicative f => a -> f a
pure case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ImpName Name
nm Map (ImpName Name) ResolvedLocal
mp of
            Just ResolvedLocal
r  -> ResolvedLocal
r

            -- XXX: could this happen because we couldn't resolve a module?
            Maybe ResolvedLocal
Nothing -> forall a. HasCallStack => [Char] -> [[Char]] -> a
panic [Char]
"lookupResolved"
                        [ [Char]
"Missing module: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ImpName Name
nm ]

setModParams :: [RenModParam] -> RenameM a -> RenameM a
setModParams :: forall a. [RenModParam] -> RenameM a -> RenameM a
setModParams [RenModParam]
ps (RenameM ReaderT RO (StateT RW Lift) a
m) =
  do let pmap :: Map Ident RenModParam
pmap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (RenModParam -> Ident
renModParamName RenModParam
p, RenModParam
p) | RenModParam
p <- [RenModParam]
ps ]

         newFrom :: Map Name DepName
newFrom =
           forall a b. [a] -> b -> (a -> b -> b) -> b
foldLoop [RenModParam]
ps forall a. Monoid a => a
mempty \RenModParam
p Map Name DepName
mp ->
             let nm :: DepName
nm = Range -> Ident -> DepName
ModParamName (RenModParam -> Range
renModParamRange RenModParam
p) (RenModParam -> Ident
renModParamName RenModParam
p)
             in forall a b. [a] -> b -> (a -> b -> b) -> b
foldLoop (forall k a. Map k a -> [k]
Map.keys (RenModParam -> Map Name Name
renModParamInstance RenModParam
p)) Map Name DepName
mp \Name
x ->
                  forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
x DepName
nm

         upd :: RO -> RO
upd RO
ro = RO
ro { roModParams :: Map Ident RenModParam
roModParams    = Map Ident RenModParam
pmap
                     , roFromModParam :: Map Name DepName
roFromModParam = Map Name DepName
newFrom forall a. Semigroup a => a -> a -> a
<> RO -> Map Name DepName
roFromModParam RO
ro
                     }

     forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall (m :: * -> *) r a. RunReaderM m r => (r -> r) -> m a -> m a
mapReader RO -> RO
upd ReaderT RO (StateT RW Lift) a
m)


foldLoop :: [a] -> b -> (a -> b -> b) -> b
foldLoop :: forall a b. [a] -> b -> (a -> b -> b) -> b
foldLoop [a]
xs b
b a -> b -> b
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f) b
b [a]
xs

getModParam :: Ident -> RenameM RenModParam
getModParam :: Ident -> RenameM RenModParam
getModParam Ident
p =
  do Map Ident RenModParam
ps <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> Map Ident RenModParam
roModParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)
     case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
p Map Ident RenModParam
ps of
       Just RenModParam
r  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RenModParam
r
       Maybe RenModParam
Nothing -> forall a. HasCallStack => [Char] -> [[Char]] -> a
panic [Char]
"getModParam" [ [Char]
"Missing module paramter", forall a. Show a => a -> [Char]
show Ident
p ]

getNamesFromModParams :: RenameM (Map Name DepName)
getNamesFromModParams :: RenameM (Map Name DepName)
getNamesFromModParams = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> Map Name DepName
roFromModParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)

getLocalModParamDeps :: RenameM (Map Ident DepName)
getLocalModParamDeps :: RenameM (Map Ident DepName)
getLocalModParamDeps =
  do Map Ident RenModParam
ps <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> Map Ident RenModParam
roModParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)
     let toName :: RenModParam -> DepName
toName RenModParam
mp = Range -> Ident -> DepName
ModParamName (RenModParam -> Range
renModParamRange RenModParam
mp) (RenModParam -> Ident
renModParamName RenModParam
mp)
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenModParam -> DepName
toName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident RenModParam
ps)


setNestedModule :: Map ModPath Name -> RenameM a -> RenameM a
setNestedModule :: forall a. Map ModPath Name -> RenameM a -> RenameM a
setNestedModule Map ModPath Name
mp (RenameM ReaderT RO (StateT RW Lift) a
m) =
  forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. RunReaderM m r => (r -> r) -> m a -> m a
mapReader (\RO
ro -> RO
ro { roNestedMods :: Map ModPath Name
roNestedMods = Map ModPath Name
mp }) ReaderT RO (StateT RW Lift) a
m

nestedModuleOrig :: ModPath -> RenameM (Maybe Name)
nestedModuleOrig :: ModPath -> RenameM (Maybe Name)
nestedModuleOrig ModPath
x = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (forall (m :: * -> *) r a. ReaderM m r => (r -> a) -> m a
asks (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModPath
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. RO -> Map ModPath Name
roNestedMods))


-- | Record an error.
recordError :: RenamerError -> RenameM ()
recordError :: RenamerError -> RenameM ()
recordError RenamerError
f = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$
  do RW { [RenamerWarning]
Map Name Int
Map DepName (Set Name)
Set Name
Set RenamerError
Supply
IfaceDecls
rwExternalDeps :: IfaceDecls
rwDepGraph :: Map DepName (Set Name)
rwCurrentDeps :: Set Name
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwErrors :: Set RenamerError
rwWarnings :: [RenamerWarning]
rwExternalDeps :: RW -> IfaceDecls
rwDepGraph :: RW -> Map DepName (Set Name)
rwCurrentDeps :: RW -> Set Name
rwNameUseCount :: RW -> Map Name Int
rwSupply :: RW -> Supply
rwErrors :: RW -> Set RenamerError
rwWarnings :: RW -> [RenamerWarning]
.. } <- forall (m :: * -> *) i. StateM m i => m i
get
     forall (m :: * -> *) i. StateM m i => i -> m ()
set RW { rwErrors :: Set RenamerError
rwErrors = forall a. Ord a => a -> Set a -> Set a
Set.insert RenamerError
f Set RenamerError
rwErrors, [RenamerWarning]
Map Name Int
Map DepName (Set Name)
Set Name
Supply
IfaceDecls
rwExternalDeps :: IfaceDecls
rwDepGraph :: Map DepName (Set Name)
rwCurrentDeps :: Set Name
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwWarnings :: [RenamerWarning]
rwExternalDeps :: IfaceDecls
rwDepGraph :: Map DepName (Set Name)
rwCurrentDeps :: Set Name
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwWarnings :: [RenamerWarning]
.. }

recordWarning :: RenamerWarning -> RenameM ()
recordWarning :: RenamerWarning -> RenameM ()
recordWarning RenamerWarning
w =
  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
w forall a. a -> [a] -> [a]
: RW -> [RenamerWarning]
rwWarnings RW
rw }

collectIfaceDeps :: RenameM a -> RenameM (IfaceDecls,a)
collectIfaceDeps :: forall a. RenameM a -> RenameM (IfaceDecls, a)
collectIfaceDeps (RenameM ReaderT RO (StateT RW Lift) a
m) =
  forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM
  do IfaceDecls
ds  <- forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets \RW
s -> (RW -> IfaceDecls
rwExternalDeps RW
s, RW
s { rwExternalDeps :: IfaceDecls
rwExternalDeps = forall a. Monoid a => a
mempty })
     a
a   <- ReaderT RO (StateT RW Lift) a
m
     IfaceDecls
ds' <- forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets \RW
s -> (RW -> IfaceDecls
rwExternalDeps RW
s, RW
s { rwExternalDeps :: IfaceDecls
rwExternalDeps = IfaceDecls
ds })
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (IfaceDecls
ds',a
a)

-- |  Rename something.  All name uses in the sub-computation are assumed
-- to be dependenices of the thing.
depsOf :: DepName -> RenameM a -> RenameM a
depsOf :: forall a. DepName -> RenameM a -> RenameM a
depsOf DepName
x (RenameM ReaderT RO (StateT RW Lift) a
m) = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM
  do Set Name
ds <- forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets \RW
rw -> (RW -> Set Name
rwCurrentDeps RW
rw, RW
rw { rwCurrentDeps :: Set Name
rwCurrentDeps = forall a. Set a
Set.empty })
     a
a  <- ReaderT RO (StateT RW Lift) a
m
     forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ \RW
rw ->
        RW
rw { rwCurrentDeps :: Set Name
rwCurrentDeps = forall a. Ord a => Set a -> Set a -> Set a
Set.union (RW -> Set Name
rwCurrentDeps RW
rw) Set Name
ds
           , rwDepGraph :: Map DepName (Set Name)
rwDepGraph = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DepName
x (RW -> Set Name
rwCurrentDeps RW
rw) (RW -> Map DepName (Set Name)
rwDepGraph RW
rw)
           }
     forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | This is used when renaming a group of things.  The result contains
-- dependencies between names defined in the group, and is intended to
-- be used to order the group members in dependency order.
depGroup :: RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup :: forall a. RenameM a -> RenameM (a, Map DepName (Set Name))
depGroup (RenameM ReaderT RO (StateT RW Lift) a
m) = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM
  do Map DepName (Set Name)
ds  <- forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets \RW
rw -> (RW -> Map DepName (Set Name)
rwDepGraph RW
rw, RW
rw { rwDepGraph :: Map DepName (Set Name)
rwDepGraph = forall k a. Map k a
Map.empty })
     a
a   <- ReaderT RO (StateT RW Lift) a
m
     Map DepName (Set Name)
ds1 <- forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets \RW
rw -> (RW -> Map DepName (Set Name)
rwDepGraph RW
rw, RW
rw { rwDepGraph :: Map DepName (Set Name)
rwDepGraph = Map DepName (Set Name)
ds })
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,Map DepName (Set Name)
ds1)

-- | Get the source range for wahtever we are currently renaming.
curLoc :: RenameM Range
curLoc :: RenameM Range
curLoc  = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> Range
roLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. ReaderM m i => m i
ask)

-- | Annotate something with the current range.
located :: a -> RenameM (Located a)
located :: forall a. a -> RenameM (Located a)
located a
thing =
  do Range
srcRange <- RenameM Range
curLoc
     forall (m :: * -> *) a. Monad m => a -> m a
return Located { a
Range
thing :: a
srcRange :: Range
srcRange :: Range
thing :: a
.. }

-- | Do the given computation using the source code range from `loc` if any.
withLoc :: HasLoc loc => loc -> RenameM a -> RenameM a
withLoc :: forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc loc
loc RenameM a
m = forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall a b. (a -> b) -> a -> b
$ case forall t. HasLoc t => t -> Maybe Range
getLoc loc
loc of

  Just Range
range -> do
    RO
ro <- forall (m :: * -> *) i. ReaderM m i => m i
ask
    forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO
ro { roLoc :: Range
roLoc = Range
range } (forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m)

  Maybe Range
Nothing -> forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m


-- | Shadow the current naming environment with some more names.
shadowNames :: BindsNames env => env -> RenameM a -> RenameM a
shadowNames :: forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames  = forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckAll

data EnvCheck = CheckAll     -- ^ Check for overlap and shadowing
              | CheckOverlap -- ^ Only check for overlap
              | CheckNone    -- ^ Don't check the environment
                deriving (EnvCheck -> EnvCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvCheck -> EnvCheck -> Bool
$c/= :: EnvCheck -> EnvCheck -> Bool
== :: EnvCheck -> EnvCheck -> Bool
$c== :: EnvCheck -> EnvCheck -> Bool
Eq,Int -> EnvCheck -> ShowS
[EnvCheck] -> ShowS
EnvCheck -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EnvCheck] -> ShowS
$cshowList :: [EnvCheck] -> ShowS
show :: EnvCheck -> [Char]
$cshow :: EnvCheck -> [Char]
showsPrec :: Int -> EnvCheck -> ShowS
$cshowsPrec :: Int -> EnvCheck -> ShowS
Show)

-- | Report errors if the given naming environemnt contains multiple
-- definitions for the same symbol
checkOverlap :: NamingEnv -> RenameM NamingEnv
checkOverlap :: NamingEnv -> RenameM NamingEnv
checkOverlap NamingEnv
env =
  case NamingEnv -> [[Name]]
findAmbig NamingEnv
env of
    []    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingEnv
env
    [[Name]]
ambig -> do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerError -> RenameM ()
recordError [ [Name] -> RenamerError
OverlappingSyms [Name]
xs | [Name]
xs <- [[Name]]
ambig ]
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv -> NamingEnv
forceUnambig NamingEnv
env)

-- | Issue warnings if entries in the first environment would
-- shadow something in the second.
checkShadowing :: NamingEnv -> NamingEnv -> RenameM ()
checkShadowing :: NamingEnv -> NamingEnv -> RenameM ()
checkShadowing NamingEnv
envNew NamingEnv
envOld =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenamerWarning -> RenameM ()
recordWarning
    [ PName -> Name -> [Name] -> RenamerWarning
SymbolShadowed PName
p Name
x [Name]
xs | (PName
p,Name
x,[Name]
xs) <- NamingEnv -> NamingEnv -> [(PName, Name, [Name])]
findShadowing NamingEnv
envNew NamingEnv
envOld ]


-- | Shadow the current naming environment with some more names.
-- XXX: The checks are really confusing
shadowNames' :: BindsNames env => EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' :: forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
check env
names RenameM a
m = do
  do NamingEnv
env    <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
defsOf env
names)
     NamingEnv
envOld <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> NamingEnv
roNames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)
     NamingEnv
env1   <- case EnvCheck
check of
                 EnvCheck
CheckNone    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingEnv
env
                 EnvCheck
CheckOverlap -> NamingEnv -> RenameM NamingEnv
checkOverlap NamingEnv
env
                 EnvCheck
CheckAll     -> do NamingEnv -> NamingEnv -> RenameM ()
checkShadowing NamingEnv
env NamingEnv
envOld
                                    NamingEnv -> RenameM NamingEnv
checkOverlap NamingEnv
env
     forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM
       do RO
ro  <- forall (m :: * -> *) i. ReaderM m i => m i
ask
          let ro' :: RO
ro' = RO
ro { roNames :: NamingEnv
roNames = NamingEnv
env1 NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
envOld }
          forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO
ro' (forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m)

recordUse :: Name -> RenameM ()
recordUse :: Name -> RenameM ()
recordUse Name
x = 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_ forall a b. (a -> b) -> a -> b
$ \RW
rw ->
  RW
rw { rwNameUseCount :: Map Name Int
rwNameUseCount = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Num a => a -> a -> a
(+) Name
x Int
1 (RW -> Map Name Int
rwNameUseCount RW
rw) }
  {- NOTE: we don't distinguish between bindings and uses here, because
  the situation is complicated by the pattern signatures where the first
  "use" site is actually the binding site.  Instead we just count them all, and
  something is considered unused if it is used only once (i.e, just the
  binding site) -}

-- | Mark something as a dependency. This is similar but different from
-- `recordUse`, in particular:
--    * We only record use sites, not bindings
--    * We record all namespaces, not just types
--    * We only keep track of actual uses mentioned in the code.
--      Otoh, `recordUse` also considers exported entities to be used.
--    * If we depend on a name from a sibling submodule we add a dependency on
--      the module in our common ancestor.  Examples:
--      - @A::B::x@ depends on @A::B::C::D::y@, @x@ depends on @A::B::C@
--      - @A::B::x@ depends on @A::P::Q::y@@,   @x@ depends on @A::P@

addDep :: Name -> RenameM ()
addDep :: Name -> RenameM ()
addDep Name
x =
  do ModPath
cur  <- RenameM ModPath
getCurMod
     Set Name
deps <- case Name -> NameInfo
nameInfo Name
x of
               GlobalName NameSource
_ OrigName { ogModule :: OrigName -> ModPath
ogModule = ModPath
m }
                 | Just (ModPath
c,[Ident]
_,Ident
i:[Ident]
_) <- ModPath -> ModPath -> Maybe (ModPath, [Ident], [Ident])
modPathCommon ModPath
cur ModPath
m ->
                 do Maybe Name
mb <- ModPath -> RenameM (Maybe Name)
nestedModuleOrig (ModPath -> Ident -> ModPath
Nested ModPath
c Ident
i)
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure case Maybe Name
mb of
                           Just Name
y  -> forall a. Ord a => [a] -> Set a
Set.fromList [Name
x,Name
y]
                           Maybe Name
Nothing -> forall a. a -> Set a
Set.singleton Name
x
               NameInfo
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
Set.singleton Name
x)
     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 { rwCurrentDeps :: Set Name
rwCurrentDeps = forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Name
deps (RW -> Set Name
rwCurrentDeps RW
rw) }


warnUnused :: ModPath -> NamingEnv -> RW -> [RenamerWarning]
warnUnused :: ModPath -> NamingEnv -> RW -> [RenamerWarning]
warnUnused ModPath
m0 NamingEnv
env RW
rw =
  forall a b. (a -> b) -> [a] -> [b]
map Name -> RenamerWarning
UnusedName
  forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys
  forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey forall {a}. (Eq a, Num a) => Name -> a -> Bool
keep
  forall a b. (a -> b) -> a -> b
$ RW -> Map Name Int
rwNameUseCount RW
rw
  where
  keep :: Name -> a -> Bool
keep Name
nm a
count = a
count forall a. Eq a => a -> a -> Bool
== a
1 Bool -> Bool -> Bool
&& Name -> Bool
isLocal Name
nm
  oldNames :: Set Name
oldNames = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty Namespace
NSType (NamingEnv -> Map Namespace (Set Name)
visibleNames NamingEnv
env)

  -- returns true iff the name comes from a definition in a nested module,
  -- including the current module
  isNestd :: OrigName -> Bool
isNestd OrigName
og = case ModPath -> ModPath -> Maybe (ModPath, [Ident], [Ident])
modPathCommon ModPath
m0 (OrigName -> ModPath
ogModule OrigName
og) of
                 Just (ModPath
_,[],[Ident]
_) | OrigSource
FromDefinition <- OrigName -> OrigSource
ogSource OrigName
og -> Bool
True
                 Maybe (ModPath, [Ident], [Ident])
_ -> Bool
False

  isLocal :: Name -> Bool
isLocal Name
nm = case Name -> NameInfo
nameInfo Name
nm of
                 GlobalName NameSource
sys OrigName
og ->
                   NameSource
sys forall a. Eq a => a -> a -> Bool
== NameSource
UserName Bool -> Bool -> Bool
&& OrigName -> Bool
isNestd OrigName
og Bool -> Bool -> Bool
&& Name
nm forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Name
oldNames
                 LocalName {} -> Bool
True


getExternal :: RenameM (ImpName Name -> Mod ())
getExternal :: RenameM (ImpName Name -> Mod ())
getExternal =
  do Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
mp <- RO -> Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
roExternal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     forall (f :: * -> *) a. Applicative f => a -> f a
pure \ImpName Name
nm -> let mb :: Maybe (Mod ())
mb = do ModName
t   <- case ImpName Name
nm of
                                      ImpTop ModName
t  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ModName
t
                                      ImpNested Name
x -> Name -> Maybe ModName
nameTopModuleMaybe Name
x
                             (Maybe Iface
_,Map (ImpName Name) (Mod ())
mp1) <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModName
t Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
mp
                             forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ImpName Name
nm Map (ImpName Name) (Mod ())
mp1
                 in case Maybe (Mod ())
mb of
                      Just Mod ()
m -> Mod ()
m
                      Maybe (Mod ())
Nothing -> forall a. HasCallStack => [Char] -> [[Char]] -> a
panic [Char]
"getExternal"
                                    [[Char]
"Missing external name", forall a. Show a => a -> [Char]
show (forall a. PP a => a -> Doc
pp ImpName Name
nm) ]

getExternalMod :: ImpName Name -> RenameM (Mod ())
getExternalMod :: ImpName Name -> RenameM (Mod ())
getExternalMod ImpName Name
nm = (forall a b. (a -> b) -> a -> b
$ ImpName Name
nm) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RenameM (ImpName Name -> Mod ())
getExternal

-- | Returns `Nothing` if the name does not refer to a module (i.e., it is a sig)
getTopModuleIface :: ImpName Name -> RenameM (Maybe Iface)
getTopModuleIface :: ImpName Name -> RenameM (Maybe Iface)
getTopModuleIface ImpName Name
nm =
  do Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
mp <- RO -> Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
roExternal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     let t :: ModName
t = case ImpName Name
nm of
               ImpTop ModName
t' -> ModName
t'
               ImpNested Name
x -> Name -> ModName
nameTopModule Name
x
     case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModName
t Map ModName (Maybe Iface, Map (ImpName Name) (Mod ()))
mp of
       Just (Maybe Iface
mb, Map (ImpName Name) (Mod ())
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Iface
mb
       Maybe (Maybe Iface, Map (ImpName Name) (Mod ()))
Nothing -> forall a. HasCallStack => [Char] -> [[Char]] -> a
panic [Char]
"getTopModuleIface"
                                [[Char]
"Missing external module", forall a. Show a => a -> [Char]
show (forall a. PP a => a -> Doc
pp ImpName Name
nm) ]

{- | Record an import:
      * record external dependency if the name refers to an external import
      * record an error if the imported thing is a functor
-}
recordImport :: Range -> ImpName Name -> RenameM ()
recordImport :: Range -> ImpName Name -> RenameM ()
recordImport Range
r ImpName Name
i =
  do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ImpName Name
i (RO -> Map (ImpName Name) ResolvedLocal
roResolvedModules RO
ro) of
       Just ResolvedLocal
loc ->
         case forall imps. ResolvedModule imps -> ModKind
rmodKind ResolvedLocal
loc of
           ModKind
AModule -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
           ModKind
k       -> RenamerError -> RenameM ()
recordError (Range -> ImpName Name -> ModKind -> ModKind -> RenamerError
ModuleKindMismatch Range
r ImpName Name
i ModKind
AModule ModKind
k)
       Maybe ResolvedLocal
Nothing ->
        do Maybe Iface
mb <- ImpName Name -> RenameM (Maybe Iface)
getTopModuleIface ImpName Name
i
           case Maybe Iface
mb of
             Maybe Iface
Nothing -> RenamerError -> RenameM ()
recordError (Range -> ImpName Name -> ModKind -> ModKind -> RenamerError
ModuleKindMismatch Range
r ImpName Name
i ModKind
AModule ModKind
ASignature)
             Just Iface
iface
               | forall name. IfaceG name -> Bool
ifaceIsFunctor Iface
iface ->
                       RenamerError -> RenameM ()
recordError (Range -> ImpName Name -> ModKind -> ModKind -> RenamerError
ModuleKindMismatch Range
r ImpName Name
i ModKind
AModule ModKind
AFunctor)
               | Bool
otherwise ->
                 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
s -> RW
s { rwExternalDeps :: IfaceDecls
rwExternalDeps = forall name. IfaceG name -> IfaceDecls
ifDefines Iface
iface forall a. Semigroup a => a -> a -> a
<>
                                                            RW -> IfaceDecls
rwExternalDeps RW
s }


-- | Lookup a name either in the locally resolved thing or in an external module
lookupModuleThing :: ImpName Name -> RenameM (Either ResolvedLocal (Mod ()))
lookupModuleThing :: ImpName Name -> RenameM (Either ResolvedLocal (Mod ()))
lookupModuleThing ImpName Name
nm =
  do RO
ro <- forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM forall (m :: * -> *) i. ReaderM m i => m i
ask
     case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ImpName Name
nm (RO -> Map (ImpName Name) ResolvedLocal
roResolvedModules RO
ro) of
       Just ResolvedLocal
loc -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ResolvedLocal
loc)
       Maybe ResolvedLocal
Nothing  -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpName Name -> RenameM (Mod ())
getExternalMod ImpName Name
nm

lookupDefines :: ImpName Name -> RenameM NamingEnv
lookupDefines :: ImpName Name -> RenameM NamingEnv
lookupDefines ImpName Name
nm =
  do Either ResolvedLocal (Mod ())
thing <- ImpName Name -> RenameM (Either ResolvedLocal (Mod ()))
lookupModuleThing ImpName Name
nm
     forall (f :: * -> *) a. Applicative f => a -> f a
pure case Either ResolvedLocal (Mod ())
thing of
            Left ResolvedLocal
loc -> forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedLocal
loc
            Right Mod ()
e  -> forall a. Mod a -> NamingEnv
modDefines Mod ()
e

checkIsModule :: Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule :: Range -> ImpName Name -> ModKind -> RenameM ()
checkIsModule Range
r ImpName Name
nm ModKind
expect =
  do Either ResolvedLocal (Mod ())
thing <- ImpName Name -> RenameM (Either ResolvedLocal (Mod ()))
lookupModuleThing ImpName Name
nm
     let actual :: ModKind
actual = case Either ResolvedLocal (Mod ())
thing of
                    Left ResolvedLocal
rmod -> forall imps. ResolvedModule imps -> ModKind
rmodKind ResolvedLocal
rmod
                    Right Mod ()
mo  -> forall a. Mod a -> ModKind
modKind Mod ()
mo
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ModKind
actual forall a. Eq a => a -> a -> Bool
== ModKind
expect)
        (RenamerError -> RenameM ()
recordError (Range -> ImpName Name -> ModKind -> ModKind -> RenamerError
ModuleKindMismatch Range
r ImpName Name
nm ModKind
expect ModKind
actual))

lookupDefinesAndSubs :: ImpName Name -> RenameM (NamingEnv, Set Name)
lookupDefinesAndSubs :: ImpName Name -> RenameM (NamingEnv, Set Name)
lookupDefinesAndSubs ImpName Name
nm =
  do Either ResolvedLocal (Mod ())
thing <- ImpName Name -> RenameM (Either ResolvedLocal (Mod ()))
lookupModuleThing ImpName Name
nm
     forall (f :: * -> *) a. Applicative f => a -> f a
pure case Either ResolvedLocal (Mod ())
thing of
            Left ResolvedLocal
rmod -> ( forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedLocal
rmod, forall imps. ResolvedModule imps -> Set Name
rmodNested ResolvedLocal
rmod)
            Right Mod ()
m ->
              ( forall a. Mod a -> NamingEnv
modDefines Mod ()
m
              , forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ forall k a. Map k a -> Set k
Map.keysSet (forall a. Mod a -> Map Name (Mod a)
modMods Mod ()
m)
                           , forall k a. Map k a -> Set k
Map.keysSet (forall a.
Mod a -> Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances Mod ()
m)
                           ]
              )