[Git][ghc/ghc][wip/derived-refactor] Checkpoint for CI.
Richard Eisenberg
gitlab at gitlab.haskell.org
Thu Jun 25 16:40:25 UTC 2020
Richard Eisenberg pushed to branch wip/derived-refactor at Glasgow Haskell Compiler / GHC
Commits:
bb7b331e by Richard Eisenberg at 2020-06-25T17:40:07+01:00
Checkpoint for CI.
- - - - -
18 changed files:
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Solver/Interact.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- testsuite/tests/indexed-types/should_fail/ExplicitForAllFams4b.hs
- testsuite/tests/indexed-types/should_fail/ExplicitForAllFams4b.stderr
- testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
- testsuite/tests/indexed-types/should_fail/SimpleFail9.stderr
- − testsuite/tests/typecheck/should_compile/FD1.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/hole_constraints.stderr
- testsuite/tests/typecheck/should_compile/FD1.hs → testsuite/tests/typecheck/should_fail/FD1.hs
- + testsuite/tests/typecheck/should_fail/FD1.stderr
- testsuite/tests/typecheck/should_compile/FD2.hs → testsuite/tests/typecheck/should_fail/FD2.hs
- testsuite/tests/typecheck/should_compile/FD2.stderr → testsuite/tests/typecheck/should_fail/FD2.stderr
- testsuite/tests/typecheck/should_compile/FD3.hs → testsuite/tests/typecheck/should_fail/FD3.hs
- testsuite/tests/typecheck/should_compile/FD3.stderr → testsuite/tests/typecheck/should_fail/FD3.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -662,7 +662,14 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
-- See Note [Suppressing confusing errors]
suppress :: ErrorItem -> Bool
- suppress item = is_ww_fundep_item item
+ suppress item
+ | Wanted _ <- ei_flavour item
+ = is_ww_fundep_item item
+{- "RAE" || (not has_gadt_match_here &&
+ is_given_eq item (classifyPredType (ei_pred item)))
+-}
+ | otherwise
+ = False
-- report1: ones that should *not* be suppressed by
-- an insoluble somewhere else in the tree
@@ -693,14 +700,16 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
, ("Dicts", is_dict, False, mkGroupReporter mkDictErr) ]
-- report3: suppressed errors should be reported as categorized by either report1
- -- or report2.
- report3 = [ ("wanted/wanted fundeps", is_ww_fundep, True, mkGroupReporter mkEqErr) ]
+ -- or report2. Keep this in sync with the suppress function above
+ report3 = [ ("wanted/wanted fundeps", is_ww_fundep, True, mkGroupReporter mkEqErr)
+ , ("insoluble1c", is_given_eq, True, mkGivenErrorReporter ) ] -- "RAE"
-- rigid_nom_eq, rigid_nom_tv_eq,
is_dict, is_equality, is_ip, is_irred :: ErrorItem -> Pred -> Bool
is_given_eq item pred
- | EqPred {} <- pred = arisesFromGivens (ei_flavour item) (ei_loc item)
+ | Given <- ei_flavour item
+ , EqPred {} <- pred = True
| otherwise = False
-- I think all given residuals are equalities
@@ -742,7 +751,7 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
is_ww_fundep_item = isWantedWantedFunDepOrigin . errorItemOrigin
given_eq_spec -- See Note [Given errors]
- | has_gadt_match (cec_encl ctxt)
+ | has_gadt_match_here
= ("insoluble1a", is_given_eq, True, mkGivenErrorReporter)
| otherwise
= ("insoluble1b", is_given_eq, False, ignoreErrorReporter)
@@ -753,6 +762,7 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics
-- #13446 is an example
-- See Note [Given errors]
+ has_gadt_match_here = has_gadt_match (cec_encl ctxt)
has_gadt_match [] = False
has_gadt_match (implic : implics)
| PatSkol {} <- ic_info implic
@@ -787,9 +797,9 @@ isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of
Certain errors we might encounter are potentially confusing to users.
If there are any other errors to report, at all, we want to suppress these.
-Which errors (right now, only 1, but this may grow):
+Which errors:
- Errors which arise from the interaction of two Wanted fun-dep constraints.
+1) Errors which arise from the interaction of two Wanted fun-dep constraints.
Example:
class C a b | a -> b where
@@ -817,6 +827,14 @@ Which errors (right now, only 1, but this may grow):
both are givens, the error represents unreachable code. For
a Given/Wanted case, see #9612.
+2) Errors which arise from given functional dependencies. Functional
+ dependencies have no evidence, and so they are always Wanted -- we have no
+ evidence to supply to build a Given. So we can have a Wanted that arises
+ from Givens. These can be surprising for users. However, we still must
+ report (in contrast to Note [Given errors]): the (non-existent) evidence
+ might have been used to rewrite another Wanted. If we fail to report, then
+ we get an unfilled coercion hole. This happened in typecheck/should_fail/FD1.
+
Mechanism:
We use the `suppress` function within reportWanteds to filter out these two
=====================================
compiler/GHC/Tc/Solver/Interact.hs
=====================================
@@ -1820,7 +1820,7 @@ emitFunDepDeriveds work_rewriters fd_eqns
topReactionsStage :: WorkItem -> TcS (StopOrContinue Ct)
-- The work item does not react with the inert set,
--- so try interaction with top-level instances. Note:
+-- so try interaction with top-level instances.
topReactionsStage work_item
= do { traceTcS "doTopReact" (ppr work_item)
; case work_item of
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -56,7 +56,8 @@ module GHC.Tc.Types.Constraint (
RewriterSet(..), emptyRewriterSet, isEmptyRewriterSet,
-- exported concretely only for anyUnfilledCoercionHoles
- wantedRewriteWanted, rewriterSetFromCo, addRewriterSet,
+ wantedRewriteWanted, rewriterSetFromType, rewriterSetFromTypes, rewriterSetFromCo,
+ addRewriterSet,
wrapType,
@@ -1551,18 +1552,31 @@ addRewriterSet = coerce (addOneToUniqSet @CoercionHole)
-- | Makes a 'RewriterSet' from all the coercion holes that occur in the
-- given coercion.
rewriterSetFromCo :: Coercion -> RewriterSet
-rewriterSetFromCo co = appEndo (go_co co) emptyRewriterSet
- where
- go_co :: Coercion -> Endo RewriterSet
- (go_ty, _, go_co, _) = foldTyCo folder ()
+rewriterSetFromCo co = appEndo (rewriter_set_from_co co) emptyRewriterSet
+
+-- | Makes a 'RewriterSet' from all the coercion holes that occur in the
+-- given type.
+rewriterSetFromType :: Type -> RewriterSet
+rewriterSetFromType ty = appEndo (rewriter_set_from_ty ty) emptyRewriterSet
+-- | Makes a 'RewriterSet' from all the coercion holes that occur in the
+-- given types.
+rewriterSetFromTypes :: [Type] -> RewriterSet
+rewriterSetFromTypes tys = appEndo (rewriter_set_from_tys tys) emptyRewriterSet
+
+rewriter_set_from_ty :: Type -> Endo RewriterSet
+rewriter_set_from_tys :: [Type] -> Endo RewriterSet
+rewriter_set_from_co :: Coercion -> Endo RewriterSet
+(rewriter_set_from_ty, rewriter_set_from_tys, rewriter_set_from_co, _)
+ = foldTyCo folder ()
+ where
folder :: TyCoFolder () (Endo RewriterSet)
folder = TyCoFolder
{ tcf_view = noView
- , tcf_tyvar = \ _ tv -> go_ty (tyVarKind tv)
- , tcf_covar = \ _ cv -> go_ty (varType cv)
+ , tcf_tyvar = \ _ tv -> rewriter_set_from_ty (tyVarKind tv)
+ , tcf_covar = \ _ cv -> rewriter_set_from_ty (varType cv)
, tcf_hole = \ _ hole -> coerce (`addOneToUniqSet` hole) S.<>
- go_ty (varType (coHoleCoVar hole))
+ rewriter_set_from_ty (varType (coHoleCoVar hole))
, tcf_tycobinder = \ _ _ _ -> () }
{-
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -258,7 +258,7 @@ emitWantedEq origin t_or_k role ty1 ty2
, ctev_dest = HoleDest hole
, ctev_nosh = WDeriv
, ctev_loc = loc
- , ctev_rewriters = emptyRewriterSet }
+ , ctev_rewriters = rewriterSetFromTypes [ty1, ty2] }
; return (HoleCo hole) }
where
pty = mkPrimEqPredRole role ty1 ty2
=====================================
testsuite/tests/indexed-types/should_fail/ExplicitForAllFams4b.hs
=====================================
@@ -21,7 +21,12 @@ class C a where
instance C Int where
type forall a b. CT [a] (a,a) = Float
- type forall b. CT _ _ = Maybe b
-
data forall a b. CD [a] (a,a) = CD5 Float
+
+instance C Bool where
+ type forall b. CT _ _ = Maybe b
data forall b. CD _ _ = CD6 (Maybe b)
+
+instance C Double where
+ type forall b. CT _ _ = Bool
+ data forall b. CD _ _ = CD7
=====================================
testsuite/tests/indexed-types/should_fail/ExplicitForAllFams4b.stderr
=====================================
@@ -44,40 +44,38 @@ ExplicitForAllFams4b.hs:16:25: error:
but not bound on the LHS of the family instance
• In the newtype instance declaration for ‘L’
-ExplicitForAllFams4b.hs:23:3: error:
- • Type indexes must match class instance head
- Expected: CT Int _
- Actual: CT [a] (a, a)
+ExplicitForAllFams4b.hs:23:20: error:
+ • Couldn't match type ‘Int’ with ‘[a]’
+ when matching a family LHS with its class instance head
• In the type instance declaration for ‘CT’
In the instance declaration for ‘C Int’
-ExplicitForAllFams4b.hs:23:17: error:
- • Type variable ‘b’ is bound by a forall,
- but not used in the family instance
- • In the type instance declaration for ‘CT’
+ExplicitForAllFams4b.hs:24:3: error:
+ • Couldn't match type ‘Int’ with ‘[a]’
+ when matching a family LHS with its class instance head
+ • In the data instance declaration for ‘CD’
In the instance declaration for ‘C Int’
-ExplicitForAllFams4b.hs:24:15: error:
+ExplicitForAllFams4b.hs:27:15: error:
• Type variable ‘b’ is mentioned in the RHS,
but not bound on the LHS of the family instance
• In the type instance declaration for ‘CT’
- In the instance declaration for ‘C Int’
-
-ExplicitForAllFams4b.hs:26:3: error:
- • Type indexes must match class instance head
- Expected: CD Int _
- Actual: CD [a] (a, a)
- • In the data instance declaration for ‘CD’
- In the instance declaration for ‘C Int’
+ In the instance declaration for ‘C Bool’
-ExplicitForAllFams4b.hs:26:17: error:
+ExplicitForAllFams4b.hs:28:15: error:
• Type variable ‘b’ is mentioned in the RHS,
but not bound on the LHS of the family instance
• In the data instance declaration for ‘CD’
- In the instance declaration for ‘C Int’
+ In the instance declaration for ‘C Bool’
-ExplicitForAllFams4b.hs:27:15: error:
+ExplicitForAllFams4b.hs:31:15: error:
+ • Type variable ‘b’ is bound by a forall,
+ but not used in the family instance
+ • In the type instance declaration for ‘CT’
+ In the instance declaration for ‘C Double’
+
+ExplicitForAllFams4b.hs:32:15: error:
• Type variable ‘b’ is mentioned in the RHS,
but not bound on the LHS of the family instance
• In the data instance declaration for ‘CD’
- In the instance declaration for ‘C Int’
+ In the instance declaration for ‘C Double’
=====================================
testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
=====================================
@@ -1,12 +1,6 @@
SimpleFail2a.hs:11:3: error:
- • Type indexes must match class instance head
- Expected: Sd Int
- Actual: Sd a
+ • Couldn't match type ‘a’ with ‘Int’
+ when matching a family LHS with its class instance head
• In the data instance declaration for ‘Sd’
In the instance declaration for ‘C Int’
-
-SimpleFail2a.hs:11:11: error:
- Conflicting family instance declarations:
- Sd a -- Defined at SimpleFail2a.hs:11:11
- Sd Int -- Defined at SimpleFail2a.hs:12:11
=====================================
testsuite/tests/indexed-types/should_fail/SimpleFail9.stderr
=====================================
@@ -1,7 +1,6 @@
SimpleFail9.hs:16:3: error:
- • Type indexes must match class instance head
- Expected: S7 (a, Int)
- Actual: S7 (b, Int)
+ • Couldn't match type ‘a’ with ‘b’
+ when matching a family LHS with its class instance head
• In the data instance declaration for ‘S7’
In the instance declaration for ‘C7 Char (a, Int)’
=====================================
testsuite/tests/typecheck/should_compile/FD1.stderr deleted
=====================================
@@ -1,10 +0,0 @@
-
-FD1.hs:16:1: error:
- • Couldn't match expected type ‘a’ with actual type ‘Int -> Int’
- ‘a’ is a rigid type variable bound by
- the type signature for:
- plus :: forall a. E a (Int -> Int) => Int -> a
- at FD1.hs:15:1-38
- • The equation(s) for ‘plus’ have two value arguments,
- but its type ‘Int -> a’ has only one
- • Relevant bindings include plus :: Int -> a (bound at FD1.hs:16:1)
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -260,9 +260,6 @@ test('tc246', normal, compile, [''])
test('tc247', normal, compile, [''])
test('tc248', normal, compile, [''])
-test('FD1', normal, compile_fail, [''])
-test('FD2', normal, compile_fail, [''])
-test('FD3', normal, compile_fail, [''])
test('FD4', normal, compile, [''])
test('faxen', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_compile/hole_constraints.stderr
=====================================
@@ -47,8 +47,8 @@ hole_constraints.hs:16:35: warning: [-Wtyped-holes (in -Wdefault)]
mempty :: forall a. Monoid a => a
hole_constraints.hs:20:19: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: b
- Where: ‘b’ is a rigid type variable bound by
+ • Found hole: _ :: a
+ Where: ‘a’ is a rigid type variable bound by
the type signature for:
castWith :: forall a b. (a :~: b) -> a -> b
at hole_constraints.hs:19:1-29
=====================================
testsuite/tests/typecheck/should_compile/FD1.hs → testsuite/tests/typecheck/should_fail/FD1.hs
=====================================
=====================================
testsuite/tests/typecheck/should_fail/FD1.stderr
=====================================
@@ -0,0 +1,15 @@
+
+FD1.hs:15:9: error:
+ • Couldn't match type ‘a’ with ‘Int -> Int’
+ arising from a functional dependency between:
+ constraint ‘E a (Int -> Int)’
+ arising from the type signature for:
+ plus :: forall a. E a (Int -> Int) => Int -> a
+ instance ‘E a1 a1’ at FD1.hs:13:10-14
+ ‘a’ is a rigid type variable bound by
+ the type signature for:
+ plus :: forall a. E a (Int -> Int) => Int -> a
+ at FD1.hs:15:9-38
+ • In the ambiguity check for ‘plus’
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ In the type signature: plus :: (E a (Int -> Int)) => Int -> a
=====================================
testsuite/tests/typecheck/should_compile/FD2.hs → testsuite/tests/typecheck/should_fail/FD2.hs
=====================================
=====================================
testsuite/tests/typecheck/should_compile/FD2.stderr → testsuite/tests/typecheck/should_fail/FD2.stderr
=====================================
@@ -1,6 +1,17 @@
-FD2.hs:26:36: error:
- • Couldn't match expected type ‘e’ with actual type ‘e1’
+FD2.hs:24:12: error:
+ • Couldn't match type ‘e1’ with ‘e’
+ arising from a functional dependency between constraints:
+ ‘Elem a e1’
+ arising from the type signature for:
+ mf :: forall e.
+ Elem a e =>
+ e -> Maybe e -> Maybe e at FD2.hs:24:12-54
+ ‘Elem a e’
+ arising from the type signature for:
+ foldr1 :: forall e.
+ Elem a e =>
+ (e -> e -> e) -> a -> e at FD2.hs:21:13-47
‘e1’ is a rigid type variable bound by
the type signature for:
mf :: forall e1. Elem a e1 => e1 -> Maybe e1 -> Maybe e1
@@ -9,12 +20,13 @@ FD2.hs:26:36: error:
the type signature for:
foldr1 :: forall e. Elem a e => (e -> e -> e) -> a -> e
at FD2.hs:21:13-47
- • In the first argument of ‘f’, namely ‘x’
- In the first argument of ‘Just’, namely ‘(f x y)’
- In the expression: Just (f x y)
+ • In an equation for ‘foldr1’:
+ foldr1 f xs
+ = fromMaybe (error "foldr1: empty structure") (foldr mf Nothing xs)
+ where
+ mf :: Elem a e => (e -> Maybe e -> Maybe e)
+ mf x Nothing = Just x
+ mf x (Just y) = Just (f x y)
• Relevant bindings include
- y :: e1 (bound at FD2.hs:26:23)
- x :: e1 (bound at FD2.hs:26:15)
- mf :: e1 -> Maybe e1 -> Maybe e1 (bound at FD2.hs:25:12)
f :: e -> e -> e (bound at FD2.hs:22:10)
foldr1 :: (e -> e -> e) -> a -> e (bound at FD2.hs:22:3)
=====================================
testsuite/tests/typecheck/should_compile/FD3.hs → testsuite/tests/typecheck/should_fail/FD3.hs
=====================================
=====================================
testsuite/tests/typecheck/should_compile/FD3.stderr → testsuite/tests/typecheck/should_fail/FD3.stderr
=====================================
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -564,3 +564,6 @@ test('T17021b', normal, compile_fail, [''])
test('T17955', normal, compile_fail, [''])
test('T17173', normal, compile_fail, [''])
test('FunDepOrigin1b', normal, compile_fail, [''])
+test('FD1', normal, compile_fail, [''])
+test('FD2', normal, compile_fail, [''])
+test('FD3', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb7b331e9627c637fc7ac5f7cdacacd5b9dfc665
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb7b331e9627c637fc7ac5f7cdacacd5b9dfc665
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/20200625/7f79becc/attachment-0001.html>
More information about the ghc-commits
mailing list