[Git][ghc/ghc][master] Fix issue #18262 by zonking constraints after solving
Marge Bot
gitlab at gitlab.haskell.org
Wed Jun 24 02:49:03 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00
Fix issue #18262 by zonking constraints after solving
Zonk residual constraints in checkForExistence to reveal user type
errors.
Previously when `:instances` was used with instances that have TypeError
constraints the result would look something like:
instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10
whereas after zonking, `:instances` now sees the `TypeError` and
properly eliminates the constraint from the results.
- - - - -
6 changed files:
- compiler/GHC/Runtime/Eval.hs
- docs/users_guide/ghci.rst
- + testsuite/tests/ghci/T18262/T18262.hs
- + testsuite/tests/ghci/T18262/T18262.script
- + testsuite/tests/ghci/T18262/T18262.stdout
- + testsuite/tests/ghci/T18262/all.T
Changes:
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -118,11 +118,8 @@ import GHC.Tc.Module ( runTcInteractive, tcRnType, loadUnqualIfaces )
import GHC.Tc.Utils.Zonk ( ZonkFlexi (SkolemiseFlexi) )
import GHC.Tc.Utils.Env (tcGetInstEnvs)
import GHC.Tc.Utils.Instantiate (instDFunType)
-import GHC.Tc.Solver (solveWanteds)
+import GHC.Tc.Solver (simplifyWantedsTcM)
import GHC.Tc.Utils.Monad
-import GHC.Tc.Types.Evidence
-import Data.Bifunctor (second)
-import GHC.Tc.Solver.Monad (runTcS)
import GHC.Core.Class (classTyCon)
-- -----------------------------------------------------------------------------
@@ -1069,24 +1066,22 @@ parseInstanceHead str = withSession $ \hsc_env0 -> do
return ty
-- Get all the constraints required of a dictionary binding
-getDictionaryBindings :: PredType -> TcM WantedConstraints
+getDictionaryBindings :: PredType -> TcM CtEvidence
getDictionaryBindings theta = do
dictName <- newName (mkDictOcc (mkVarOcc "magic"))
let dict_var = mkVanillaGlobal dictName theta
loc <- getCtLocM (GivenOrigin UnkSkol) Nothing
- -- Generate a wanted constraint here because at the end of constraint
+ -- Generate a wanted here because at the end of constraint
-- solving, most derived constraints get thrown away, which in certain
-- cases, notably with quantified constraints makes it impossible to rule
-- out instances as invalid. (See #18071)
- let wCs = mkSimpleWC [CtWanted {
+ return CtWanted {
ctev_pred = varType dict_var,
ctev_dest = EvVarDest dict_var,
ctev_nosh = WDeriv,
ctev_loc = loc
- }]
-
- return wCs
+ }
-- Find instances where the head unifies with the provided type
findMatchingInstances :: Type -> TcM [(ClsInst, [DFunInstType])]
@@ -1142,17 +1137,18 @@ checkForExistence clsInst mb_inst_tys = do
-- thetas of clsInst.
(tys, thetas) <- instDFunType (is_dfun clsInst) mb_inst_tys
wanteds <- mapM getDictionaryBindings thetas
- (residuals, _) <- second evBindMapBinds <$> runTcS (solveWanteds (unionsWC wanteds))
-
- let WC { wc_simple = simples, wc_impl = impls } = (dropDerivedWC residuals)
+ -- It's important to zonk constraints after solving in order to expose things like TypeErrors
+ -- which otherwise appear as opaque type variables. (See #18262).
+ WC { wc_simple = simples, wc_impl = impls } <- simplifyWantedsTcM wanteds
- let resPreds = mapBag ctPred simples
-
- if allBag isSatisfiablePred resPreds && solvedImplics impls
- then return . Just $ substInstArgs tys (bagToList resPreds) clsInst
+ if allBag allowedSimple simples && solvedImplics impls
+ then return . Just $ substInstArgs tys (bagToList (mapBag ctPred simples)) clsInst
else return Nothing
where
+ allowedSimple :: Ct -> Bool
+ allowedSimple ct = isSatisfiablePred (ctPred ct)
+
solvedImplics :: Bag Implication -> Bool
solvedImplics impls = allBag (isSolvedStatus . ic_status) impls
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -2518,6 +2518,25 @@ commonly used commands.
instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’
instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’
+ Only instances which could potentially be used will be displayed in the results.
+ Instances which require unsatisfiable constraints such as ``TypeError`` will not be
+ included. In the following example, the instance for ``A`` is not shown because it cannot
+ be used.
+
+ .. code-block:: none
+ ghci>:set -XDataKinds -XUndecidableInstances
+ ghci>import GHC.TypeLits
+ ghci>class A a
+ ghci>instance (TypeError (Text "Not possible")) => A Bool
+ ghci>:instances Bool
+ instance Eq Bool -- Defined in ‘GHC.Classes’
+ instance Ord Bool -- Defined in ‘GHC.Classes’
+ instance Enum Bool -- Defined in ‘GHC.Enum’
+ instance Show Bool -- Defined in ‘GHC.Show’
+ instance Read Bool -- Defined in ‘GHC.Read’
+ instance Bounded Bool -- Defined in ‘GHC.Enum’
+
+
.. ghci-cmd:: :issafe; [⟨module⟩]
Displays Safe Haskell information about the given module (or the
=====================================
testsuite/tests/ghci/T18262/T18262.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies, FlexibleInstances, DataKinds, UndecidableInstances #-}
+
+import GHC.TypeLits
+
+data C = A | B
+
+class Err (a :: C)
+
+instance (TypeError ('Text "uh-oh")) => Err 'A
+instance Err 'B
=====================================
testsuite/tests/ghci/T18262/T18262.script
=====================================
@@ -0,0 +1,6 @@
+:load T18262.hs
+:set -XDataKinds
+-- Should report no instances
+:instances 'A
+-- Should report an instance with no constraints
+:instances 'B
=====================================
testsuite/tests/ghci/T18262/T18262.stdout
=====================================
@@ -0,0 +1 @@
+instance [safe] Err 'B -- Defined at T18262.hs:10:10
=====================================
testsuite/tests/ghci/T18262/all.T
=====================================
@@ -0,0 +1 @@
+test('T18262', [extra_files(['T18262.hs'])], ghci_script, ['T18262.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a9006b068ba9af9d41711307a8d597d2bb03d7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a9006b068ba9af9d41711307a8d597d2bb03d7
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/20200623/084c4f5e/attachment-0001.html>
More information about the ghc-commits
mailing list