    {-# LANGUAGE NondecreasingIndentation #-}
    -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
    module Distribution.Backpack.MixLink (
        mixLink,
    ) where

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

    import Distribution.Backpack
    import Distribution.Backpack.UnifyM
    import Distribution.Backpack.FullUnitId
    import Distribution.Backpack.ModuleScope

    import qualified Distribution.Utils.UnionFind as UnionFind
    import Distribution.ModuleName
    import Distribution.Pretty
    import Distribution.Types.ComponentId

    import Text.PrettyPrint
    import Control.Monad
    import qualified Data.Map as Map
    import qualified Data.Foldable as F

    -----------------------------------------------------------------------
    -- Linking

    -- | Given to scopes of provisions and requirements, link them together.
    mixLink :: [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)
    mixLink :: forall s. [ModuleScopeU s] -> UnifyM s (ModuleScopeU s)
    mixLink [ModuleScopeU s]
    scopes = do
        let provs :: Map ModuleName [ModuleWithSourceU s]
    provs = ([ModuleWithSourceU s]
     -> [ModuleWithSourceU s] -> [ModuleWithSourceU s])
    -> [Map ModuleName [ModuleWithSourceU s]]
    -> Map ModuleName [ModuleWithSourceU s]
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    (a -> a -> a) -> f (Map k a) -> Map k a
    Map.unionsWith [ModuleWithSourceU s]
    -> [ModuleWithSourceU s] -> [ModuleWithSourceU s]
    forall a. [a] -> [a] -> [a]
    (++) ((ModuleScopeU s -> Map ModuleName [ModuleWithSourceU s])
    -> [ModuleScopeU s] -> [Map ModuleName [ModuleWithSourceU s]]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleScopeU s -> Map ModuleName [ModuleWithSourceU s]
    forall a b. (a, b) -> a
    fst [ModuleScopeU s]
    scopes)
            -- Invariant: any identically named holes refer to same mutable cell
            reqs :: Map ModuleName [ModuleWithSourceU s]
    reqs  = ([ModuleWithSourceU s]
     -> [ModuleWithSourceU s] -> [ModuleWithSourceU s])
    -> [Map ModuleName [ModuleWithSourceU s]]
    -> Map ModuleName [ModuleWithSourceU s]
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    (a -> a -> a) -> f (Map k a) -> Map k a
    Map.unionsWith [ModuleWithSourceU s]
    -> [ModuleWithSourceU s] -> [ModuleWithSourceU s]
    forall a. [a] -> [a] -> [a]
    (++) ((ModuleScopeU s -> Map ModuleName [ModuleWithSourceU s])
    -> [ModuleScopeU s] -> [Map ModuleName [ModuleWithSourceU s]]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleScopeU s -> Map ModuleName [ModuleWithSourceU s]
    forall a b. (a, b) -> b
    snd [ModuleScopeU s]
    scopes)
            filled :: Map ModuleName (UnifyM s [ModuleWithSourceU s])
    filled = (ModuleName
     -> [ModuleWithSourceU s]
     -> [ModuleWithSourceU s]
     -> UnifyM s [ModuleWithSourceU s])
    -> Map ModuleName [ModuleWithSourceU s]
    -> Map ModuleName [ModuleWithSourceU s]
    -> Map ModuleName (UnifyM s [ModuleWithSourceU s])
    forall k a b c.
    Ord k =>
    (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
    Map.intersectionWithKey ModuleName
    -> [ModuleWithSourceU s]
    -> [ModuleWithSourceU s]
    -> UnifyM s [ModuleWithSourceU s]
    forall s.
    ModuleName
    -> [ModuleWithSourceU s]
    -> [ModuleWithSourceU s]
    -> UnifyM s [ModuleWithSourceU s]
    linkProvision Map ModuleName [ModuleWithSourceU s]
    provs Map ModuleName [ModuleWithSourceU s]
    reqs
        Map ModuleName (UnifyM s [ModuleWithSourceU s]) -> UnifyM s ()
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Applicative f) =>
    t (f a) -> f ()
    F.sequenceA_ Map ModuleName (UnifyM s [ModuleWithSourceU s])
    filled
        let remaining :: Map ModuleName [ModuleWithSourceU s]
    remaining = Map ModuleName [ModuleWithSourceU s]
    -> Map ModuleName (UnifyM s [ModuleWithSourceU s])
    -> Map ModuleName [ModuleWithSourceU s]
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    Map.difference Map ModuleName [ModuleWithSourceU s]
    reqs Map ModuleName (UnifyM s [ModuleWithSourceU s])
    filled
        ModuleScopeU s -> UnifyM s (ModuleScopeU s)
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map ModuleName [ModuleWithSourceU s]
    provs, Map ModuleName [ModuleWithSourceU s]
    remaining)

    -- | Link a list of possibly provided modules to a single
    -- requirement.  This applies a side-condition that all
    -- of the provided modules at the same name are *actually*
    -- the same module.
    linkProvision :: ModuleName
                  -> [ModuleWithSourceU s] -- provs
                  -> [ModuleWithSourceU s] -- reqs
                  -> UnifyM s [ModuleWithSourceU s]
    linkProvision :: forall s.
    ModuleName
    -> [ModuleWithSourceU s]
    -> [ModuleWithSourceU s]
    -> UnifyM s [ModuleWithSourceU s]
    linkProvision ModuleName
    mod_name ret :: [ModuleWithSourceU s]
    ret@(ModuleWithSourceU s
    prov:[ModuleWithSourceU s]
    provs) (ModuleWithSourceU s
    req:[ModuleWithSourceU s]
    reqs) = do
        -- TODO: coalesce all the non-unifying modules together
        [ModuleWithSourceU s]
    -> (ModuleWithSourceU s -> UnifyM s ()) -> UnifyM s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [ModuleWithSourceU s]
    provs ((ModuleWithSourceU s -> UnifyM s ()) -> UnifyM s ())
    -> (ModuleWithSourceU s -> UnifyM s ()) -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ \ModuleWithSourceU s
    prov' -> do
            -- Careful: read it out BEFORE unifying, because the
            -- unification algorithm preemptively unifies modules
            OpenModule
    mod  <- ModuleU s -> UnifyM s OpenModule
    forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU (ModuleWithSourceU s -> ModuleU s
    forall a. WithSource a -> a
    unWithSource ModuleWithSourceU s
    prov)
            OpenModule
    mod' <- ModuleU s -> UnifyM s OpenModule
    forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU (ModuleWithSourceU s -> ModuleU s
    forall a. WithSource a -> a
    unWithSource ModuleWithSourceU s
    prov')
            Maybe ()
    r <- ModuleWithSourceU s -> ModuleWithSourceU s -> UnifyM s (Maybe ())
    forall {s}.
    WithSource (ModuleU s)
    -> WithSource (ModuleU s) -> UnifyM s (Maybe ())
    unify ModuleWithSourceU s
    prov ModuleWithSourceU s
    prov'
            case Maybe ()
    r of
                Just () -> () -> UnifyM s ()
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Maybe ()
    Nothing -> do
                    MsgDoc -> UnifyM s ()
    forall s. MsgDoc -> UnifyM s ()
    addErr (MsgDoc -> UnifyM s ()) -> MsgDoc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                      String -> MsgDoc
    text String
    "Ambiguous module" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (ModuleName -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ModuleName
    mod_name) MsgDoc -> MsgDoc -> MsgDoc
    $$
                      String -> MsgDoc
    text String
    "It could refer to" MsgDoc -> MsgDoc -> MsgDoc
    <+>
                        ( String -> MsgDoc
    text String
    "  " MsgDoc -> MsgDoc -> MsgDoc
    <+> (MsgDoc -> MsgDoc
    quotes (OpenModule -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty OpenModule
    mod)  MsgDoc -> MsgDoc -> MsgDoc
    $$ ModuleSource -> MsgDoc
    in_scope_by (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    prov)) MsgDoc -> MsgDoc -> MsgDoc
    $$
                          String -> MsgDoc
    text String
    "or" MsgDoc -> MsgDoc -> MsgDoc
    <+> (MsgDoc -> MsgDoc
    quotes (OpenModule -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty OpenModule
    mod') MsgDoc -> MsgDoc -> MsgDoc
    $$ ModuleSource -> MsgDoc
    in_scope_by (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    prov')) ) MsgDoc -> MsgDoc -> MsgDoc
    $$
                      MsgDoc
    link_doc
        OpenModule
    mod <- ModuleU s -> UnifyM s OpenModule
    forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU (ModuleWithSourceU s -> ModuleU s
    forall a. WithSource a -> a
    unWithSource ModuleWithSourceU s
    prov)
        OpenModule
    req_mod <- ModuleU s -> UnifyM s OpenModule
    forall s. ModuleU s -> UnifyM s OpenModule
    convertModuleU (ModuleWithSourceU s -> ModuleU s
    forall a. WithSource a -> a
    unWithSource ModuleWithSourceU s
    req)
        ComponentId
    self_cid <- (UnifEnv s -> ComponentId)
    -> UnifyM s (UnifEnv s) -> UnifyM s ComponentId
    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 -> ComponentId
    forall s. UnifEnv s -> ComponentId
    unify_self_cid UnifyM s (UnifEnv s)
    forall s. UnifyM s (UnifEnv s)
    getUnifEnv
        case OpenModule
    mod of
          OpenModule (IndefFullUnitId ComponentId
    cid OpenModuleSubst
    _) ModuleName
    _
            | ComponentId
    cid ComponentId -> ComponentId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ComponentId
    self_cid -> MsgDoc -> UnifyM s ()
    forall s. MsgDoc -> UnifyM s ()
    addErr (MsgDoc -> UnifyM s ()) -> MsgDoc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                String -> MsgDoc
    text String
    "Cannot instantiate requirement" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (ModuleName -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ModuleName
    mod_name) MsgDoc -> MsgDoc -> MsgDoc
    <+>
                    ModuleSource -> MsgDoc
    in_scope_by (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    req) MsgDoc -> MsgDoc -> MsgDoc
    $$
                String -> MsgDoc
    text String
    "with locally defined module" MsgDoc -> MsgDoc -> MsgDoc
    <+> ModuleSource -> MsgDoc
    in_scope_by (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    prov) MsgDoc -> MsgDoc -> MsgDoc
    $$
                String -> MsgDoc
    text String
    "as this would create a cyclic dependency, which GHC does not support." MsgDoc -> MsgDoc -> MsgDoc
    $$
                String -> MsgDoc
    text String
    "Try moving this module to a separate library, e.g.," MsgDoc -> MsgDoc -> MsgDoc
    $$
                String -> MsgDoc
    text String
    "create a new stanza: library 'sublib'."
          OpenModule
    _ -> () -> UnifyM s ()
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Maybe ()
    r <- ModuleWithSourceU s -> ModuleWithSourceU s -> UnifyM s (Maybe ())
    forall {s}.
    WithSource (ModuleU s)
    -> WithSource (ModuleU s) -> UnifyM s (Maybe ())
    unify ModuleWithSourceU s
    prov ModuleWithSourceU s
    req
        case Maybe ()
    r of
            Just () -> () -> UnifyM s ()
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Maybe ()
    Nothing -> do
                -- TODO: Record and report WHERE the bad constraint came from
                MsgDoc -> UnifyM s ()
    forall s. MsgDoc -> UnifyM s ()
    addErr (MsgDoc -> UnifyM s ()) -> MsgDoc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ String -> MsgDoc
    text String
    "Could not instantiate requirement" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (ModuleName -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ModuleName
    mod_name) MsgDoc -> MsgDoc -> MsgDoc
    $$
                         Int -> MsgDoc -> MsgDoc
    nest Int
    4 (String -> MsgDoc
    text String
    "Expected:" MsgDoc -> MsgDoc -> MsgDoc
    <+> OpenModule -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty OpenModule
    mod MsgDoc -> MsgDoc -> MsgDoc
    $$
                                 String -> MsgDoc
    text String
    "Actual:  " MsgDoc -> MsgDoc -> MsgDoc
    <+> OpenModule -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty OpenModule
    req_mod) MsgDoc -> MsgDoc -> MsgDoc
    $$
                         MsgDoc -> MsgDoc
    parens (String -> MsgDoc
    text String
    "This can occur if an exposed module of" MsgDoc -> MsgDoc -> MsgDoc
    <+>
                                 String -> MsgDoc
    text String
    "a libraries shares a name with another module.") MsgDoc -> MsgDoc -> MsgDoc
    $$
                         MsgDoc
    link_doc
        [ModuleWithSourceU s] -> UnifyM s [ModuleWithSourceU s]
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ModuleWithSourceU s]
    ret
      where
        unify :: WithSource (ModuleU s)
    -> WithSource (ModuleU s) -> UnifyM s (Maybe ())
    unify WithSource (ModuleU s)
    s1 WithSource (ModuleU s)
    s2 = UnifyM s () -> UnifyM s (Maybe ())
    forall s a. UnifyM s a -> UnifyM s (Maybe a)
    tryM (UnifyM s () -> UnifyM s (Maybe ()))
    -> UnifyM s () -> UnifyM s (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ MsgDoc -> UnifyM s () -> UnifyM s ()
    forall s a. MsgDoc -> UnifyM s a -> UnifyM s a
    addErrContext MsgDoc
    short_link_doc
                           (UnifyM s () -> UnifyM s ()) -> UnifyM s () -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ ModuleU s -> ModuleU s -> UnifyM s ()
    forall s. ModuleU s -> ModuleU s -> UnifyM s ()
    unifyModule (WithSource (ModuleU s) -> ModuleU s
    forall a. WithSource a -> a
    unWithSource WithSource (ModuleU s)
    s1) (WithSource (ModuleU s) -> ModuleU s
    forall a. WithSource a -> a
    unWithSource WithSource (ModuleU s)
    s2)
        in_scope_by :: ModuleSource -> MsgDoc
    in_scope_by ModuleSource
    s = String -> MsgDoc
    text String
    "brought into scope by" MsgDoc -> MsgDoc -> MsgDoc
    <+> ModuleSource -> MsgDoc
    dispModuleSource ModuleSource
    s
        short_link_doc :: MsgDoc
    short_link_doc = String -> MsgDoc
    text String
    "While filling requirement" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (ModuleName -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ModuleName
    mod_name)
        link_doc :: MsgDoc
    link_doc = String -> MsgDoc
    text String
    "While filling requirements of" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    reqs_doc
        reqs_doc :: MsgDoc
    reqs_doc
          | [ModuleWithSourceU s] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ModuleWithSourceU s]
    reqs = ModuleSource -> MsgDoc
    dispModuleSource (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    req)
          | Bool
    otherwise =  (       String -> MsgDoc
    text String
    "   " MsgDoc -> MsgDoc -> MsgDoc
    <+> ModuleSource -> MsgDoc
    dispModuleSource (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    req)  MsgDoc -> MsgDoc -> MsgDoc
    $$
                          [MsgDoc] -> MsgDoc
    vcat [ String -> MsgDoc
    text String
    "and" MsgDoc -> MsgDoc -> MsgDoc
    <+> ModuleSource -> MsgDoc
    dispModuleSource (ModuleWithSourceU s -> ModuleSource
    forall a. WithSource a -> ModuleSource
    getSource ModuleWithSourceU s
    r) | ModuleWithSourceU s
    r <- [ModuleWithSourceU s]
    reqs])
    linkProvision ModuleName
    _ [ModuleWithSourceU s]
    _ [ModuleWithSourceU s]
    _ = String -> UnifyM s [ModuleWithSourceU s]
    forall a. HasCallStack => String -> a
    error String
    "linkProvision"

    -----------------------------------------------------------------------
    -- The unification algorithm

    -- This is based off of https://gist.github.com/amnn/559551517d020dbb6588
    -- which is a translation from Huet's thesis.

    unifyUnitId :: UnitIdU s -> UnitIdU s -> UnifyM s ()
    unifyUnitId :: forall s. UnitIdU s -> UnitIdU s -> UnifyM s ()
    unifyUnitId UnitIdU s
    uid1_u UnitIdU s
    uid2_u
        | UnitIdU s
    uid1_u UnitIdU s -> UnitIdU s -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnitIdU s
    uid2_u = () -> UnifyM s ()
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise = do
            UnitIdU' s
    xuid1 <- 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
    uid1_u
            UnitIdU' s
    xuid2 <- 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
    uid2_u
            case (UnitIdU' s
    xuid1, UnitIdU' s
    xuid2) of
                (UnitIdThunkU DefUnitId
    u1, UnitIdThunkU DefUnitId
    u2)
                    | DefUnitId
    u1 DefUnitId -> DefUnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == DefUnitId
    u2  -> () -> UnifyM s ()
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    | Bool
    otherwise ->
                        MsgDoc -> UnifyM s ()
    forall s a. MsgDoc -> UnifyM s a
    failWith (MsgDoc -> UnifyM s ()) -> MsgDoc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Couldn't match unit IDs:") Int
    4
                                   (String -> MsgDoc
    text String
    "   " MsgDoc -> MsgDoc -> MsgDoc
    <+> DefUnitId -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty DefUnitId
    u1 MsgDoc -> MsgDoc -> MsgDoc
    $$
                                    String -> MsgDoc
    text String
    "and" MsgDoc -> MsgDoc -> MsgDoc
    <+> DefUnitId -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty DefUnitId
    u2)
                (UnitIdThunkU DefUnitId
    uid1, UnitIdU Int
    _ ComponentId
    cid2 Map ModuleName (ModuleU s)
    insts2)
                    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> DefUnitId
    -> UnitIdU s
    -> UnifyM s ()
    forall s.
    ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> DefUnitId
    -> UnitIdU s
    -> UnifyM s ()
    unifyThunkWith ComponentId
    cid2 Map ModuleName (ModuleU s)
    insts2 UnitIdU s
    uid2_u DefUnitId
    uid1 UnitIdU s
    uid1_u
                (UnitIdU Int
    _ ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1, UnitIdThunkU DefUnitId
    uid2)
                    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> DefUnitId
    -> UnitIdU s
    -> UnifyM s ()
    forall s.
    ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> DefUnitId
    -> UnitIdU s
    -> UnifyM s ()
    unifyThunkWith ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1 UnitIdU s
    uid1_u DefUnitId
    uid2 UnitIdU s
    uid2_u
                (UnitIdU Int
    _ ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1, UnitIdU Int
    _ ComponentId
    cid2 Map ModuleName (ModuleU s)
    insts2)
                    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> UnifyM s ()
    forall s.
    ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> UnifyM s ()
    unifyInner ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1 UnitIdU s
    uid1_u ComponentId
    cid2 Map ModuleName (ModuleU s)
    insts2 UnitIdU s
    uid2_u

    unifyThunkWith :: ComponentId
                   -> Map ModuleName (ModuleU s)
                   -> UnitIdU s
                   -> DefUnitId
                   -> UnitIdU s
                   -> UnifyM s ()
    unifyThunkWith :: forall s.
    ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> DefUnitId
    -> UnitIdU s
    -> UnifyM s ()
    unifyThunkWith ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1 UnitIdU s
    uid1_u DefUnitId
    uid2 UnitIdU s
    uid2_u = do
        FullDb
    db <- (UnifEnv s -> FullDb) -> UnifyM s (UnifEnv s) -> UnifyM s FullDb
    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 -> FullDb
    forall s. UnifEnv s -> FullDb
    unify_db UnifyM s (UnifEnv s)
    forall s. UnifyM s (UnifEnv s)
    getUnifEnv
        let FullUnitId ComponentId
    cid2 OpenModuleSubst
    insts2' = FullDb -> FullDb
    expandUnitId FullDb
    db DefUnitId
    uid2
        Map ModuleName (ModuleU s)
    insts2 <- OpenModuleSubst -> UnifyM s (Map ModuleName (ModuleU s))
    forall s. OpenModuleSubst -> UnifyM s (Map ModuleName (ModuleU s))
    convertModuleSubst OpenModuleSubst
    insts2'
        ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> UnifyM s ()
    forall s.
    ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> UnifyM s ()
    unifyInner ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1 UnitIdU s
    uid1_u ComponentId
    cid2 Map ModuleName (ModuleU s)
    insts2 UnitIdU s
    uid2_u

    unifyInner :: ComponentId
               -> Map ModuleName (ModuleU s)
               -> UnitIdU s
               -> ComponentId
               -> Map ModuleName (ModuleU s)
               -> UnitIdU s
               -> UnifyM s ()
    unifyInner :: forall s.
    ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> ComponentId
    -> Map ModuleName (ModuleU s)
    -> UnitIdU s
    -> UnifyM s ()
    unifyInner ComponentId
    cid1 Map ModuleName (ModuleU s)
    insts1 UnitIdU s
    uid1_u ComponentId
    cid2 Map ModuleName (ModuleU s)
    insts2 UnitIdU s
    uid2_u = do
        Bool -> UnifyM s () -> UnifyM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ComponentId
    cid1 ComponentId -> ComponentId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ComponentId
    cid2) (UnifyM s () -> UnifyM s ()) -> UnifyM s () -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
            -- TODO: if we had a package identifier, could be an
            -- easier to understand error message.
            MsgDoc -> UnifyM s ()
    forall s a. MsgDoc -> UnifyM s a
    failWith (MsgDoc -> UnifyM s ()) -> MsgDoc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Couldn't match component IDs:") Int
    4
                     (String -> MsgDoc
    text String
    "   " MsgDoc -> MsgDoc -> MsgDoc
    <+> ComponentId -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ComponentId
    cid1 MsgDoc -> MsgDoc -> MsgDoc
    $$
                      String -> MsgDoc
    text String
    "and" MsgDoc -> MsgDoc -> MsgDoc
    <+> ComponentId -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ComponentId
    cid2)
        -- The KEY STEP which makes this a Huet-style unification
        -- algorithm.  (Also a payoff of using union-find.)
        -- We can build infinite unit IDs this way, which is necessary
        -- for support mutual recursion. NB: union keeps the SECOND
        -- descriptor, so we always arrange for a UnitIdThunkU to live
        -- there.
        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
    uid1_u UnitIdU s
    uid2_u
        Map ModuleName (UnifyM s ()) -> UnifyM s ()
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Applicative f) =>
    t (f a) -> f ()
    F.sequenceA_ (Map ModuleName (UnifyM s ()) -> UnifyM s ())
    -> Map ModuleName (UnifyM s ()) -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $ (ModuleU s -> ModuleU s -> UnifyM s ())
    -> Map ModuleName (ModuleU s)
    -> Map ModuleName (ModuleU s)
    -> Map ModuleName (UnifyM s ())
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    Map.intersectionWith ModuleU s -> ModuleU s -> UnifyM s ()
    forall s. ModuleU s -> ModuleU s -> UnifyM s ()
    unifyModule Map ModuleName (ModuleU s)
    insts1 Map ModuleName (ModuleU s)
    insts2

    -- | Imperatively unify two modules.
    unifyModule :: ModuleU s -> ModuleU s -> UnifyM s ()
    unifyModule :: forall s. ModuleU s -> ModuleU s -> UnifyM s ()
    unifyModule ModuleU s
    mod1_u ModuleU s
    mod2_u
        | ModuleU s
    mod1_u ModuleU s -> ModuleU s -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleU s
    mod2_u = () -> UnifyM s ()
    forall a. a -> UnifyM s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise = do
            ModuleU' s
    mod1 <- 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
    mod1_u
            ModuleU' s
    mod2 <- 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
    mod2_u
            case (ModuleU' s
    mod1, ModuleU' s
    mod2) of
                (ModuleVarU ModuleName
    _, ModuleU' s
    _) -> 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
    $ ModuleU s -> ModuleU s -> ST s ()
    forall s a. Point s a -> Point s a -> ST s ()
    UnionFind.union ModuleU s
    mod1_u ModuleU s
    mod2_u
                (ModuleU' s
    _, ModuleVarU ModuleName
    _) -> 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
    $ ModuleU s -> ModuleU s -> ST s ()
    forall s a. Point s a -> Point s a -> ST s ()
    UnionFind.union ModuleU s
    mod2_u ModuleU s
    mod1_u
                (ModuleU UnitIdU s
    uid1 ModuleName
    mod_name1, ModuleU UnitIdU s
    uid2 ModuleName
    mod_name2) -> do
                    Bool -> UnifyM s () -> UnifyM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ModuleName
    mod_name1 ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ModuleName
    mod_name2) (UnifyM s () -> UnifyM s ()) -> UnifyM s () -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                        MsgDoc -> UnifyM s ()
    forall s a. MsgDoc -> UnifyM s a
    failWith (MsgDoc -> UnifyM s ()) -> MsgDoc -> UnifyM s ()
    forall a b. (a -> b) -> a -> b
    $
                            MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Cannot match module names") Int
    4 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
    forall a b. (a -> b) -> a -> b
    $
                                String -> MsgDoc
    text String
    "   " MsgDoc -> MsgDoc -> MsgDoc
    <+> ModuleName -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ModuleName
    mod_name1 MsgDoc -> MsgDoc -> MsgDoc
    $$
                                String -> MsgDoc
    text String
    "and" MsgDoc -> MsgDoc -> MsgDoc
    <+> ModuleName -> MsgDoc
    forall a. Pretty a => a -> MsgDoc
    pretty ModuleName
    mod_name2
                    -- NB: this is not actually necessary (because we'll
                    -- detect loops eventually in 'unifyUnitId'), but it
                    -- seems harmless enough
                    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
    $ ModuleU s -> ModuleU s -> ST s ()
    forall s a. Point s a -> Point s a -> ST s ()
    UnionFind.union ModuleU s
    mod1_u ModuleU s
    mod2_u
                    UnitIdU s -> UnitIdU s -> UnifyM s ()
    forall s. UnitIdU s -> UnitIdU s -> UnifyM s ()
    unifyUnitId UnitIdU s
    uid1 UnitIdU s
    uid2