[Git][ghc/ghc][wip/cfuneqcan-refactor] Simplify code a bit

[Richard Eisenberg]

Richard Eisenberg pushed to branch wip/cfuneqcan-refactor at Glasgow Haskell Compiler / GHC


Commits:
564244ce by Richard Eisenberg at 2020-11-04T22:49:39-05:00
Simplify code a bit

- - - - -


1 changed file:

- compiler/GHC/Tc/Solver/Monad.hs


Changes:

=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -2055,32 +2055,7 @@ getNoGivenEqs :: TcLevel          -- TcLevel of this implication
 getNoGivenEqs tclvl skol_tvs
   = do { inerts@(IC { inert_eqs = ieqs, inert_funeqs = funeqs, inert_irreds = irreds })
               <- getInertCans
-       ; tc_lvl <- getTcLevel
-       ; let is_local_given_ct :: Ct -> Bool
-             is_local_given_ct = ct_given_here <&&> ct_mentions_outer_var
-
-             is_local_given_equal_ct_list :: EqualCtList -> Bool
-             is_local_given_equal_ct_list [ct] = is_local_given_ct ct
-               -- Givens are always singletons in an EqualCtList
-             is_local_given_equal_ct_list _    = False
-
-             ct_given_here :: Ct -> Bool
-             -- True for a Given bound by the current implication,
-             -- i.e. the current level
-             ct_given_here ct =  isGiven ev
-                              && tclvl == ctLocLevel (ctEvLoc ev)
-                 where
-                   ev = ctEvidence ct
-
-             ct_mentions_outer_var :: Ct -> Bool
-             ct_mentions_outer_var = anyFreeVarsOfType is_outer_var . ctPred
-
-             is_outer_var :: TyCoVar -> Bool
-             is_outer_var tv
-               | isTyVar tv = tc_lvl `strictlyDeeperThan` tcTyVarLevel tv
-               | otherwise  = False
-
-             has_given_eqs = anyBag is_local_given_ct irreds
+       ; let has_given_eqs = anyBag is_local_given_ct irreds
                           || anyDVarEnv is_local_given_equal_ct_list ieqs
                           || anyFunEqMap funeqs is_local_given_equal_ct_list
              insols = filterBag insolubleEqCt irreds
@@ -2095,6 +2070,28 @@ getNoGivenEqs tclvl skol_tvs
               , text "Inerts:" <+> ppr inerts
               , text "Insols:" <+> ppr insols]
        ; return (not has_given_eqs, insols) }
+  where
+    is_local_given_ct :: Ct -> Bool
+    is_local_given_ct = (given_here <&&> mentions_outer_var) . ctEvidence
+
+    is_local_given_equal_ct_list :: EqualCtList -> Bool
+    is_local_given_equal_ct_list [ct] = is_local_given_ct ct
+      -- Givens are always singletons in an EqualCtList
+    is_local_given_equal_ct_list _    = False
+
+    given_here :: CtEvidence -> Bool
+    -- True for a Given bound by the current implication,
+    -- i.e. the current level
+    given_here ev =  isGiven ev
+                  && tclvl == ctLocLevel (ctEvLoc ev)
+
+    mentions_outer_var :: CtEvidence -> Bool
+    mentions_outer_var = anyFreeVarsOfType is_outer_var . ctEvPred
+
+    is_outer_var :: TyCoVar -> Bool
+    is_outer_var tv
+      | isTyVar tv = tclvl `strictlyDeeperThan` tcTyVarLevel tv
+      | otherwise  = False
 
 -- | Returns Given constraints that might,
 -- potentially, match the given pred. This is used when checking to see if a



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564244cef7c6a106bbb9d893e63fd84126dcf842

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564244cef7c6a106bbb9d893e63fd84126dcf842
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201104/792e0cb5/attachment-0001.html>