diff options
| author | Pavol Vargovcik <pavol.vargovcik@gmail.com> | 2022-04-26 08:46:40 +0200 |
|---|---|---|
| committer | Pavol Vargovcik <pavol.vargovcik@gmail.com> | 2022-05-13 06:17:51 +0200 |
| commit | fefddc6ba9ace488fe9c954f39a212d32d08ffc9 (patch) | |
| tree | fd90458efb0da72949094c8fc67b52f6ca9703d1 | |
| parent | e9283ba5778872f0160e63c25ec60315c56ce55f (diff) | |
| download | haskell-fefddc6ba9ace488fe9c954f39a212d32d08ffc9.tar.gz | |
TcPlugin can read and resolve irreducible givens
| -rw-r--r-- | compiler/GHC/Tc/Solver/Monad.hs | 10 |
1 files changed, 8 insertions, 2 deletions
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs index 764f1eb454..26af2ff689 100644 --- a/compiler/GHC/Tc/Solver/Monad.hs +++ b/compiler/GHC/Tc/Solver/Monad.hs @@ -507,7 +507,8 @@ getInertGivens :: TcS [Ct] -- Returns the Given constraints in the inert set getInertGivens = do { inerts <- getInertCans - ; let all_cts = foldDicts (:) (inert_dicts inerts) + ; let all_cts = foldIrreds (:) (inert_irreds inerts) + $ foldDicts (:) (inert_dicts inerts) $ foldFunEqs (++) (inert_funeqs inerts) $ foldDVarEnv (++) [] (inert_eqs inerts) ; return (filter isGivenCt all_cts) } @@ -645,10 +646,15 @@ removeInertCt is ct = CEqCan { cc_lhs = lhs, cc_rhs = rhs } -> delEq is lhs rhs + CIrredCan {} -> is { inert_irreds = filterBag (not . eqCt ct) $ inert_irreds is } + CQuantCan {} -> panic "removeInertCt: CQuantCan" - CIrredCan {} -> panic "removeInertCt: CIrredEvCan" CNonCanonical {} -> panic "removeInertCt: CNonCanonical" +eqCt :: Ct -> Ct -> Bool +-- Equality via ctEvId +eqCt c c' = ctEvId c == ctEvId c' + -- | Looks up a family application in the inerts. lookupFamAppInert :: (CtFlavourRole -> Bool) -- can it rewrite the target? -> TyCon -> [Type] -> TcS (Maybe (Reduction, CtFlavourRole)) |