    {-# LANGUAGE CPP #-}

    module GHC.Types.Name.Shape
       ( NameShape(..)
       , emptyNameShape
       , mkNameShape
       , extendNameShape
       , nameShapeExports
       , substNameShape
       , maybeSubstNameShape
       )
    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Env

    import GHC.Unit.Module

    import GHC.Types.Unique.FM
    import GHC.Types.Avail
    import GHC.Types.FieldLabel
    import GHC.Types.Name
    import GHC.Types.Name.Env

    import GHC.Tc.Utils.Monad
    import GHC.Iface.Env

    import GHC.Utils.Outputable
    import GHC.Utils.Misc
    import GHC.Utils.Panic

    import Control.Monad

    -- Note [NameShape]
    -- ~~~~~~~~~~~~~~~~
    -- When we write a declaration in a signature, e.g., data T, we
    -- ascribe to it a *name variable*, e.g., {m.T}.  This
    -- name variable may be substituted with an actual original
    -- name when the signature is implemented (or even if we
    -- merge the signature with one which reexports this entity
    -- from another module).

    -- When we instantiate a signature m with a module M,
    -- we also need to substitute over names.  To do so, we must
    -- compute the *name substitution* induced by the *exports*
    -- of the module in question.  A NameShape represents
    -- such a name substitution for a single module instantiation.
    -- The "shape" in the name comes from the fact that the computation
    -- of a name substitution is essentially the *shaping pass* from
    -- Backpack'14, but in a far more restricted form.

    -- The name substitution for an export list is easy to explain.  If we are
    -- filling the module variable <m>, given an export N of the form
    -- M.n or {m'.n} (where n is an OccName), the induced name
    -- substitution is from {m.n} to N.  So, for example, if we have
    -- A=impl:B, and the exports of impl:B are impl:B.f and
    -- impl:C.g, then our name substitution is {A.f} to impl:B.f
    -- and {A.g} to impl:C.g

    -- The 'NameShape' type is defined in GHC.Tc.Types, because GHC.Tc.Types
    -- needs to refer to NameShape, and having GHC.Tc.Types import
    -- NameShape (even by SOURCE) would cause a large number of
    -- modules to be pulled into the DynFlags cycle.
    {-
    data NameShape = NameShape {
            ns_mod_name :: ModuleName,
            ns_exports :: [AvailInfo],
            ns_map :: OccEnv Name
        }
    -}

    -- NB: substitution functions need 'HscEnv' since they need the name cache
    -- to allocate new names if we change the 'Module' of a 'Name'

    -- | Create an empty 'NameShape' (i.e., the renaming that
    -- would occur with an implementing module with no exports)
    -- for a specific hole @mod_name@.
    emptyNameShape :: ModuleName -> NameShape
    emptyNameShape :: ModuleName -> NameShape
    emptyNameShape ModuleName
    mod_name = ModuleName -> [AvailInfo] -> OccEnv Name -> NameShape
    NameShape ModuleName
    mod_name [] OccEnv Name
    forall a. OccEnv a
    emptyOccEnv

    -- | Create a 'NameShape' corresponding to an implementing
    -- module for the hole @mod_name@ that exports a list of 'AvailInfo's.
    mkNameShape :: ModuleName -> [AvailInfo] -> NameShape
    mkNameShape :: ModuleName -> [AvailInfo] -> NameShape
    mkNameShape ModuleName
    mod_name [AvailInfo]
    as =
        ModuleName -> [AvailInfo] -> OccEnv Name -> NameShape
    NameShape ModuleName
    mod_name [AvailInfo]
    as (OccEnv Name -> NameShape) -> OccEnv Name -> NameShape
    forall a b. (a -> b) -> a -> b
    $ [(OccName, Name)] -> OccEnv Name
    forall a. [(OccName, a)] -> OccEnv a
    mkOccEnv ([(OccName, Name)] -> OccEnv Name)
    -> [(OccName, Name)] -> OccEnv Name
    forall a b. (a -> b) -> a -> b
    $ do
            AvailInfo
    a <- [AvailInfo]
    as
            Name
    n <- AvailInfo -> Name
    availName AvailInfo
    a Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : AvailInfo -> [Name]
    availNamesWithSelectors AvailInfo
    a
            (OccName, Name) -> [(OccName, Name)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> OccName
    forall name. HasOccName name => name -> OccName
    occName Name
    n, Name
    n)

    -- | Given an existing 'NameShape', merge it with a list of 'AvailInfo's
    -- with Backpack style mix-in linking.  This is used solely when merging
    -- signatures together: we successively merge the exports of each
    -- signature until we have the final, full exports of the merged signature.
    --
    -- What makes this operation nontrivial is what we are supposed to do when
    -- we want to merge in an export for M.T when we already have an existing
    -- export {H.T}.  What should happen in this case is that {H.T} should be
    -- unified with @M.T@: we've determined a more *precise* identity for the
    -- export at 'OccName' @T@.
    --
    -- Note that we don't do unrestricted unification: only name holes from
    -- @ns_mod_name ns@ are flexible.  This is because we have a much more
    -- restricted notion of shaping than in Backpack'14: we do shaping
    -- *as* we do type-checking.  Thus, once we shape a signature, its
    -- exports are *final* and we're not allowed to refine them further,
    extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape)
    extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape)
    extendNameShape HscEnv
    hsc_env NameShape
    ns [AvailInfo]
    as =
        case ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst
    uAvailInfos (NameShape -> ModuleName
    ns_mod_name NameShape
    ns) (NameShape -> [AvailInfo]
    ns_exports NameShape
    ns) [AvailInfo]
    as of
            Left SDoc
    err -> Either SDoc NameShape -> IO (Either SDoc NameShape)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SDoc -> Either SDoc NameShape
    forall a b. a -> Either a b
    Left SDoc
    err)
            Right ShNameSubst
    nsubst -> do
                [AvailInfo]
    as1 <- (AvailInfo -> IO AvailInfo) -> [AvailInfo] -> IO [AvailInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (IO AvailInfo -> IO AvailInfo
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO AvailInfo -> IO AvailInfo)
    -> (AvailInfo -> IO AvailInfo) -> AvailInfo -> IO AvailInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo
    substNameAvailInfo HscEnv
    hsc_env ShNameSubst
    nsubst) (NameShape -> [AvailInfo]
    ns_exports NameShape
    ns)
                [AvailInfo]
    as2 <- (AvailInfo -> IO AvailInfo) -> [AvailInfo] -> IO [AvailInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (IO AvailInfo -> IO AvailInfo
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO AvailInfo -> IO AvailInfo)
    -> (AvailInfo -> IO AvailInfo) -> AvailInfo -> IO AvailInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo
    substNameAvailInfo HscEnv
    hsc_env ShNameSubst
    nsubst) [AvailInfo]
    as
                let new_avails :: [AvailInfo]
    new_avails = [AvailInfo] -> [AvailInfo] -> [AvailInfo]
    mergeAvails [AvailInfo]
    as1 [AvailInfo]
    as2
                Either SDoc NameShape -> IO (Either SDoc NameShape)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either SDoc NameShape -> IO (Either SDoc NameShape))
    -> (NameShape -> Either SDoc NameShape)
    -> NameShape
    -> IO (Either SDoc NameShape)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameShape -> Either SDoc NameShape
    forall a b. b -> Either a b
    Right (NameShape -> IO (Either SDoc NameShape))
    -> NameShape -> IO (Either SDoc NameShape)
    forall a b. (a -> b) -> a -> b
    $ NameShape
    ns {
                    ns_exports :: [AvailInfo]
    ns_exports = [AvailInfo]
    new_avails,
                    -- TODO: stop repeatedly rebuilding the OccEnv
                    ns_map :: OccEnv Name
    ns_map = [(OccName, Name)] -> OccEnv Name
    forall a. [(OccName, a)] -> OccEnv a
    mkOccEnv ([(OccName, Name)] -> OccEnv Name)
    -> [(OccName, Name)] -> OccEnv Name
    forall a b. (a -> b) -> a -> b
    $ do
                                AvailInfo
    a <- [AvailInfo]
    new_avails
                                Name
    n <- AvailInfo -> Name
    availName AvailInfo
    a Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : AvailInfo -> [Name]
    availNames AvailInfo
    a
                                (OccName, Name) -> [(OccName, Name)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> OccName
    forall name. HasOccName name => name -> OccName
    occName Name
    n, Name
    n)
                    }

    -- | The export list associated with this 'NameShape' (i.e., what
    -- the exports of an implementing module which induces this 'NameShape'
    -- would be.)
    nameShapeExports :: NameShape -> [AvailInfo]
    nameShapeExports :: NameShape -> [AvailInfo]
    nameShapeExports = NameShape -> [AvailInfo]
    ns_exports

    -- | Given a 'Name', substitute it according to the 'NameShape' implied
    -- substitution, i.e. map @{A.T}@ to @M.T@, if the implementing module
    -- exports @M.T@.
    substNameShape :: NameShape -> Name -> Name
    substNameShape :: NameShape -> Name -> Name
    substNameShape NameShape
    ns Name
    n | HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    n Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    == NameShape -> Module
    ns_module NameShape
    ns
                        , Just Name
    n' <- OccEnv Name -> OccName -> Maybe Name
    forall a. OccEnv a -> OccName -> Maybe a
    lookupOccEnv (NameShape -> OccEnv Name
    ns_map NameShape
    ns) (Name -> OccName
    forall name. HasOccName name => name -> OccName
    occName Name
    n)
                        = Name
    n'
                        | Bool
    otherwise
                        = Name
    n

    -- | Like 'substNameShape', but returns @Nothing@ if no substitution
    -- works.
    maybeSubstNameShape :: NameShape -> Name -> Maybe Name
    maybeSubstNameShape :: NameShape -> Name -> Maybe Name
    maybeSubstNameShape NameShape
    ns Name
    n
        | HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    n Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    == NameShape -> Module
    ns_module NameShape
    ns
        = OccEnv Name -> OccName -> Maybe Name
    forall a. OccEnv a -> OccName -> Maybe a
    lookupOccEnv (NameShape -> OccEnv Name
    ns_map NameShape
    ns) (Name -> OccName
    forall name. HasOccName name => name -> OccName
    occName Name
    n)
        | Bool
    otherwise
        = Maybe Name
    forall a. Maybe a
    Nothing

    -- | The 'Module' of any 'Name's a 'NameShape' has action over.
    ns_module :: NameShape -> Module
    ns_module :: NameShape -> Module
    ns_module = ModuleName -> Module
    forall u. ModuleName -> GenModule (GenUnit u)
    mkHoleModule (ModuleName -> Module)
    -> (NameShape -> ModuleName) -> NameShape -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameShape -> ModuleName
    ns_mod_name

    {-
    ************************************************************************
    *                                                                      *
                            Name substitutions
    *                                                                      *
    ************************************************************************
    -}

    -- | Substitution on @{A.T}@.  We enforce the invariant that the
    -- 'nameModule' of keys of this map have 'moduleUnit' @hole@
    -- (meaning that if we have a hole substitution, the keys of the map
    -- are never affected.)  Alternatively, this is isomorphic to
    -- @Map ('ModuleName', 'OccName') 'Name'@.
    type ShNameSubst = NameEnv Name

    -- NB: In this module, we actually only ever construct 'ShNameSubst'
    -- at a single 'ModuleName'.  But 'ShNameSubst' is more convenient to
    -- work with.

    -- | Substitute names in a 'Name'.
    substName :: ShNameSubst -> Name -> Name
    substName :: ShNameSubst -> Name -> Name
    substName ShNameSubst
    env Name
    n | Just Name
    n' <- ShNameSubst -> Name -> Maybe Name
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv ShNameSubst
    env Name
    n = Name
    n'
                    | Bool
    otherwise                      = Name
    n

    -- | Substitute names in an 'AvailInfo'.  This has special behavior
    -- for type constructors, where it is sufficient to substitute the 'availName'
    -- to induce a substitution on 'availNames'.
    substNameAvailInfo :: HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo
    substNameAvailInfo :: HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo
    substNameAvailInfo HscEnv
    _ ShNameSubst
    env (Avail (NormalGreName Name
    n)) = AvailInfo -> IO AvailInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GreName -> AvailInfo
    Avail (Name -> GreName
    NormalGreName (ShNameSubst -> Name -> Name
    substName ShNameSubst
    env Name
    n)))
    substNameAvailInfo HscEnv
    _ ShNameSubst
    env (Avail (FieldGreName FieldLabel
    fl)) =
        AvailInfo -> IO AvailInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GreName -> AvailInfo
    Avail (FieldLabel -> GreName
    FieldGreName FieldLabel
    fl { flSelector :: Name
    flSelector = ShNameSubst -> Name -> Name
    substName ShNameSubst
    env (FieldLabel -> Name
    flSelector FieldLabel
    fl) }))
    substNameAvailInfo HscEnv
    hsc_env ShNameSubst
    env (AvailTC Name
    n [GreName]
    ns) =
        let mb_mod :: Maybe Module
    mb_mod = (Name -> Module) -> Maybe Name -> Maybe Module
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule (ShNameSubst -> Name -> Maybe Name
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv ShNameSubst
    env Name
    n)
        in Name -> [GreName] -> AvailInfo
    AvailTC (ShNameSubst -> Name -> Name
    substName ShNameSubst
    env Name
    n) ([GreName] -> AvailInfo) -> IO [GreName] -> IO AvailInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (GreName -> IO GreName) -> [GreName] -> IO [GreName]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (HscEnv -> Maybe Module -> GreName -> IO GreName
    setNameGreName HscEnv
    hsc_env Maybe Module
    mb_mod) [GreName]
    ns

    setNameGreName :: HscEnv -> Maybe Module -> GreName -> IO GreName
    setNameGreName :: HscEnv -> Maybe Module -> GreName -> IO GreName
    setNameGreName HscEnv
    hsc_env Maybe Module
    mb_mod GreName
    gname = case GreName
    gname of
        NormalGreName Name
    n -> Name -> GreName
    NormalGreName (Name -> GreName) -> IO Name -> IO GreName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HscEnv -> IfG Name -> IO Name
    forall a. HscEnv -> IfG a -> IO a
    initIfaceLoad HscEnv
    hsc_env (Maybe Module -> Name -> IfG Name
    forall m n. Maybe Module -> Name -> TcRnIf m n Name
    setNameModule Maybe Module
    mb_mod Name
    n)
        FieldGreName FieldLabel
    fl -> FieldLabel -> GreName
    FieldGreName  (FieldLabel -> GreName) -> IO FieldLabel -> IO GreName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel
    setNameFieldSelector HscEnv
    hsc_env Maybe Module
    mb_mod FieldLabel
    fl

    -- | Set the 'Module' of a 'FieldSelector'
    setNameFieldSelector :: HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel
    setNameFieldSelector :: HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel
    setNameFieldSelector HscEnv
    _ Maybe Module
    Nothing FieldLabel
    f = FieldLabel -> IO FieldLabel
    forall (m :: * -> *) a. Monad m => a -> m a
    return FieldLabel
    f
    setNameFieldSelector HscEnv
    hsc_env Maybe Module
    mb_mod (FieldLabel FieldLabelString
    l DuplicateRecordFields
    b FieldSelectors
    has_sel Name
    sel) = do
        Name
    sel' <- HscEnv -> IfG Name -> IO Name
    forall a. HscEnv -> IfG a -> IO a
    initIfaceLoad HscEnv
    hsc_env (IfG Name -> IO Name) -> IfG Name -> IO Name
    forall a b. (a -> b) -> a -> b
    $ Maybe Module -> Name -> IfG Name
    forall m n. Maybe Module -> Name -> TcRnIf m n Name
    setNameModule Maybe Module
    mb_mod Name
    sel
        FieldLabel -> IO FieldLabel
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FieldLabelString
    -> DuplicateRecordFields -> FieldSelectors -> Name -> FieldLabel
    FieldLabel FieldLabelString
    l DuplicateRecordFields
    b FieldSelectors
    has_sel Name
    sel')

    {-
    ************************************************************************
    *                                                                      *
                            AvailInfo merging
    *                                                                      *
    ************************************************************************
    -}

    -- | Merges to 'AvailInfo' lists together, assuming the 'AvailInfo's have
    -- already been unified ('uAvailInfos').
    mergeAvails :: [AvailInfo] -> [AvailInfo] -> [AvailInfo]
    mergeAvails :: [AvailInfo] -> [AvailInfo] -> [AvailInfo]
    mergeAvails [AvailInfo]
    as1 [AvailInfo]
    as2 =
        let mkNE :: [AvailInfo] -> NameEnv AvailInfo
    mkNE [AvailInfo]
    as = [(Name, AvailInfo)] -> NameEnv AvailInfo
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(AvailInfo -> Name
    availName AvailInfo
    a, AvailInfo
    a) | AvailInfo
    a <- [AvailInfo]
    as]
        in NameEnv AvailInfo -> [AvailInfo]
    forall a. NameEnv a -> [a]
    nameEnvElts ((AvailInfo -> AvailInfo -> AvailInfo)
    -> NameEnv AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
    forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
    plusNameEnv_C AvailInfo -> AvailInfo -> AvailInfo
    plusAvail ([AvailInfo] -> NameEnv AvailInfo
    mkNE [AvailInfo]
    as1) ([AvailInfo] -> NameEnv AvailInfo
    mkNE [AvailInfo]
    as2))

    {-
    ************************************************************************
    *                                                                      *
                            AvailInfo unification
    *                                                                      *
    ************************************************************************
    -}

    -- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@,
    -- with only name holes from @flexi@ unifiable (all other name holes rigid.)
    uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst
    uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst
    uAvailInfos ModuleName
    flexi [AvailInfo]
    as1 [AvailInfo]
    as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $
        let mkOE :: [AvailInfo] -> UniqFM OccName AvailInfo
    mkOE [AvailInfo]
    as = [(OccName, AvailInfo)] -> UniqFM OccName AvailInfo
    forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM ([(OccName, AvailInfo)] -> UniqFM OccName AvailInfo)
    -> [(OccName, AvailInfo)] -> UniqFM OccName AvailInfo
    forall a b. (a -> b) -> a -> b
    $ do AvailInfo
    a <- [AvailInfo]
    as
                                     Name
    n <- AvailInfo -> [Name]
    availNames AvailInfo
    a
                                     (OccName, AvailInfo) -> [(OccName, AvailInfo)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> OccName
    nameOccName Name
    n, AvailInfo
    a)
        in (ShNameSubst -> (AvailInfo, AvailInfo) -> Either SDoc ShNameSubst)
    -> ShNameSubst
    -> [(AvailInfo, AvailInfo)]
    -> Either SDoc ShNameSubst
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (\ShNameSubst
    subst (AvailInfo
    a1, AvailInfo
    a2) -> ModuleName
    -> ShNameSubst -> AvailInfo -> AvailInfo -> Either SDoc ShNameSubst
    uAvailInfo ModuleName
    flexi ShNameSubst
    subst AvailInfo
    a1 AvailInfo
    a2) ShNameSubst
    forall a. NameEnv a
    emptyNameEnv
                 (UniqFM OccName (AvailInfo, AvailInfo) -> [(AvailInfo, AvailInfo)]
    forall key elt. UniqFM key elt -> [elt]
    eltsUFM ((AvailInfo -> AvailInfo -> (AvailInfo, AvailInfo))
    -> UniqFM OccName AvailInfo
    -> UniqFM OccName AvailInfo
    -> UniqFM OccName (AvailInfo, AvailInfo)
    forall elt1 elt2 elt3 key.
    (elt1 -> elt2 -> elt3)
    -> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt3
    intersectUFM_C (,) ([AvailInfo] -> UniqFM OccName AvailInfo
    mkOE [AvailInfo]
    as1) ([AvailInfo] -> UniqFM OccName AvailInfo
    mkOE [AvailInfo]
    as2)))
                 -- Edward: I have to say, this is pretty clever.

    -- | Unify two 'AvailInfo's, given an existing substitution @subst@,
    -- with only name holes from @flexi@ unifiable (all other name holes rigid.)
    uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo
               -> Either SDoc ShNameSubst
    uAvailInfo :: ModuleName
    -> ShNameSubst -> AvailInfo -> AvailInfo -> Either SDoc ShNameSubst
    uAvailInfo ModuleName
    flexi ShNameSubst
    subst (Avail (NormalGreName Name
    n1)) (Avail (NormalGreName Name
    n2)) = ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uName ModuleName
    flexi ShNameSubst
    subst Name
    n1 Name
    n2
    uAvailInfo ModuleName
    flexi ShNameSubst
    subst (AvailTC Name
    n1 [GreName]
    _) (AvailTC Name
    n2 [GreName]
    _) = ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uName ModuleName
    flexi ShNameSubst
    subst Name
    n1 Name
    n2
    uAvailInfo ModuleName
    _ ShNameSubst
    _ AvailInfo
    a1 AvailInfo
    a2 = SDoc -> Either SDoc ShNameSubst
    forall a b. a -> Either a b
    Left (SDoc -> Either SDoc ShNameSubst)
    -> SDoc -> Either SDoc ShNameSubst
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "While merging export lists, could not combine"
                               SDoc -> SDoc -> SDoc
    <+> AvailInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AvailInfo
    a1 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with" SDoc -> SDoc -> SDoc
    <+> AvailInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AvailInfo
    a2
                               SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    text String
    "one is a type, the other is a plain identifier")

    -- | Unify two 'Name's, given an existing substitution @subst@,
    -- with only name holes from @flexi@ unifiable (all other name holes rigid.)
    uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uName :: ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uName ModuleName
    flexi ShNameSubst
    subst Name
    n1 Name
    n2
        | Name
    n1 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    n2      = ShNameSubst -> Either SDoc ShNameSubst
    forall a b. b -> Either a b
    Right ShNameSubst
    subst
        | Name -> Bool
    isFlexi Name
    n1    = ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uHoleName ModuleName
    flexi ShNameSubst
    subst Name
    n1 Name
    n2
        | Name -> Bool
    isFlexi Name
    n2    = ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uHoleName ModuleName
    flexi ShNameSubst
    subst Name
    n2 Name
    n1
        | Bool
    otherwise     = SDoc -> Either SDoc ShNameSubst
    forall a b. a -> Either a b
    Left (String -> SDoc
    text String
    "While merging export lists, could not unify"
                             SDoc -> SDoc -> SDoc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n1 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with" SDoc -> SDoc -> SDoc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n2 SDoc -> SDoc -> SDoc
    $$ SDoc
    extra)
      where
        isFlexi :: Name -> Bool
    isFlexi Name
    n = Name -> Bool
    isHoleName Name
    n Bool -> Bool -> Bool
    && Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    n) ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    flexi
        extra :: SDoc
    extra | Name -> Bool
    isHoleName Name
    n1 Bool -> Bool -> Bool
    || Name -> Bool
    isHoleName Name
    n2
              = String -> SDoc
    text String
    "Neither name variable originates from the current signature."
              | Bool
    otherwise
              = SDoc
    empty

    -- | Unify a name @h@ which 'isHoleName' with another name, given an existing
    -- substitution @subst@, with only name holes from @flexi@ unifiable (all
    -- other name holes rigid.)
    uHoleName :: ModuleName -> ShNameSubst -> Name {- hole name -} -> Name
              -> Either SDoc ShNameSubst
    uHoleName :: ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uHoleName ModuleName
    flexi ShNameSubst
    subst Name
    h Name
    n =
        ASSERT( isHoleName h )
        case ShNameSubst -> Name -> Maybe Name
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv ShNameSubst
    subst Name
    h of
            Just Name
    n' -> ModuleName
    -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
    uName ModuleName
    flexi ShNameSubst
    subst Name
    n' Name
    n
                    -- Do a quick check if the other name is substituted.
            Maybe Name
    Nothing | Just Name
    n' <- ShNameSubst -> Name -> Maybe Name
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv ShNameSubst
    subst Name
    n ->
                        ASSERT( isHoleName n ) uName flexi subst h n'
                    | Bool
    otherwise ->
                        ShNameSubst -> Either SDoc ShNameSubst
    forall a b. b -> Either a b
    Right (ShNameSubst -> Name -> Name -> ShNameSubst
    forall a. NameEnv a -> Name -> a -> NameEnv a
    extendNameEnv ShNameSubst
    subst Name
    h Name
    n)