    -- | 'RoughMap' is an approximate finite map data structure keyed on
    -- @['RoughMatchTc']@. This is useful when keying maps on lists of 'Type's
    -- (e.g. an instance head).
    module GHC.Core.RoughMap
      ( -- * RoughMatchTc
        RoughMatchTc(..)
      , isRoughWildcard
      , typeToRoughMatchTc
      , RoughMatchLookupTc(..)
      , typeToRoughMatchLookupTc
      , roughMatchTcToLookup
      , roughMatchTcs
      , roughMatchTcsLookup
      , instanceCantMatch

        -- * RoughMap
      , RoughMap
      , emptyRM
      , lookupRM
      , lookupRM'
      , insertRM
      , filterRM
      , filterMatchingRM
      , elemsRM
      , sizeRM
      , foldRM
      , unionRM
      ) where

    import GHC.Prelude

    import GHC.Data.Bag
    import GHC.Core.TyCon
    import GHC.Core.TyCo.Rep
    import GHC.Core.Type
    import GHC.Utils.Outputable
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Builtin.Types.Prim( cONSTRAINTTyConName, tYPETyConName )

    import Control.Monad (join)
    import Data.Data (Data)
    import GHC.Utils.Panic

    {-
    Note [RoughMap]
    ~~~~~~~~~~~~~~~
    We often want to compute whether one type matches another. That is, given
    `ty1` and `ty2`, we want to know whether `ty1` is a substitution instance of `ty2`.

    We can bail out early by taking advantage of the following observation:

      If `ty2` is headed by a generative type constructor, say `tc`,
      but `ty1` is not headed by that same type constructor,
      then `ty1` does not match `ty2`.

    The idea is that we can use a `RoughMap` as a pre-filter, to produce a
    short-list of candidates to examine more closely.

    This means we can avoid computing a full substitution if we represent types
    as applications of known generative type constructors. So, after type synonym
    expansion, we classify application heads into two categories ('RoughMatchTc')

      - `RM_KnownTc tc`: the head is the generative type constructor `tc`,
      - `RM_Wildcard`: anything else.

    A (RoughMap val) is semantically a list of (key,[val]) pairs, where
       key :: [RoughMatchTc]
    So, writing # for `OtherTc`, and Int for `KnownTc "Int"`, we might have
        [ ([#, Int, Maybe, #, Int], v1)
        , ([Int, #, List], v2 ]

    This map is stored as a trie, so looking up a key is very fast.
    See Note [Matching a RoughMap] and Note [Simple Matching Semantics] for details on
    lookup.

    We lookup a key of type [RoughMatchLookupTc], and return the list of all values whose
    keys "match":

    Given the above map, here are the results of some lookups:
       Lookup key       Result
       -------------------------
       [Int, Int]       [v1,v2] -- Matches because the prefix of both entries matches
       [Int,Int,List]   [v2]
       [Bool]           []

    Notice that a single key can map to /multiple/ values.  E.g. if we started
    with (Maybe Int, val1) and (Maybe Bool, val2), we'd generate a RoughMap
    that is semantically the list   [( Maybe, [val1,val2] )]

    Note [RoughMap and beta reduction]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    There is one tricky case we have to account for when matching a rough map due
    to Note [Eta reduction for data families] in `GHC.Core.Coercion.Axiom`:
    Consider that the user has written a program containing a data family:

    > data family Fam a b
    > data instance Fam Int a = SomeType  -- known henceforth as FamIntInst

    The LHS of this instance will be eta reduced, as described in Note [Eta
    reduction for data families]. Consequently, we will end up with a `FamInst`
    with `fi_tcs = [KnownTc Int]`. Naturally, we need RoughMap to return this
    instance when queried for an instance with template, e.g., `[KnownTc Fam,
    KnownTc Int, KnownTc Char]`.

    This explains the third clause of the mightMatch specification in Note [Simple Matching Semantics].
    As soon as the lookup key runs out, the remaining instances might match.

    This only matters for the data-family case of a FamInstEnv (see Note [Over-saturated matches]
    in GHC.Core.FamInstEnv; it's irrelevantfor ClsInstEnv and for type-family instances.
    But we use RoughMaps for all cases, so we are conservative.

    Note [Matching a RoughMap]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    The /lookup key/ into a rough map (RoughMatchLookupTc) is slightly
    different to the /insertion key/ (RoughMatchTc).  Like the insertion
    key each lookup argument is classified to a simpler key which
    describes what could match that position. There are three
    possibilities:

    * RML_KnownTc Name: The argument is headed by a known type
      constructor.  Example: 'Bool' is classified as 'RML_KnownTc Bool'
      and '[Int]' is classified as `RML_KnownTc []`

    * RML_NoKnownTc: The argument is definitely not headed by any known
      type constructor.  Example: For instance matching 'a[sk], a[tau]' and 'F a[sk], F a[tau]'
      are classified as 'RML_NoKnownTc', for family instance matching no examples.

    * RML_WildCard: The argument could match anything, we don't know
      enough about it. For instance matching no examples, for type family matching,
      things to do with variables.

    The interesting case for instance matching is the second case, because it does not appear in
    an insertion key. The second case arises in two situations:

    1. The head of the application is a type variable. The type variable definitely
       doesn't match with any of the KnownTC instances so we can discard them all. For example:
        Show a[sk] or Show (a[sk] b[sk]). One place constraints like this arise is when
        typechecking derived instances.

    2. The head of the application is a known type family.
       For example: F a[sk]. The application of F is stuck, and because
       F is a type family it won't match any KnownTC instance so it's safe to discard
       all these instances.

    Of course, these two cases can still match instances of the form `forall a . Show a =>`,
    and those instances are retained as they are classified as RM_WildCard instances.

    Note [Matches vs Unifiers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    The lookupRM' function returns a pair of potential /matches/ and potential /unifiers/.
    The potential matches is likely to be much smaller than the bag of potential unifiers due
    to the reasoning about rigid type variables described in Note [Matching a RoughMap].
    On the other hand, the instances captured by the RML_NoKnownTC case can still potentially unify
    with any instance (depending on the substitution of said rigid variable) so they can't be discounted
    from the list of potential unifiers. This is achieved by the RML_NoKnownTC case continuing
    the lookup for unifiers by replacing RML_NoKnownTC with RML_LookupOtherTC.

    This distinction between matches and unifiers is also important for type families.
    During normal type family lookup, we care about matches and when checking for consistency
    we care about the unifiers. This is evident in the code as `lookup_fam_inst_env` is
    parameterised over a lookup function which either performs matching checking or unification
    checking.

    In addition to this, we only care whether there are zero or non-zero potential
    unifiers, even if we have many candidates, the search can stop before consulting
    each candidate. We only need the full list of unifiers when displaying error messages.
    Therefore the list is computed lazily so much work can be avoided constructing the
    list in the first place.

    Note [Simple Matching Semantics]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose `rm` is a RoughMap representing a set of (key,vals) pairs,
      where key::[RoughMapTc] and val::a.
    Suppose I look up a key lk :: [RoughMapLookupTc] in `rm`
    Then I get back (matches, unifiers) where
       matches  = [ vals | (key,vals) <- rm, key `mightMatch` lk ]
       unifiers = [ vals | (key,vals) <- rm, key `mightUnify` lk ]

    Where mightMatch is defined like this:

      mightMatch :: [RoughMapTc] -> [RoughMapLookupTc] -> Bool
      mightMatch []  []    = True   -- A perfectly sized match might match
      mightMatch key []    = True   -- A shorter lookup key matches everything
      mightMatch []  (_:_) = True   -- If the lookup key is longer, then still might match
                                    -- Note [RoughMap and beta reduction]
      mightMatch (k:ks) (lk:lks) =
        = case (k,lk) of
             -- Standard case, matching on a specific known TyCon.
             (RM_KnownTc n1, RML_KnownTc n2) -> n1==n2 && mightMatch ks lks
             -- For example, if the key for 'Show Bool' is [RM_KnownTc Show, RM_KnownTc Bool]
             ---and we match against (Show a[sk]) [RM_KnownTc Show, RML_NoKnownTc]
             -- then Show Bool can never match Show a[sk] so return False.
             (RM_KnownTc _, RML_NoKnownTc)   -> False
             -- Wildcard cases don't inform us anything about the match.
             (RM_WildCard, _ )    -> mightMatch ks lks
             (_, RML_WildCard)    -> mightMatch ks lks

      -- Might unify is very similar to mightMatch apart from RML_NoKnownTc may
      -- unify with any instance.
      mightUnify :: [RoughMapTc] -> [RoughMapLookupTc] -> Bool
      mightUnify []  []    = True   -- A perfectly sized match might unify
      mightUnify key []    = True   -- A shorter lookup key matches everything
      mightUnify []  (_:_) = True
      mightUnify (k:ks) (lk:lks) =
        = case (k,lk) of
             (RM_KnownTc n1, RML_KnownTc n2) -> n1==n2 && mightUnify ks lks
             (RM_KnownTc _, RML_NoKnownTc)   -> mightUnify (k:ks) (RML_WildCard:lks)
             (RM_WildCard, _ )    -> mightUnify ks lks
             (_, RML_WildCard)    -> mightUnify ks lks

    The guarantee that RoughMap provides is that

    if
       insert_ty `tcMatchTy` lookup_ty
    then definitely
       typeToRoughMatchTc insert_ty `mightMatch` typeToRoughMatchLookupTc lookup_ty
    but not vice versa

    this statement encodes the intuition that the RoughMap is used as a quick pre-filter
    to remove instances from the matching pool. The contrapositive states that if the
    RoughMap reports that the instance doesn't match then `tcMatchTy` will report that the
    types don't match as well.

    -}

    {- *********************************************************************
    *                                                                      *
                    Rough matching
    *                                                                      *
    ********************************************************************* -}

    {- Note [Rough matching in class and family instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      instance C (Maybe [Tree a]) Bool
    and suppose we are looking up
         C Bool Bool

    We can very quickly rule the instance out, because the first
    argument is headed by Maybe, whereas in the constraint we are looking
    up has first argument headed by Bool.  These "headed by" TyCons are
    called the "rough match TyCons" of the constraint or instance.
    They are used for a quick filter, to check when an instance cannot
    possibly match.

    The main motivation is to avoid sucking in whole instance
    declarations that are utterly useless.  See GHC.Core.InstEnv
    Note [ClsInst laziness and the rough-match fields].

    INVARIANT: a rough-match TyCons `tc` is always a real, generative tycon,
    like Maybe or Either, including a newtype or a data family, both of
    which are generative. It replies True to `isGenerativeTyCon tc Nominal`.

    But it is never
        - A type synonym
          E.g. Int and (S Bool) might match
               if (S Bool) is a synonym for Int

        - A type family (#19336)
          E.g.   (Just a) and (F a) might match if (F a) reduces to (Just a)
                 albeit perhaps only after 'a' is instantiated.
    -}

    -- Key for insertion into a RoughMap
    data RoughMatchTc
      = RM_KnownTc Name  -- INVARIANT: Name refers to a TyCon tc that responds
                         -- true to `isGenerativeTyCon tc Nominal`. See
                         -- Note [Rough matching in class and family instances]
      | RM_WildCard      -- e.g. type variable at the head
      deriving( Typeable RoughMatchTc
    Typeable RoughMatchTc =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c RoughMatchTc)
    -> (RoughMatchTc -> Constr)
    -> (RoughMatchTc -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c RoughMatchTc))
    -> ((forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r)
    -> (forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc)
    -> Data RoughMatchTc
    RoughMatchTc -> Constr
    RoughMatchTc -> DataType
    (forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u. Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u
    forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RoughMatchTc
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RoughMatchTc)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RoughMatchTc -> c RoughMatchTc
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RoughMatchTc
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RoughMatchTc
    $ctoConstr :: RoughMatchTc -> Constr
    toConstr :: RoughMatchTc -> Constr
    $cdataTypeOf :: RoughMatchTc -> DataType
    dataTypeOf :: RoughMatchTc -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RoughMatchTc)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RoughMatchTc)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RoughMatchTc)
    $cgmapT :: (forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc
    gmapT :: (forall b. Data b => b -> b) -> RoughMatchTc -> RoughMatchTc
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchTc -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchTc -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RoughMatchTc -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RoughMatchTc -> m RoughMatchTc
    Data )

    -- Key for lookup into a RoughMap
    -- See Note [Matching a RoughMap]
    data RoughMatchLookupTc
      = RML_KnownTc Name -- ^ The position only matches the specified KnownTc
      | RML_NoKnownTc    -- ^ The position definitely doesn't match any KnownTc
      | RML_WildCard     -- ^ The position can match anything
      deriving ( Typeable RoughMatchLookupTc
    Typeable RoughMatchLookupTc =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g)
     -> RoughMatchLookupTc
     -> c RoughMatchLookupTc)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc)
    -> (RoughMatchLookupTc -> Constr)
    -> (RoughMatchLookupTc -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c RoughMatchLookupTc))
    -> ((forall b. Data b => b -> b)
        -> RoughMatchLookupTc -> RoughMatchLookupTc)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r)
    -> (forall u.
        (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d)
        -> RoughMatchLookupTc -> m RoughMatchLookupTc)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d)
        -> RoughMatchLookupTc -> m RoughMatchLookupTc)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d)
        -> RoughMatchLookupTc -> m RoughMatchLookupTc)
    -> Data RoughMatchLookupTc
    RoughMatchLookupTc -> Constr
    RoughMatchLookupTc -> DataType
    (forall b. Data b => b -> b)
    -> RoughMatchLookupTc -> RoughMatchLookupTc
    forall a.
    Typeable a =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> a -> c a)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c a)
    -> (a -> Constr)
    -> (a -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c a))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
    -> ((forall b. Data b => b -> b) -> a -> a)
    -> (forall r r'.
        (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall r r'.
        (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
    -> (forall u. (forall d. Data d => d -> u) -> a -> [u])
    -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> a -> m a)
    -> Data a
    forall u.
    Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u
    forall u. (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RoughMatchLookupTc
    -> c RoughMatchLookupTc
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RoughMatchLookupTc)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RoughMatchLookupTc
    -> c RoughMatchLookupTc
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RoughMatchLookupTc
    -> c RoughMatchLookupTc
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RoughMatchLookupTc
    $ctoConstr :: RoughMatchLookupTc -> Constr
    toConstr :: RoughMatchLookupTc -> Constr
    $cdataTypeOf :: RoughMatchLookupTc -> DataType
    dataTypeOf :: RoughMatchLookupTc -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RoughMatchLookupTc)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RoughMatchLookupTc)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RoughMatchLookupTc)
    $cgmapT :: (forall b. Data b => b -> b)
    -> RoughMatchLookupTc -> RoughMatchLookupTc
    gmapT :: (forall b. Data b => b -> b)
    -> RoughMatchLookupTc -> RoughMatchLookupTc
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RoughMatchLookupTc -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> RoughMatchLookupTc -> [u]
    $cgmapQi :: forall u.
    Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u
    gmapQi :: forall u.
    Int -> (forall d. Data d => d -> u) -> RoughMatchLookupTc -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RoughMatchLookupTc -> m RoughMatchLookupTc
    Data )

    instance Outputable RoughMatchLookupTc where
        ppr :: RoughMatchLookupTc -> SDoc
    ppr (RML_KnownTc Name
    nm) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RML_KnownTc" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    nm
        ppr RoughMatchLookupTc
    RML_NoKnownTc = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RML_NoKnownTC"
        ppr RoughMatchLookupTc
    RML_WildCard = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "_"

    instance Outputable RoughMatchTc where
        ppr :: RoughMatchTc -> SDoc
    ppr (RM_KnownTc Name
    nm) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "KnownTc" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    nm
        ppr RoughMatchTc
    RM_WildCard = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "OtherTc"

    instanceCantMatch :: [RoughMatchTc] -> [RoughMatchTc] -> Bool
    -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
    -- possibly be instantiated to actual, nor vice versa;
    -- False is non-committal
    instanceCantMatch :: [RoughMatchTc] -> [RoughMatchTc] -> Bool
    instanceCantMatch (RoughMatchTc
    mt : [RoughMatchTc]
    ts) (RoughMatchTc
    ma : [RoughMatchTc]
    as) = RoughMatchTc -> RoughMatchTc -> Bool
    itemCantMatch RoughMatchTc
    mt RoughMatchTc
    ma Bool -> Bool -> Bool
    || [RoughMatchTc] -> [RoughMatchTc] -> Bool
    instanceCantMatch [RoughMatchTc]
    ts [RoughMatchTc]
    as
    instanceCantMatch [RoughMatchTc]
    _         [RoughMatchTc]
    _         =  Bool
    False  -- Safe

    itemCantMatch :: RoughMatchTc -> RoughMatchTc -> Bool
    itemCantMatch :: RoughMatchTc -> RoughMatchTc -> Bool
    itemCantMatch (RM_KnownTc Name
    t) (RM_KnownTc Name
    a) = Name
    t Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name
    a
    itemCantMatch RoughMatchTc
    _              RoughMatchTc
    _              = Bool
    False

    roughMatchTcToLookup :: RoughMatchTc -> RoughMatchLookupTc
    roughMatchTcToLookup :: RoughMatchTc -> RoughMatchLookupTc
    roughMatchTcToLookup (RM_KnownTc Name
    n) = Name -> RoughMatchLookupTc
    RML_KnownTc Name
    n
    roughMatchTcToLookup RoughMatchTc
    RM_WildCard = RoughMatchLookupTc
    RML_WildCard

    isRoughWildcard :: RoughMatchTc -> Bool
    isRoughWildcard :: RoughMatchTc -> Bool
    isRoughWildcard RoughMatchTc
    RM_WildCard  = Bool
    True
    isRoughWildcard (RM_KnownTc {}) = Bool
    False

    roughMatchTcs :: [Type] -> [RoughMatchTc]
    roughMatchTcs :: [Type] -> [RoughMatchTc]
    roughMatchTcs [Type]
    tys = (Type -> RoughMatchTc) -> [Type] -> [RoughMatchTc]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> RoughMatchTc
    typeToRoughMatchTc [Type]
    tys

    roughMatchTcsLookup :: [Type] -> [RoughMatchLookupTc]
    roughMatchTcsLookup :: [Type] -> [RoughMatchLookupTc]
    roughMatchTcsLookup [Type]
    tys = (Type -> RoughMatchLookupTc) -> [Type] -> [RoughMatchLookupTc]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> RoughMatchLookupTc
    typeToRoughMatchLookupTc [Type]
    tys

    typeToRoughMatchLookupTc :: Type -> RoughMatchLookupTc
    typeToRoughMatchLookupTc :: Type -> RoughMatchLookupTc
    typeToRoughMatchLookupTc Type
    ty
      -- Expand synonyms first, as explained in Note [Rough matching in class and family instances].
      -- Failing to do so led to #22985.
      | Just Type
    ty' <- Type -> Maybe Type
    coreView Type
    ty
      = Type -> RoughMatchLookupTc
    typeToRoughMatchLookupTc Type
    ty'
      | CastTy Type
    ty' KindCoercion
    _ <- Type
    ty
      = Type -> RoughMatchLookupTc
    typeToRoughMatchLookupTc Type
    ty'
      | Bool
    otherwise
      = case HasDebugCallStack => Type -> (Type, [Type])
    Type -> (Type, [Type])
    splitAppTys Type
    ty of
            -- Case 1: Head of application is a type variable, does not match any KnownTc.
            (TyVarTy {}, [Type]
    _) -> RoughMatchLookupTc
    RML_NoKnownTc

            (TyConApp TyCon
    tc [Type]
    _, [Type]
    _)
              -- Case 2: Head of application is a known type constructor, hence KnownTc.
              | Bool -> Bool
    not (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc) -> Name -> RoughMatchLookupTc
    RML_KnownTc (Name -> RoughMatchLookupTc) -> Name -> RoughMatchLookupTc
    forall a b. (a -> b) -> a -> b
    $! TyCon -> Name
    roughMatchTyConName TyCon
    tc
              -- Case 3: Head is a type family so it's stuck and therefore doesn't match
              -- any KnownTc
              | TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc -> RoughMatchLookupTc
    RML_NoKnownTc

            -- Fallthrough: Otherwise, anything might match this position
            (Type, [Type])
    _ -> RoughMatchLookupTc
    RML_WildCard

    typeToRoughMatchTc :: Type -> RoughMatchTc
    typeToRoughMatchTc :: Type -> RoughMatchTc
    typeToRoughMatchTc Type
    ty
      | Just (Type
    ty', KindCoercion
    _) <- Type -> Maybe (Type, KindCoercion)
    splitCastTy_maybe Type
    ty   = Type -> RoughMatchTc
    typeToRoughMatchTc Type
    ty'
      | Just (TyCon
    tc,[Type]
    _)   <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty
      , Bool -> Bool
    not (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc)              = Name -> RoughMatchTc
    RM_KnownTc (Name -> RoughMatchTc) -> Name -> RoughMatchTc
    forall a b. (a -> b) -> a -> b
    $! TyCon -> Name
    roughMatchTyConName TyCon
    tc
        -- See Note [Rough matching in class and family instances]
      | Bool
    otherwise                               = RoughMatchTc
    RM_WildCard

    roughMatchTyConName :: TyCon -> Name
    roughMatchTyConName :: TyCon -> Name
    roughMatchTyConName TyCon
    tc
      | Name
    tc_name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    cONSTRAINTTyConName
      = Name
    tYPETyConName  -- TYPE and CONSTRAINT are not apart, so they must use
                       -- the same rough-map key. We arbitrarily use TYPE.
                       -- See Note [Type and Constraint are not apart]
                       -- wrinkle (W1) in GHC.Builtin.Types.Prim
      | Bool
    otherwise
      = Bool -> SDoc -> Name -> Name
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (TyCon -> Role -> Bool
    isGenerativeTyCon TyCon
    tc Role
    Nominal) (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc) Name
    tc_name
      where
        tc_name :: Name
    tc_name = TyCon -> Name
    tyConName TyCon
    tc

    -- | Trie of @[RoughMatchTc]@
    --
    -- *Examples*
    -- @
    -- insert [OtherTc] 1
    -- insert [OtherTc] 2
    -- lookup [OtherTc] == [1,2]
    -- @
    data RoughMap a
      = RMEmpty -- An optimised (finite) form of emptyRM
                -- Invariant: Empty RoughMaps are always represented with RMEmpty

      | RM { forall a. RoughMap a -> Bag a
    rm_empty :: Bag a
               -- Keyed by an empty [RoughMapTc]

           , forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known :: DNameEnv (RoughMap a)
               -- Keyed by (RM_KnownTc tc : rm_tcs)
               -- DNameEnv: see Note [InstEnv determinism] in GHC.Core.InstEnv

           , forall a. RoughMap a -> RoughMap a
    rm_wild :: RoughMap a }
               -- Keyed by (RM_WildCard : rm_tcs)
      deriving ((forall a b. (a -> b) -> RoughMap a -> RoughMap b)
    -> (forall a b. a -> RoughMap b -> RoughMap a) -> Functor RoughMap
    forall a b. a -> RoughMap b -> RoughMap a
    forall a b. (a -> b) -> RoughMap a -> RoughMap b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> RoughMap a -> RoughMap b
    fmap :: forall a b. (a -> b) -> RoughMap a -> RoughMap b
    $c<$ :: forall a b. a -> RoughMap b -> RoughMap a
    <$ :: forall a b. a -> RoughMap b -> RoughMap a
    Functor)

    instance Outputable a => Outputable (RoughMap a) where
      ppr :: RoughMap a -> SDoc
    ppr (RM Bag a
    empty DNameEnv (RoughMap a)
    known RoughMap a
    unknown) =
          [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RM"
               , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Empty:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Bag a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bag a
    empty
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Known:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DNameEnv (RoughMap a) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DNameEnv (RoughMap a)
    known
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Unknown:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> RoughMap a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RoughMap a
    unknown])]
      ppr RoughMap a
    RMEmpty = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "{}"

    emptyRM :: RoughMap a
    emptyRM :: forall a. RoughMap a
    emptyRM = RoughMap a
    forall a. RoughMap a
    RMEmpty

    -- | Order of result is deterministic.
    lookupRM :: [RoughMatchLookupTc] -> RoughMap a -> [a]
    lookupRM :: forall a. [RoughMatchLookupTc] -> RoughMap a -> [a]
    lookupRM [RoughMatchLookupTc]
    tcs RoughMap a
    rm = Bag a -> [a]
    forall a. Bag a -> [a]
    bagToList ((Bag a, [a]) -> Bag a
    forall a b. (a, b) -> a
    fst ((Bag a, [a]) -> Bag a) -> (Bag a, [a]) -> Bag a
    forall a b. (a -> b) -> a -> b
    $ [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    tcs RoughMap a
    rm)

    -- | N.B. Returns a 'Bag' for matches, which allows us to avoid rebuilding all of the lists
    -- we find in 'rm_empty', which would otherwise be necessary due to '++' if we
    -- returned a list. We use a list for unifiers because the tail is computed lazily and
    -- we often only care about the first couple of potential unifiers. Constructing a
    -- bag forces the tail which performs much too much work.
    --
    -- See Note [Matching a RoughMap]
    -- See Note [Matches vs Unifiers]
    lookupRM' :: [RoughMatchLookupTc] -> RoughMap a -> (Bag a -- Potential matches
                                                       , [a]) -- Potential unifiers
    lookupRM' :: forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    _ RoughMap a
    RMEmpty   -- The RoughMap is empty
      = (Bag a
    forall a. Bag a
    emptyBag, [])

    lookupRM' [] RoughMap a
    rm       -- See Note [Simple Matching Semantics] about why
      = ([a] -> Bag a
    forall a. [a] -> Bag a
    listToBag [a]
    m, [a]
    m)  -- we return everything when the lookup key runs out
      where
        m :: [a]
    m = RoughMap a -> [a]
    forall a. RoughMap a -> [a]
    elemsRM RoughMap a
    rm

    lookupRM' (RML_KnownTc Name
    tc : [RoughMatchLookupTc]
    tcs) RoughMap a
    rm  =
      let (Bag a
    common_m, [a]
    common_u) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    tcs (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm)
          (Bag a
    m, [a]
    u) = (Bag a, [a])
    -> (RoughMap a -> (Bag a, [a]))
    -> Maybe (RoughMap a)
    -> (Bag a, [a])
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bag a
    forall a. Bag a
    emptyBag, []) ([RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    tcs) (DNameEnv (RoughMap a) -> Name -> Maybe (RoughMap a)
    forall a. DNameEnv a -> Name -> Maybe a
    lookupDNameEnv (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    rm) Name
    tc)
      in ( RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag a
    common_m Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag a
    m
         , Bag a -> [a]
    forall a. Bag a -> [a]
    bagToList (RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm) [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    common_u [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    u)

    -- A RML_NoKnownTC does **not** match any KnownTC but can unify
    lookupRM' (RoughMatchLookupTc
    RML_NoKnownTc : [RoughMatchLookupTc]
    tcs) RoughMap a
    rm =
      let (Bag a
    u_m, [a]
    _u_u) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    tcs (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm)
      in ( RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag a
    u_m -- Definitely don't match
         , (Bag a, [a]) -> [a]
    forall a b. (a, b) -> b
    snd ((Bag a, [a]) -> [a]) -> (Bag a, [a]) -> [a]
    forall a b. (a -> b) -> a -> b
    $ [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' (RoughMatchLookupTc
    RML_WildCard RoughMatchLookupTc -> [RoughMatchLookupTc] -> [RoughMatchLookupTc]
    forall a. a -> [a] -> [a]
    : [RoughMatchLookupTc]
    tcs) RoughMap a
    rm) -- But could unify..

    lookupRM' (RoughMatchLookupTc
    RML_WildCard : [RoughMatchLookupTc]
    tcs)    RoughMap a
    rm  =
    --  pprTrace "RM wild" (ppr tcs $$ ppr (eltsDNameEnv (rm_known rm))) $
      let (Bag a
    m, [a]
    u)     = (RoughMap a -> (Bag a, [a]) -> (Bag a, [a]))
    -> (Bag a, [a]) -> DNameEnv (RoughMap a) -> (Bag a, [a])
    forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
    foldDNameEnv RoughMap a -> (Bag a, [a]) -> (Bag a, [a])
    forall a. RoughMap a -> (Bag a, [a]) -> (Bag a, [a])
    add_one (Bag a
    forall a. Bag a
    emptyBag, []) (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    rm)
          (Bag a
    u_m, [a]
    u_u) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    tcs (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm)
      in ( RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag a
    u_m Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag a
    m
         , Bag a -> [a]
    forall a. Bag a -> [a]
    bagToList (RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm) [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    u_u [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    u )
      where
         add_one :: RoughMap a -> (Bag a, [a]) -> (Bag a, [a])
         add_one :: forall a. RoughMap a -> (Bag a, [a]) -> (Bag a, [a])
    add_one RoughMap a
    rm ~(Bag a
    m2, [a]
    u2) = (Bag a
    m1 Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag a
    m2, [a]
    u1 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    u2)
                              where
                                (Bag a
    m1,[a]
    u1) = [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    forall a. [RoughMatchLookupTc] -> RoughMap a -> (Bag a, [a])
    lookupRM' [RoughMatchLookupTc]
    tcs RoughMap a
    rm

    unionRM :: RoughMap a -> RoughMap a -> RoughMap a
    unionRM :: forall a. RoughMap a -> RoughMap a -> RoughMap a
    unionRM RoughMap a
    RMEmpty RoughMap a
    a = RoughMap a
    a
    unionRM RoughMap a
    a RoughMap a
    RMEmpty = RoughMap a
    a
    unionRM RoughMap a
    a RoughMap a
    b =
      RM { rm_empty :: Bag a
    rm_empty = RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    a Bag a -> Bag a -> Bag a
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    b
         , rm_known :: DNameEnv (RoughMap a)
    rm_known = (RoughMap a -> RoughMap a -> RoughMap a)
    -> DNameEnv (RoughMap a)
    -> DNameEnv (RoughMap a)
    -> DNameEnv (RoughMap a)
    forall elt.
    (elt -> elt -> elt) -> DNameEnv elt -> DNameEnv elt -> DNameEnv elt
    plusDNameEnv_C RoughMap a -> RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a -> RoughMap a
    unionRM (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    a) (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    b)
         , rm_wild :: RoughMap a
    rm_wild = RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    a RoughMap a -> RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a -> RoughMap a
    `unionRM` RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    b
         }

    insertRM :: [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    insertRM :: forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    insertRM [RoughMatchTc]
    k a
    v RoughMap a
    RMEmpty =
        [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    insertRM [RoughMatchTc]
    k a
    v (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
    forall a b. (a -> b) -> a -> b
    $ RM { rm_empty :: Bag a
    rm_empty = Bag a
    forall a. Bag a
    emptyBag
                          , rm_known :: DNameEnv (RoughMap a)
    rm_known = DNameEnv (RoughMap a)
    forall a. DNameEnv a
    emptyDNameEnv
                          , rm_wild :: RoughMap a
    rm_wild = RoughMap a
    forall a. RoughMap a
    emptyRM }
    insertRM [] a
    v rm :: RoughMap a
    rm@(RM {}) =
        -- See Note [Simple Matching Semantics]
        RoughMap a
    rm { rm_empty = v `consBag` rm_empty rm }

    insertRM (RM_KnownTc Name
    k : [RoughMatchTc]
    ks) a
    v rm :: RoughMap a
    rm@(RM {}) =
        RoughMap a
    rm { rm_known = alterDNameEnv f (rm_known rm) k }
      where
        f :: Maybe (RoughMap a) -> Maybe (RoughMap a)
    f Maybe (RoughMap a)
    Nothing  = RoughMap a -> Maybe (RoughMap a)
    forall a. a -> Maybe a
    Just (RoughMap a -> Maybe (RoughMap a))
    -> RoughMap a -> Maybe (RoughMap a)
    forall a b. (a -> b) -> a -> b
    $ ([RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    insertRM [RoughMatchTc]
    ks a
    v RoughMap a
    forall a. RoughMap a
    emptyRM)
        f (Just RoughMap a
    m) = RoughMap a -> Maybe (RoughMap a)
    forall a. a -> Maybe a
    Just (RoughMap a -> Maybe (RoughMap a))
    -> RoughMap a -> Maybe (RoughMap a)
    forall a b. (a -> b) -> a -> b
    $ ([RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    forall a. [RoughMatchTc] -> a -> RoughMap a -> RoughMap a
    insertRM [RoughMatchTc]
    ks a
    v RoughMap a
    m)

    insertRM (RoughMatchTc
    RM_WildCard : [RoughMatchTc]
    ks) a
    v rm :: RoughMap a
    rm@(RM {}) =
        RoughMap a
    rm { rm_wild = insertRM ks v (rm_wild rm) }

    filterRM :: (a -> Bool) -> RoughMap a -> RoughMap a
    filterRM :: forall a. (a -> Bool) -> RoughMap a -> RoughMap a
    filterRM a -> Bool
    _ RoughMap a
    RMEmpty = RoughMap a
    forall a. RoughMap a
    RMEmpty
    filterRM a -> Bool
    pred RoughMap a
    rm =
        RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    normalise (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
    forall a b. (a -> b) -> a -> b
    $ RM {
          rm_empty :: Bag a
    rm_empty = (a -> Bool) -> Bag a -> Bag a
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag a -> Bool
    pred (RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm),
          rm_known :: DNameEnv (RoughMap a)
    rm_known = (RoughMap a -> RoughMap a)
    -> DNameEnv (RoughMap a) -> DNameEnv (RoughMap a)
    forall a b. (a -> b) -> DNameEnv a -> DNameEnv b
    mapDNameEnv ((a -> Bool) -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> RoughMap a -> RoughMap a
    filterRM a -> Bool
    pred) (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    rm),
          rm_wild :: RoughMap a
    rm_wild = (a -> Bool) -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> RoughMap a -> RoughMap a
    filterRM a -> Bool
    pred (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm)
        }

    -- | Place a 'RoughMap' in normal form, turning all empty 'RM's into
    -- 'RMEmpty's. Necessary after removing items.
    normalise :: RoughMap a -> RoughMap a
    normalise :: forall a. RoughMap a -> RoughMap a
    normalise RoughMap a
    RMEmpty = RoughMap a
    forall a. RoughMap a
    RMEmpty
    normalise (RM Bag a
    empty DNameEnv (RoughMap a)
    known RoughMap a
    RMEmpty)
      | Bag a -> Bool
    forall a. Bag a -> Bool
    isEmptyBag Bag a
    empty
      , DNameEnv (RoughMap a) -> Bool
    forall a. DNameEnv a -> Bool
    isEmptyDNameEnv DNameEnv (RoughMap a)
    known = RoughMap a
    forall a. RoughMap a
    RMEmpty
    normalise RoughMap a
    rm = RoughMap a
    rm

    -- | Filter all elements that might match a particular key with the given
    -- predicate.
    filterMatchingRM :: (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    filterMatchingRM :: forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    filterMatchingRM a -> Bool
    _    [RoughMatchTc]
    _  RoughMap a
    RMEmpty = RoughMap a
    forall a. RoughMap a
    RMEmpty
    filterMatchingRM a -> Bool
    pred [] RoughMap a
    rm      = (a -> Bool) -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> RoughMap a -> RoughMap a
    filterRM a -> Bool
    pred RoughMap a
    rm
    filterMatchingRM a -> Bool
    pred (RM_KnownTc Name
    tc : [RoughMatchTc]
    tcs) RoughMap a
    rm =
        RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    normalise (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
    forall a b. (a -> b) -> a -> b
    $ RM {
          rm_empty :: Bag a
    rm_empty = (a -> Bool) -> Bag a -> Bag a
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag a -> Bool
    pred (RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm),
          rm_known :: DNameEnv (RoughMap a)
    rm_known = (Maybe (RoughMap a) -> Maybe (RoughMap a))
    -> DNameEnv (RoughMap a) -> Name -> DNameEnv (RoughMap a)
    forall a. (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
    alterDNameEnv (Maybe (Maybe (RoughMap a)) -> Maybe (RoughMap a)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe (RoughMap a)) -> Maybe (RoughMap a))
    -> (Maybe (RoughMap a) -> Maybe (Maybe (RoughMap a)))
    -> Maybe (RoughMap a)
    -> Maybe (RoughMap a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RoughMap a -> Maybe (RoughMap a))
    -> Maybe (RoughMap a) -> Maybe (Maybe (RoughMap a))
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (RoughMap a -> Maybe (RoughMap a)
    forall a. RoughMap a -> Maybe (RoughMap a)
    dropEmpty (RoughMap a -> Maybe (RoughMap a))
    -> (RoughMap a -> RoughMap a) -> RoughMap a -> Maybe (RoughMap a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    filterMatchingRM a -> Bool
    pred [RoughMatchTc]
    tcs)) (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    rm) Name
    tc,
          rm_wild :: RoughMap a
    rm_wild = (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    filterMatchingRM a -> Bool
    pred [RoughMatchTc]
    tcs (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm)
        }
    filterMatchingRM a -> Bool
    pred (RoughMatchTc
    RM_WildCard : [RoughMatchTc]
    tcs) RoughMap a
    rm =
        RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    normalise (RoughMap a -> RoughMap a) -> RoughMap a -> RoughMap a
    forall a b. (a -> b) -> a -> b
    $ RM {
          rm_empty :: Bag a
    rm_empty = (a -> Bool) -> Bag a -> Bag a
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag a -> Bool
    pred (RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm),
          rm_known :: DNameEnv (RoughMap a)
    rm_known = (RoughMap a -> RoughMap a)
    -> DNameEnv (RoughMap a) -> DNameEnv (RoughMap a)
    forall a b. (a -> b) -> DNameEnv a -> DNameEnv b
    mapDNameEnv ((a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    filterMatchingRM a -> Bool
    pred [RoughMatchTc]
    tcs) (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    rm),
          rm_wild :: RoughMap a
    rm_wild = (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    forall a. (a -> Bool) -> [RoughMatchTc] -> RoughMap a -> RoughMap a
    filterMatchingRM a -> Bool
    pred [RoughMatchTc]
    tcs (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm)
        }

    dropEmpty :: RoughMap a -> Maybe (RoughMap a)
    dropEmpty :: forall a. RoughMap a -> Maybe (RoughMap a)
    dropEmpty RoughMap a
    RMEmpty = Maybe (RoughMap a)
    forall a. Maybe a
    Nothing
    dropEmpty RoughMap a
    rm = RoughMap a -> Maybe (RoughMap a)
    forall a. a -> Maybe a
    Just RoughMap a
    rm

    elemsRM :: RoughMap a -> [a]
    elemsRM :: forall a. RoughMap a -> [a]
    elemsRM = (a -> [a] -> [a]) -> [a] -> RoughMap a -> [a]
    forall a b. (a -> b -> b) -> b -> RoughMap a -> b
    foldRM (:) []

    foldRM :: (a -> b -> b) -> b -> RoughMap a -> b
    foldRM :: forall a b. (a -> b -> b) -> b -> RoughMap a -> b
    foldRM a -> b -> b
    f = b -> RoughMap a -> b
    go
      where
        -- N.B. local worker ensures that the loop can be specialised to the fold
        -- function.
        go :: b -> RoughMap a -> b
    go b
    z RoughMap a
    RMEmpty = b
    z
        go b
    z (RM{ rm_wild :: forall a. RoughMap a -> RoughMap a
    rm_wild = RoughMap a
    unk, rm_known :: forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known = DNameEnv (RoughMap a)
    known, rm_empty :: forall a. RoughMap a -> Bag a
    rm_empty = Bag a
    empty}) =
          (a -> b -> b) -> b -> Bag a -> b
    forall a b. (a -> b -> b) -> b -> Bag a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
            a -> b -> b
    f
            ((RoughMap a -> b -> b) -> b -> DNameEnv (RoughMap a) -> b
    forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
    foldDNameEnv
               ((b -> RoughMap a -> b) -> RoughMap a -> b -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip b -> RoughMap a -> b
    go)
               (b -> RoughMap a -> b
    go b
    z RoughMap a
    unk)
               DNameEnv (RoughMap a)
    known
            )
            Bag a
    empty

    nonDetStrictFoldRM :: (b -> a -> b) -> b -> RoughMap a -> b
    nonDetStrictFoldRM :: forall b a. (b -> a -> b) -> b -> RoughMap a -> b
    nonDetStrictFoldRM b -> a -> b
    f = b -> RoughMap a -> b
    go
      where
        -- N.B. local worker ensures that the loop can be specialised to the fold
        -- function.
        go :: b -> RoughMap a -> b
    go !b
    z RoughMap a
    RMEmpty = b
    z
        go  b
    z rm :: RoughMap a
    rm@(RM{}) =
          (b -> a -> b) -> b -> Bag a -> b
    forall b a. (b -> a -> b) -> b -> Bag a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl'
            b -> a -> b
    f
            ((RoughMap a -> b -> b) -> b -> DNameEnv (RoughMap a) -> b
    forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
    nonDetStrictFoldDNameEnv
               ((b -> RoughMap a -> b) -> RoughMap a -> b -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip b -> RoughMap a -> b
    go)
               (b -> RoughMap a -> b
    go b
    z (RoughMap a -> RoughMap a
    forall a. RoughMap a -> RoughMap a
    rm_wild RoughMap a
    rm))
               (RoughMap a -> DNameEnv (RoughMap a)
    forall a. RoughMap a -> DNameEnv (RoughMap a)
    rm_known RoughMap a
    rm)
            )
            (RoughMap a -> Bag a
    forall a. RoughMap a -> Bag a
    rm_empty RoughMap a
    rm)

    sizeRM :: RoughMap a -> Int
    sizeRM :: forall a. RoughMap a -> Int
    sizeRM = (Int -> a -> Int) -> Int -> RoughMap a -> Int
    forall b a. (b -> a -> b) -> b -> RoughMap a -> b
    nonDetStrictFoldRM (\Int
    acc a
    _ -> Int
    acc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int
    0