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

    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RecordWildCards #-}
    module Cryptol.ModuleSystem.NamingEnv where

    import Cryptol.ModuleSystem.Interface
    import Cryptol.ModuleSystem.Name
    import Cryptol.Parser.AST
    import Cryptol.Parser.Name(isGeneratedName)
    import Cryptol.Parser.Position
    import qualified Cryptol.TypeCheck.AST as T
    import Cryptol.Utils.PP
    import Cryptol.Utils.Panic (panic)

    import Data.List (nub)
    import Data.Maybe (fromMaybe)
    import qualified Data.Map.Strict as Map
    import qualified Data.Set as Set
    import Data.Semigroup
    import MonadLib (runId,Id)

    import GHC.Generics (Generic)
    import Control.DeepSeq

    import Prelude ()
    import Prelude.Compat

    -- Naming Environment ----------------------------------------------------------

    -- XXX The fixity environment should be removed, and Name should include fixity
    -- information.
    data NamingEnv = NamingEnv { NamingEnv -> Map PName [Name]
    neExprs :: !(Map.Map PName [Name])
                                 -- ^ Expr renaming environment
                               , NamingEnv -> Map PName [Name]
    neTypes :: !(Map.Map PName [Name])
                                 -- ^ Type renaming environment
                               } deriving (Int -> NamingEnv -> ShowS
    [NamingEnv] -> ShowS
    NamingEnv -> String
    (Int -> NamingEnv -> ShowS)
    -> (NamingEnv -> String)
    -> ([NamingEnv] -> ShowS)
    -> Show NamingEnv
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [NamingEnv] -> ShowS
    $cshowList :: [NamingEnv] -> ShowS
    show :: NamingEnv -> String
    $cshow :: NamingEnv -> String
    showsPrec :: Int -> NamingEnv -> ShowS
    $cshowsPrec :: Int -> NamingEnv -> ShowS
    Show, (forall x. NamingEnv -> Rep NamingEnv x)
    -> (forall x. Rep NamingEnv x -> NamingEnv) -> Generic NamingEnv
    forall x. Rep NamingEnv x -> NamingEnv
    forall x. NamingEnv -> Rep NamingEnv x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep NamingEnv x -> NamingEnv
    $cfrom :: forall x. NamingEnv -> Rep NamingEnv x
    Generic, NamingEnv -> ()
    (NamingEnv -> ()) -> NFData NamingEnv
    forall a. (a -> ()) -> NFData a
    rnf :: NamingEnv -> ()
    $crnf :: NamingEnv -> ()
    NFData)

    -- | Return a list of value-level names to which this parsed name may refer.
    lookupValNames :: PName -> NamingEnv -> [Name]
    lookupValNames :: PName -> NamingEnv -> [Name]
    lookupValNames qn :: PName
    qn ro :: NamingEnv
    ro = [Name] -> PName -> Map PName [Name] -> [Name]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] PName
    qn (NamingEnv -> Map PName [Name]
    neExprs NamingEnv
    ro)

    -- | Return a list of type-level names to which this parsed name may refer.
    lookupTypeNames :: PName -> NamingEnv -> [Name]
    lookupTypeNames :: PName -> NamingEnv -> [Name]
    lookupTypeNames qn :: PName
    qn ro :: NamingEnv
    ro = [Name] -> PName -> Map PName [Name] -> [Name]
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault [] PName
    qn (NamingEnv -> Map PName [Name]
    neTypes NamingEnv
    ro)

    instance Semigroup NamingEnv where
      l :: NamingEnv
    l <> :: NamingEnv -> NamingEnv -> NamingEnv
    <> r :: NamingEnv
    r   =
        $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv { neExprs :: Map PName [Name]
    neExprs  = ([Name] -> [Name] -> [Name])
    -> Map PName [Name] -> Map PName [Name] -> Map PName [Name]
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith [Name] -> [Name] -> [Name]
    merge (NamingEnv -> Map PName [Name]
    neExprs  NamingEnv
    l) (NamingEnv -> Map PName [Name]
    neExprs  NamingEnv
    r)
                  , neTypes :: Map PName [Name]
    neTypes  = ([Name] -> [Name] -> [Name])
    -> Map PName [Name] -> Map PName [Name] -> Map PName [Name]
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith [Name] -> [Name] -> [Name]
    merge (NamingEnv -> Map PName [Name]
    neTypes  NamingEnv
    l) (NamingEnv -> Map PName [Name]
    neTypes  NamingEnv
    r) }

    instance Monoid NamingEnv where
      mempty :: NamingEnv
    mempty        =
        $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv { neExprs :: Map PName [Name]
    neExprs  = Map PName [Name]
    forall k a. Map k a
    Map.empty
                  , neTypes :: Map PName [Name]
    neTypes  = Map PName [Name]
    forall k a. Map k a
    Map.empty }

      mappend :: NamingEnv -> NamingEnv -> NamingEnv
    mappend l :: NamingEnv
    l r :: NamingEnv
    r   = NamingEnv
    l NamingEnv -> NamingEnv -> NamingEnv
    forall a. Semigroup a => a -> a -> a
    <> NamingEnv
    r

      mconcat :: [NamingEnv] -> NamingEnv
    mconcat envs :: [NamingEnv]
    envs  =
        $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv { neExprs :: Map PName [Name]
    neExprs  = ([Name] -> [Name] -> [Name])
    -> [Map PName [Name]] -> Map PName [Name]
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    (a -> a -> a) -> f (Map k a) -> Map k a
    Map.unionsWith [Name] -> [Name] -> [Name]
    merge ((NamingEnv -> Map PName [Name])
    -> [NamingEnv] -> [Map PName [Name]]
    forall a b. (a -> b) -> [a] -> [b]
    map NamingEnv -> Map PName [Name]
    neExprs  [NamingEnv]
    envs)
                  , neTypes :: Map PName [Name]
    neTypes  = ([Name] -> [Name] -> [Name])
    -> [Map PName [Name]] -> Map PName [Name]
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    (a -> a -> a) -> f (Map k a) -> Map k a
    Map.unionsWith [Name] -> [Name] -> [Name]
    merge ((NamingEnv -> Map PName [Name])
    -> [NamingEnv] -> [Map PName [Name]]
    forall a b. (a -> b) -> [a] -> [b]
    map NamingEnv -> Map PName [Name]
    neTypes  [NamingEnv]
    envs) }

      {-# INLINE mempty #-}
      {-# INLINE mappend #-}
      {-# INLINE mconcat #-}

    -- | Merge two name maps, collapsing cases where the entries are the same, and
    -- producing conflicts otherwise.
    merge :: [Name] -> [Name] -> [Name]
    merge :: [Name] -> [Name] -> [Name]
    merge xs :: [Name]
    xs ys :: [Name]
    ys | [Name]
    xs [Name] -> [Name] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Name]
    ys  = [Name]
    xs
                | Bool
    otherwise = [Name] -> [Name]
    forall a. Eq a => [a] -> [a]
    nub ([Name]
    xs [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name]
    ys)

    -- | Generate a mapping from 'Ident' to 'Name' for a given naming environment.
    toPrimMap :: NamingEnv -> PrimMap
    toPrimMap :: NamingEnv -> PrimMap
    toPrimMap NamingEnv { .. } = PrimMap :: Map Ident Name -> Map Ident Name -> PrimMap
    PrimMap { .. }
      where
      primDecls :: Map Ident Name
    primDecls = [(Ident, Name)] -> Map Ident Name
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [ (Name -> Ident
    nameIdent Name
    n,Name
    n) | [Name]
    ns <- Map PName [Name] -> [[Name]]
    forall k a. Map k a -> [a]
    Map.elems Map PName [Name]
    neExprs
                                                 , Name
    n  <- [Name]
    ns ]
      primTypes :: Map Ident Name
    primTypes = [(Ident, Name)] -> Map Ident Name
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [ (Name -> Ident
    nameIdent Name
    n,Name
    n) | [Name]
    ns <- Map PName [Name] -> [[Name]]
    forall k a. Map k a -> [a]
    Map.elems Map PName [Name]
    neTypes
                                                 , Name
    n  <- [Name]
    ns ]

    -- | Generate a display format based on a naming environment.
    toNameDisp :: NamingEnv -> NameDisp
    toNameDisp :: NamingEnv -> NameDisp
    toNameDisp NamingEnv { .. } = (ModName -> Ident -> Maybe NameFormat) -> NameDisp
    NameDisp ModName -> Ident -> Maybe NameFormat
    display
      where
      display :: ModName -> Ident -> Maybe NameFormat
    display mn :: ModName
    mn ident :: Ident
    ident = (ModName, Ident)
    -> Map (ModName, Ident) NameFormat -> Maybe NameFormat
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (ModName
    mn,Ident
    ident) Map (ModName, Ident) NameFormat
    names

      -- only format declared names, as parameters don't need any special
      -- formatting.
      names :: Map (ModName, Ident) NameFormat
    names = [((ModName, Ident), NameFormat)] -> Map (ModName, Ident) NameFormat
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
         ([((ModName, Ident), NameFormat)]
     -> Map (ModName, Ident) NameFormat)
    -> [((ModName, Ident), NameFormat)]
    -> Map (ModName, Ident) NameFormat
    forall a b. (a -> b) -> a -> b
    $ [ PName -> ModName -> Ident -> ((ModName, Ident), NameFormat)
    forall a b. PName -> a -> b -> ((a, b), NameFormat)
    mkEntry PName
    pn ModName
    mn (Name -> Ident
    nameIdent Name
    n) | (pn :: PName
    pn,ns :: [Name]
    ns)     <- Map PName [Name] -> [(PName, [Name])]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PName [Name]
    neExprs
                                         , Name
    n           <- [Name]
    ns
                                         , Declared mn :: ModName
    mn _ <- [Name -> NameInfo
    nameInfo Name
    n] ]

        [((ModName, Ident), NameFormat)]
    -> [((ModName, Ident), NameFormat)]
    -> [((ModName, Ident), NameFormat)]
    forall a. [a] -> [a] -> [a]
    ++ [ PName -> ModName -> Ident -> ((ModName, Ident), NameFormat)
    forall a b. PName -> a -> b -> ((a, b), NameFormat)
    mkEntry PName
    pn ModName
    mn (Name -> Ident
    nameIdent Name
    n) | (pn :: PName
    pn,ns :: [Name]
    ns)     <- Map PName [Name] -> [(PName, [Name])]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PName [Name]
    neTypes
                                         , Name
    n           <- [Name]
    ns
                                         , Declared mn :: ModName
    mn _ <- [Name -> NameInfo
    nameInfo Name
    n] ]

      mkEntry :: PName -> a -> b -> ((a, b), NameFormat)
    mkEntry pn :: PName
    pn mn :: a
    mn i :: b
    i = ((a
    mn,b
    i),NameFormat
    fmt)
        where
        fmt :: NameFormat
    fmt = case PName -> Maybe ModName
    getModName PName
    pn of
                Just ns :: ModName
    ns -> ModName -> NameFormat
    Qualified ModName
    ns
                Nothing -> NameFormat
    UnQualified

    -- | Produce sets of visible names for types and declarations.
    --
    -- NOTE: if entries in the NamingEnv would have produced a name clash, they will
    -- be omitted from the resulting sets.
    visibleNames :: NamingEnv -> ({- types -} Set.Set Name
                                 ,{- decls -} Set.Set Name)

    visibleNames :: NamingEnv -> (Set Name, Set Name)
    visibleNames NamingEnv { .. } = (Set Name
    types,Set Name
    decls)
      where
      types :: Set Name
    types = [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [ Name
    n | [n :: Name
    n] <- Map PName [Name] -> [[Name]]
    forall k a. Map k a -> [a]
    Map.elems Map PName [Name]
    neTypes ]
      decls :: Set Name
    decls = [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [ Name
    n | [n :: Name
    n] <- Map PName [Name] -> [[Name]]
    forall k a. Map k a -> [a]
    Map.elems Map PName [Name]
    neExprs ]

    -- | Qualify all symbols in a 'NamingEnv' with the given prefix.
    qualify :: ModName -> NamingEnv -> NamingEnv
    qualify :: ModName -> NamingEnv -> NamingEnv
    qualify pfx :: ModName
    pfx NamingEnv { .. } =
      $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv { neExprs :: Map PName [Name]
    neExprs = (PName -> PName) -> Map PName [Name] -> Map PName [Name]
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeys PName -> PName
    toQual Map PName [Name]
    neExprs
                , neTypes :: Map PName [Name]
    neTypes = (PName -> PName) -> Map PName [Name] -> Map PName [Name]
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeys PName -> PName
    toQual Map PName [Name]
    neTypes
                , .. }

      where
      -- XXX we don't currently qualify fresh names
      toQual :: PName -> PName
    toQual (Qual _ n :: Ident
    n)  = ModName -> Ident -> PName
    Qual ModName
    pfx Ident
    n
      toQual (UnQual n :: Ident
    n)  = ModName -> Ident -> PName
    Qual ModName
    pfx Ident
    n
      toQual n :: PName
    n@NewName{} = PName
    n

    filterNames :: (PName -> Bool) -> NamingEnv -> NamingEnv
    filterNames :: (PName -> Bool) -> NamingEnv -> NamingEnv
    filterNames p :: PName -> Bool
    p NamingEnv { .. } =
      $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv { neExprs :: Map PName [Name]
    neExprs = (PName -> [Name] -> Bool) -> Map PName [Name] -> Map PName [Name]
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey PName -> [Name] -> Bool
    forall a. PName -> a -> Bool
    check Map PName [Name]
    neExprs
                , neTypes :: Map PName [Name]
    neTypes = (PName -> [Name] -> Bool) -> Map PName [Name] -> Map PName [Name]
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey PName -> [Name] -> Bool
    forall a. PName -> a -> Bool
    check Map PName [Name]
    neTypes
                , .. }
      where
      check :: PName -> a -> Bool
      check :: PName -> a -> Bool
    check n :: PName
    n _ = PName -> Bool
    p PName
    n

    -- | Singleton type renaming environment.
    singletonT :: PName -> Name -> NamingEnv
    singletonT :: PName -> Name -> NamingEnv
    singletonT qn :: PName
    qn tn :: Name
    tn = NamingEnv
    forall a. Monoid a => a
    mempty { neTypes :: Map PName [Name]
    neTypes = PName -> [Name] -> Map PName [Name]
    forall k a. k -> a -> Map k a
    Map.singleton PName
    qn [Name
    tn] }

    -- | Singleton expression renaming environment.
    singletonE :: PName -> Name -> NamingEnv
    singletonE :: PName -> Name -> NamingEnv
    singletonE qn :: PName
    qn en :: Name
    en = NamingEnv
    forall a. Monoid a => a
    mempty { neExprs :: Map PName [Name]
    neExprs = PName -> [Name] -> Map PName [Name]
    forall k a. k -> a -> Map k a
    Map.singleton PName
    qn [Name
    en] }

    -- | Like mappend, but when merging, prefer values on the lhs.
    shadowing :: NamingEnv -> NamingEnv -> NamingEnv
    shadowing :: NamingEnv -> NamingEnv -> NamingEnv
    shadowing l :: NamingEnv
    l r :: NamingEnv
    r = $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv
      { neExprs :: Map PName [Name]
    neExprs  = Map PName [Name] -> Map PName [Name] -> Map PName [Name]
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union (NamingEnv -> Map PName [Name]
    neExprs  NamingEnv
    l) (NamingEnv -> Map PName [Name]
    neExprs  NamingEnv
    r)
      , neTypes :: Map PName [Name]
    neTypes  = Map PName [Name] -> Map PName [Name] -> Map PName [Name]
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union (NamingEnv -> Map PName [Name]
    neTypes  NamingEnv
    l) (NamingEnv -> Map PName [Name]
    neTypes  NamingEnv
    r) }

    travNamingEnv :: Applicative f => (Name -> f Name) -> NamingEnv -> f NamingEnv
    travNamingEnv :: (Name -> f Name) -> NamingEnv -> f NamingEnv
    travNamingEnv f :: Name -> f Name
    f ne :: NamingEnv
    ne = Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv (Map PName [Name] -> Map PName [Name] -> NamingEnv)
    -> f (Map PName [Name]) -> f (Map PName [Name] -> NamingEnv)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Map PName [Name])
    neExprs' f (Map PName [Name] -> NamingEnv)
    -> f (Map PName [Name]) -> f NamingEnv
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f (Map PName [Name])
    neTypes'
      where
        neExprs' :: f (Map PName [Name])
    neExprs' = ([Name] -> f [Name]) -> Map PName [Name] -> f (Map PName [Name])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Name -> f Name) -> [Name] -> f [Name]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Name -> f Name
    f) (NamingEnv -> Map PName [Name]
    neExprs NamingEnv
    ne)
        neTypes' :: f (Map PName [Name])
    neTypes' = ([Name] -> f [Name]) -> Map PName [Name] -> f (Map PName [Name])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((Name -> f Name) -> [Name] -> f [Name]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Name -> f Name
    f) (NamingEnv -> Map PName [Name]
    neTypes NamingEnv
    ne)

    data InModule a = InModule !ModName a
                      deriving (a -> InModule b -> InModule a
    (a -> b) -> InModule a -> InModule b
    (forall a b. (a -> b) -> InModule a -> InModule b)
    -> (forall a b. a -> InModule b -> InModule a) -> Functor InModule
    forall a b. a -> InModule b -> InModule a
    forall a b. (a -> b) -> InModule a -> InModule b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> InModule b -> InModule a
    $c<$ :: forall a b. a -> InModule b -> InModule a
    fmap :: (a -> b) -> InModule a -> InModule b
    $cfmap :: forall a b. (a -> b) -> InModule a -> InModule b
    Functor,Functor InModule
    Foldable InModule
    (Functor InModule, Foldable InModule) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> InModule a -> f (InModule b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        InModule (f a) -> f (InModule a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> InModule a -> m (InModule b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        InModule (m a) -> m (InModule a))
    -> Traversable InModule
    (a -> f b) -> InModule a -> f (InModule b)
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a. Monad m => InModule (m a) -> m (InModule a)
    forall (f :: * -> *) a.
    Applicative f =>
    InModule (f a) -> f (InModule a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> InModule a -> m (InModule b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> InModule a -> f (InModule b)
    sequence :: InModule (m a) -> m (InModule a)
    $csequence :: forall (m :: * -> *) a. Monad m => InModule (m a) -> m (InModule a)
    mapM :: (a -> m b) -> InModule a -> m (InModule b)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> InModule a -> m (InModule b)
    sequenceA :: InModule (f a) -> f (InModule a)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    InModule (f a) -> f (InModule a)
    traverse :: (a -> f b) -> InModule a -> f (InModule b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> InModule a -> f (InModule b)
    $cp2Traversable :: Foldable InModule
    $cp1Traversable :: Functor InModule
    Traversable,InModule a -> Bool
    (a -> m) -> InModule a -> m
    (a -> b -> b) -> b -> InModule a -> b
    (forall m. Monoid m => InModule m -> m)
    -> (forall m a. Monoid m => (a -> m) -> InModule a -> m)
    -> (forall m a. Monoid m => (a -> m) -> InModule a -> m)
    -> (forall a b. (a -> b -> b) -> b -> InModule a -> b)
    -> (forall a b. (a -> b -> b) -> b -> InModule a -> b)
    -> (forall b a. (b -> a -> b) -> b -> InModule a -> b)
    -> (forall b a. (b -> a -> b) -> b -> InModule a -> b)
    -> (forall a. (a -> a -> a) -> InModule a -> a)
    -> (forall a. (a -> a -> a) -> InModule a -> a)
    -> (forall a. InModule a -> [a])
    -> (forall a. InModule a -> Bool)
    -> (forall a. InModule a -> Int)
    -> (forall a. Eq a => a -> InModule a -> Bool)
    -> (forall a. Ord a => InModule a -> a)
    -> (forall a. Ord a => InModule a -> a)
    -> (forall a. Num a => InModule a -> a)
    -> (forall a. Num a => InModule a -> a)
    -> Foldable InModule
    forall a. Eq a => a -> InModule a -> Bool
    forall a. Num a => InModule a -> a
    forall a. Ord a => InModule a -> a
    forall m. Monoid m => InModule m -> m
    forall a. InModule a -> Bool
    forall a. InModule a -> Int
    forall a. InModule a -> [a]
    forall a. (a -> a -> a) -> InModule a -> a
    forall m a. Monoid m => (a -> m) -> InModule a -> m
    forall b a. (b -> a -> b) -> b -> InModule a -> b
    forall a b. (a -> b -> b) -> b -> InModule a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    product :: InModule a -> a
    $cproduct :: forall a. Num a => InModule a -> a
    sum :: InModule a -> a
    $csum :: forall a. Num a => InModule a -> a
    minimum :: InModule a -> a
    $cminimum :: forall a. Ord a => InModule a -> a
    maximum :: InModule a -> a
    $cmaximum :: forall a. Ord a => InModule a -> a
    elem :: a -> InModule a -> Bool
    $celem :: forall a. Eq a => a -> InModule a -> Bool
    length :: InModule a -> Int
    $clength :: forall a. InModule a -> Int
    null :: InModule a -> Bool
    $cnull :: forall a. InModule a -> Bool
    toList :: InModule a -> [a]
    $ctoList :: forall a. InModule a -> [a]
    foldl1 :: (a -> a -> a) -> InModule a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> InModule a -> a
    foldr1 :: (a -> a -> a) -> InModule a -> a
    $cfoldr1 :: forall a. (a -> a -> a) -> InModule a -> a
    foldl' :: (b -> a -> b) -> b -> InModule a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> InModule a -> b
    foldl :: (b -> a -> b) -> b -> InModule a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> InModule a -> b
    foldr' :: (a -> b -> b) -> b -> InModule a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> InModule a -> b
    foldr :: (a -> b -> b) -> b -> InModule a -> b
    $cfoldr :: forall a b. (a -> b -> b) -> b -> InModule a -> b
    foldMap' :: (a -> m) -> InModule a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> InModule a -> m
    foldMap :: (a -> m) -> InModule a -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> InModule a -> m
    fold :: InModule m -> m
    $cfold :: forall m. Monoid m => InModule m -> m
    Foldable,Int -> InModule a -> ShowS
    [InModule a] -> ShowS
    InModule a -> String
    (Int -> InModule a -> ShowS)
    -> (InModule a -> String)
    -> ([InModule a] -> ShowS)
    -> Show (InModule a)
    forall a. Show a => Int -> InModule a -> ShowS
    forall a. Show a => [InModule a] -> ShowS
    forall a. Show a => InModule a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [InModule a] -> ShowS
    $cshowList :: forall a. Show a => [InModule a] -> ShowS
    show :: InModule a -> String
    $cshow :: forall a. Show a => InModule a -> String
    showsPrec :: Int -> InModule a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> InModule a -> ShowS
    Show)

    -- | Generate a 'NamingEnv' using an explicit supply.
    namingEnv' :: BindsNames a => a -> Supply -> (NamingEnv,Supply)
    namingEnv' :: a -> Supply -> (NamingEnv, Supply)
    namingEnv' a :: a
    a supply :: Supply
    supply = Id (NamingEnv, Supply) -> (NamingEnv, Supply)
    forall a. Id a -> a
    runId (Supply -> SupplyT Id NamingEnv -> Id (NamingEnv, Supply)
    forall (m :: * -> *) a.
    Monad m =>
    Supply -> SupplyT m a -> m (a, Supply)
    runSupplyT Supply
    supply (BuildNamingEnv -> SupplyT Id NamingEnv
    runBuild (a -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv a
    a)))

    newTop :: FreshM m => ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop :: ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ns :: ModName
    ns thing :: PName
    thing fx :: Maybe Fixity
    fx rng :: Range
    rng = (Supply -> (Name, Supply)) -> m Name
    forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
    liftSupply (ModName
    -> NameSource
    -> Ident
    -> Maybe Fixity
    -> Range
    -> Supply
    -> (Name, Supply)
    mkDeclared ModName
    ns NameSource
    src (PName -> Ident
    getIdent PName
    thing) Maybe Fixity
    fx Range
    rng)
      where src :: NameSource
    src = if PName -> Bool
    isGeneratedName PName
    thing then NameSource
    SystemName else NameSource
    UserName

    newLocal :: FreshM m => PName -> Range -> m Name
    newLocal :: PName -> Range -> m Name
    newLocal thing :: PName
    thing rng :: Range
    rng = (Supply -> (Name, Supply)) -> m Name
    forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
    liftSupply (Ident -> Range -> Supply -> (Name, Supply)
    mkParameter (PName -> Ident
    getIdent PName
    thing) Range
    rng)

    newtype BuildNamingEnv = BuildNamingEnv { BuildNamingEnv -> SupplyT Id NamingEnv
    runBuild :: SupplyT Id NamingEnv }

    instance Semigroup BuildNamingEnv where
      BuildNamingEnv a :: SupplyT Id NamingEnv
    a <> :: BuildNamingEnv -> BuildNamingEnv -> BuildNamingEnv
    <> BuildNamingEnv b :: SupplyT Id NamingEnv
    b = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        do NamingEnv
    x <- SupplyT Id NamingEnv
    a
           NamingEnv
    y <- SupplyT Id NamingEnv
    b
           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NamingEnv -> NamingEnv -> NamingEnv
    forall a. Monoid a => a -> a -> a
    mappend NamingEnv
    x NamingEnv
    y)

    instance Monoid BuildNamingEnv where
      mempty :: BuildNamingEnv
    mempty = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (NamingEnv -> SupplyT Id NamingEnv
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure NamingEnv
    forall a. Monoid a => a
    mempty)

      mappend :: BuildNamingEnv -> BuildNamingEnv -> BuildNamingEnv
    mappend = BuildNamingEnv -> BuildNamingEnv -> BuildNamingEnv
    forall a. Semigroup a => a -> a -> a
    (<>)

      mconcat :: [BuildNamingEnv] -> BuildNamingEnv
    mconcat bs :: [BuildNamingEnv]
    bs = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        do [NamingEnv]
    ns <- [SupplyT Id NamingEnv] -> SupplyT Id [NamingEnv]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence ((BuildNamingEnv -> SupplyT Id NamingEnv)
    -> [BuildNamingEnv] -> [SupplyT Id NamingEnv]
    forall a b. (a -> b) -> [a] -> [b]
    map BuildNamingEnv -> SupplyT Id NamingEnv
    runBuild [BuildNamingEnv]
    bs)
           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [NamingEnv]
    ns)

    -- | Things that define exported names.
    class BindsNames a where
      namingEnv :: a -> BuildNamingEnv

    instance BindsNames NamingEnv where
      namingEnv :: NamingEnv -> BuildNamingEnv
    namingEnv env :: NamingEnv
    env = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return NamingEnv
    env)
      {-# INLINE namingEnv #-}

    instance BindsNames a => BindsNames (Maybe a) where
      namingEnv :: Maybe a -> BuildNamingEnv
    namingEnv = (a -> BuildNamingEnv) -> Maybe a -> BuildNamingEnv
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap a -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv
      {-# INLINE namingEnv #-}

    instance BindsNames a => BindsNames [a] where
      namingEnv :: [a] -> BuildNamingEnv
    namingEnv = (a -> BuildNamingEnv) -> [a] -> BuildNamingEnv
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap a -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv
      {-# INLINE namingEnv #-}

    -- | Generate a type renaming environment from the parameters that are bound by
    -- this schema.
    instance BindsNames (Schema PName) where
      namingEnv :: Schema PName -> BuildNamingEnv
    namingEnv (Forall ps :: [TParam PName]
    ps _ _ _) = (TParam PName -> BuildNamingEnv)
    -> [TParam PName] -> BuildNamingEnv
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap TParam PName -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv [TParam PName]
    ps
      {-# INLINE namingEnv #-}

    -- | Interpret an import in the context of an interface, to produce a name
    -- environment for the renamer, and a 'NameDisp' for pretty-printing.
    interpImport :: Import -> IfaceDecls -> NamingEnv
    interpImport :: Import -> IfaceDecls -> NamingEnv
    interpImport imp :: Import
    imp publicDecls :: IfaceDecls
    publicDecls = NamingEnv
    qualified
      where

      -- optionally qualify names based on the import
      qualified :: NamingEnv
    qualified | Just pfx :: ModName
    pfx <- Import -> Maybe ModName
    iAs Import
    imp = ModName -> NamingEnv -> NamingEnv
    qualify ModName
    pfx NamingEnv
    restricted
                | Bool
    otherwise           =             NamingEnv
    restricted

      -- restrict or hide imported symbols
      restricted :: NamingEnv
    restricted
        | Just (Hiding ns :: [Ident]
    ns) <- Import -> Maybe ImportSpec
    iSpec Import
    imp =
           (PName -> Bool) -> NamingEnv -> NamingEnv
    filterNames (\qn :: PName
    qn -> Bool -> Bool
    not (PName -> Ident
    getIdent PName
    qn Ident -> [Ident] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Ident]
    ns)) NamingEnv
    public

        | Just (Only ns :: [Ident]
    ns) <- Import -> Maybe ImportSpec
    iSpec Import
    imp =
           (PName -> Bool) -> NamingEnv -> NamingEnv
    filterNames (\qn :: PName
    qn -> PName -> Ident
    getIdent PName
    qn Ident -> [Ident] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Ident]
    ns) NamingEnv
    public

        | Bool
    otherwise = NamingEnv
    public

      -- generate the initial environment from the public interface, where no names
      -- are qualified
      public :: NamingEnv
    public = IfaceDecls -> NamingEnv
    unqualifiedEnv IfaceDecls
    publicDecls

    -- | Generate a naming environment from a declaration interface, where none of
    -- the names are qualified.
    unqualifiedEnv :: IfaceDecls -> NamingEnv
    unqualifiedEnv :: IfaceDecls -> NamingEnv
    unqualifiedEnv IfaceDecls { .. } =
      [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ NamingEnv
    exprs, NamingEnv
    tySyns, NamingEnv
    ntTypes, NamingEnv
    absTys, NamingEnv
    ntExprs ]
      where
      toPName :: Name -> PName
    toPName n :: Name
    n = Ident -> PName
    mkUnqual (Name -> Ident
    nameIdent Name
    n)

      exprs :: NamingEnv
    exprs   = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ PName -> Name -> NamingEnv
    singletonE (Name -> PName
    toPName Name
    n) Name
    n | Name
    n <- Map Name IfaceDecl -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name IfaceDecl
    ifDecls ]
      tySyns :: NamingEnv
    tySyns  = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ PName -> Name -> NamingEnv
    singletonT (Name -> PName
    toPName Name
    n) Name
    n | Name
    n <- Map Name IfaceTySyn -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name IfaceTySyn
    ifTySyns ]
      ntTypes :: NamingEnv
    ntTypes = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ PName -> Name -> NamingEnv
    singletonT (Name -> PName
    toPName Name
    n) Name
    n | Name
    n <- Map Name IfaceNewtype -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name IfaceNewtype
    ifNewtypes ]
      absTys :: NamingEnv
    absTys  = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ PName -> Name -> NamingEnv
    singletonT (Name -> PName
    toPName Name
    n) Name
    n | Name
    n <- Map Name IfaceAbstractType -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name IfaceAbstractType
    ifAbstractTypes ]
      ntExprs :: NamingEnv
    ntExprs = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ PName -> Name -> NamingEnv
    singletonE (Name -> PName
    toPName Name
    n) Name
    n | Name
    n <- Map Name IfaceNewtype -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name IfaceNewtype
    ifNewtypes ]

    -- | Compute an unqualified naming environment, containing the various module
    -- parameters.
    modParamsNamingEnv :: IfaceParams -> NamingEnv
    modParamsNamingEnv :: IfaceParams -> NamingEnv
    modParamsNamingEnv IfaceParams { .. } =
      $WNamingEnv :: Map PName [Name] -> Map PName [Name] -> NamingEnv
    NamingEnv { neExprs :: Map PName [Name]
    neExprs = [(PName, [Name])] -> Map PName [Name]
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(PName, [Name])] -> Map PName [Name])
    -> [(PName, [Name])] -> Map PName [Name]
    forall a b. (a -> b) -> a -> b
    $ (Name -> (PName, [Name])) -> [Name] -> [(PName, [Name])]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> (PName, [Name])
    fromFu ([Name] -> [(PName, [Name])]) -> [Name] -> [(PName, [Name])]
    forall a b. (a -> b) -> a -> b
    $ Map Name ModVParam -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name ModVParam
    ifParamFuns
                , neTypes :: Map PName [Name]
    neTypes = [(PName, [Name])] -> Map PName [Name]
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(PName, [Name])] -> Map PName [Name])
    -> [(PName, [Name])] -> Map PName [Name]
    forall a b. (a -> b) -> a -> b
    $ (ModTParam -> (PName, [Name])) -> [ModTParam] -> [(PName, [Name])]
    forall a b. (a -> b) -> [a] -> [b]
    map ModTParam -> (PName, [Name])
    fromTy ([ModTParam] -> [(PName, [Name])])
    -> [ModTParam] -> [(PName, [Name])]
    forall a b. (a -> b) -> a -> b
    $ Map Name ModTParam -> [ModTParam]
    forall k a. Map k a -> [a]
    Map.elems Map Name ModTParam
    ifParamTypes
                }

      where
      toPName :: Name -> PName
    toPName n :: Name
    n = Ident -> PName
    mkUnqual (Name -> Ident
    nameIdent Name
    n)

      fromTy :: ModTParam -> (PName, [Name])
    fromTy tp :: ModTParam
    tp = let nm :: Name
    nm = ModTParam -> Name
    T.mtpName ModTParam
    tp
                  in (Name -> PName
    toPName Name
    nm, [Name
    nm])

      fromFu :: Name -> (PName, [Name])
    fromFu f :: Name
    f  = (Name -> PName
    toPName Name
    f, [Name
    f])

    data ImportIface = ImportIface Import Iface

    -- | Produce a naming environment from an interface file, that contains a
    -- mapping only from unqualified names to qualified ones.
    instance BindsNames ImportIface where
      namingEnv :: ImportIface -> BuildNamingEnv
    namingEnv (ImportIface imp :: Import
    imp Iface { .. }) = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Import -> IfaceDecls -> NamingEnv
    interpImport Import
    imp IfaceDecls
    ifPublic)
      {-# INLINE namingEnv #-}

    -- | Introduce the name
    instance BindsNames (InModule (Bind PName)) where
      namingEnv :: InModule (Bind PName) -> BuildNamingEnv
    namingEnv (InModule ns :: ModName
    ns b :: Bind PName
    b) = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        do let Located { .. } = Bind PName -> Located PName
    forall name. Bind name -> Located name
    bName Bind PName
    b
           Name
    n <- ModName -> PName -> Maybe Fixity -> Range -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ModName
    ns PName
    thing (Bind PName -> Maybe Fixity
    forall name. Bind name -> Maybe Fixity
    bFixity Bind PName
    b) Range
    srcRange

           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonE PName
    thing Name
    n)

    -- | Generate the naming environment for a type parameter.
    instance BindsNames (TParam PName) where
      namingEnv :: TParam PName -> BuildNamingEnv
    namingEnv TParam { .. } = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        do let range :: Range
    range = Range -> Maybe Range -> Range
    forall a. a -> Maybe a -> a
    fromMaybe Range
    emptyRange Maybe Range
    tpRange
           Name
    n <- PName -> Range -> SupplyT Id Name
    forall (m :: * -> *). FreshM m => PName -> Range -> m Name
    newLocal PName
    tpName Range
    range
           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonT PName
    tpName Name
    n)

    -- | The naming environment for a single module.  This is the mapping from
    -- unqualified names to fully qualified names with uniques.
    instance BindsNames (Module PName) where
      namingEnv :: Module PName -> BuildNamingEnv
    namingEnv Module { .. } = (TopDecl PName -> BuildNamingEnv)
    -> [TopDecl PName] -> BuildNamingEnv
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (InModule (TopDecl PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (InModule (TopDecl PName) -> BuildNamingEnv)
    -> (TopDecl PName -> InModule (TopDecl PName))
    -> TopDecl PName
    -> BuildNamingEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModName -> TopDecl PName -> InModule (TopDecl PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    ns) [TopDecl PName]
    mDecls
        where
        ns :: ModName
    ns = Located ModName -> ModName
    forall a. Located a -> a
    thing Located ModName
    mName

    instance BindsNames (InModule (TopDecl PName)) where
      namingEnv :: InModule (TopDecl PName) -> BuildNamingEnv
    namingEnv (InModule ns :: ModName
    ns td :: TopDecl PName
    td) =
        case TopDecl PName
    td of
          Decl d :: TopLevel (Decl PName)
    d           -> InModule (Decl PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (ModName -> Decl PName -> InModule (Decl PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    ns (TopLevel (Decl PName) -> Decl PName
    forall a. TopLevel a -> a
    tlValue TopLevel (Decl PName)
    d))
          DPrimType d :: TopLevel (PrimType PName)
    d      -> InModule (PrimType PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (ModName -> PrimType PName -> InModule (PrimType PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    ns (TopLevel (PrimType PName) -> PrimType PName
    forall a. TopLevel a -> a
    tlValue TopLevel (PrimType PName)
    d))
          TDNewtype d :: TopLevel (Newtype PName)
    d      -> InModule (Newtype PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (ModName -> Newtype PName -> InModule (Newtype PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    ns (TopLevel (Newtype PName) -> Newtype PName
    forall a. TopLevel a -> a
    tlValue TopLevel (Newtype PName)
    d))
          DParameterType d :: ParameterType PName
    d -> InModule (ParameterType PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (ModName -> ParameterType PName -> InModule (ParameterType PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    ns ParameterType PName
    d)
          DParameterConstraint {} -> BuildNamingEnv
    forall a. Monoid a => a
    mempty
          DParameterFun  d :: ParameterFun PName
    d -> InModule (ParameterFun PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (ModName -> ParameterFun PName -> InModule (ParameterFun PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    ns ParameterFun PName
    d)
          Include _   -> BuildNamingEnv
    forall a. Monoid a => a
    mempty

    instance BindsNames (InModule (PrimType PName)) where
      namingEnv :: InModule (PrimType PName) -> BuildNamingEnv
    namingEnv (InModule ns :: ModName
    ns PrimType { .. }) =
        SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
          do let Located { .. } = Located PName
    primTName
             Name
    nm <- ModName -> PName -> Maybe Fixity -> Range -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ModName
    ns PName
    thing Maybe Fixity
    primTFixity Range
    srcRange
             NamingEnv -> SupplyT Id NamingEnv
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PName -> Name -> NamingEnv
    singletonT PName
    thing Name
    nm)

    instance BindsNames (InModule (ParameterFun PName)) where
      namingEnv :: InModule (ParameterFun PName) -> BuildNamingEnv
    namingEnv (InModule ns :: ModName
    ns ParameterFun { .. }) = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        do let Located { .. } = Located PName
    pfName
           Name
    ntName <- ModName -> PName -> Maybe Fixity -> Range -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ModName
    ns PName
    thing Maybe Fixity
    pfFixity Range
    srcRange
           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonE PName
    thing Name
    ntName)

    instance BindsNames (InModule (ParameterType PName)) where
      namingEnv :: InModule (ParameterType PName) -> BuildNamingEnv
    namingEnv (InModule ns :: ModName
    ns ParameterType { .. }) = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        -- XXX: we don't seem to have a fixity environment at the type level
        do let Located { .. } = Located PName
    ptName
           Name
    ntName <- ModName -> PName -> Maybe Fixity -> Range -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ModName
    ns PName
    thing Maybe Fixity
    forall a. Maybe a
    Nothing Range
    srcRange
           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonT PName
    thing Name
    ntName)

    -- NOTE: we use the same name at the type and expression level, as there's only
    -- ever one name introduced in the declaration. The names are only ever used in
    -- different namespaces, so there's no ambiguity.
    instance BindsNames (InModule (Newtype PName)) where
      namingEnv :: InModule (Newtype PName) -> BuildNamingEnv
    namingEnv (InModule ns :: ModName
    ns Newtype { .. }) = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
        do let Located { .. } = Located PName
    nName
           Name
    ntName <- ModName -> PName -> Maybe Fixity -> Range -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ModName
    ns PName
    thing Maybe Fixity
    forall a. Maybe a
    Nothing Range
    srcRange
           NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonT PName
    thing Name
    ntName NamingEnv -> NamingEnv -> NamingEnv
    forall a. Monoid a => a -> a -> a
    `mappend` PName -> Name -> NamingEnv
    singletonE PName
    thing Name
    ntName)

    -- | The naming environment for a single declaration.
    instance BindsNames (InModule (Decl PName)) where
      namingEnv :: InModule (Decl PName) -> BuildNamingEnv
    namingEnv (InModule pfx :: ModName
    pfx d :: Decl PName
    d) = case Decl PName
    d of
        DBind b :: Bind PName
    b -> SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
          do Name
    n <- Located PName -> Maybe Fixity -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    Located PName -> Maybe Fixity -> m Name
    mkName (Bind PName -> Located PName
    forall name. Bind name -> Located name
    bName Bind PName
    b) (Bind PName -> Maybe Fixity
    forall name. Bind name -> Maybe Fixity
    bFixity Bind PName
    b)
             NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonE (Located PName -> PName
    forall a. Located a -> a
    thing (Bind PName -> Located PName
    forall name. Bind name -> Located name
    bName Bind PName
    b)) Name
    n)

        DSignature ns :: [Located PName]
    ns _sig :: Schema PName
    _sig      -> (Located PName -> BuildNamingEnv)
    -> [Located PName] -> BuildNamingEnv
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Located PName -> BuildNamingEnv
    qualBind [Located PName]
    ns
        DPragma ns :: [Located PName]
    ns _p :: Pragma
    _p           -> (Located PName -> BuildNamingEnv)
    -> [Located PName] -> BuildNamingEnv
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Located PName -> BuildNamingEnv
    qualBind [Located PName]
    ns
        DType syn :: TySyn PName
    syn               -> Located PName -> Maybe Fixity -> BuildNamingEnv
    qualType (TySyn PName -> Located PName
    forall name. TySyn name -> Located name
    tsName TySyn PName
    syn) (TySyn PName -> Maybe Fixity
    forall name. TySyn name -> Maybe Fixity
    tsFixity TySyn PName
    syn)
        DProp syn :: PropSyn PName
    syn               -> Located PName -> Maybe Fixity -> BuildNamingEnv
    qualType (PropSyn PName -> Located PName
    forall name. PropSyn name -> Located name
    psName PropSyn PName
    syn) (PropSyn PName -> Maybe Fixity
    forall name. PropSyn name -> Maybe Fixity
    psFixity PropSyn PName
    syn)
        DLocated d' :: Decl PName
    d' _           -> InModule (Decl PName) -> BuildNamingEnv
    forall a. BindsNames a => a -> BuildNamingEnv
    namingEnv (ModName -> Decl PName -> InModule (Decl PName)
    forall a. ModName -> a -> InModule a
    InModule ModName
    pfx Decl PName
    d')
        DPatBind _pat :: Pattern PName
    _pat _e :: Expr PName
    _e        -> String -> [String] -> BuildNamingEnv
    forall a. HasCallStack => String -> [String] -> a
    panic "ModuleSystem" ["Unexpected pattern binding"]
        DFixity{}               -> String -> [String] -> BuildNamingEnv
    forall a. HasCallStack => String -> [String] -> a
    panic "ModuleSystem" ["Unexpected fixity declaration"]

        where

        mkName :: Located PName -> Maybe Fixity -> m Name
    mkName ln :: Located PName
    ln fx :: Maybe Fixity
    fx = ModName -> PName -> Maybe Fixity -> Range -> m Name
    forall (m :: * -> *).
    FreshM m =>
    ModName -> PName -> Maybe Fixity -> Range -> m Name
    newTop ModName
    pfx (Located PName -> PName
    forall a. Located a -> a
    thing Located PName
    ln) Maybe Fixity
    fx (Located PName -> Range
    forall a. Located a -> Range
    srcRange Located PName
    ln)

        qualBind :: Located PName -> BuildNamingEnv
    qualBind ln :: Located PName
    ln = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
          do Name
    n <- Located PName -> Maybe Fixity -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    Located PName -> Maybe Fixity -> m Name
    mkName Located PName
    ln Maybe Fixity
    forall a. Maybe a
    Nothing
             NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonE (Located PName -> PName
    forall a. Located a -> a
    thing Located PName
    ln) Name
    n)

        qualType :: Located PName -> Maybe Fixity -> BuildNamingEnv
    qualType ln :: Located PName
    ln f :: Maybe Fixity
    f = SupplyT Id NamingEnv -> BuildNamingEnv
    BuildNamingEnv (SupplyT Id NamingEnv -> BuildNamingEnv)
    -> SupplyT Id NamingEnv -> BuildNamingEnv
    forall a b. (a -> b) -> a -> b
    $
          do Name
    n <- Located PName -> Maybe Fixity -> SupplyT Id Name
    forall (m :: * -> *).
    FreshM m =>
    Located PName -> Maybe Fixity -> m Name
    mkName Located PName
    ln Maybe Fixity
    f
             NamingEnv -> SupplyT Id NamingEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Name -> NamingEnv
    singletonT (Located PName -> PName
    forall a. Located a -> a
    thing Located PName
    ln) Name
    n)