    {-
    This module contains code which maintains and manipulates the
    fixity environment during renaming.
    -}

    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.SourceText
    import GHC.Types.SrcLoc

    import GHC.Utils.Outputable

    import GHC.Data.Maybe

    import GHC.Rename.Unbound

    {-
    *********************************************************
    *                                                      *
                    Fixities
    *                                                      *
    *********************************************************

    Note [Fixity signature lookup]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    A fixity declaration like

        infixr 2 ?

    can refer to a value-level operator, e.g.:

        (?) :: String -> String -> String

    or a type-level operator, like:

        data (?) a b = A a | B b

    so we extend the lookup of the reader name '?' to the TcClsName namespace, as
    well as the original namespace.

    The extended lookup is also used in other places, like resolution of
    deprecation declarations, and lookup of names in GHCi.
    -}

    --------------------------------

    -- | Mini fixity env for the names we're about
    -- to bind, in a single binding group
    --
    -- It is keyed by the *FastString*, not the *OccName*, because
    -- the single fixity decl       @infix 3 T@
    -- affects both the data constructor T and the type constructor T
    --
    -- We keep the location so that if we find
    -- a duplicate, we can report it sensibly
    --
    -- Fixity declarations may influence names in a single namespace by using
    -- a type or data specifier, e.g. in:
    --
    -- >  data a :*: b = a :*: b
    -- >  infix 3 type :*:
    --
    -- To handle that correctly, MiniFixityEnv contains separate
    -- fields for type-level and data-level names.
    -- If no namespace specifier is provided, the declaration will
    -- populate both the type-level and data-level fields.
    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)
      }

    --------------------------------
    -- Used for nested fixity decls to bind names along with their fixities.
    -- the fixities are given as a UFM from an OccName's FastString to a fixity decl

    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

    {-
    --------------------------------
    lookupFixity is a bit strange.

    * Nested local fixity decls are put in the local fixity env, which we
      find with getFixtyEnv

    * Imported fixities are found in the PIT

    * Top-level fixity decls in this module may be for Names that are
        either  Global         (constructors, class operations)
        or      Local/Exported (everything else)
      (See notes with GHC.Rename.Names.getLocalDeclBinders for why we have this split.)
      We put them all in the local fixity environment
    -}

    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' returns @(True, fixity)@ if it finds a 'Fixity'
    -- in a local environment or from an interface file. Otherwise, it returns
    -- @(False, fixity)@ (e.g., for unbound 'Name's or 'Name's without
    -- user-supplied fixity declarations).
    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, SourceText -> Int -> FixityDirection -> Fixity
    Fixity SourceText
    NoSourceText Int
    minPrecedence FixityDirection
    InfixL)
        -- Minimise errors from unbound names; eg
        --    a>0 `foo` b>0
        -- where 'foo' is not in scope, should not give an error (#7937)

      | 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
                   -- Local (and interactive) names are all in the
                   -- fixity env, and don't have entries in the HPT
             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
          -- For imported names, we have to get their fixities by doing a
          -- loadInterfaceForName, and consulting the Ifaces that comes back
          -- from that, because the interface file for the Name might not
          -- have been loaded yet.  Why not?  Suppose you import module A,
          -- which exports a function 'f', thus;
          --        module CurrentModule where
          --          import A( f )
          --        module A( f ) where
          --          import B( f )
          -- Then B isn't loaded right away (after all, it's possible that
          -- nothing from B will be used).  When we come across a use of
          -- 'f', we need to know its fixity, and it's then, and only
          -- then, that we load B.hi.  That is what's happening here.
          --
          -- loadInterfaceForName will find B.hi even if B is a hidden module,
          -- and that's what we want.
          = 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
    n XRec GhcRn RdrName
    _) = Name -> RnM Fixity
    lookupFixityRn XCFieldOcc GhcRn
    Name
    n