From 09789b273e56c0ca46302224a23ee0d7aa305fff Mon Sep 17 00:00:00 2001 From: Hiromi ISHII Date: Mon, 1 Mar 2021 15:19:57 +0900 Subject: [PATCH] Stop discharging redundant constraints --- .../src/GHC/TypeLits/Presburger/Types.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/ghc-typelits-presburger/src/GHC/TypeLits/Presburger/Types.hs b/ghc-typelits-presburger/src/GHC/TypeLits/Presburger/Types.hs index b60db9e..a805f09 100644 --- a/ghc-typelits-presburger/src/GHC/TypeLits/Presburger/Types.hs +++ b/ghc-typelits-presburger/src/GHC/TypeLits/Presburger/Types.hs @@ -267,16 +267,9 @@ decidePresburger _ genTrans _ gs [] [] = do let givens = catMaybes ngs prems0 = map snd givens prems = foldr assert' noProps prems0 - (solved, _) = foldr go ([], noProps) givens if isNothing (checkSat prems) then return $ TcPluginContradiction gs - else do - tcPluginTrace "Redundant solveds" $ ppr solved - return $ TcPluginOk (map withEv solved) [] - where - go (ct, p) (ss, prem) - | Proved <- testIf prem p = (ct : ss, prem) - | otherwise = (ss, assert' p prem) + else return $ TcPluginOk [] [] decidePresburger mode genTrans _ gs _ds ws = do trans <- genTrans give trans $ do