{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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
newtype NamingEnv = NamingEnv (Map Namespace (Map PName Names))
deriving (Int -> NamingEnv -> ShowS
[NamingEnv] -> ShowS
NamingEnv -> String
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: NamingEnv -> ()
$crnf :: NamingEnv -> ()
NFData)
instance Monoid NamingEnv where
mempty :: NamingEnv
mempty = Map Namespace (Map PName Names) -> NamingEnv
NamingEnv 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 (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (PP a, PP a) => (a, Map a Names) -> Doc
ppNS forall a b. (a -> b) -> a -> b
$ 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 (forall a. PP a => a -> Doc
pp a
ns forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. PP a => (a, Names) -> Doc
ppNm (forall k a. Map k a -> [(k, a)]
Map.toList Map a Names
xs)))
ppNm :: (a, Names) -> Doc
ppNm (a
x,Names
as) = forall a. PP a => a -> Doc
pp a
x Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp (Names -> [Name]
namesToList Names
as))
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) = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall k a. Map k a -> [a]
Map.elems (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 = 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 ]
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 = forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith 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 = 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 forall k a. Map k a -> Bool
Map.null Map k Names
c then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Map k Names
c
namingEnvNames :: NamingEnv -> Set Name
namingEnvNames :: NamingEnv -> Set Name
namingEnvNames (NamingEnv Map Namespace (Map PName Names)
xs) =
case [Names] -> Maybe Names
unionManyNames (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Names] -> Maybe Names
unionManyNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems) (forall k a. Map k a -> [a]
Map.elems Map Namespace (Map PName Names)
xs)) of
Maybe Names
Nothing -> forall a. Set a
Set.empty
Just (One Name
x) -> forall a. a -> Set a
Set.singleton Name
x
Just (Ambig Set Name
as) -> Set Name
as
namingEnvFromNames :: Set Name -> NamingEnv
namingEnvFromNames :: Set Name -> NamingEnv
namingEnvFromNames Set Name
xs = Map Namespace (Map PName Names) -> NamingEnv
NamingEnv (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 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 forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>))
Namespace
ns (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
namespaceMap :: Namespace -> NamingEnv -> Map PName Names
namespaceMap :: Namespace -> NamingEnv -> Map PName Names
namespaceMap Namespace
ns (NamingEnv Map Namespace (Map PName Names)
env) = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty Namespace
ns Map Namespace (Map PName Names)
env
lookupNS :: Namespace -> PName -> NamingEnv -> Maybe Names
lookupNS :: Namespace -> PName -> NamingEnv -> Maybe Names
lookupNS Namespace
ns PName
x NamingEnv
env = 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)
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
singletonNS :: Namespace -> PName -> Name -> NamingEnv
singletonNS :: Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
ns PName
pn Name
n = Map Namespace (Map PName Names) -> NamingEnv
NamingEnv (forall k a. k -> a -> Map k a
Map.singleton Namespace
ns (forall k a. k -> a -> Map k a
Map.singleton PName
pn (Name -> Names
One Name
n)))
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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ Name -> (PrimIdent, Name)
entry Name
x | Names
xs <- 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 -> forall a. HasCallStack => String -> [String] -> a
panic String
"toPrimMap" [ String
"Not a declared name?"
, forall a. Show a => a -> String
show Name
n
]
toNameDisp :: NamingEnv -> NameDisp
toNameDisp :: NamingEnv -> NameDisp
toNameDisp NamingEnv
env = (OrigName -> Maybe NameFormat) -> NameDisp
NameDisp (forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map OrigName NameFormat
names)
where
names :: Map OrigName NameFormat
names = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (OrigName
og, NameFormat
qn)
| Namespace
ns <- [Namespace]
allNamespaces
, (PName
pn,Names
xs) <- 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 <- 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
]
visibleNames :: NamingEnv -> Map Namespace (Set Name)
visibleNames :: NamingEnv -> Map Namespace (Set Name)
visibleNames (NamingEnv Map Namespace (Map PName Names)
env) = forall {k}. Map k Names -> Set Name
check 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 = forall a. Ord a => [a] -> Set a
Set.fromList [ Name
a | One Name
a <- forall k a. Map k a -> [a]
Map.elems Map k Names
mp ]
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 (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys PName -> PName
toQual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Namespace (Map PName Names)
env)
where
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 (forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe 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 = 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 forall k a. Map k a -> Bool
Map.null Map PName a
new then forall a. Maybe a
Nothing else 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 (forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe 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 = 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 forall k a. Map k a -> Bool
Map.null Map k Names
new then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Map k Names
new
findAmbig :: NamingEnv -> [ [Name] ]
findAmbig :: NamingEnv -> [[Name]]
findAmbig (NamingEnv Map Namespace (Map PName Names)
ns) =
[ forall a. Set a -> [a]
Set.toList Set Name
xs
| Map PName Names
mp <- forall k a. Map k a -> [a]
Map.elems Map Namespace (Map PName Names)
ns
, Ambig Set Name
xs <- forall k a. Map k a -> [a]
Map.elems Map PName Names
mp
]
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) <- forall k a. Map k a -> [(k, a)]
Map.toList Map Namespace (Map PName Names)
lhs
, (PName
p,Names
xs) <- 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 ]
]
forceUnambig :: NamingEnv -> NamingEnv
forceUnambig :: NamingEnv -> NamingEnv
forceUnambig (NamingEnv Map Namespace (Map PName Names)
mp) = Map Namespace (Map PName Names) -> NamingEnv
NamingEnv (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Names
One forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Name
anyOne) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Namespace (Map PName Names)
mp)
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 (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Name) -> Names -> Names
mapNames Name -> Name
f) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *).
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) = forall k a. Map k a -> Bool
Map.null Map Namespace (Map PName Names)
mp
modParamsNamingEnv :: T.ModParamNames -> NamingEnv
modParamsNamingEnv :: ModParamNames -> NamingEnv
modParamsNamingEnv T.ModParamNames { [Located Prop]
Maybe Text
Map Name TySyn
Map Name ModVParam
Map Name ModTParam
mpnDoc :: ModParamNames -> Maybe Text
mpnFuns :: ModParamNames -> Map Name ModVParam
mpnConstraints :: ModParamNames -> [Located Prop]
mpnTySyn :: ModParamNames -> Map Name TySyn
mpnTypes :: ModParamNames -> Map Name ModTParam
mpnDoc :: Maybe Text
mpnFuns :: Map Name ModVParam
mpnConstraints :: [Located Prop]
mpnTySyn :: Map Name TySyn
mpnTypes :: Map Name ModTParam
.. } =
Map Namespace (Map PName Names) -> NamingEnv
NamingEnv forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Namespace
NSValue, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Name -> (PName, Names)
fromFu forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map Name ModVParam
mpnFuns)
, (Namespace
NSType, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TySyn -> (PName, Names)
fromTS (forall k a. Map k a -> [a]
Map.elems Map Name TySyn
mpnTySyn) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map ModTParam -> (PName, Names)
fromTy (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))
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)
ifFunctors :: IfaceDecls -> Map Name (IfaceG Name)
ifSignatures :: IfaceDecls -> Map Name ModParamNames
ifModules :: IfaceDecls -> Map Name (IfaceNames Name)
ifDecls :: IfaceDecls -> Map Name IfaceDecl
ifAbstractTypes :: IfaceDecls -> Map Name AbstractType
ifNewtypes :: IfaceDecls -> Map Name Newtype
ifTySyns :: IfaceDecls -> Map Name TySyn
ifFunctors :: Map Name (IfaceG Name)
ifSignatures :: Map Name ModParamNames
ifModules :: Map Name (IfaceNames Name)
ifDecls :: Map Name IfaceDecl
ifAbstractTypes :: Map Name AbstractType
ifNewtypes :: Map Name Newtype
ifTySyns :: Map Name TySyn
.. } =
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 = forall a. Monoid a => [a] -> a
mconcat [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSValue (Name -> PName
toPName Name
n) Name
n
| Name
n <- forall k a. Map k a -> [k]
Map.keys Map Name IfaceDecl
ifDecls ]
tySyns :: NamingEnv
tySyns = forall a. Monoid a => [a] -> a
mconcat [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType (Name -> PName
toPName Name
n) Name
n
| Name
n <- forall k a. Map k a -> [k]
Map.keys Map Name TySyn
ifTySyns ]
ntTypes :: NamingEnv
ntTypes = forall a. Monoid a => [a] -> a
mconcat [ NamingEnv
n
| Newtype
nt <- 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 = forall a. Monoid a => [a] -> a
mconcat [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType (Name -> PName
toPName Name
n) Name
n
| Name
n <- forall k a. Map k a -> [k]
Map.keys Map Name AbstractType
ifAbstractTypes ]
ntExprs :: NamingEnv
ntExprs = forall a. Monoid a => [a] -> a
mconcat [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSValue (Name -> PName
toPName Name
n) Name
n
| Name
n <- forall k a. Map k a -> [k]
Map.keys Map Name Newtype
ifNewtypes ]
mods :: NamingEnv
mods = forall a. Monoid a => [a] -> a
mconcat [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSModule (Name -> PName
toPName Name
n) Name
n
| Name
n <- forall k a. Map k a -> [k]
Map.keys Map Name (IfaceNames Name)
ifModules ]
sigs :: NamingEnv
sigs = forall a. Monoid a => [a] -> a
mconcat [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSModule (Name -> PName
toPName Name
n) Name
n
| Name
n <- forall k a. Map k a -> [k]
Map.keys Map Name ModParamNames
ifSignatures ]
interpImportEnv :: ImportG name ->
NamingEnv ->
NamingEnv
interpImportEnv :: forall name. ImportG name -> NamingEnv -> NamingEnv
interpImportEnv ImportG name
imp NamingEnv
public = NamingEnv
qualified
where
qualified :: NamingEnv
qualified | Just ModName
pfx <- forall mname. ImportG mname -> Maybe ModName
iAs ImportG name
imp = ModName -> NamingEnv -> NamingEnv
qualify ModName
pfx NamingEnv
restricted
| Bool
otherwise = NamingEnv
restricted
restricted :: NamingEnv
restricted
| Just (Hiding [Ident]
ns) <- 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
ns)) NamingEnv
public
| Just (Only [Ident]
ns) <- forall mname. ImportG mname -> Maybe ImportSpec
iSpec ImportG name
imp =
(PName -> Bool) -> NamingEnv -> NamingEnv
filterPNames (\PName
qn -> PName -> Ident
getIdent PName
qn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
ns) NamingEnv
public
| Bool
otherwise = NamingEnv
public