module GHC.Rename.Fixity
( MiniFixityEnv
, addLocalFixities
, 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.Name.Reader
import GHC.Types.Fixity
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Data.Maybe
import GHC.Rename.Unbound
type MiniFixityEnv = FastStringEnv (Located Fixity)
addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities :: forall a. MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities MiniFixityEnv
mini_fix_env [Name]
names RnM a
thing_inside
= forall a. [(Name, FixItem)] -> RnM a -> RnM a
extendFixityEnv (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 forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv MiniFixityEnv
mini_fix_env (OccName -> FastString
occNameFS OccName
occ) of
Just Located Fixity
lfix -> forall a. a -> Maybe a
Just (Name
name, OccName -> Fixity -> FixItem
FixItem OccName
occ (forall l e. GenLocated l e -> e
unLoc Located Fixity
lfix))
Maybe (Located Fixity)
Nothing -> forall a. Maybe a
Nothing
where
occ :: OccName
occ = Name -> OccName
nameOccName Name
name
lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn Name
name = Name -> OccName -> RnM Fixity
lookupFixityRn' Name
name (Name -> OccName
nameOccName Name
name)
lookupFixityRn' :: Name -> OccName -> RnM Fixity
lookupFixityRn' :: Name -> OccName -> RnM Fixity
lookupFixityRn' Name
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName -> RnM (Bool, Fixity)
lookupFixityRn_help' Name
name
lookupFixityRn_help :: Name
-> RnM (Bool, Fixity)
lookupFixityRn_help :: Name -> RnM (Bool, Fixity)
lookupFixityRn_help Name
name =
Name -> OccName -> RnM (Bool, Fixity)
lookupFixityRn_help' Name
name (Name -> OccName
nameOccName Name
name)
lookupFixityRn_help' :: Name
-> OccName
-> RnM (Bool, Fixity)
lookupFixityRn_help' :: Name -> OccName -> RnM (Bool, Fixity)
lookupFixityRn_help' Name
name OccName
occ
| Name -> Bool
isUnboundName Name
name
= forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
minPrecedence FixityDirection
InfixL)
| Bool
otherwise
= do { FixityEnv
local_fix_env <- TcRn FixityEnv
getFixityEnv
; case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv FixityEnv
local_fix_env Name
name of {
Just (FixItem OccName
_ Fixity
fix) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Fixity
fix) ;
Maybe FixItem
Nothing ->
do { Module
this_mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name
then forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Fixity
defaultFixity)
else RnM (Bool, Fixity)
lookup_imported } } }
where
lookup_imported :: RnM (Bool, Fixity)
lookup_imported
= do { ModIface
iface <- SDoc -> Name -> TcRn ModIface
loadInterfaceForName SDoc
doc Name
name
; let mb_fix :: Maybe Fixity
mb_fix = ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) OccName
occ
; let msg :: SDoc
msg = case Maybe Fixity
mb_fix of
Maybe Fixity
Nothing ->
String -> SDoc
text String
"looking up name" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in iface, but found no fixity for it."
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"Using default fixity instead."
Just Fixity
f ->
String -> SDoc
text String
"looking up name in iface and found:"
SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
vcat [forall a. Outputable a => a -> SDoc
ppr Name
name, forall a. Outputable a => a -> SDoc
ppr Fixity
f]
; String -> SDoc -> TcRn ()
traceRn String
"lookupFixityRn_either:" SDoc
msg
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False, Fixity
defaultFixity) (\Fixity
f -> (Bool
True, Fixity
f)) Maybe Fixity
mb_fix) }
doc :: SDoc
doc = String -> SDoc
text String
"Checking fixity for" SDoc -> SDoc -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
lookupFieldFixityRn :: FieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn :: FieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn (FieldOcc XCFieldOcc GhcRn
n XRec GhcRn RdrName
lrdr)
= Name -> OccName -> RnM Fixity
lookupFixityRn' XCFieldOcc GhcRn
n (RdrName -> OccName
rdrNameOcc (forall l e. GenLocated l e -> e
unLoc XRec GhcRn RdrName
lrdr))