    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
    module Distribution.Backpack.UnifyM (
        -- * Unification monad
        UnifyM,
        runUnifyM,
        failWith,
        addErr,
        failIfErrs,
        tryM,
        addErrContext,
        addErrContextM,
        liftST,

        UnifEnv(..),
        getUnifEnv,

        -- * Modules and unit IDs
        ModuleU,
        ModuleU'(..),
        convertModule,
        convertModuleU,

        UnitIdU,
        UnitIdU'(..),
        convertUnitId,
        convertUnitIdU,

        ModuleSubstU,
        convertModuleSubstU,
        convertModuleSubst,

        ModuleScopeU,
        emptyModuleScopeU,
        convertModuleScopeU,

        ModuleWithSourceU,

        convertInclude,
        convertModuleProvides,
        convertModuleProvidesU,

    ) where

    import Prelude ()
    import Distribution.Compat.Prelude hiding (mod)

    import Distribution.Backpack.ModuleShape
    import Distribution.Backpack.ModuleScope
    import Distribution.Backpack.ModSubst
    import Distribution.Backpack.FullUnitId
    import Distribution.Backpack

    import qualified Distribution.Utils.UnionFind as UnionFind
    import Distribution.ModuleName
    import Distribution.Package
    import Distribution.PackageDescription
    import Distribution.Pretty
    import Distribution.Types.ComponentInclude
    import Distribution.Types.AnnotatedId
    import Distribution.Verbosity

    import Data.STRef
    import Data.Traversable
    import Control.Monad.ST
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    import Data.IntMap (IntMap)
    import qualified Data.IntMap as IntMap
    import Text.PrettyPrint

    -- TODO: more detailed trace output on high verbosity would probably
    -- be appreciated by users debugging unification errors.  Collect
    -- some good examples!

    data ErrMsg = ErrMsg {
            ErrMsg -> Doc
    err_msg :: Doc,
            ErrMsg -> [Doc]
    err_ctx :: [Doc]
        }
    type MsgDoc = Doc

    renderErrMsg :: ErrMsg -> MsgDoc
    renderErrMsg :: ErrMsg -> Doc
    renderErrMsg ErrMsg { err_msg :: ErrMsg -> Doc
    err_msg = Doc
    msg, err_ctx :: ErrMsg -> [Doc]
    err_ctx = [Doc]
    ctx } =
        Doc
    msg Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat [Doc]
    ctx

    -- | The unification monad, this monad encapsulates imperative
    -- unification.
    newtype UnifyM s a = UnifyM { forall s a. UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    unUnifyM :: UnifEnv s -> ST s (Maybe a) }

    -- | Run a computation in the unification monad.
    runUnifyM :: Verbosity -> ComponentId -> FullDb -> (forall s. UnifyM s a) -> Either [MsgDoc] a
    runUnifyM :: forall a.
    Verbosity
    -> ComponentId
    -> FullDb
    -> (forall s. UnifyM s a)
    -> Either [Doc] a
    runUnifyM Verbosity
    verbosity ComponentId
    self_cid FullDb
    db forall s. UnifyM s a
    m
        = (forall s. ST s (Either [Doc] a)) -> Either [Doc] a
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either [Doc] a)) -> Either [Doc] a)
    -> (forall s. ST s (Either [Doc] a)) -> Either [Doc] a
    forall a b. (a -> b) -> a -> b
    $ do STRef s Int
    i    <- Int -> ST s (STRef s Int)
    forall a s. a -> ST s (STRef s a)
    newSTRef Int
    0
                     STRef s (Map ModuleName (ModuleU s))
    hmap <- Map ModuleName (ModuleU s)
    -> ST s (STRef s (Map ModuleName (ModuleU s)))
    forall a s. a -> ST s (STRef s a)
    newSTRef Map ModuleName (ModuleU s)
    forall k a. Map k a
    Map.empty
                     STRef s [ErrMsg]
    errs <- [ErrMsg] -> ST s (STRef s [ErrMsg])
    forall a s. a -> ST s (STRef s a)
    newSTRef []
                     Maybe a
    mb_r <- UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    forall s a. UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    unUnifyM UnifyM s a
    forall s. UnifyM s a
    m UnifEnv {
                                unify_uniq :: STRef s Int
    unify_uniq = STRef s Int
    i,
                                unify_reqs :: STRef s (Map ModuleName (ModuleU s))
    unify_reqs = STRef s (Map ModuleName (ModuleU s))
    hmap,
                                unify_self_cid :: ComponentId
    unify_self_cid = ComponentId
    self_cid,
                                unify_verbosity :: Verbosity
    unify_verbosity = Verbosity
    verbosity,
                                unify_ctx :: [Doc]
    unify_ctx = [],
                                unify_db :: FullDb
    unify_db = FullDb
    db,
                                unify_errs :: STRef s [ErrMsg]
    unify_errs = STRef s [ErrMsg]
    errs }
                     [ErrMsg]
    final_errs <- STRef s [ErrMsg] -> ST s [ErrMsg]
    forall s a. STRef s a -> ST s a
    readSTRef STRef s [ErrMsg]
    errs
                     case Maybe a
    mb_r of
                        Just a
    x | [ErrMsg] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ErrMsg]
    final_errs -> Either [Doc] a -> ST s (Either [Doc] a)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Either [Doc] a
    forall a b. b -> Either a b
    Right a
    x)
                        Maybe a
    _ -> Either [Doc] a -> ST s (Either [Doc] a)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Doc] -> Either [Doc] a
    forall a b. a -> Either a b
    Left ((ErrMsg -> Doc) -> [ErrMsg] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ErrMsg -> Doc
    renderErrMsg ([ErrMsg] -> [ErrMsg]
    forall a. [a] -> [a]
    reverse [ErrMsg]
    final_errs)))
    -- NB: GHC 7.6 throws a hissy fit if you pattern match on 'm'.

    type ErrCtx s = MsgDoc

    -- | The unification environment.
    data UnifEnv s = UnifEnv {
            -- | A supply of unique integers to label 'UnitIdU'
            -- cells.  This is used to determine loops in unit
            -- identifiers (which can happen with mutual recursion.)
            forall s. UnifEnv s -> UnifRef s Int
    unify_uniq :: UnifRef s UnitIdUnique,
            -- | The set of requirements in scope.  When
            -- a provision is brought into scope, we unify with
            -- the requirement at the same module name to fill it.
            -- This mapping grows monotonically.
            forall s. UnifEnv s -> UnifRef s (Map ModuleName (ModuleU s))
    unify_reqs :: UnifRef s (Map ModuleName (ModuleU s)),
            -- | Component id of the unit we're linking.  We use this
            -- to detect if we fill a requirement with a local module,
            -- which in principle should be OK but is not currently
            -- supported by GHC.
            forall s. UnifEnv s -> ComponentId
    unify_self_cid :: ComponentId,
            -- | How verbose the error message should be
            forall s. UnifEnv s -> Verbosity
    unify_verbosity :: Verbosity,
            -- | The error reporting context
            forall s. UnifEnv s -> [Doc]
    unify_ctx :: [ErrCtx s],
            -- | The package index for expanding unit identifiers
            forall s. UnifEnv s -> FullDb
    unify_db :: FullDb,
            -- | Accumulated errors
            forall s. UnifEnv s -> UnifRef s [ErrMsg]
    unify_errs :: UnifRef s [ErrMsg]
        }

    instance Functor (UnifyM s) where
        fmap :: forall a b. (a -> b) -> UnifyM s a -> UnifyM s b
    fmap a -> b
    f (UnifyM UnifEnv s -> ST s (Maybe a)
    m) = (UnifEnv s -> ST s (Maybe b)) -> UnifyM s b
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((ST s (Maybe a) -> ST s (Maybe b))
    -> (UnifEnv s -> ST s (Maybe a)) -> UnifEnv s -> ST s (Maybe b)
    forall a b. (a -> b) -> (UnifEnv s -> a) -> UnifEnv s -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Maybe a -> Maybe b) -> ST s (Maybe a) -> ST s (Maybe b)
    forall a b. (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> Maybe a -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f)) UnifEnv s -> ST s (Maybe a)
    m)

    instance Applicative (UnifyM s) where
        pure :: forall a. a -> UnifyM s a
    pure = (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe a)) -> UnifyM s a)
    -> (a -> UnifEnv s -> ST s (Maybe a)) -> a -> UnifyM s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ST s (Maybe a) -> UnifEnv s -> ST s (Maybe a)
    forall a. a -> UnifEnv s -> a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ST s (Maybe a) -> UnifEnv s -> ST s (Maybe a))
    -> (a -> ST s (Maybe a)) -> a -> UnifEnv s -> ST s (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe a -> ST s (Maybe a)
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe a -> ST s (Maybe a))
    -> (a -> Maybe a) -> a -> ST s (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        UnifyM UnifEnv s -> ST s (Maybe (a -> b))
    f <*> :: forall a b. UnifyM s (a -> b) -> UnifyM s a -> UnifyM s b
    <*> UnifyM UnifEnv s -> ST s (Maybe a)
    x = (UnifEnv s -> ST s (Maybe b)) -> UnifyM s b
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe b)) -> UnifyM s b)
    -> (UnifEnv s -> ST s (Maybe b)) -> UnifyM s b
    forall a b. (a -> b) -> a -> b
    $ \UnifEnv s
    r -> do
            Maybe (a -> b)
    f' <- UnifEnv s -> ST s (Maybe (a -> b))
    f UnifEnv s
    r
            case Maybe (a -> b)
    f' of
              Maybe (a -> b)
    Nothing -> Maybe b -> ST s (Maybe b)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe b
    forall a. Maybe a
    Nothing
              Just a -> b
    f'' -> do
                  Maybe a
    x' <- UnifEnv s -> ST s (Maybe a)
    x UnifEnv s
    r
                  case Maybe a
    x' of
                      Maybe a
    Nothing -> Maybe b -> ST s (Maybe b)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe b
    forall a. Maybe a
    Nothing
                      Just a
    x'' -> Maybe b -> ST s (Maybe b)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> Maybe b
    forall a. a -> Maybe a
    Just (a -> b
    f'' a
    x''))

    instance Monad (UnifyM s) where
        return :: forall a. a -> UnifyM s a
    return = a -> UnifyM s a
    forall a. a -> UnifyM s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        UnifyM UnifEnv s -> ST s (Maybe a)
    m >>= :: forall a b. UnifyM s a -> (a -> UnifyM s b) -> UnifyM s b
    >>= a -> UnifyM s b
    f = (UnifEnv s -> ST s (Maybe b)) -> UnifyM s b
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe b)) -> UnifyM s b)
    -> (UnifEnv s -> ST s (Maybe b)) -> UnifyM s b
    forall a b. (a -> b) -> a -> b
    $ \UnifEnv s
    r -> do
            Maybe a
    x <- UnifEnv s -> ST s (Maybe a)
    m UnifEnv s
    r
            case Maybe a
    x of
                Maybe a
    Nothing -> Maybe b -> ST s (Maybe b)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe b
    forall a. Maybe a
    Nothing
                Just a
    x' -> UnifyM s b -> UnifEnv s -> ST s (Maybe b)
    forall s a. UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    unUnifyM (a -> UnifyM s b
    f a
    x') UnifEnv s
    r

    -- | Lift a computation from 'ST' monad to 'UnifyM' monad.
    -- Internal use only.
    liftST :: ST s a -> UnifyM s a
    liftST :: forall s a. ST s a -> UnifyM s a
    liftST ST s a
    m = (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe a)) -> UnifyM s a)
    -> (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall a b. (a -> b) -> a -> b
    $ \UnifEnv s
    _ -> (a -> Maybe a) -> ST s a -> ST s (Maybe a)
    forall a b. (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Maybe a
    forall a. a -> Maybe a
    Just ST s a
    m

    addErr :: MsgDoc -> UnifyM s ()
    addErr :: forall s. Doc -> UnifyM s ()
    addErr Doc
    msg = do
        UnifEnv s
    env <- UnifyM s (UnifEnv s)
    forall s. UnifyM s (UnifEnv s)
    getUnifEnv
        let err :: ErrMsg
    err = ErrMsg {
                    err_msg :: Doc
    err_msg = Doc
    msg,
                    err_ctx :: [Doc]
    err_ctx = UnifEnv s -> [Doc]
    forall s. UnifEnv s -> [Doc]
    unify_ctx UnifEnv s
    env
                  }
        ST s () -> UnifyM s ()
    forall s a. ST s a -> UnifyM s a
    liftST (ST s () -> UnifyM s ()) -> ST s () -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ STRef s [ErrMsg] -> ([ErrMsg] -> [ErrMsg]) -> ST s ()
    forall s a. STRef s a -> (a -> a) -> ST s ()
    modifySTRef (UnifEnv s -> STRef s [ErrMsg]
    forall s. UnifEnv s -> UnifRef s [ErrMsg]
    unify_errs UnifEnv s
    env) (\[ErrMsg]
    errs -> ErrMsg
    errErrMsg -> [ErrMsg] -> [ErrMsg]
    forall a. a -> [a] -> [a]
    :[ErrMsg]
    errs)

    failWith :: MsgDoc -> UnifyM s a
    failWith :: forall s a. Doc -> UnifyM s a
    failWith Doc
    msg = do
        Doc -> UnifyM s ()
    forall s. Doc -> UnifyM s ()
    addErr Doc
    msg
        UnifyM s a
    forall s a. UnifyM s a
    failM

    failM :: UnifyM s a
    failM :: forall s a. UnifyM s a
    failM = (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe a)) -> UnifyM s a)
    -> (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall a b. (a -> b) -> a -> b
    $ \UnifEnv s
    _ -> Maybe a -> ST s (Maybe a)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

    failIfErrs :: UnifyM s ()
    failIfErrs :: forall s. UnifyM s ()
    failIfErrs = do
        UnifEnv s
    env <- UnifyM s (UnifEnv s)
    forall s. UnifyM s (UnifEnv s)
    getUnifEnv
        [ErrMsg]
    errs <- ST s [ErrMsg] -> UnifyM s [ErrMsg]
    forall s a. ST s a -> UnifyM s a
    liftST (ST s [ErrMsg] -> UnifyM s [ErrMsg])
    -> ST s [ErrMsg] -> UnifyM s [ErrMsg]
    forall a b. (a -> b) -> a -> b
    $ STRef s [ErrMsg] -> ST s [ErrMsg]
    forall s a. STRef s a -> ST s a
    readSTRef (UnifEnv s -> STRef s [ErrMsg]
    forall s. UnifEnv s -> UnifRef s [ErrMsg]
    unify_errs UnifEnv s
    env)
        Bool -> UnifyM s () -> UnifyM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not ([ErrMsg] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ErrMsg]
    errs)) UnifyM s ()
    forall s a. UnifyM s a
    failM

    tryM :: UnifyM s a -> UnifyM s (Maybe a)
    tryM :: forall s a. UnifyM s a -> UnifyM s (Maybe a)
    tryM UnifyM s a
    m =
        (UnifEnv s -> ST s (Maybe (Maybe a))) -> UnifyM s (Maybe a)
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM (\UnifEnv s
    env -> do
            Maybe a
    mb_r <- UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    forall s a. UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    unUnifyM UnifyM s a
    m UnifEnv s
    env
            Maybe (Maybe a) -> ST s (Maybe (Maybe a))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just Maybe a
    mb_r))

    {-
    otherFail :: ErrMsg -> UnifyM s a
    otherFail s = UnifyM $ \_ -> return (Left s)

    unifyFail :: ErrMsg -> UnifyM s a
    unifyFail err = do
        env <- getUnifEnv
        msg <- case unify_ctx env of
            Nothing -> return (text "Unspecified unification error:" <+> err)
            Just (ctx, mod1, mod2)
                | unify_verbosity env > normal
                -> do mod1' <- convertModuleU mod1
                      mod2' <- convertModuleU mod2
                      let extra = " (was unifying " ++ display mod1'
                                         ++ " and " ++ display mod2' ++ ")"
                      return (ctx ++ err ++ extra)
                | otherwise
                -> return (ctx ++ err ++ " (for more information, pass -v flag)")
        UnifyM $ \_ -> return (Left msg)
    -}

    -- | A convenient alias for mutable references in the unification monad.
    type UnifRef s a = STRef s a

    -- | Imperatively read a 'UnifRef'.
    readUnifRef :: UnifRef s a -> UnifyM s a
    readUnifRef :: forall s a. UnifRef s a -> UnifyM s a
    readUnifRef = ST s a -> UnifyM s a
    forall s a. ST s a -> UnifyM s a
    liftST (ST s a -> UnifyM s a)
    -> (UnifRef s a -> ST s a) -> UnifRef s a -> UnifyM s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnifRef s a -> ST s a
    forall s a. STRef s a -> ST s a
    readSTRef

    -- | Imperatively write a 'UnifRef'.
    writeUnifRef :: UnifRef s a -> a -> UnifyM s ()
    writeUnifRef :: forall s a. UnifRef s a -> a -> UnifyM s ()
    writeUnifRef UnifRef s a
    x = ST s () -> UnifyM s ()
    forall s a. ST s a -> UnifyM s a
    liftST (ST s () -> UnifyM s ()) -> (a -> ST s ()) -> a -> UnifyM s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnifRef s a -> a -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef UnifRef s a
    x

    -- | Get the current unification environment.
    getUnifEnv :: UnifyM s (UnifEnv s)
    getUnifEnv :: forall s. UnifyM s (UnifEnv s)
    getUnifEnv = (UnifEnv s -> ST s (Maybe (UnifEnv s))) -> UnifyM s (UnifEnv s)
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe (UnifEnv s))) -> UnifyM s (UnifEnv s))
    -> (UnifEnv s -> ST s (Maybe (UnifEnv s))) -> UnifyM s (UnifEnv s)
    forall a b. (a -> b) -> a -> b
    $ \UnifEnv s
    r -> Maybe (UnifEnv s) -> ST s (Maybe (UnifEnv s))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnifEnv s -> Maybe (UnifEnv s)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnifEnv s
    r)

    -- | Add a fixed message to the error context.
    addErrContext :: Doc -> UnifyM s a -> UnifyM s a
    addErrContext :: forall s a. Doc -> UnifyM s a -> UnifyM s a
    addErrContext Doc
    ctx UnifyM s a
    m = Doc -> UnifyM s a -> UnifyM s a
    forall s a. Doc -> UnifyM s a -> UnifyM s a
    addErrContextM Doc
    ctx UnifyM s a
    m

    -- | Add a message to the error context.  It may make monadic queries.
    addErrContextM :: ErrCtx s -> UnifyM s a -> UnifyM s a
    addErrContextM :: forall s a. Doc -> UnifyM s a -> UnifyM s a
    addErrContextM Doc
    ctx UnifyM s a
    m =
        (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall s a. (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    UnifyM ((UnifEnv s -> ST s (Maybe a)) -> UnifyM s a)
    -> (UnifEnv s -> ST s (Maybe a)) -> UnifyM s a
    forall a b. (a -> b) -> a -> b
    $ \UnifEnv s
    r -> UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    forall s a. UnifyM s a -> UnifEnv s -> ST s (Maybe a)
    unUnifyM UnifyM s a
    m UnifEnv s
    r { unify_ctx = ctx : unify_ctx r }

    -----------------------------------------------------------------------
    -- The "unifiable" variants of the data types
    --
    -- In order to properly do unification over infinite trees, we
    -- need to union find over 'Module's and 'UnitId's.  The pure
    -- representation is ill-equipped to do this, so we convert
    -- from the pure representation into one which is indirected
    -- through union-find.  'ModuleU' handles hole variables;
    -- 'UnitIdU' handles mu-binders.

    -- | Contents of a mutable 'ModuleU' reference.
    data ModuleU' s
        = ModuleU (UnitIdU s) ModuleName
        | ModuleVarU ModuleName

    -- | Contents of a mutable 'UnitIdU' reference.
    data UnitIdU' s
        = UnitIdU UnitIdUnique ComponentId (Map ModuleName (ModuleU s))
        | UnitIdThunkU DefUnitId

    -- | A mutable version of 'Module' which can be imperatively unified.
    type ModuleU s = UnionFind.Point s (ModuleU' s)

    -- | A mutable version of 'UnitId' which can be imperatively unified.
    type UnitIdU s = UnionFind.Point s (UnitIdU' s)

    -- | An integer for uniquely labeling 'UnitIdU' nodes.  We need
    -- these labels in order to efficiently serialize 'UnitIdU's into
    -- 'UnitId's (we use the label to check if any parent is the
    -- node in question, and if so insert a deBruijn index instead.)
    -- These labels must be unique across all 'UnitId's/'Module's which
    -- participate in unification!
    type UnitIdUnique = Int

    -----------------------------------------------------------------------
    -- Conversion to the unifiable data types

    -- An environment for tracking the mu-bindings in scope.
    -- The invariant for a state @(m, i)@ is that [0..i] are
    -- keys of @m@; in fact, the @i-k@th entry is the @k@th
    -- de Bruijn index (this saves us from having to shift as
    -- we enter mu-binders.)
    type MuEnv s = (IntMap (UnitIdU s), Int)

    extendMuEnv :: MuEnv s -> UnitIdU s -> MuEnv s
    extendMuEnv :: forall s. MuEnv s -> UnitIdU s -> MuEnv s
    extendMuEnv (IntMap (UnitIdU s)
    m, Int
    i) UnitIdU s
    x =
        (Int -> UnitIdU s -> IntMap (UnitIdU s) -> IntMap (UnitIdU s)
    forall a. Int -> a -> IntMap a -> IntMap a
    IntMap.insert (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) UnitIdU s
    x IntMap (UnitIdU s)
    m, Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

    {-
    lookupMuEnv :: MuEnv s -> Int {- de Bruijn index -} -> UnitIdU s
    lookupMuEnv (m, i) k =
        case IntMap.lookup (i - k) m of
            -- Technically a user can trigger this by giving us a
            -- bad 'UnitId', so handle this better.
            Nothing -> error "lookupMuEnv: out of bounds (malformed de Bruijn index)"
            Just v -> v
    -}

    emptyMuEnv :: MuEnv s
    emptyMuEnv :: forall s. MuEnv s
    emptyMuEnv = (IntMap (UnitIdU s)
    forall a. IntMap a
    IntMap.empty, -Int
    1)

    -- The workhorse functions.  These share an environment:
    --   * @UnifRef s UnitIdUnique@ - the unique label supply for 'UnitIdU' nodes
    --   * @UnifRef s (Map ModuleName moduleU)@ - the (lazily initialized)
    --     environment containing the implicitly universally quantified
    --     @hole:A@ binders.
    --   * @MuEnv@ - the environment for mu-binders.

    convertUnitId' :: MuEnv s
                   -> OpenUnitId
                   -> UnifyM s (UnitIdU s)
    -- TODO: this could be more lazy if we know there are no internal
    -- references
    convertUnitId' :: forall s. MuEnv s -> OpenUnitId -> UnifyM s (UnitIdU s)
    convertUnitId' MuEnv s
    _ (DefiniteUnitId DefUnitId
    uid) =
        ST s (UnitIdU s) -> UnifyM s (UnitIdU s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (UnitIdU s) -> UnifyM s (UnitIdU s))
    -> ST s (UnitIdU s) -> UnifyM s (UnitIdU s)
    forall a b. (a -> b) -> a -> b
    $ UnitIdU' s -> ST s (UnitIdU s)
    forall a s. a -> ST s (Point s a)
    UnionFind.fresh (DefUnitId -> UnitIdU' s
    forall s. DefUnitId -> UnitIdU' s
    UnitIdThunkU DefUnitId
    uid)
    convertUnitId' MuEnv s
    stk (IndefFullUnitId ComponentId
    cid OpenModuleSubst
    insts) = do
        UnifRef s Int
    fs <- (UnifEnv s -> UnifRef s Int)
    -> UnifyM s (UnifEnv s) -> UnifyM s (UnifRef s Int)
    forall a b. (a -> b) -> UnifyM s a -> UnifyM s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UnifEnv s -> UnifRef s Int
    forall s. UnifEnv s -> UnifRef s Int
    unify_uniq UnifyM s (UnifEnv s)
    forall s. UnifyM s (UnifEnv s)
    getUnifEnv
        UnitIdU s
    x <- ST s (UnitIdU s) -> UnifyM s (UnitIdU s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (UnitIdU s) -> UnifyM s (UnitIdU s))
    -> ST s (UnitIdU s) -> UnifyM s (UnitIdU s)
    forall a b. (a -> b) -> a -> b
    $ UnitIdU' s -> ST s (UnitIdU s)
    forall a s. a -> ST s (Point s a)
    UnionFind.fresh ([Char] -> UnitIdU' s
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "convertUnitId") -- tie the knot later
        Map ModuleName (ModuleU s)
    insts_u <- OpenModuleSubst
    -> (OpenModule -> UnifyM s (ModuleU s))
    -> UnifyM s (Map ModuleName (ModuleU s))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for OpenModuleSubst
    insts ((OpenModule -> UnifyM s (ModuleU s))
     -> UnifyM s (Map ModuleName (ModuleU s)))
    -> (OpenModule -> UnifyM s (ModuleU s))
    -> UnifyM s (Map ModuleName (ModuleU s))
    forall a b. (a -> b) -> a -> b
    $ MuEnv s -> OpenModule -> UnifyM s (ModuleU s)
    forall s. MuEnv s -> OpenModule -> UnifyM s (ModuleU s)
    convertModule' (MuEnv s -> UnitIdU s -> MuEnv s
    forall s. MuEnv s -> UnitIdU s -> MuEnv s
    extendMuEnv MuEnv s
    stk UnitIdU s
    x)
        Int
    u <- UnifRef s Int -> UnifyM s Int
    forall s a. UnifRef s a -> UnifyM s a
    readUnifRef UnifRef s Int
    fs
        UnifRef s Int -> Int -> UnifyM s ()
    forall s a. UnifRef s a -> a -> UnifyM s ()
    writeUnifRef UnifRef s Int
    fs (Int
    uInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
        UnitIdU s
    y <- ST s (UnitIdU s) -> UnifyM s (UnitIdU s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (UnitIdU s) -> UnifyM s (UnitIdU s))
    -> ST s (UnitIdU s) -> UnifyM s (UnitIdU s)
    forall a b. (a -> b) -> a -> b
    $ UnitIdU' s -> ST s (UnitIdU s)
    forall a s. a -> ST s (Point s a)
    UnionFind.fresh (Int -> ComponentId -> Map ModuleName (ModuleU s) -> UnitIdU' s
    forall s.
    Int -> ComponentId -> Map ModuleName (ModuleU s) -> UnitIdU' s
    UnitIdU Int
    u ComponentId
    cid Map ModuleName (ModuleU s)
    insts_u)
        ST s () -> UnifyM s ()
    forall s a. ST s a -> UnifyM s a
    liftST (ST s () -> UnifyM s ()) -> ST s () -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ UnitIdU s -> UnitIdU s -> ST s ()
    forall s a. Point s a -> Point s a -> ST s ()
    UnionFind.union UnitIdU s
    x UnitIdU s
    y
        UnitIdU s -> UnifyM s (UnitIdU s)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnitIdU s
    y
    -- convertUnitId' stk (UnitIdVar i) = return (lookupMuEnv stk i)

    convertModule' :: MuEnv s
                   -> OpenModule -> UnifyM s (ModuleU s)
    convertModule' :: forall s. MuEnv s -> OpenModule -> UnifyM s (ModuleU s)
    convertModule' MuEnv s
    _stk (OpenModuleVar ModuleName
    mod_name) = do
        UnifRef s (Map ModuleName (ModuleU s))
    hmap <- (UnifEnv s -> UnifRef s (Map ModuleName (ModuleU s)))
    -> UnifyM s (UnifEnv s)
    -> UnifyM s (UnifRef s (Map ModuleName (ModuleU s)))
    forall a b. (a -> b) -> UnifyM s a -> UnifyM s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UnifEnv s -> UnifRef s (Map ModuleName (ModuleU s))
    forall s. UnifEnv s -> UnifRef s (Map ModuleName (ModuleU s))
    unify_reqs UnifyM s (UnifEnv s)
    forall s. UnifyM s (UnifEnv s)
    getUnifEnv
        Map ModuleName (ModuleU s)
    hm <- UnifRef s (Map ModuleName (ModuleU s))
    -> UnifyM s (Map ModuleName (ModuleU s))
    forall s a. UnifRef s a -> UnifyM s a
    readUnifRef UnifRef s (Map ModuleName (ModuleU s))
    hmap
        case ModuleName -> Map ModuleName (ModuleU s) -> Maybe (ModuleU s)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    mod_name Map ModuleName (ModuleU s)
    hm of
            Maybe (ModuleU s)
    Nothing -> do ModuleU s
    mod <- ST s (ModuleU s) -> UnifyM s (ModuleU s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (ModuleU s) -> UnifyM s (ModuleU s))
    -> ST s (ModuleU s) -> UnifyM s (ModuleU s)
    forall a b. (a -> b) -> a -> b
    $ ModuleU' s -> ST s (ModuleU s)
    forall a s. a -> ST s (Point s a)
    UnionFind.fresh (ModuleName -> ModuleU' s
    forall s. ModuleName -> ModuleU' s
    ModuleVarU ModuleName
    mod_name)
                          UnifRef s (Map ModuleName (ModuleU s))
    -> Map ModuleName (ModuleU s) -> UnifyM s ()
    forall s a. UnifRef s a -> a -> UnifyM s ()
    writeUnifRef UnifRef s (Map ModuleName (ModuleU s))
    hmap (ModuleName
    -> ModuleU s
    -> Map ModuleName (ModuleU s)
    -> Map ModuleName (ModuleU s)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert ModuleName
    mod_name ModuleU s
    mod Map ModuleName (ModuleU s)
    hm)
                          ModuleU s -> UnifyM s (ModuleU s)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleU s
    mod
            Just ModuleU s
    mod -> ModuleU s -> UnifyM s (ModuleU s)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleU s
    mod
    convertModule' MuEnv s
    stk (OpenModule OpenUnitId
    uid ModuleName
    mod_name) = do
        UnitIdU s
    uid_u <- MuEnv s -> OpenUnitId -> UnifyM s (UnitIdU s)
    forall s. MuEnv s -> OpenUnitId -> UnifyM s (UnitIdU s)
    convertUnitId' MuEnv s
    stk OpenUnitId
    uid
        ST s (ModuleU s) -> UnifyM s (ModuleU s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (ModuleU s) -> UnifyM s (ModuleU s))
    -> ST s (ModuleU s) -> UnifyM s (ModuleU s)
    forall a b. (a -> b) -> a -> b
    $ ModuleU' s -> ST s (ModuleU s)
    forall a s. a -> ST s (Point s a)
    UnionFind.fresh (UnitIdU s -> ModuleName -> ModuleU' s
    forall s. UnitIdU s -> ModuleName -> ModuleU' s
    ModuleU UnitIdU s
    uid_u ModuleName
    mod_name)

    convertUnitId :: OpenUnitId -> UnifyM s (UnitIdU s)
    convertUnitId :: forall s. OpenUnitId -> UnifyM s (UnitIdU s)
    convertUnitId = MuEnv s -> OpenUnitId -> UnifyM s (UnitIdU s)
    forall s. MuEnv s -> OpenUnitId -> UnifyM s (UnitIdU s)
    convertUnitId' MuEnv s
    forall s. MuEnv s
    emptyMuEnv

    convertModule :: OpenModule -> UnifyM s (ModuleU s)
    convertModule :: forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule = MuEnv s -> OpenModule -> UnifyM s (ModuleU s)
    forall s. MuEnv s -> OpenModule -> UnifyM s (ModuleU s)
    convertModule' MuEnv s
    forall s. MuEnv s
    emptyMuEnv

    -----------------------------------------------------------------------
    -- Substitutions

    -- | The mutable counterpart of a 'ModuleSubst' (not defined here).
    type ModuleSubstU s = Map ModuleName (ModuleU s)

    -- | Conversion of 'ModuleSubst' to 'ModuleSubstU'
    convertModuleSubst :: Map ModuleName OpenModule -> UnifyM s (Map ModuleName (ModuleU s))
    convertModuleSubst :: forall s. OpenModuleSubst -> UnifyM s (Map ModuleName (ModuleU s))
    convertModuleSubst = (OpenModule -> UnifyM s (ModuleU s))
    -> OpenModuleSubst -> UnifyM s (Map ModuleName (ModuleU s))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map ModuleName a -> f (Map ModuleName b)
    traverse OpenModule -> UnifyM s (ModuleU s)
    forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule

    -- | Conversion of 'ModuleSubstU' to 'ModuleSubst'
    convertModuleSubstU :: ModuleSubstU s -> UnifyM s OpenModuleSubst
    convertModuleSubstU :: forall s. ModuleSubstU s -> UnifyM s OpenModuleSubst
    convertModuleSubstU = (ModuleU s -> UnifyM s OpenModule)
    -> Map ModuleName (ModuleU s) -> UnifyM s OpenModuleSubst
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map ModuleName a -> f (Map ModuleName b)
    traverse ModuleU s -> UnifyM s OpenModule
    forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU

    -----------------------------------------------------------------------
    -- Conversion from the unifiable data types

    -- An environment for tracking candidates for adding a mu-binding.
    -- The invariant for a state @(m, i)@, is that if we encounter a node
    -- labeled @k@ such that @m[k -> v]@, then we can replace this
    -- node with the de Bruijn index @i-v@ referring to an enclosing
    -- mu-binder; furthermore, @range(m) = [0..i]@.
    type MooEnv = (IntMap Int, Int)

    emptyMooEnv :: MooEnv
    emptyMooEnv :: MooEnv
    emptyMooEnv = (IntMap Int
    forall a. IntMap a
    IntMap.empty, -Int
    1)

    extendMooEnv :: MooEnv -> UnitIdUnique -> MooEnv
    extendMooEnv :: MooEnv -> Int -> MooEnv
    extendMooEnv (IntMap Int
    m, Int
    i) Int
    k = (Int -> Int -> IntMap Int -> IntMap Int
    forall a. Int -> a -> IntMap a -> IntMap a
    IntMap.insert Int
    k (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) IntMap Int
    m, Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

    lookupMooEnv :: MooEnv -> UnitIdUnique -> Maybe Int
    lookupMooEnv :: MooEnv -> Int -> Maybe Int
    lookupMooEnv (IntMap Int
    m, Int
    i) Int
    k =
        case Int -> IntMap Int -> Maybe Int
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    k IntMap Int
    m of
            Maybe Int
    Nothing -> Maybe Int
    forall a. Maybe a
    Nothing
            Just Int
    v -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    v) -- de Bruijn indexize

    -- The workhorse functions

    -- | Returns `OpenUnitId` if there is no a mutually recursive unit.
    -- | Otherwise returns a list of signatures instantiated by given `UnitIdU`.
    convertUnitIdU' :: MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU' :: forall s. MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU' MooEnv
    stk UnitIdU s
    uid_u Doc
    required_mod_name = do
        UnitIdU' s
    x <- ST s (UnitIdU' s) -> UnifyM s (UnitIdU' s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (UnitIdU' s) -> UnifyM s (UnitIdU' s))
    -> ST s (UnitIdU' s) -> UnifyM s (UnitIdU' s)
    forall a b. (a -> b) -> a -> b
    $ UnitIdU s -> ST s (UnitIdU' s)
    forall s a. Point s a -> ST s a
    UnionFind.find UnitIdU s
    uid_u
        case UnitIdU' s
    x of
            UnitIdThunkU DefUnitId
    uid -> OpenUnitId -> UnifyM s OpenUnitId
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OpenUnitId -> UnifyM s OpenUnitId)
    -> OpenUnitId -> UnifyM s OpenUnitId
    forall a b. (a -> b) -> a -> b
    $ DefUnitId -> OpenUnitId
    DefiniteUnitId DefUnitId
    uid
            UnitIdU Int
    u ComponentId
    cid Map ModuleName (ModuleU s)
    insts_u ->
                case MooEnv -> Int -> Maybe Int
    lookupMooEnv MooEnv
    stk Int
    u of
                    Just Int
    _ ->
                        let mod_names :: [ModuleName]
    mod_names = Map ModuleName (ModuleU s) -> [ModuleName]
    forall k a. Map k a -> [k]
    Map.keys Map ModuleName (ModuleU s)
    insts_u
                        in Doc -> [ModuleName] -> UnifyM s OpenUnitId
    forall s a. Doc -> [ModuleName] -> UnifyM s a
    failWithMutuallyRecursiveUnitsError Doc
    required_mod_name [ModuleName]
    mod_names
                    Maybe Int
    Nothing -> do
                        OpenModuleSubst
    insts <- Map ModuleName (ModuleU s)
    -> (ModuleU s -> UnifyM s OpenModule) -> UnifyM s OpenModuleSubst
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for Map ModuleName (ModuleU s)
    insts_u ((ModuleU s -> UnifyM s OpenModule) -> UnifyM s OpenModuleSubst)
    -> (ModuleU s -> UnifyM s OpenModule) -> UnifyM s OpenModuleSubst
    forall a b. (a -> b) -> a -> b
    $ MooEnv -> ModuleU s -> UnifyM s OpenModule
    forall s. MooEnv -> ModuleU s -> UnifyM s OpenModule
    convertModuleU' (MooEnv -> Int -> MooEnv
    extendMooEnv MooEnv
    stk Int
    u)
                        OpenUnitId -> UnifyM s OpenUnitId
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OpenUnitId -> UnifyM s OpenUnitId)
    -> OpenUnitId -> UnifyM s OpenUnitId
    forall a b. (a -> b) -> a -> b
    $ ComponentId -> OpenModuleSubst -> OpenUnitId
    IndefFullUnitId ComponentId
    cid OpenModuleSubst
    insts

    convertModuleU' :: MooEnv -> ModuleU s -> UnifyM s OpenModule
    convertModuleU' :: forall s. MooEnv -> ModuleU s -> UnifyM s OpenModule
    convertModuleU' MooEnv
    stk ModuleU s
    mod_u = do
        ModuleU' s
    mod <- ST s (ModuleU' s) -> UnifyM s (ModuleU' s)
    forall s a. ST s a -> UnifyM s a
    liftST (ST s (ModuleU' s) -> UnifyM s (ModuleU' s))
    -> ST s (ModuleU' s) -> UnifyM s (ModuleU' s)
    forall a b. (a -> b) -> a -> b
    $ ModuleU s -> ST s (ModuleU' s)
    forall s a. Point s a -> ST s a
    UnionFind.find ModuleU s
    mod_u
        case ModuleU' s
    mod of
            ModuleVarU ModuleName
    mod_name -> OpenModule -> UnifyM s OpenModule
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName -> OpenModule
    OpenModuleVar ModuleName
    mod_name)
            ModuleU UnitIdU s
    uid_u ModuleName
    mod_name -> do
                OpenUnitId
    uid <- MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
    forall s. MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU' MooEnv
    stk UnitIdU s
    uid_u (ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    mod_name)
                OpenModule -> UnifyM s OpenModule
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OpenUnitId -> ModuleName -> OpenModule
    OpenModule OpenUnitId
    uid ModuleName
    mod_name)

    failWithMutuallyRecursiveUnitsError :: Doc -> [ModuleName] -> UnifyM s a
    failWithMutuallyRecursiveUnitsError :: forall s a. Doc -> [ModuleName] -> UnifyM s a
    failWithMutuallyRecursiveUnitsError Doc
    required_mod_name [ModuleName]
    mod_names =
        let sigsList :: Doc
    sigsList = [Doc] -> Doc
    hcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc -> [Doc] -> [Doc]
    punctuate ([Char] -> Doc
    text [Char]
    ", ") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (ModuleName -> Doc) -> [ModuleName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Doc -> Doc
    quotes (Doc -> Doc) -> (ModuleName -> Doc) -> ModuleName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty) [ModuleName]
    mod_names in
        Doc -> UnifyM s a
    forall s a. Doc -> UnifyM s a
    failWith (Doc -> UnifyM s a) -> Doc -> UnifyM s a
    forall a b. (a -> b) -> a -> b
    $
            [Char] -> Doc
    text [Char]
    "Cannot instantiate requirement" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes Doc
    required_mod_name Doc -> Doc -> Doc
    $$
            [Char] -> Doc
    text [Char]
    "Ensure \"build-depends:\" doesn't include any library with signatures:" Doc -> Doc -> Doc
    <+> Doc
    sigsList Doc -> Doc -> Doc
    $$
            [Char] -> Doc
    text [Char]
    "as this creates a cyclic dependency, which GHC does not support."

    -- Helper functions

    convertUnitIdU :: UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU :: forall s. UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU = MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
    forall s. MooEnv -> UnitIdU s -> Doc -> UnifyM s OpenUnitId
    convertUnitIdU' MooEnv
    emptyMooEnv

    convertModuleU :: ModuleU s -> UnifyM s OpenModule
    convertModuleU :: forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU = MooEnv -> ModuleU s -> UnifyM s OpenModule
    forall s. MooEnv -> ModuleU s -> UnifyM s OpenModule
    convertModuleU' MooEnv
    emptyMooEnv

    -- | An empty 'ModuleScopeU'.
    emptyModuleScopeU :: ModuleScopeU s
    emptyModuleScopeU :: forall s. ModuleScopeU s
    emptyModuleScopeU = (Map ModuleName [ModuleWithSourceU s]
    forall k a. Map k a
    Map.empty, Map ModuleName [ModuleWithSourceU s]
    forall k a. Map k a
    Map.empty)

    -- | The mutable counterpart of 'ModuleScope'.
    type ModuleScopeU s = (ModuleProvidesU s, ModuleRequiresU s)
    -- | The mutable counterpart of 'ModuleProvides'
    type ModuleProvidesU s = Map ModuleName [ModuleWithSourceU s]
    type ModuleRequiresU s = ModuleProvidesU s
    type ModuleWithSourceU s = WithSource (ModuleU s)

    -- TODO: Deduplicate this with Distribution.Backpack.MixLink.dispSource
    ci_msg :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Doc
    ci_msg :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Doc
    ci_msg ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci
      | ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Bool
    forall id rn. ComponentInclude id rn -> Bool
    ci_implicit ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci = [Char] -> Doc
    text [Char]
    "build-depends:" Doc -> Doc -> Doc
    <+> Doc
    pp_pn
      | Bool
    otherwise = [Char] -> Doc
    text [Char]
    "mixins:" Doc -> Doc -> Doc
    <+> Doc
    pp_pn Doc -> Doc -> Doc
    <+> IncludeRenaming -> Doc
    forall a. Pretty a => a -> Doc
    pretty (ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    -> IncludeRenaming
    forall id rn. ComponentInclude id rn -> rn
    ci_renaming ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci)
      where
        pn :: PackageName
    pn = PackageIdentifier -> PackageName
    pkgName (ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    -> PackageIdentifier
    forall id rn. ComponentInclude id rn -> PackageIdentifier
    ci_pkgid ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci)
        pp_pn :: Doc
    pp_pn =
            case ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    -> ComponentName
    forall id rn. ComponentInclude id rn -> ComponentName
    ci_cname ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci of
                CLibName LibraryName
    LMainLibName -> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn
                CLibName (LSubLibName UnqualComponentName
    cn) -> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn Doc -> Doc -> Doc
    <<>> Doc
    colon Doc -> Doc -> Doc
    <<>> UnqualComponentName -> Doc
    forall a. Pretty a => a -> Doc
    pretty UnqualComponentName
    cn
                -- Shouldn't happen
                ComponentName
    cn -> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens (ComponentName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ComponentName
    cn)

    -- | Convert a 'ModuleShape' into a 'ModuleScopeU', so we can do
    -- unification on it.
    convertInclude
        :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
        -> UnifyM s (ModuleScopeU s,
                     Either (ComponentInclude (UnitIdU s) ModuleRenaming) {- normal -}
                            (ComponentInclude (UnitIdU s) ModuleRenaming) {- sig -})
    convertInclude :: forall s.
    ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    convertInclude ci :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci@(ComponentInclude {
                        ci_ann_id :: forall id rn. ComponentInclude id rn -> AnnotatedId id
    ci_ann_id = AnnotatedId {
                                ann_id :: forall id. AnnotatedId id -> id
    ann_id = (OpenUnitId
    uid, ModuleShape OpenModuleSubst
    provs Set ModuleName
    reqs),
                                ann_pid :: forall id. AnnotatedId id -> PackageIdentifier
    ann_pid = PackageIdentifier
    pid,
                                ann_cname :: forall id. AnnotatedId id -> ComponentName
    ann_cname = ComponentName
    compname
                            },
                        ci_renaming :: forall id rn. ComponentInclude id rn -> rn
    ci_renaming = incl :: IncludeRenaming
    incl@(IncludeRenaming ModuleRenaming
    prov_rns ModuleRenaming
    req_rns),
                        ci_implicit :: forall id rn. ComponentInclude id rn -> Bool
    ci_implicit = Bool
    implicit
                   }) = Doc
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    forall s a. Doc -> UnifyM s a -> UnifyM s a
    addErrContext ([Char] -> Doc
    text [Char]
    "In" Doc -> Doc -> Doc
    <+> ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Doc
    ci_msg ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci) (UnifyM
       s
       (ModuleScopeU s,
        Either
          (ComponentInclude (UnitIdU s) ModuleRenaming)
          (ComponentInclude (UnitIdU s) ModuleRenaming))
     -> UnifyM
          s
          (ModuleScopeU s,
           Either
             (ComponentInclude (UnitIdU s) ModuleRenaming)
             (ComponentInclude (UnitIdU s) ModuleRenaming)))
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    forall a b. (a -> b) -> a -> b
    $ do
        let pn :: PackageName
    pn = PackageIdentifier -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName PackageIdentifier
    pid
            the_source :: ModuleSource
    the_source | Bool
    implicit
                       = PackageName -> ComponentName -> ModuleSource
    FromBuildDepends PackageName
    pn ComponentName
    compname
                       | Bool
    otherwise
                       = PackageName -> ComponentName -> IncludeRenaming -> ModuleSource
    FromMixins PackageName
    pn ComponentName
    compname IncludeRenaming
    incl
            source :: a -> WithSource a
    source = ModuleSource -> a -> WithSource a
    forall a. ModuleSource -> a -> WithSource a
    WithSource ModuleSource
    the_source

        -- Suppose our package has two requirements A and B, and
        -- we include it with @requires (A as X)@
        -- There are three closely related things we compute based
        -- off of @reqs@ and @reqs_rns@:
        --
        --      1. The requirement renaming (A -> X)
        --      2. The requirement substitution (A -> <X>, B -> <B>)

        -- Requirement renaming.  This is read straight off the syntax:
        --
        --      [nothing]          ==>  [empty]
        --      requires (B as Y)  ==>  B -> Y
        --
        -- Requirement renamings are NOT injective: if two requirements
        -- are mapped to the same name, the intent is to merge them
        -- together.  But they are *functions*, so @B as X, B as Y@ is
        -- illegal.

        [(ModuleName, ModuleName)]
    req_rename_list <-
          case ModuleRenaming
    req_rns of
            ModuleRenaming
    DefaultRenaming -> [(ModuleName, ModuleName)] -> UnifyM s [(ModuleName, ModuleName)]
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            HidingRenaming [ModuleName]
    _ -> do
                -- Not valid here for requires!
                Doc -> UnifyM s ()
    forall s. Doc -> UnifyM s ()
    addErr (Doc -> UnifyM s ()) -> Doc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Doc
    text [Char]
    "Unsupported syntax" Doc -> Doc -> Doc
    <+>
                         Doc -> Doc
    quotes ([Char] -> Doc
    text [Char]
    "requires hiding (...)")
                [(ModuleName, ModuleName)] -> UnifyM s [(ModuleName, ModuleName)]
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            ModuleRenaming [(ModuleName, ModuleName)]
    rns -> [(ModuleName, ModuleName)] -> UnifyM s [(ModuleName, ModuleName)]
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(ModuleName, ModuleName)]
    rns

        let req_rename_listmap :: Map ModuleName [ModuleName]
            req_rename_listmap :: Map ModuleName [ModuleName]
    req_rename_listmap =
                ([ModuleName] -> [ModuleName] -> [ModuleName])
    -> [(ModuleName, [ModuleName])] -> Map ModuleName [ModuleName]
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith [ModuleName] -> [ModuleName] -> [ModuleName]
    forall a. [a] -> [a] -> [a]
    (++) [ (ModuleName
    k,[ModuleName
    v]) | (ModuleName
    k,ModuleName
    v) <- [(ModuleName, ModuleName)]
    req_rename_list ]
        Map ModuleName ModuleName
    req_rename <- Map ModuleName (UnifyM s ModuleName)
    -> UnifyM s (Map ModuleName ModuleName)
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a.
    Applicative f =>
    Map ModuleName (f a) -> f (Map ModuleName a)
    sequenceA (Map ModuleName (UnifyM s ModuleName)
     -> UnifyM s (Map ModuleName ModuleName))
    -> ((ModuleName -> [ModuleName] -> UnifyM s ModuleName)
        -> Map ModuleName (UnifyM s ModuleName))
    -> (ModuleName -> [ModuleName] -> UnifyM s ModuleName)
    -> UnifyM s (Map ModuleName ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((ModuleName -> [ModuleName] -> UnifyM s ModuleName)
     -> Map ModuleName [ModuleName]
     -> Map ModuleName (UnifyM s ModuleName))
    -> Map ModuleName [ModuleName]
    -> (ModuleName -> [ModuleName] -> UnifyM s ModuleName)
    -> Map ModuleName (UnifyM s ModuleName)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (ModuleName -> [ModuleName] -> UnifyM s ModuleName)
    -> Map ModuleName [ModuleName]
    -> Map ModuleName (UnifyM s ModuleName)
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey Map ModuleName [ModuleName]
    req_rename_listmap ((ModuleName -> [ModuleName] -> UnifyM s ModuleName)
     -> UnifyM s (Map ModuleName ModuleName))
    -> (ModuleName -> [ModuleName] -> UnifyM s ModuleName)
    -> UnifyM s (Map ModuleName ModuleName)
    forall a b. (a -> b) -> a -> b
    $ \ModuleName
    k [ModuleName]
    vs0 ->
          case [ModuleName]
    vs0 of
            []  -> [Char] -> UnifyM s ModuleName
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "req_rename"
            [ModuleName
    v] -> ModuleName -> UnifyM s ModuleName
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleName
    v
            ModuleName
    v:[ModuleName]
    vs -> do Doc -> UnifyM s ()
    forall s. Doc -> UnifyM s ()
    addErr (Doc -> UnifyM s ()) -> Doc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                        [Char] -> Doc
    text [Char]
    "Conflicting renamings of requirement" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    k) Doc -> Doc -> Doc
    $$
                        [Char] -> Doc
    text [Char]
    "Renamed to: " Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    vcat ((ModuleName -> Doc) -> [ModuleName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty (ModuleName
    vModuleName -> [ModuleName] -> [ModuleName]
    forall a. a -> [a] -> [a]
    :[ModuleName]
    vs))
                       ModuleName -> UnifyM s ModuleName
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleName
    v

        let req_rename_fn :: ModuleName -> ModuleName
    req_rename_fn ModuleName
    k = case ModuleName -> Map ModuleName ModuleName -> Maybe ModuleName
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    k Map ModuleName ModuleName
    req_rename of
                                Maybe ModuleName
    Nothing -> ModuleName
    k
                                Just ModuleName
    v  -> ModuleName
    v

        -- Requirement substitution.
        --
        --      A -> X      ==>     A -> <X>
        let req_subst :: OpenModuleSubst
    req_subst = (ModuleName -> OpenModule)
    -> Map ModuleName ModuleName -> OpenModuleSubst
    forall a b. (a -> b) -> Map ModuleName a -> Map ModuleName b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ModuleName -> OpenModule
    OpenModuleVar Map ModuleName ModuleName
    req_rename

        UnitIdU s
    uid_u <- OpenUnitId -> UnifyM s (UnitIdU s)
    forall s. OpenUnitId -> UnifyM s (UnitIdU s)
    convertUnitId (OpenModuleSubst -> OpenUnitId -> OpenUnitId
    forall a. ModSubst a => OpenModuleSubst -> a -> a
    modSubst OpenModuleSubst
    req_subst OpenUnitId
    uid)

        -- Requirement mapping.  This is just taking the range of the
        -- requirement substitution, and making a mapping so that it is
        -- convenient to merge things together.  It INCLUDES the implicit
        -- mappings.
        --
        --      A -> X      ==>     X -> <X>, B -> <B>
        ModuleRequiresU s
    reqs_u <- ModuleRequires -> UnifyM s (ModuleRequiresU s)
    forall s. ModuleRequires -> UnifyM s (ModuleRequiresU s)
    convertModuleRequires (ModuleRequires -> UnifyM s (ModuleRequiresU s))
    -> ([(ModuleName, [ModuleWithSource])] -> ModuleRequires)
    -> [(ModuleName, [ModuleWithSource])]
    -> UnifyM s (ModuleRequiresU s)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ModuleName, [ModuleWithSource])] -> ModuleRequires
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(ModuleName, [ModuleWithSource])]
     -> UnifyM s (ModuleRequiresU s))
    -> [(ModuleName, [ModuleWithSource])]
    -> UnifyM s (ModuleRequiresU s)
    forall a b. (a -> b) -> a -> b
    $
                    [ (ModuleName
    k, [OpenModule -> ModuleWithSource
    forall {a}. a -> WithSource a
    source (ModuleName -> OpenModule
    OpenModuleVar ModuleName
    k)])
                    | ModuleName
    k <- (ModuleName -> ModuleName) -> [ModuleName] -> [ModuleName]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleName -> ModuleName
    req_rename_fn (Set ModuleName -> [ModuleName]
    forall a. Set a -> [a]
    Set.toList Set ModuleName
    reqs)
                    ]

        -- Report errors if there were unused renamings
        let leftover :: Set ModuleName
    leftover = Map ModuleName ModuleName -> Set ModuleName
    forall k a. Map k a -> Set k
    Map.keysSet Map ModuleName ModuleName
    req_rename Set ModuleName -> Set ModuleName -> Set ModuleName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set ModuleName
    reqs
        Bool -> UnifyM s () -> UnifyM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Set ModuleName -> Bool
    forall a. Set a -> Bool
    Set.null Set ModuleName
    leftover) (UnifyM s () -> UnifyM s ()) -> UnifyM s () -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
            Doc -> UnifyM s ()
    forall s. Doc -> UnifyM s ()
    addErr (Doc -> UnifyM s ()) -> Doc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                Doc -> Int -> Doc -> Doc
    hang ([Char] -> Doc
    text [Char]
    "The" Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text (ComponentName -> [Char]
    showComponentName ComponentName
    compname) Doc -> Doc -> Doc
    <+>
                      [Char] -> Doc
    text [Char]
    "from package" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (PackageIdentifier -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageIdentifier
    pid)
                      Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "does not require:") Int
    4
                     ([Doc] -> Doc
    vcat ((ModuleName -> Doc) -> [ModuleName] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty (Set ModuleName -> [ModuleName]
    forall a. Set a -> [a]
    Set.toList Set ModuleName
    leftover)))

        -- Provision computation is more complex.
        -- For example, if we have:
        --
        --      include p (A as X) requires (B as Y)
        --          where A -> q[B=<B>]:A
        --
        -- Then we need:
        --
        --      X -> [("p", q[B=<B>]:A)]
        --
        -- There are a bunch of clever ways to present the algorithm
        -- but here is the simple one:
        --
        --      1. If we have a default renaming, apply req_subst
        --      to provs and use that.
        --
        --      2. Otherwise, build a map by successively looking
        --      up the referenced modules in the renaming in provs.
        --
        -- Importantly, overlapping rename targets get accumulated
        -- together.  It's not an (immediate) error.
        ([(ModuleName, OpenModule)]
    pre_prov_scope, ModuleRenaming
    prov_rns') <-
            case ModuleRenaming
    prov_rns of
                ModuleRenaming
    DefaultRenaming -> ([(ModuleName, OpenModule)], ModuleRenaming)
    -> UnifyM s ([(ModuleName, OpenModule)], ModuleRenaming)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OpenModuleSubst -> [(ModuleName, OpenModule)]
    forall k a. Map k a -> [(k, a)]
    Map.toList OpenModuleSubst
    provs, ModuleRenaming
    prov_rns)
                HidingRenaming [ModuleName]
    hides ->
                    let hides_set :: Set ModuleName
    hides_set = [ModuleName] -> Set ModuleName
    forall a. Ord a => [a] -> Set a
    Set.fromList [ModuleName]
    hides
                    in let r :: [(ModuleName, OpenModule)]
    r = [ (ModuleName
    k,OpenModule
    v)
                               | (ModuleName
    k,OpenModule
    v) <- OpenModuleSubst -> [(ModuleName, OpenModule)]
    forall k a. Map k a -> [(k, a)]
    Map.toList OpenModuleSubst
    provs
                               , Bool -> Bool
    not (ModuleName
    k ModuleName -> Set ModuleName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set ModuleName
    hides_set) ]
                       -- GHC doesn't understand hiding, so expand it out!
                       in ([(ModuleName, OpenModule)], ModuleRenaming)
    -> UnifyM s ([(ModuleName, OpenModule)], ModuleRenaming)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(ModuleName, OpenModule)]
    r, [(ModuleName, ModuleName)] -> ModuleRenaming
    ModuleRenaming (((ModuleName, OpenModule) -> (ModuleName, ModuleName))
    -> [(ModuleName, OpenModule)] -> [(ModuleName, ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((\ModuleName
    x -> (ModuleName
    x,ModuleName
    x))(ModuleName -> (ModuleName, ModuleName))
    -> ((ModuleName, OpenModule) -> ModuleName)
    -> (ModuleName, OpenModule)
    -> (ModuleName, ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(ModuleName, OpenModule) -> ModuleName
    forall a b. (a, b) -> a
    fst) [(ModuleName, OpenModule)]
    r))
                ModuleRenaming [(ModuleName, ModuleName)]
    rns -> do
                  [(ModuleName, OpenModule)]
    r <- [UnifyM s (ModuleName, OpenModule)]
    -> UnifyM s [(ModuleName, OpenModule)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence
                    [ case ModuleName -> OpenModuleSubst -> Maybe OpenModule
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ModuleName
    from OpenModuleSubst
    provs of
                        Just OpenModule
    m -> (ModuleName, OpenModule) -> UnifyM s (ModuleName, OpenModule)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleName
    to, OpenModule
    m)
                        Maybe OpenModule
    Nothing -> Doc -> UnifyM s (ModuleName, OpenModule)
    forall s a. Doc -> UnifyM s a
    failWith (Doc -> UnifyM s (ModuleName, OpenModule))
    -> Doc -> UnifyM s (ModuleName, OpenModule)
    forall a b. (a -> b) -> a -> b
    $
                            [Char] -> Doc
    text [Char]
    "Package" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (PackageIdentifier -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageIdentifier
    pid) Doc -> Doc -> Doc
    <+>
                            [Char] -> Doc
    text [Char]
    "does not expose the module" Doc -> Doc -> Doc
    <+> Doc -> Doc
    quotes (ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    from)
                    | (ModuleName
    from, ModuleName
    to) <- [(ModuleName, ModuleName)]
    rns ]
                  ([(ModuleName, OpenModule)], ModuleRenaming)
    -> UnifyM s ([(ModuleName, OpenModule)], ModuleRenaming)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(ModuleName, OpenModule)]
    r, ModuleRenaming
    prov_rns)
        let prov_scope :: ModuleRequires
    prov_scope = OpenModuleSubst -> ModuleRequires -> ModuleRequires
    forall a. ModSubst a => OpenModuleSubst -> a -> a
    modSubst OpenModuleSubst
    req_subst
                       (ModuleRequires -> ModuleRequires)
    -> ModuleRequires -> ModuleRequires
    forall a b. (a -> b) -> a -> b
    $ ([ModuleWithSource] -> [ModuleWithSource] -> [ModuleWithSource])
    -> [(ModuleName, [ModuleWithSource])] -> ModuleRequires
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith [ModuleWithSource] -> [ModuleWithSource] -> [ModuleWithSource]
    forall a. [a] -> [a] -> [a]
    (++)
                       [ (ModuleName
    k, [OpenModule -> ModuleWithSource
    forall {a}. a -> WithSource a
    source OpenModule
    v])
                       | (ModuleName
    k, OpenModule
    v) <- [(ModuleName, OpenModule)]
    pre_prov_scope ]

        ModuleRequiresU s
    provs_u <- ModuleRequires -> UnifyM s (ModuleRequiresU s)
    forall s. ModuleRequires -> UnifyM s (ModuleRequiresU s)
    convertModuleProvides ModuleRequires
    prov_scope

        -- TODO: Assert that provs_u is empty if provs was empty
        (ModuleScopeU s,
     Either
       (ComponentInclude (UnitIdU s) ModuleRenaming)
       (ComponentInclude (UnitIdU s) ModuleRenaming))
    -> UnifyM
         s
         (ModuleScopeU s,
          Either
            (ComponentInclude (UnitIdU s) ModuleRenaming)
            (ComponentInclude (UnitIdU s) ModuleRenaming))
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ModuleRequiresU s
    provs_u, ModuleRequiresU s
    reqs_u),
                    -- NB: We test that requirements is not null so that
                    -- users can create packages with zero module exports
                    -- that cause some C library to linked in, etc.
                    (if OpenModuleSubst -> Bool
    forall k a. Map k a -> Bool
    Map.null OpenModuleSubst
    provs Bool -> Bool -> Bool
    && Bool -> Bool
    not (Set ModuleName -> Bool
    forall a. Set a -> Bool
    Set.null Set ModuleName
    reqs)
                        then ComponentInclude (UnitIdU s) ModuleRenaming
    -> Either
         (ComponentInclude (UnitIdU s) ModuleRenaming)
         (ComponentInclude (UnitIdU s) ModuleRenaming)
    forall a b. b -> Either a b
    Right -- is sig
                        else ComponentInclude (UnitIdU s) ModuleRenaming
    -> Either
         (ComponentInclude (UnitIdU s) ModuleRenaming)
         (ComponentInclude (UnitIdU s) ModuleRenaming)
    forall a b. a -> Either a b
    Left) (ComponentInclude {
                                        ci_ann_id :: AnnotatedId (UnitIdU s)
    ci_ann_id = AnnotatedId {
                                                ann_id :: UnitIdU s
    ann_id = UnitIdU s
    uid_u,
                                                ann_pid :: PackageIdentifier
    ann_pid = PackageIdentifier
    pid,
                                                ann_cname :: ComponentName
    ann_cname = ComponentName
    compname
                                            },
                                        ci_renaming :: ModuleRenaming
    ci_renaming = ModuleRenaming
    prov_rns',
                                        ci_implicit :: Bool
    ci_implicit = ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Bool
    forall id rn. ComponentInclude id rn -> Bool
    ci_implicit ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming
    ci
                                        }))

    -- | Convert a 'ModuleScopeU' to a 'ModuleScope'.
    convertModuleScopeU :: ModuleScopeU s -> UnifyM s ModuleScope
    convertModuleScopeU :: forall s. ModuleScopeU s -> UnifyM s ModuleScope
    convertModuleScopeU (ModuleProvidesU s
    provs_u, ModuleProvidesU s
    reqs_u) = do
        ModuleRequires
    provs <- ModuleProvidesU s -> UnifyM s ModuleRequires
    forall s. ModuleProvidesU s -> UnifyM s ModuleRequires
    convertModuleProvidesU ModuleProvidesU s
    provs_u
        ModuleRequires
    reqs  <- ModuleProvidesU s -> UnifyM s ModuleRequires
    forall s. ModuleProvidesU s -> UnifyM s ModuleRequires
    convertModuleRequiresU ModuleProvidesU s
    reqs_u
        -- TODO: Test that the requirements are still free. If they
        -- are not, they got unified, and that's dodgy at best.
        ModuleScope -> UnifyM s ModuleScope
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleRequires -> ModuleRequires -> ModuleScope
    ModuleScope ModuleRequires
    provs ModuleRequires
    reqs)

    -- | Convert a 'ModuleProvides' to a 'ModuleProvidesU'
    convertModuleProvides :: ModuleProvides -> UnifyM s (ModuleProvidesU s)
    convertModuleProvides :: forall s. ModuleRequires -> UnifyM s (ModuleRequiresU s)
    convertModuleProvides = ([ModuleWithSource] -> UnifyM s [ModuleWithSourceU s])
    -> ModuleRequires
    -> UnifyM s (Map ModuleName [ModuleWithSourceU s])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map ModuleName a -> f (Map ModuleName b)
    traverse ((ModuleWithSource -> UnifyM s (ModuleWithSourceU s))
    -> [ModuleWithSource] -> UnifyM s [ModuleWithSourceU s]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((OpenModule -> UnifyM s (ModuleU s))
    -> ModuleWithSource -> UnifyM s (ModuleWithSourceU s)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> WithSource a -> f (WithSource b)
    traverse OpenModule -> UnifyM s (ModuleU s)
    forall s. OpenModule -> UnifyM s (ModuleU s)
    convertModule))

    -- | Convert a 'ModuleProvidesU' to a 'ModuleProvides'
    convertModuleProvidesU :: ModuleProvidesU s -> UnifyM s ModuleProvides
    convertModuleProvidesU :: forall s. ModuleProvidesU s -> UnifyM s ModuleRequires
    convertModuleProvidesU = ([ModuleWithSourceU s] -> UnifyM s [ModuleWithSource])
    -> Map ModuleName [ModuleWithSourceU s] -> UnifyM s ModuleRequires
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map ModuleName a -> f (Map ModuleName b)
    traverse ((ModuleWithSourceU s -> UnifyM s ModuleWithSource)
    -> [ModuleWithSourceU s] -> UnifyM s [ModuleWithSource]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((ModuleU s -> UnifyM s OpenModule)
    -> ModuleWithSourceU s -> UnifyM s ModuleWithSource
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> WithSource a -> f (WithSource b)
    traverse ModuleU s -> UnifyM s OpenModule
    forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU))

    convertModuleRequires :: ModuleRequires -> UnifyM s (ModuleRequiresU s)
    convertModuleRequires :: forall s. ModuleRequires -> UnifyM s (ModuleRequiresU s)
    convertModuleRequires = ModuleRequires -> UnifyM s (ModuleProvidesU s)
    forall s. ModuleRequires -> UnifyM s (ModuleRequiresU s)
    convertModuleProvides

    convertModuleRequiresU :: ModuleRequiresU s -> UnifyM s ModuleRequires
    convertModuleRequiresU :: forall s. ModuleProvidesU s -> UnifyM s ModuleRequires
    convertModuleRequiresU = ModuleProvidesU s -> UnifyM s ModuleRequires
    forall s. ModuleProvidesU s -> UnifyM s ModuleRequires
    convertModuleProvidesU