[Git][ghc/ghc][wip/T17656] Wibbles
Simon Peyton Jones
gitlab at gitlab.haskell.org
Thu Nov 26 23:44:56 UTC 2020
Simon Peyton Jones pushed to branch wip/T17656 at Glasgow Haskell Compiler / GHC
Commits:
061eee91 by Simon Peyton Jones at 2020-11-26T23:44:19+00:00
Wibbles
- - - - -
5 changed files:
- compiler/GHC/Tc/Solver/Canonical.hs
- testsuite/tests/ghci.debugger/scripts/break012.stdout
- testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr
- testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
- testsuite/tests/typecheck/should_fail/T7453.stderr
Changes:
=====================================
compiler/GHC/Tc/Solver/Canonical.hs
=====================================
@@ -2269,7 +2269,7 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco
-- This function handles the case where one side is a tyvar and the other is
-- a type family application. Which to put on the left?
--- If we can unify the variable, put it on the left, as this may be our only
+-- If the tyvar is a meta-tyvar, put it on the left, as this may be our only
-- shot to unify.
-- Otherwise, put the function on the left, because it's generally better to
-- rewrite away function calls. This makes types smaller. And it seems necessary:
@@ -2288,17 +2288,16 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco)
-> MCoercion -- :: kind(rhs) ~N kind(lhs)
-> TcS (StopOrContinue Ct)
canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco
- = do { tclvl <- getTcLevel
- ; dflags <- getDynFlags
- ; if | isTouchableMetaTyVar tclvl tv1
- , MTVU_OK _ <- checkTyVarEq dflags YesTypeFamilies tv1 (ps_xi2 `mkCastTyMCo` mco)
- -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1)
- (ps_xi2 `mkCastTyMCo` mco)
+ = do { -- tclvl <- getTcLevel
+ -- dflags <- getDynFlags
+ ; if | isMetaTyVar tv1
+ -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1)
+ (ps_xi2 `mkCastTyMCo` mco)
| otherwise
- -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped
+ -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped
(mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2)
mco
- ; canEqCanLHSFinish new_ev eq_rel IsSwapped
+ ; canEqCanLHSFinish new_ev eq_rel IsSwapped
(TyFamLHS fun_tc2 fun_args2)
(ps_xi1 `mkCastTyMCo` sym_mco) } }
where
=====================================
testsuite/tests/ghci.debugger/scripts/break012.stdout
=====================================
@@ -1,14 +1,14 @@
Stopped in Main.g, break012.hs:5:10-18
-_result :: (p, a1 -> a1, (), a -> a -> a) = _
-a :: p = _
-b :: a2 -> a2 = _
+_result :: (a1, a2 -> a2, (), a -> a -> a) = _
+a :: a1 = _
+b :: a3 -> a3 = _
c :: () = _
d :: a -> a -> a = _
-a :: p
-b :: a2 -> a2
+a :: a1
+b :: a3 -> a3
c :: ()
d :: a -> a -> a
-a = (_t1::p)
-b = (_t2::a2 -> a2)
+a = (_t1::a1)
+b = (_t2::a3 -> a3)
c = (_t3::())
d = (_t4::a -> a -> a)
=====================================
testsuite/tests/partial-sigs/should_fail/ScopedNamedWildcardsBad.stderr
=====================================
@@ -1,6 +1,11 @@
-ScopedNamedWildcardsBad.hs:8:21: error:
+ScopedNamedWildcardsBad.hs:11:15: error:
• Couldn't match expected type ‘Bool’ with actual type ‘Char’
- • In the first argument of ‘not’, namely ‘x’
- In the expression: not x
- In an equation for ‘v’: v = not x
+ • In the first argument of ‘g’, namely ‘'x'’
+ In the expression: g 'x'
+ In the expression:
+ let
+ v = not x
+ g :: _a -> _a
+ g x = x
+ in (g 'x')
=====================================
testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
=====================================
@@ -1,6 +1,6 @@
ExpandSynsFail2.hs:19:37: error:
- • Couldn't match type ‘Int’ with ‘Bool’
+ • Couldn't match type ‘Bool’ with ‘Int’
Expected: ST s Foo
Actual: MyBarST s
Type synonyms expanded:
=====================================
testsuite/tests/typecheck/should_fail/T7453.stderr
=====================================
@@ -1,6 +1,8 @@
-T7453.hs:10:30: error:
- • Couldn't match expected type ‘t’ with actual type ‘p’
+T7453.hs:9:15: error:
+ • Couldn't match type ‘t’ with ‘p’
+ Expected: Id t
+ Actual: Id p
‘t’ is a rigid type variable bound by
the type signature for:
z :: forall t. Id t
@@ -8,17 +10,29 @@ T7453.hs:10:30: error:
‘p’ is a rigid type variable bound by
the inferred type of cast1 :: p -> a
at T7453.hs:(7,1)-(10,30)
- • In the first argument of ‘Id’, namely ‘v’
- In the expression: Id v
- In an equation for ‘aux’: aux = Id v
+ • In the expression: aux
+ In an equation for ‘z’:
+ z = aux
+ where
+ aux = Id v
+ In an equation for ‘cast1’:
+ cast1 v
+ = runId z
+ where
+ z :: Id t
+ z = aux
+ where
+ aux = Id v
• Relevant bindings include
- aux :: Id t (bound at T7453.hs:10:21)
+ aux :: Id p (bound at T7453.hs:10:21)
z :: Id t (bound at T7453.hs:9:11)
v :: p (bound at T7453.hs:7:7)
cast1 :: p -> a (bound at T7453.hs:7:1)
-T7453.hs:16:33: error:
- • Couldn't match expected type ‘t1’ with actual type ‘p’
+T7453.hs:15:15: error:
+ • Couldn't match type ‘t1’ with ‘p’
+ Expected: () -> t1
+ Actual: () -> p
‘t1’ is a rigid type variable bound by
the type signature for:
z :: forall t1. () -> t1
@@ -26,11 +40,21 @@ T7453.hs:16:33: error:
‘p’ is a rigid type variable bound by
the inferred type of cast2 :: p -> t
at T7453.hs:(13,1)-(16,33)
- • In the first argument of ‘const’, namely ‘v’
- In the expression: const v
- In an equation for ‘aux’: aux = const v
+ • In the expression: aux
+ In an equation for ‘z’:
+ z = aux
+ where
+ aux = const v
+ In an equation for ‘cast2’:
+ cast2 v
+ = z ()
+ where
+ z :: () -> t
+ z = aux
+ where
+ aux = const v
• Relevant bindings include
- aux :: b -> t1 (bound at T7453.hs:16:21)
+ aux :: forall {b}. b -> p (bound at T7453.hs:16:21)
z :: () -> t1 (bound at T7453.hs:15:11)
v :: p (bound at T7453.hs:13:7)
cast2 :: p -> t (bound at T7453.hs:13:1)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/061eee913a913b934845549ba90a4e8381454b1d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/061eee913a913b934845549ba90a4e8381454b1d
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/20201126/336a539c/attachment-0001.html>
More information about the ghc-commits
mailing list