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

    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.Utils.Panic

    import GHC.Data.Maybe

    import GHC.Rename.Unbound

    import Data.List (groupBy)
    import Data.Function    ( on )

    {-
    *********************************************************
    *                                                      *
                    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.
    -}

    --------------------------------
    type MiniFixityEnv = FastStringEnv (Located Fixity)
            -- 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

    --------------------------------
    -- 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
    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

    {-
    --------------------------------
    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 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' 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 -> 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)
        -- Minimise errors from ubound names; eg
        --    a>0 `foo` b>0
        -- where 'foo' is not in scope, should not give an error (#7937)

      | 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
                   -- Local (and interactive) names are all in the
                   -- fixity env, and don't have entries in the HPT
             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
          -- 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 { 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

    -- | Look up the fixity of a (possibly ambiguous) occurrence of a record field
    -- selector.  We use 'lookupFixityRn'' so that we can specify the 'OccName' as
    -- the field label, which might be different to the 'OccName' of the selector
    -- 'Name' if @DuplicateRecordFields@ is in use (#1173). If there are
    -- multiple possible selectors with different fixities, generate an error.
    lookupFieldFixityRn :: AmbiguousFieldOcc GhcRn -> RnM Fixity
    lookupFieldFixityRn :: AmbiguousFieldOcc GhcRn -> RnM Fixity
    lookupFieldFixityRn (Unambiguous XUnambiguous GhcRn
    n LocatedN RdrName
    lrdr)
      = Name -> OccName -> RnM Fixity
    lookupFixityRn' XUnambiguous GhcRn
    n (RdrName -> OccName
    rdrNameOcc (forall l e. GenLocated l e -> e
    unLoc LocatedN RdrName
    lrdr))
    lookupFieldFixityRn (Ambiguous XAmbiguous GhcRn
    _ LocatedN RdrName
    lrdr) = RdrName -> RnM Fixity
    get_ambiguous_fixity (forall l e. GenLocated l e -> e
    unLoc LocatedN RdrName
    lrdr)
      where
        get_ambiguous_fixity :: RdrName -> RnM Fixity
        get_ambiguous_fixity :: RdrName -> RnM Fixity
    get_ambiguous_fixity RdrName
    rdr_name = do
          String -> SDoc -> TcRn ()
    traceRn String
    "get_ambiguous_fixity" (forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name)
          GlobalRdrEnv
    rdr_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
          let elts :: [GlobalRdrElt]
    elts =  RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName RdrName
    rdr_name GlobalRdrEnv
    rdr_env

          [[(GlobalRdrElt, Fixity)]]
    fixities <- forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (forall a. Eq a => a -> a -> Bool
    (==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` forall a b. (a, b) -> b
    snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. [a] -> [b] -> [(a, b)]
    zip [GlobalRdrElt]
    elts
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GlobalRdrElt -> RnM Fixity
    lookup_gre_fixity [GlobalRdrElt]
    elts

          case [[(GlobalRdrElt, Fixity)]]
    fixities of
            -- There should always be at least one fixity.
            -- Something's very wrong if there are no fixity candidates, so panic
            [] -> forall a. String -> a
    panic String
    "get_ambiguous_fixity: no candidates for a given RdrName"
            [ (GlobalRdrElt
    _, Fixity
    fix):[(GlobalRdrElt, Fixity)]
    _ ] -> forall (m :: * -> *) a. Monad m => a -> m a
    return Fixity
    fix
            [[(GlobalRdrElt, Fixity)]]
    ambigs -> SDoc -> TcRn ()
    addErr (forall {a} {a} {t :: * -> *}.
    (Outputable a, Outputable a, Foldable t) =>
    a -> t [(GlobalRdrElt, a)] -> SDoc
    ambiguous_fixity_err RdrName
    rdr_name [[(GlobalRdrElt, Fixity)]]
    ambigs)
                      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall (m :: * -> *) a. Monad m => a -> m a
    return (SourceText -> Int -> FixityDirection -> Fixity
    Fixity SourceText
    NoSourceText Int
    minPrecedence FixityDirection
    InfixL)

        lookup_gre_fixity :: GlobalRdrElt -> RnM Fixity
    lookup_gre_fixity GlobalRdrElt
    gre = Name -> OccName -> RnM Fixity
    lookupFixityRn' (GlobalRdrElt -> Name
    greMangledName GlobalRdrElt
    gre) (GlobalRdrElt -> OccName
    greOccName GlobalRdrElt
    gre)

        ambiguous_fixity_err :: a -> t [(GlobalRdrElt, a)] -> SDoc
    ambiguous_fixity_err a
    rn t [(GlobalRdrElt, a)]
    ambigs
          = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Ambiguous fixity for record field" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr a
    rn)
                 , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Conflicts: ") Int
    2 forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                   forall a b. (a -> b) -> [a] -> [b]
    map forall {a}. Outputable a => (GlobalRdrElt, a) -> SDoc
    format_ambig forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [(GlobalRdrElt, a)]
    ambigs ]

        format_ambig :: (GlobalRdrElt, a) -> SDoc
    format_ambig (GlobalRdrElt
    elt, a
    fix) = SDoc -> Int -> SDoc -> SDoc
    hang (forall a. Outputable a => a -> SDoc
    ppr a
    fix)
                                     Int
    2 (GlobalRdrElt -> SDoc
    pprNameProvenance GlobalRdrElt
    elt)