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

    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE BlockArguments #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    -- See Note [-Wincomplete-uni-patterns and irrefutable patterns] in Cryptol.TypeCheck.TypePat
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    module Cryptol.ModuleSystem.NamingEnv where

    import Data.Maybe (mapMaybe,maybeToList)
    import           Data.Map.Strict (Map)
    import qualified Data.Map.Strict as Map
    import           Data.Set (Set)
    import qualified Data.Set as Set
    import           Data.Foldable(foldl')

    import GHC.Generics (Generic)
    import Control.DeepSeq(NFData)

    import Cryptol.Utils.PP
    import Cryptol.Utils.Panic (panic)
    import Cryptol.Utils.Ident(allNamespaces)
    import Cryptol.Parser.AST
    import qualified Cryptol.TypeCheck.AST as T
    import Cryptol.ModuleSystem.Name
    import Cryptol.ModuleSystem.Names
    import Cryptol.ModuleSystem.Interface

    -- | The 'NamingEnv' is used by the renamer to determine what
    -- identifiers refer to.
    newtype NamingEnv = NamingEnv (Map Namespace (Map PName Names))
      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
    $cshowsPrec :: Int -> NamingEnv -> ShowS
    showsPrec :: Int -> NamingEnv -> ShowS
    $cshow :: NamingEnv -> String
    show :: NamingEnv -> String
    $cshowList :: [NamingEnv] -> ShowS
    showList :: [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
    $cfrom :: forall x. NamingEnv -> Rep NamingEnv x
    from :: forall x. NamingEnv -> Rep NamingEnv x
    $cto :: forall x. Rep NamingEnv x -> NamingEnv
    to :: forall x. Rep NamingEnv x -> NamingEnv
    Generic,NamingEnv -> ()
    (NamingEnv -> ()) -> NFData NamingEnv
    forall a. (a -> ()) -> NFData a
    $crnf :: NamingEnv -> ()
    rnf :: NamingEnv -> ()
    NFData)

    instance Monoid NamingEnv where
      mempty :: NamingEnv
    mempty = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv Map Namespace (Map PName Names)
    forall k a. Map k a
    Map.empty
      {-# INLINE mempty #-}

    instance Semigroup NamingEnv where
      NamingEnv Map Namespace (Map PName Names)
    l <> :: NamingEnv -> NamingEnv -> NamingEnv
    <> NamingEnv Map Namespace (Map PName Names)
    r =
        Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Map PName Names -> Map PName Names -> Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith ((Names -> Names -> Names)
    -> Map PName Names -> Map PName Names -> Map PName Names
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Names -> Names -> Names
    forall a. Semigroup a => a -> a -> a
    (<>)) Map Namespace (Map PName Names)
    l Map Namespace (Map PName Names)
    r)

    instance PP NamingEnv where
      ppPrec :: Int -> NamingEnv -> Doc
    ppPrec Int
    _ (NamingEnv Map Namespace (Map PName Names)
    mps)   = [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ ((Namespace, Map PName Names) -> Doc)
    -> [(Namespace, Map PName Names)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Namespace, Map PName Names) -> Doc
    forall {a} {a}. (PP a, PP a) => (a, Map a Names) -> Doc
    ppNS ([(Namespace, Map PName Names)] -> [Doc])
    -> [(Namespace, Map PName Names)] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ Map Namespace (Map PName Names) -> [(Namespace, Map PName Names)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Namespace (Map PName Names)
    mps
        where ppNS :: (a, Map a Names) -> Doc
    ppNS (a
    ns,Map a Names
    xs) = Int -> Doc -> Doc
    nest Int
    2 ([Doc] -> Doc
    vcat (a -> Doc
    forall a. PP a => a -> Doc
    pp a
    ns Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : ((a, Names) -> Doc) -> [(a, Names)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Names) -> Doc
    forall {a}. PP a => (a, Names) -> Doc
    ppNm (Map a Names -> [(a, Names)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map a Names
    xs)))
              ppNm :: (a, Names) -> Doc
    ppNm (a
    x,Names
    as)  = a -> Doc
    forall a. PP a => a -> Doc
    pp a
    x Doc -> Doc -> Doc
    <+> Doc
    "->" Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    commaSep ((Name -> Doc) -> [Name] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Doc
    forall a. PP a => a -> Doc
    pp (Names -> [Name]
    namesToList Names
    as))

    {- | This "joins" two naming environments by matching the text name.
    The result maps the unique names from the first environment with the
    matching names in the second.  This is used to compute the naming for
    an instantiated functor:
      * if the left environment has the defined names of the functor, and
      * the right one has the defined names of the instantiation, then
      * the result maps functor names to instance names.
    -}
    zipByTextName :: NamingEnv -> NamingEnv -> Map Name Name
    zipByTextName :: NamingEnv -> NamingEnv -> Map Name Name
    zipByTextName (NamingEnv Map Namespace (Map PName Names)
    k) (NamingEnv Map Namespace (Map PName Names)
    v) = [(Name, Name)] -> Map Name Name
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Name)] -> Map Name Name)
    -> [(Name, Name)] -> Map Name Name
    forall a b. (a -> b) -> a -> b
    $ (Map PName Names -> Map PName Names -> [(Name, Name)])
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    -> [(Name, Name)]
    forall k a b c.
    Ord k =>
    (a -> b -> [c]) -> Map k a -> Map k b -> [c]
    doInter Map PName Names -> Map PName Names -> [(Name, Name)]
    doNS Map Namespace (Map PName Names)
    k Map Namespace (Map PName Names)
    v
      where
      doInter :: Ord k => (a -> b -> [c]) -> Map k a -> Map k b -> [c]
      doInter :: forall k a b c.
    Ord k =>
    (a -> b -> [c]) -> Map k a -> Map k b -> [c]
    doInter a -> b -> [c]
    f Map k a
    a Map k b
    b = [[c]] -> [c]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Map k [c] -> [[c]]
    forall k a. Map k a -> [a]
    Map.elems ((a -> b -> [c]) -> Map k a -> Map k b -> Map k [c]
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    Map.intersectionWith a -> b -> [c]
    f Map k a
    a Map k b
    b))

      doNS :: Map PName Names -> Map PName Names -> [(Name,Name)]
      doNS :: Map PName Names -> Map PName Names -> [(Name, Name)]
    doNS Map PName Names
    as Map PName Names
    bs = (Names -> Names -> [(Name, Name)])
    -> Map PName Names -> Map PName Names -> [(Name, Name)]
    forall k a b c.
    Ord k =>
    (a -> b -> [c]) -> Map k a -> Map k b -> [c]
    doInter Names -> Names -> [(Name, Name)]
    doPName Map PName Names
    as Map PName Names
    bs

      doPName :: Names -> Names -> [(Name,Name)]
      doPName :: Names -> Names -> [(Name, Name)]
    doPName Names
    xs Names
    ys = [ (Name
    x,Name
    y) | Name
    x <- Names -> [Name]
    namesToList Names
    xs, Name
    y <- Names -> [Name]
    namesToList Names
    ys ]
      -- NOTE: we'd exepct that there are no ambiguities in the environments.

    -- | Keep only the bindings in the 1st environment that are *NOT* in the second.
    without :: NamingEnv -> NamingEnv -> NamingEnv
    NamingEnv Map Namespace (Map PName Names)
    keep without :: NamingEnv -> NamingEnv -> NamingEnv
    `without` NamingEnv Map Namespace (Map PName Names)
    remove = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv Map Namespace (Map PName Names)
    result
      where
      result :: Map Namespace (Map PName Names)
    result     = (Map PName Names -> Map PName Names -> Maybe (Map PName Names))
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall k a b.
    Ord k =>
    (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
    Map.differenceWith Map PName Names -> Map PName Names -> Maybe (Map PName Names)
    forall {k}.
    Ord k =>
    Map k Names -> Map k Names -> Maybe (Map k Names)
    rmInNS Map Namespace (Map PName Names)
    keep Map Namespace (Map PName Names)
    remove
      rmInNS :: Map k Names -> Map k Names -> Maybe (Map k Names)
    rmInNS Map k Names
    a Map k Names
    b = let c :: Map k Names
    c = (Names -> Names -> Maybe Names)
    -> Map k Names -> Map k Names -> Map k Names
    forall k a b.
    Ord k =>
    (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
    Map.differenceWith Names -> Names -> Maybe Names
    diffNames Map k Names
    a Map k Names
    b
                   in if Map k Names -> Bool
    forall k a. Map k a -> Bool
    Map.null Map k Names
    c then Maybe (Map k Names)
    forall a. Maybe a
    Nothing else Map k Names -> Maybe (Map k Names)
    forall a. a -> Maybe a
    Just Map k Names
    c

    -- | All names mentioned in the environment
    namingEnvNames :: NamingEnv -> Set Name
    namingEnvNames :: NamingEnv -> Set Name
    namingEnvNames (NamingEnv Map Namespace (Map PName Names)
    xs) =
      case [Names] -> Maybe Names
    unionManyNames ((Map PName Names -> Maybe Names) -> [Map PName Names] -> [Names]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ([Names] -> Maybe Names
    unionManyNames ([Names] -> Maybe Names)
    -> (Map PName Names -> [Names]) -> Map PName Names -> Maybe Names
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map PName Names -> [Names]
    forall k a. Map k a -> [a]
    Map.elems) (Map Namespace (Map PName Names) -> [Map PName Names]
    forall k a. Map k a -> [a]
    Map.elems Map Namespace (Map PName Names)
    xs)) of
        Maybe Names
    Nothing -> Set Name
    forall a. Set a
    Set.empty
        Just (One Name
    x) -> Name -> Set Name
    forall a. a -> Set a
    Set.singleton Name
    x
        Just (Ambig Set Name
    as) -> Set Name
    as

    -- | Get a unqualified naming environment for the given names
    namingEnvFromNames :: Set Name -> NamingEnv
    namingEnvFromNames :: Set Name -> NamingEnv
    namingEnvFromNames Set Name
    xs = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Map Namespace (Map PName Names)
     -> Name -> Map Namespace (Map PName Names))
    -> Map Namespace (Map PName Names)
    -> Set Name
    -> Map Namespace (Map PName Names)
    forall b a. (b -> a -> b) -> b -> Set a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Map Namespace (Map PName Names)
    -> Name -> Map Namespace (Map PName Names)
    add Map Namespace (Map PName Names)
    forall a. Monoid a => a
    mempty Set Name
    xs)
      where
      add :: Map Namespace (Map PName Names)
    -> Name -> Map Namespace (Map PName Names)
    add Map Namespace (Map PName Names)
    mp Name
    x = let ns :: Namespace
    ns = Name -> Namespace
    nameNamespace Name
    x
                     txt :: Ident
    txt = Name -> Ident
    nameIdent Name
    x
                 in (Map PName Names -> Map PName Names -> Map PName Names)
    -> Namespace
    -> Map PName Names
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith ((Names -> Names -> Names)
    -> Map PName Names -> Map PName Names -> Map PName Names
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Names -> Names -> Names
    forall a. Semigroup a => a -> a -> a
    (<>))
                                   Namespace
    ns (PName -> Names -> Map PName Names
    forall k a. k -> a -> Map k a
    Map.singleton (Ident -> PName
    mkUnqual Ident
    txt) (Name -> Names
    One Name
    x))
                                   Map Namespace (Map PName Names)
    mp

    -- | Get the names in a given namespace
    namespaceMap :: Namespace -> NamingEnv -> Map PName Names
    namespaceMap :: Namespace -> NamingEnv -> Map PName Names
    namespaceMap Namespace
    ns (NamingEnv Map Namespace (Map PName Names)
    env) = Map PName Names
    -> Namespace -> Map Namespace (Map PName Names) -> Map PName Names
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Map PName Names
    forall k a. Map k a
    Map.empty Namespace
    ns Map Namespace (Map PName Names)
    env

    -- | Resolve a name in the given namespace.
    lookupNS :: Namespace -> PName -> NamingEnv -> Maybe Names
    lookupNS :: Namespace -> PName -> NamingEnv -> Maybe Names
    lookupNS Namespace
    ns PName
    x NamingEnv
    env = PName -> Map PName Names -> Maybe Names
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup PName
    x (Namespace -> NamingEnv -> Map PName Names
    namespaceMap Namespace
    ns NamingEnv
    env)

    -- | Resolve a name in the given namespace.
    lookupListNS :: Namespace -> PName -> NamingEnv -> [Name]
    lookupListNS :: Namespace -> PName -> NamingEnv -> [Name]
    lookupListNS Namespace
    ns PName
    x NamingEnv
    env =
      case Namespace -> PName -> NamingEnv -> Maybe Names
    lookupNS Namespace
    ns PName
    x NamingEnv
    env of
        Maybe Names
    Nothing -> []
        Just Names
    as -> Names -> [Name]
    namesToList Names
    as

    -- | Singleton renaming environment for the given namespace.
    singletonNS :: Namespace -> PName -> Name -> NamingEnv
    singletonNS :: Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    ns PName
    pn Name
    n = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv (Namespace -> Map PName Names -> Map Namespace (Map PName Names)
    forall k a. k -> a -> Map k a
    Map.singleton Namespace
    ns (PName -> Names -> Map PName Names
    forall k a. k -> a -> Map k a
    Map.singleton PName
    pn (Name -> Names
    One Name
    n)))

    -- | Generate a mapping from 'PrimIdent' to 'Name' for a
    -- given naming environment.
    toPrimMap :: NamingEnv -> PrimMap
    toPrimMap :: NamingEnv -> PrimMap
    toPrimMap NamingEnv
    env =
      PrimMap
        { primDecls :: Map PrimIdent Name
    primDecls = Namespace -> Map PrimIdent Name
    fromNS Namespace
    NSValue
        , primTypes :: Map PrimIdent Name
    primTypes = Namespace -> Map PrimIdent Name
    fromNS Namespace
    NSType
        }
      where
      fromNS :: Namespace -> Map PrimIdent Name
    fromNS Namespace
    ns = [(PrimIdent, Name)] -> Map PrimIdent Name
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
                    [ Name -> (PrimIdent, Name)
    entry Name
    x | Names
    xs <- Map PName Names -> [Names]
    forall k a. Map k a -> [a]
    Map.elems (Namespace -> NamingEnv -> Map PName Names
    namespaceMap Namespace
    ns NamingEnv
    env)
                              , Name
    x <- Names -> [Name]
    namesToList Names
    xs ]

      entry :: Name -> (PrimIdent, Name)
    entry Name
    n = case Name -> Maybe PrimIdent
    asPrim Name
    n of
                  Just PrimIdent
    p  -> (PrimIdent
    p,Name
    n)
                  Maybe PrimIdent
    Nothing -> String -> [String] -> (PrimIdent, Name)
    forall a. HasCallStack => String -> [String] -> a
    panic String
    "toPrimMap" [ String
    "Not a declared name?"
                                               , Name -> String
    forall a. Show a => a -> String
    show Name
    n
                                               ]

    -- | Generate a display format based on a naming environment.
    toNameDisp :: NamingEnv -> NameDisp
    toNameDisp :: NamingEnv -> NameDisp
    toNameDisp NamingEnv
    env = (OrigName -> Maybe NameFormat) -> NameDisp
    NameDisp (OrigName -> Map OrigName NameFormat -> Maybe NameFormat
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map OrigName NameFormat
    names)
      where
      names :: Map OrigName NameFormat
    names = [(OrigName, NameFormat)] -> Map OrigName NameFormat
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
                [ (OrigName
    og, NameFormat
    qn)
                  | Namespace
    ns            <- [Namespace]
    allNamespaces
                  , (PName
    pn,Names
    xs)       <- Map PName Names -> [(PName, Names)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Namespace -> NamingEnv -> Map PName Names
    namespaceMap Namespace
    ns NamingEnv
    env)
                  , Name
    x             <- Names -> [Name]
    namesToList Names
    xs
                  , OrigName
    og            <- Maybe OrigName -> [OrigName]
    forall a. Maybe a -> [a]
    maybeToList (Name -> Maybe OrigName
    asOrigName Name
    x)
                  , let qn :: NameFormat
    qn = case PName -> Maybe ModName
    getModName PName
    pn of
                              Just ModName
    q  -> ModName -> NameFormat
    Qualified ModName
    q
                              Maybe ModName
    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 -> Map Namespace (Set Name)
    visibleNames :: NamingEnv -> Map Namespace (Set Name)
    visibleNames (NamingEnv Map Namespace (Map PName Names)
    env) = Map PName Names -> Set Name
    forall {k}. Map k Names -> Set Name
    check (Map PName Names -> Set Name)
    -> Map Namespace (Map PName Names) -> Map Namespace (Set Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map Namespace (Map PName Names)
    env
      where check :: Map k Names -> Set Name
    check Map k Names
    mp = [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [ Name
    a | One Name
    a <- Map k Names -> [Names]
    forall k a. Map k a -> [a]
    Map.elems Map k Names
    mp ]

    -- | Qualify all symbols in a 'NamingEnv' with the given prefix.
    qualify :: ModName -> NamingEnv -> NamingEnv
    qualify :: ModName -> NamingEnv -> NamingEnv
    qualify ModName
    pfx (NamingEnv Map Namespace (Map PName Names)
    env) = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((PName -> PName) -> Map PName Names -> Map PName Names
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeys PName -> PName
    toQual (Map PName Names -> Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map Namespace (Map PName Names)
    env)
      where
      -- We don't qualify fresh names, because they should not be directly
      -- visible to the end users (i.e., they shouldn't really be exported)
      toQual :: PName -> PName
    toQual (Qual ModName
    _ Ident
    n)  = ModName -> Ident -> PName
    Qual ModName
    pfx Ident
    n
      toQual (UnQual Ident
    n)  = ModName -> Ident -> PName
    Qual ModName
    pfx Ident
    n
      toQual n :: PName
    n@NewName{} = PName
    n

    filterPNames :: (PName -> Bool) -> NamingEnv -> NamingEnv
    filterPNames :: (PName -> Bool) -> NamingEnv -> NamingEnv
    filterPNames PName -> Bool
    p (NamingEnv Map Namespace (Map PName Names)
    env) = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Map PName Names -> Maybe (Map PName Names))
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall a b k. (a -> Maybe b) -> Map k a -> Map k b
    Map.mapMaybe Map PName Names -> Maybe (Map PName Names)
    forall {a}. Map PName a -> Maybe (Map PName a)
    checkNS Map Namespace (Map PName Names)
    env)
      where
      checkNS :: Map PName a -> Maybe (Map PName a)
    checkNS Map PName a
    nsMap = let new :: Map PName a
    new = (PName -> a -> Bool) -> Map PName a -> Map PName a
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey (\PName
    n a
    _ -> PName -> Bool
    p PName
    n) Map PName a
    nsMap
                      in if Map PName a -> Bool
    forall k a. Map k a -> Bool
    Map.null Map PName a
    new then Maybe (Map PName a)
    forall a. Maybe a
    Nothing else Map PName a -> Maybe (Map PName a)
    forall a. a -> Maybe a
    Just Map PName a
    new

    filterUNames :: (Name -> Bool) -> NamingEnv -> NamingEnv
    filterUNames :: (Name -> Bool) -> NamingEnv -> NamingEnv
    filterUNames Name -> Bool
    p (NamingEnv Map Namespace (Map PName Names)
    env) = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Map PName Names -> Maybe (Map PName Names))
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall a b k. (a -> Maybe b) -> Map k a -> Map k b
    Map.mapMaybe Map PName Names -> Maybe (Map PName Names)
    forall {k}. Map k Names -> Maybe (Map k Names)
    check Map Namespace (Map PName Names)
    env)
      where
      check :: Map k Names -> Maybe (Map k Names)
    check Map k Names
    nsMap = let new :: Map k Names
    new = (Names -> Maybe Names) -> Map k Names -> Map k Names
    forall a b k. (a -> Maybe b) -> Map k a -> Map k b
    Map.mapMaybe ((Name -> Bool) -> Names -> Maybe Names
    filterNames Name -> Bool
    p) Map k Names
    nsMap
                    in if Map k Names -> Bool
    forall k a. Map k a -> Bool
    Map.null Map k Names
    new then Maybe (Map k Names)
    forall a. Maybe a
    Nothing else Map k Names -> Maybe (Map k Names)
    forall a. a -> Maybe a
    Just Map k Names
    new

    -- | Find the ambiguous entries in an environmet.
    -- A name is ambiguous if it might refer to multiple entities.
    findAmbig :: NamingEnv -> [ [Name] ]
    findAmbig :: NamingEnv -> [[Name]]
    findAmbig (NamingEnv Map Namespace (Map PName Names)
    ns) =
      [ Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList Set Name
    xs
      | Map PName Names
    mp <- Map Namespace (Map PName Names) -> [Map PName Names]
    forall k a. Map k a -> [a]
    Map.elems Map Namespace (Map PName Names)
    ns
      , Ambig Set Name
    xs <- Map PName Names -> [Names]
    forall k a. Map k a -> [a]
    Map.elems Map PName Names
    mp
      ]

    -- | Get the subset of the first environment that shadows something
    -- in the second one.
    findShadowing :: NamingEnv -> NamingEnv -> [ (PName,Name,[Name]) ]
    findShadowing :: NamingEnv -> NamingEnv -> [(PName, Name, [Name])]
    findShadowing (NamingEnv Map Namespace (Map PName Names)
    lhs) NamingEnv
    rhs =
      [ (PName
    p, Names -> Name
    anyOne Names
    xs, Names -> [Name]
    namesToList Names
    ys)
      | (Namespace
    ns,Map PName Names
    mp) <- Map Namespace (Map PName Names) -> [(Namespace, Map PName Names)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Namespace (Map PName Names)
    lhs
      , (PName
    p,Names
    xs) <- Map PName Names -> [(PName, Names)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PName Names
    mp
      , Just Names
    ys <- [ Namespace -> PName -> NamingEnv -> Maybe Names
    lookupNS Namespace
    ns PName
    p NamingEnv
    rhs ]
      ]

    -- | Do an arbitrary choice for ambiguous names.
    -- We do this to continue checking afetr we've reported an ambiguity error.
    forceUnambig :: NamingEnv -> NamingEnv
    forceUnambig :: NamingEnv -> NamingEnv
    forceUnambig (NamingEnv Map Namespace (Map PName Names)
    mp) = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Names -> Names) -> Map PName Names -> Map PName Names
    forall a b. (a -> b) -> Map PName a -> Map PName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Name -> Names
    One (Name -> Names) -> (Names -> Name) -> Names -> Names
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Names -> Name
    anyOne) (Map PName Names -> Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map Namespace (Map PName Names)
    mp)

    -- | Like mappend, but when merging, prefer values on the lhs.
    shadowing :: NamingEnv -> NamingEnv -> NamingEnv
    shadowing :: NamingEnv -> NamingEnv -> NamingEnv
    shadowing (NamingEnv Map Namespace (Map PName Names)
    l) (NamingEnv Map Namespace (Map PName Names)
    r) = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Map PName Names -> Map PName Names -> Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Map PName Names -> Map PName Names -> Map PName Names
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union Map Namespace (Map PName Names)
    l Map Namespace (Map PName Names)
    r)

    mapNamingEnv :: (Name -> Name) -> NamingEnv -> NamingEnv
    mapNamingEnv :: (Name -> Name) -> NamingEnv -> NamingEnv
    mapNamingEnv Name -> Name
    f (NamingEnv Map Namespace (Map PName Names)
    mp) = Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv ((Names -> Names) -> Map PName Names -> Map PName Names
    forall a b. (a -> b) -> Map PName a -> Map PName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Name -> Name) -> Names -> Names
    mapNames Name -> Name
    f) (Map PName Names -> Map PName Names)
    -> Map Namespace (Map PName Names)
    -> Map Namespace (Map PName Names)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Map Namespace (Map PName Names)
    mp)

    travNamingEnv :: Applicative f => (Name -> f Name) -> NamingEnv -> f NamingEnv
    travNamingEnv :: forall (f :: * -> *).
    Applicative f =>
    (Name -> f Name) -> NamingEnv -> f NamingEnv
    travNamingEnv Name -> f Name
    f (NamingEnv Map Namespace (Map PName Names)
    mp) =
      Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv (Map Namespace (Map PName Names) -> NamingEnv)
    -> f (Map Namespace (Map PName Names)) -> f NamingEnv
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Map PName Names -> f (Map PName Names))
    -> Map Namespace (Map PName Names)
    -> f (Map Namespace (Map PName Names))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map Namespace a -> f (Map Namespace b)
    traverse ((Names -> f Names) -> Map PName Names -> f (Map PName Names)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map PName a -> f (Map PName b)
    traverse ((Name -> f Name) -> Names -> f Names
    forall (f :: * -> *).
    Applicative f =>
    (Name -> f Name) -> Names -> f Names
    travNames Name -> f Name
    f)) Map Namespace (Map PName Names)
    mp

    isEmptyNamingEnv :: NamingEnv -> Bool
    isEmptyNamingEnv :: NamingEnv -> Bool
    isEmptyNamingEnv (NamingEnv Map Namespace (Map PName Names)
    mp) = Map Namespace (Map PName Names) -> Bool
    forall k a. Map k a -> Bool
    Map.null Map Namespace (Map PName Names)
    mp
    -- This assumes that we've been normalizing away empty maps, hopefully
    -- we've been doing it everywhere.

    -- | Compute an unqualified naming environment, containing the various module
    -- parameters.
    modParamsNamingEnv :: T.ModParamNames -> NamingEnv
    modParamsNamingEnv :: ModParamNames -> NamingEnv
    modParamsNamingEnv T.ModParamNames { [Located Prop]
    Maybe Text
    Map Name TySyn
    Map Name ModVParam
    Map Name ModTParam
    mpnTypes :: Map Name ModTParam
    mpnTySyn :: Map Name TySyn
    mpnConstraints :: [Located Prop]
    mpnFuns :: Map Name ModVParam
    mpnDoc :: Maybe Text
    mpnTypes :: ModParamNames -> Map Name ModTParam
    mpnTySyn :: ModParamNames -> Map Name TySyn
    mpnConstraints :: ModParamNames -> [Located Prop]
    mpnFuns :: ModParamNames -> Map Name ModVParam
    mpnDoc :: ModParamNames -> Maybe Text
    .. } =
      Map Namespace (Map PName Names) -> NamingEnv
    NamingEnv (Map Namespace (Map PName Names) -> NamingEnv)
    -> Map Namespace (Map PName Names) -> NamingEnv
    forall a b. (a -> b) -> a -> b
    $ [(Namespace, Map PName Names)] -> Map Namespace (Map PName Names)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
        [ (Namespace
    NSValue, [(PName, Names)] -> Map PName Names
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(PName, Names)] -> Map PName Names)
    -> [(PName, Names)] -> Map PName Names
    forall a b. (a -> b) -> a -> b
    $ (Name -> (PName, Names)) -> [Name] -> [(PName, Names)]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> (PName, Names)
    fromFu ([Name] -> [(PName, Names)]) -> [Name] -> [(PName, Names)]
    forall a b. (a -> b) -> a -> b
    $ Map Name ModVParam -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name ModVParam
    mpnFuns)
        , (Namespace
    NSType,  [(PName, Names)] -> Map PName Names
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(PName, Names)] -> Map PName Names)
    -> [(PName, Names)] -> Map PName Names
    forall a b. (a -> b) -> a -> b
    $ (TySyn -> (PName, Names)) -> [TySyn] -> [(PName, Names)]
    forall a b. (a -> b) -> [a] -> [b]
    map TySyn -> (PName, Names)
    fromTS (Map Name TySyn -> [TySyn]
    forall k a. Map k a -> [a]
    Map.elems Map Name TySyn
    mpnTySyn) [(PName, Names)] -> [(PName, Names)] -> [(PName, Names)]
    forall a. [a] -> [a] -> [a]
    ++
                                   (ModTParam -> (PName, Names)) -> [ModTParam] -> [(PName, Names)]
    forall a b. (a -> b) -> [a] -> [b]
    map ModTParam -> (PName, Names)
    fromTy (Map Name ModTParam -> [ModTParam]
    forall k a. Map k a -> [a]
    Map.elems Map Name ModTParam
    mpnTypes))
        ]
      where
      toPName :: Name -> PName
    toPName Name
    n = Ident -> PName
    mkUnqual (Name -> Ident
    nameIdent Name
    n)

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

      fromFu :: Name -> (PName, Names)
    fromFu Name
    f  = (Name -> PName
    toPName Name
    f, Name -> Names
    One Name
    f)

      fromTS :: TySyn -> (PName, Names)
    fromTS TySyn
    ts = (Name -> PName
    toPName (TySyn -> Name
    T.tsName TySyn
    ts), Name -> Names
    One (TySyn -> Name
    T.tsName TySyn
    ts))

    -- | Generate a naming environment from a declaration interface, where none of
    -- the names are qualified.
    unqualifiedEnv :: IfaceDecls -> NamingEnv
    unqualifiedEnv :: IfaceDecls -> NamingEnv
    unqualifiedEnv IfaceDecls { Map Name AbstractType
    Map Name Newtype
    Map Name TySyn
    Map Name ModParamNames
    Map Name IfaceDecl
    Map Name (IfaceNames Name)
    Map Name (IfaceG Name)
    ifTySyns :: Map Name TySyn
    ifNewtypes :: Map Name Newtype
    ifAbstractTypes :: Map Name AbstractType
    ifDecls :: Map Name IfaceDecl
    ifModules :: Map Name (IfaceNames Name)
    ifSignatures :: Map Name ModParamNames
    ifFunctors :: Map Name (IfaceG Name)
    ifTySyns :: IfaceDecls -> Map Name TySyn
    ifNewtypes :: IfaceDecls -> Map Name Newtype
    ifAbstractTypes :: IfaceDecls -> Map Name AbstractType
    ifDecls :: IfaceDecls -> Map Name IfaceDecl
    ifModules :: IfaceDecls -> Map Name (IfaceNames Name)
    ifSignatures :: IfaceDecls -> Map Name ModParamNames
    ifFunctors :: IfaceDecls -> Map Name (IfaceG Name)
    .. } =
      [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ NamingEnv
    exprs, NamingEnv
    tySyns, NamingEnv
    ntTypes, NamingEnv
    absTys, NamingEnv
    ntExprs, NamingEnv
    mods, NamingEnv
    sigs ]
      where
      toPName :: Name -> PName
    toPName Name
    n = Ident -> PName
    mkUnqual (Name -> Ident
    nameIdent Name
    n)

      exprs :: NamingEnv
    exprs   = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSValue (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 [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSType (Name -> PName
    toPName Name
    n) Name
    n
                        | Name
    n <- Map Name TySyn -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name TySyn
    ifTySyns ]

      ntTypes :: NamingEnv
    ntTypes = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ NamingEnv
    n
                        | Newtype
    nt <- Map Name Newtype -> [Newtype]
    forall k a. Map k a -> [a]
    Map.elems Map Name Newtype
    ifNewtypes
                        , let tname :: Name
    tname = Newtype -> Name
    T.ntName Newtype
    nt
                              cname :: Name
    cname = Newtype -> Name
    T.ntConName Newtype
    nt
                        , NamingEnv
    n  <- [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSType (Name -> PName
    toPName Name
    tname) Name
    tname
                                , Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSValue (Name -> PName
    toPName Name
    cname) Name
    cname
                                ]
                        ]

      absTys :: NamingEnv
    absTys  = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSType (Name -> PName
    toPName Name
    n) Name
    n
                        | Name
    n <- Map Name AbstractType -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name AbstractType
    ifAbstractTypes ]

      ntExprs :: NamingEnv
    ntExprs = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSValue (Name -> PName
    toPName Name
    n) Name
    n
                        | Name
    n <- Map Name Newtype -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name Newtype
    ifNewtypes ]

      mods :: NamingEnv
    mods    = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSModule (Name -> PName
    toPName Name
    n) Name
    n
                        | Name
    n <- Map Name (IfaceNames Name) -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name (IfaceNames Name)
    ifModules ]

      sigs :: NamingEnv
    sigs    = [NamingEnv] -> NamingEnv
    forall a. Monoid a => [a] -> a
    mconcat [ Namespace -> PName -> Name -> NamingEnv
    singletonNS Namespace
    NSModule (Name -> PName
    toPName Name
    n) Name
    n
                        | Name
    n <- Map Name ModParamNames -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name ModParamNames
    ifSignatures ]

    -- | Adapt the things exported by something to the specific import/open.
    interpImportEnv :: ImportG name  {- ^ The import declarations -} ->
                    NamingEnv     {- ^ All public things coming in -} ->
                    NamingEnv
    interpImportEnv :: forall name. ImportG name -> NamingEnv -> NamingEnv
    interpImportEnv ImportG name
    imp NamingEnv
    public = NamingEnv
    qualified
      where

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

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

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

        | Bool
    otherwise = NamingEnv
    public