module GHC.Rename.Fixity
( MiniFixityEnv(..)
, addLocalFixities
, lookupMiniFixityEnv
, emptyMiniFixityEnv
, lookupFixityRn
, lookupFixityRn_help
, lookupFieldFixityRn
, lookupTyFixityRn
) where
import GHC.Prelude
import GHC.Iface.Load
import GHC.Hs
import GHC.Tc.Utils.Monad
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Types.Fixity.Env
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Fixity
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Data.Maybe
import GHC.Rename.Unbound
data MiniFixityEnv = MFE
{ MiniFixityEnv -> FastStringEnv (Located Fixity)
mfe_data_level_names :: FastStringEnv (Located Fixity)
, MiniFixityEnv -> FastStringEnv (Located Fixity)
mfe_type_level_names :: FastStringEnv (Located Fixity)
}
addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities :: forall a. MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities MiniFixityEnv
env [Name]
names RnM a
thing_inside
= [(Name, FixItem)] -> RnM a -> RnM a
forall a. [(Name, FixItem)] -> RnM a -> RnM a
extendFixityEnv ((Name -> Maybe (Name, FixItem)) -> [Name] -> [(Name, FixItem)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Name -> Maybe (Name, FixItem)
find_fixity [Name]
names) RnM a
thing_inside
where
find_fixity :: Name -> Maybe (Name, FixItem)
find_fixity Name
name = case MiniFixityEnv -> Name -> Maybe (Located Fixity)
lookupMiniFixityEnv MiniFixityEnv
env Name
name of
Just Located Fixity
lfix -> (Name, FixItem) -> Maybe (Name, FixItem)
forall a. a -> Maybe a
Just (Name
name, OccName -> Fixity -> FixItem
FixItem OccName
occ (Located Fixity -> Fixity
forall l e. GenLocated l e -> e
unLoc Located Fixity
lfix))
Maybe (Located Fixity)
Nothing -> Maybe (Name, FixItem)
forall a. Maybe a
Nothing
where
occ :: OccName
occ = Name -> OccName
nameOccName Name
name
lookupMiniFixityEnv :: MiniFixityEnv -> Name -> Maybe (Located Fixity)
lookupMiniFixityEnv :: MiniFixityEnv -> Name -> Maybe (Located Fixity)
lookupMiniFixityEnv MFE{FastStringEnv (Located Fixity)
mfe_data_level_names :: MiniFixityEnv -> FastStringEnv (Located Fixity)
mfe_data_level_names :: FastStringEnv (Located Fixity)
mfe_data_level_names, FastStringEnv (Located Fixity)
mfe_type_level_names :: MiniFixityEnv -> FastStringEnv (Located Fixity)
mfe_type_level_names :: FastStringEnv (Located Fixity)
mfe_type_level_names} Name
name
| NameSpace -> Bool
isValNameSpace NameSpace
namespace = FastStringEnv (Located Fixity) -> Name -> Maybe (Located Fixity)
forall {a}. FastStringEnv a -> Name -> Maybe a
find_fixity_in_env FastStringEnv (Located Fixity)
mfe_data_level_names Name
name
| Bool
otherwise = FastStringEnv (Located Fixity) -> Name -> Maybe (Located Fixity)
forall {a}. FastStringEnv a -> Name -> Maybe a
find_fixity_in_env FastStringEnv (Located Fixity)
mfe_type_level_names Name
name
where
namespace :: NameSpace
namespace = Name -> NameSpace
nameNameSpace Name
name
find_fixity_in_env :: FastStringEnv a -> Name -> Maybe a
find_fixity_in_env FastStringEnv a
mini_fix_env Name
name
= FastStringEnv a -> FastString -> Maybe a
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv a
mini_fix_env (OccName -> FastString
occNameFS OccName
occ)
where
occ :: OccName
occ = Name -> OccName
nameOccName Name
name
emptyMiniFixityEnv :: MiniFixityEnv
emptyMiniFixityEnv :: MiniFixityEnv
emptyMiniFixityEnv = FastStringEnv (Located Fixity)
-> FastStringEnv (Located Fixity) -> MiniFixityEnv
MFE FastStringEnv (Located Fixity)
forall a. FastStringEnv a
emptyFsEnv FastStringEnv (Located Fixity)
forall a. FastStringEnv a
emptyFsEnv
lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn = ((Bool, Fixity) -> Fixity)
-> IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity) -> RnM Fixity
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Fixity) -> Fixity
forall a b. (a, b) -> b
snd (IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity) -> RnM Fixity)
-> (Name -> IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity))
-> Name
-> RnM Fixity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity)
lookupFixityRn_help
lookupFixityRn_help :: Name
-> RnM (Bool, Fixity)
lookupFixityRn_help :: Name -> IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity)
lookupFixityRn_help Name
name
| Name -> Bool
isUnboundName Name
name
= (Bool, Fixity) -> IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Int -> FixityDirection -> Fixity
Fixity Int
minPrecedence FixityDirection
InfixL)
| Bool
otherwise
= do { local_fix_env <- TcRn FixityEnv
getFixityEnv
; case lookupNameEnv local_fix_env name of {
Just (FixItem OccName
_ Fixity
fix) -> (Bool, Fixity) -> IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Fixity
fix) ;
Maybe FixItem
Nothing ->
do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; if nameIsLocalOrFrom this_mod name
then return (False, defaultFixity)
else lookup_imported } } }
where
occ :: OccName
occ = Name -> OccName
nameOccName Name
name
lookup_imported :: IOEnv (Env TcGblEnv TcLclEnv) (Bool, Fixity)
lookup_imported
= do { iface <- SDoc -> Name -> TcRn ModIface
loadInterfaceForName SDoc
doc Name
name
; let mb_fix = ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) OccName
occ
; let msg = case Maybe Fixity
mb_fix of
Maybe Fixity
Nothing ->
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"looking up name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in iface, but found no fixity for it."
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Using default fixity instead."
Just Fixity
f ->
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"looking up name in iface and found:"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name, Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
f]
; traceRn "lookupFixityRn_either:" msg
; return (maybe (False, defaultFixity) (\Fixity
f -> (Bool
True, Fixity
f)) mb_fix) }
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Checking fixity for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
lookupTyFixityRn :: LocatedN Name -> RnM Fixity
lookupTyFixityRn :: LocatedN Name -> RnM Fixity
lookupTyFixityRn = Name -> RnM Fixity
lookupFixityRn (Name -> RnM Fixity)
-> (LocatedN Name -> Name) -> LocatedN Name -> RnM Fixity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN Name -> Name
forall l e. GenLocated l e -> e
unLoc
lookupFieldFixityRn :: FieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn :: FieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn (FieldOcc XCFieldOcc GhcRn
_ LIdP GhcRn
n) = Name -> RnM Fixity
lookupFixityRn (LocatedN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
LocatedN Name
n)