{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Cryptol.ModuleSystem.NamingEnv
( module Cryptol.ModuleSystem.NamingEnv.Types
, 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 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
import Cryptol.ModuleSystem.NamingEnv.Types
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 ]
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
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
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
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 (Name -> PName
nameToDefPName Name
x) (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) = 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
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)
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 (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)))
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
]
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
]
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 :: 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
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
findAmbig :: NamingEnv -> [ [Name] ]
findAmbig :: NamingEnv -> [[Name]]
findAmbig NamingEnv
env =
[ 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
]
where
NamingEnv Map Namespace (Map PName Names)
ns = NamingEnv -> NamingEnv
consToValues NamingEnv
env
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 ]
]
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)
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
modParamNamesNamingEnv :: T.ModParamNames -> NamingEnv
modParamNamesNamingEnv :: ModParamNames -> NamingEnv
modParamNamesNamingEnv 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))
modParamNamingEnv :: T.ModParam -> NamingEnv
modParamNamingEnv :: ModParam -> NamingEnv
modParamNamingEnv ModParam
mp = (NamingEnv -> NamingEnv)
-> (ModName -> NamingEnv -> NamingEnv)
-> Maybe ModName
-> NamingEnv
-> NamingEnv
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NamingEnv -> NamingEnv
forall a. a -> a
id ModName -> NamingEnv -> NamingEnv
qualify (ModParam -> Maybe ModName
T.mpQual ModParam
mp) (NamingEnv -> NamingEnv) -> NamingEnv -> NamingEnv
forall a b. (a -> b) -> a -> b
$
ModParamNames -> NamingEnv
modParamNamesNamingEnv (ModParam -> ModParamNames
T.mpParameters ModParam
mp)
unqualifiedEnv :: IfaceDecls -> NamingEnv
unqualifiedEnv :: IfaceDecls -> NamingEnv
unqualifiedEnv IfaceDecls { Map Name NominalType
Map Name TySyn
Map Name ModParamNames
Map Name IfaceDecl
Map Name (IfaceNames Name)
Map Name (IfaceG Name)
ifTySyns :: Map Name TySyn
ifNominalTypes :: Map Name NominalType
ifDecls :: Map Name IfaceDecl
ifModules :: Map Name (IfaceNames Name)
ifSignatures :: Map Name ModParamNames
ifFunctors :: Map Name (IfaceG Name)
ifTySyns :: IfaceDecls -> Map Name TySyn
ifNominalTypes :: IfaceDecls -> Map Name NominalType
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
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
| NominalType
nt <- Map Name NominalType -> [NominalType]
forall k a. Map k a -> [a]
Map.elems Map Name NominalType
ifNominalTypes
, let tname :: Name
tname = NominalType -> Name
T.ntName NominalType
nt
, NamingEnv
n <- Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSType (Name -> PName
toPName Name
tname) Name
tname
NamingEnv -> [NamingEnv] -> [NamingEnv]
forall a. a -> [a] -> [a]
: [ Namespace -> PName -> Name -> NamingEnv
singletonNS Namespace
NSValue (Name -> PName
toPName Name
cname) Name
cname
| Name
cname <-((Name, Schema) -> Name) -> [(Name, Schema)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Schema) -> Name
forall a b. (a, b) -> a
fst (NominalType -> [(Name, Schema)]
T.nominalTypeConTypes NominalType
nt)
]
]
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 NominalType -> [Name]
forall k a. Map k a -> [k]
Map.keys Map Name NominalType
ifNominalTypes ]
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 ]
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 <- 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
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