[Git][ghc/ghc][wip/T23070-dicts] Wibbles

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Fri May 19 21:37:09 UTC 2023



Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC


Commits:
6aab8150 by Simon Peyton Jones at 2023-05-19T22:36:53+01:00
Wibbles

- - - - -


23 changed files:

- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Irred.hs
- compiler/GHC/Tc/Validity.hs
- testsuite/tests/gadt/T3651.hs
- testsuite/tests/gadt/T3651.stderr
- testsuite/tests/gadt/T7558.hs
- testsuite/tests/gadt/T7558.stderr
- testsuite/tests/gadt/all.T
- testsuite/tests/ghci/scripts/Defer02.stderr
- testsuite/tests/indexed-types/should_fail/T13674.stderr
- testsuite/tests/pmcheck/should_compile/T12957a.stderr
- testsuite/tests/pmcheck/should_compile/T15450.hs
- testsuite/tests/pmcheck/should_compile/T15450.stderr
- testsuite/tests/typecheck/should_fail/GivenForallLoop.hs
- testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
- testsuite/tests/typecheck/should_fail/T14325.hs
- testsuite/tests/typecheck/should_fail/T14325.stderr
- testsuite/tests/typecheck/should_fail/T20189.hs
- testsuite/tests/typecheck/should_fail/T20189.stderr
- testsuite/tests/typecheck/should_run/Defer01.hs


Changes:

=====================================
compiler/GHC/Core/Predicate.hs
=====================================
@@ -38,6 +38,7 @@ import GHC.Prelude
 
 import GHC.Core.Type
 import GHC.Core.Class
+import GHC.Core.TyCo.Compare( eqType )
 import GHC.Core.TyCon
 import GHC.Core.TyCon.RecWalk
 import GHC.Types.Var
@@ -262,12 +263,11 @@ isIPClass cls = cls `hasKey` ipClassKey
 
 -- | Decomposes a predicate if it is an implicit parameter. Does not look in
 -- superclasses. See also [Local implicit parameters].
-isIPPred_maybe :: Class -> [Type] -> Maybe (FastString, Type)
+isIPPred_maybe :: Class -> [Type] -> Maybe (Type, Type)
 isIPPred_maybe cls tys
   | isIPClass cls
   , [t1,t2] <- tys
-  , Just x <- isStrLitTy t1
-  = Just (x,t2)
+  = Just (t1,t2)
   | otherwise
   = Nothing
 
@@ -311,29 +311,29 @@ isIPLikePred :: Type -> Bool
 -- See Note [Local implicit parameters]
 isIPLikePred pred = mentions_ip_pred initIPRecTc Nothing pred
 
-mentionsIP :: FastString -> Class -> [Type] -> Bool
--- Is (cls tys) an implicit parameter with string `fs`, or
+mentionsIP :: Type -> Class -> [Type] -> Bool
+-- Is (cls tys) an implicit parameter with key `str_ty`, or
 -- is any of its superclasses such at thing.
 -- See Note [Local implicit parameters]
-mentionsIP fs cls tys = mentions_ip initIPRecTc (Just fs) cls tys
+mentionsIP str_ty cls tys = mentions_ip initIPRecTc (Just str_ty) cls tys
 
-mentions_ip :: RecTcChecker -> Maybe FastString -> Class -> [Type] -> Bool
-mentions_ip rec_clss mb_fs cls tys
-  | Just (fs', _) <- isIPPred_maybe cls tys
-  = case mb_fs of
+mentions_ip :: RecTcChecker -> Maybe Type -> Class -> [Type] -> Bool
+mentions_ip rec_clss mb_str_ty cls tys
+  | Just (str_ty', _) <- isIPPred_maybe cls tys
+  = case mb_str_ty of
        Nothing -> True
-       Just fs -> fs == fs'
+       Just str_ty -> str_ty `eqType` str_ty'
   | otherwise
-  = or [ mentions_ip_pred rec_clss mb_fs (classMethodInstTy sc_sel_id tys)
+  = or [ mentions_ip_pred rec_clss mb_str_ty (classMethodInstTy sc_sel_id tys)
        | sc_sel_id <- classSCSelIds cls ]
 
-mentions_ip_pred :: RecTcChecker -> Maybe FastString -> Type -> Bool
-mentions_ip_pred  rec_clss mb_fs ty
+mentions_ip_pred :: RecTcChecker -> Maybe Type -> Type -> Bool
+mentions_ip_pred  rec_clss mb_str_ty ty
   | Just (cls, tys) <- getClassPredTys_maybe ty
   , let tc = classTyCon cls
   , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss
                       else checkRecTc rec_clss tc
-  = mentions_ip rec_clss' mb_fs cls tys
+  = mentions_ip rec_clss' mb_str_ty cls tys
   | otherwise
   = False -- Includes things like (D []) where D is
           -- a Constraint-ranged family; #7785


=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -1007,7 +1007,7 @@ simplifyAmbiguityCheck ty wanteds
 
        ; traceTc "End simplifyAmbiguityCheck }" empty
 
-       -- Normally report all errors; but with -XAllowAmbiguousTypes
+{-     -- Normally report all errors; but with -XAllowAmbiguousTypes
        -- report only insoluble ones, since they represent genuinely
        -- inaccessible code
        ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes
@@ -1015,6 +1015,8 @@ simplifyAmbiguityCheck ty wanteds
        ; unless (allow_ambiguous && not (insolubleWC final_wc))
                 (discardResult (reportUnsolved final_wc))
        ; traceTc "reportUnsolved(ambig) }" empty
+-}
+       ; discardResult (reportUnsolved final_wc)
 
        ; return () }
 


=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -212,6 +212,8 @@ in two places:
   with (?x::ty). See Note [Local implicit parameters] in GHC.Core.Predicate.
   An important special case is constraint tuples like [G] (% ?x::ty, Eq a )
 
+  Example in #14218.
+
 * Wrinkle (SIP2): we delete dictionaries in inert_dicts, but we don't need to
   look in inert_solved_dicts.  They are never implicit parameters.  See
   Note [Solved dictionaries] in GHC.Tc.Solver.InertSet
@@ -347,36 +349,23 @@ I tried treating tuple constraints, such as (% Eq a, Show a %), rather like
 equality-class constraints (see Note [Solving equality classes]). That is, by
 eagerly decomposing tuple-constraints into their component (Eq a) and (Show a).
 
-But discarding the tuple Given (which "replacing" does) means that
-we may have to reconstruct it for a recursive call, and the optimiser isn't
-quite clever enough to figure that out: see #10359 and its test case; and #23398.
-This is less pressing for equality classes because they have to be unpacked
-strictly, so CSE-ing away the reconstruction works fine.
-
-
-(NC2) Because of this replacement, we don't need do the fancy footwork
-  of Note [Solving superclass constraints], so the computation of `sc_loc`
-  in `mk_strict_superclasses` can be simpler.
-
-  For tuple predicates, this matters, because their size can be large,
-  and we don't want to add a big class to the size of the dictionaries
-  in the chain. When we get down to a base predicate, we'll include
-  its size. See #10335
-
-And less obviously to:
-
-* Tuple classes.  For reasons described in GHC.Tc.Solver.Types
-  Note [Shadowing of implicit parameters], we may have a constraint
-     [W] (?x::Int, C a)
-  with an exactly-matching Given constraint.  We must decompose this
-  tuple and solve the components separately, otherwise we won't solve
-  it at all!  It is perfectly safe to decompose it, because again the
-  superclasses invert the instance;  e.g.
-      class (c1, c2) => (% c1, c2 %)
-      instance (c1, c2) => (% c1, c2 %)
-  Example in #14218
-
-Examples: T5853, T10432, T5315, T9222, T2627b, T3028b
+But discarding the tuple Given (which "replacing" does) means that we may
+have to reconstruct it for a recursive call.  For example
+    f :: (% Eq a, Show a %) => blah
+    f x = ....(f x')....
+If we decomposed eagerly we'd get
+    f = \(d : (% Eq a, Show a %)).
+         let de = fst d
+             ds = snd d
+         in ....(f (% de, ds %))...
+and the optimiser may not be clever enough to transform (f (% de, ds %)) into
+(f d). See #10359 and its test case, and #23398.  (This issue is less pressing for
+equality classes because they have to be unpacked strictly, so CSE-ing away
+the reconstruction works fine.
+
+So at the moment we don't decompose tuple constraints eagerly; instead we mostly
+just treat them like other constraints. There is a bit of special treatment:
+search for isCTupleClass.
 -}
 
 solveEqualityDict :: CtEvidence -> Class -> [Type] -> SolverStage Void
@@ -912,7 +901,10 @@ matchClassInst dflags inerts clas tys loc
 -- whether top level, or local quantified constraints.
 -- See Note [Instance and Given overlap]
   | not (xopt LangExt.IncoherentInstances dflags)
-  , not (isCTupleClass clas)  -- It is always safe to unpack constraint tuples
+  , not (isCTupleClass clas)
+        -- It is always safe to unpack constraint tuples
+        -- And if we don't do so, we may never solve it at all
+        -- See Note [Solving tuple constraints]
   , not (noMatchableGivenDicts inerts loc clas tys)
   = do { traceTcS "Delaying instance application" $
            vcat [ text "Work item:" <+> pprClassPred clas tys ]
@@ -938,16 +930,6 @@ matchClassInst dflags inerts clas tys loc
   where
     pred = mkClassPred clas tys
 
-{-
--- | If a class is "naturally coherent", then we needn't worry at all, in any
--- way, about overlapping/incoherent instances. Just solve the thing!
--- See Note [Naturally coherent classes]
--- See also Note [The equality types story] in GHC.Builtin.Types.Prim.
-naturallyCoherentClass :: Class -> Bool
-naturallyCoherentClass cls
-  = isCTupleClass cls || isEqualityClass cls
--}
-
 {- Note [Instance and Given overlap]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Example, from the OutsideIn(X) paper:
@@ -1027,82 +1009,6 @@ All of this is disgustingly delicate, so to discourage people from writing
 simplifiable class givens, we warn about signatures that contain them;
 see GHC.Tc.Validity Note [Simplifiable given constraints].
 
-Note [Naturally coherent classes]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A few built-in classes are "naturally coherent".  This term means that
-the "instance" for the class is bidirectional with its superclass(es).
-For example, consider (~~), which behaves as if it was defined like
-this:
-  class a ~# b => a ~~ b
-  instance a ~# b => a ~~ b
-(See Note [The equality types story] in GHC.Builtin.Types.Prim.)
-
-PS: the term "naturally coherent" doesn't really seem helpful.
-Perhaps "invertible" or "bidirectional" or something?  I left it for
-now though.
-
-For naturally coherent classes:
-
-(NC1) For Givens, when expanding the superclasses of a naturally coherent class,
-  we can /replace/ the constraint with its superclasses (which, remember, are
-  equally powerful) rather than /adding/ them. This can make a huge difference.
-  Consider T17836, which has a constraint like
-      forall b,c. a ~ (b,c) =>
-        forall d,e. c ~ (d,e) =>
-          ...etc...
-  If we just /add/ the superclasses of [G] g1:a ~ (b,c), we'll put
-  [G] g1:(a~(b,c)) in the inert set and emit [G] g2:a ~# (b,c).  That will
-  kick out g1, and it'll be re-inserted as [G] g1':(b,c)~(b,c) which does
-  no good to anyone.  When the implication is deeply nested, this has
-  quadratic cost, and no benefit.  Just replace!
-
-  Originally I tried this for all naturally-coherent classes, including
-  tuples.  But discarding the tuple Given (which "replacing" does) means that
-  we may have to reconstruct it for a recursive call, and the optimiser isn't
-  quite clever enough to figure that out: see #10359 and its test case.
-  This is less pressing for equality classes because they have to be unpacked
-  strictly, so CSE-ing away the reconstuction works fine.  Hence the use
-  of isEqualityClass rather than naturallyCoherentClass in canDictCt.
-  A bit ad-hoc.
-
-(NC2) Because of this replacement, we don't need do the fancy footwork
-  of Note [Solving superclass constraints], so the computation of `sc_loc`
-  in `mk_strict_superclasses` can be simpler.
-
-  For tuple predicates, this matters, because their size can be large,
-  and we don't want to add a big class to the size of the dictionaries
-  in the chain. When we get down to a base predicate, we'll include
-  its size. See #10335
-
-(NC3) Faced with [W] t1 ~ t2, it's always OK to reduce it to [W] t1 ~# t2,
-  without worrying about Note [Instance and Given overlap].  Why?  Because
-  if we had [G] s1 ~ s2, then we'd get the superclass [G] s1 ~# s2, and
-  so the reduction of the [W] constraint does not risk losing any solutions.
-
-  On the other hand, it can be fatal to /fail/ to reduce such equalities
-  on the grounds of Note [Instance and Given overlap], because many good
-  things flow from [W] t1 ~# t2.
-
-The same reasoning applies to
-
-* (~~)        heqTyCon
-* (~)         eqTyCon
-* Coercible   coercibleTyCon
-
-And less obviously to:
-
-* Tuple classes.  For reasons described in GHC.Tc.Solver.Types
-  Note [Shadowing of implicit parameters], we may have a constraint
-     [W] (?x::Int, C a)
-  with an exactly-matching Given constraint.  We must decompose this
-  tuple and solve the components separately, otherwise we won't solve
-  it at all!  It is perfectly safe to decompose it, because again the
-  superclasses invert the instance;  e.g.
-      class (c1, c2) => (% c1, c2 %)
-      instance (c1, c2) => (% c1, c2 %)
-  Example in #14218
-
-Examples: T5853, T10432, T5315, T9222, T2627b, T3028b
 
 Note [Local instances and incoherence]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2093,10 +1999,14 @@ mk_strict_superclasses fuel rec_clss
             `App` (evId evar `mkVarApps` (tvs ++ dict_ids))
             `mkVarApps` sc_tvs
 
-    sc_loc | isCTupleClass cls
-           = loc  -- See (NC2) in Note [Naturally coherent classes]
-           | otherwise
-           = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) }
+    sc_loc | isCTupleClass cls = loc
+           | otherwise         = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) }
+           -- isCTupleClass: we don't want tuples to mess up the size calculations
+           -- of Note [Solving superclass constraints]. For tuple predicates, this
+           -- matters, because their size can be large, and we don't want to add a
+           -- big class to the size of the dictionaries in the chain. When we get
+           -- down to a base predicate, we'll include its size. See #10335.
+           -- See Note [Solving tuple constraints]
 
     -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance
     -- for explanation of GivenSCOrigin and Note [Replacement vs keeping] in


=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -79,7 +79,6 @@ import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
 import GHC.Data.Maybe
 import GHC.Data.Bag
-import GHC.Data.FastString
 
 import Data.List.NonEmpty ( NonEmpty(..), (<|) )
 import qualified Data.List.NonEmpty as NE
@@ -1326,14 +1325,14 @@ delDict (DictCt { di_cls = cls, di_tys = tys }) m
 
 delIPDict :: DictCt -> DictMap DictCt -> DictMap DictCt
 delIPDict dict@(DictCt { di_cls = cls, di_tys = tys }) dict_map
-  | Just (fs, _) <- isIPPred_maybe cls tys
-  = filterDicts (doesn't_match fs) dict_map
+  | Just (str_ty, _) <- isIPPred_maybe cls tys
+  = filterDicts (doesn't_match str_ty) dict_map
   | otherwise
   = pprPanic "delIPDict" (ppr dict)
  where
-    doesn't_match :: FastString -> DictCt -> Bool
-    doesn't_match fs (DictCt { di_cls = cls, di_tys = tys })
-      = not (mentionsIP fs cls tys)
+    doesn't_match :: Type -> DictCt -> Bool
+    doesn't_match str_ty (DictCt { di_cls = cls, di_tys = tys })
+      = not (mentionsIP str_ty cls tys)
 
 addDict :: DictCt -> DictMap DictCt -> DictMap DictCt
 addDict item@(DictCt { di_cls = cls, di_tys = tys }) dm


=====================================
compiler/GHC/Tc/Solver/Irred.hs
=====================================
@@ -64,8 +64,7 @@ try_inert_irreds :: InertCans -> IrredCt -> TcS (StopOrContinue ())
 
 try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason })
   | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w
-  , ((irred_i, swap) : _rest) <- pprTrace "try_inert_irreds" (ppr ev_w $$ ppr matching_irreds) $
-                                 bagToList matching_irreds
+  , ((irred_i, swap) : _rest) <- bagToList matching_irreds
         -- See Note [Multiple matching irreds]
   , let ev_i = irredCtEvidence irred_i
         ct_i = CIrredCan irred_i


=====================================
compiler/GHC/Tc/Validity.hs
=====================================
@@ -233,20 +233,20 @@ so we can take their type variables into account as part of the
 checkAmbiguity :: UserTypeCtxt -> Type -> TcM ()
 checkAmbiguity ctxt ty
   | wantAmbiguityCheck ctxt
-  = do { traceTc "Ambiguity check for" (ppr ty)
+  = do { traceTc "Ambiguity check for {" (ppr ty)
          -- Solve the constraints eagerly because an ambiguous type
          -- can cause a cascade of further errors.  Since the free
          -- tyvars are skolemised, we can safely use tcSimplifyTop
        ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes
        ; unless allow_ambiguous $
          do { (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $
-                            captureConstraints $
-                            tcSubTypeAmbiguity ctxt ty ty
-                            -- See Note [Ambiguity check and deep subsumption]
-                            -- in GHC.Tc.Utils.Unify
-           ; simplifyAmbiguityCheck ty wanted }
+                                 captureConstraints $
+                                 tcSubTypeAmbiguity ctxt ty ty
+                                 -- See Note [Ambiguity check and deep subsumption]
+                                 -- in GHC.Tc.Utils.Unify
+            ; simplifyAmbiguityCheck ty wanted }
 
-       ; traceTc "Done ambiguity check for" (ppr ty) }
+       ; traceTc "} Done ambiguity check for" (ppr ty) }
 
   | otherwise
   = return ()


=====================================
testsuite/tests/gadt/T3651.hs
=====================================
@@ -15,12 +15,12 @@ unsafe1 B U = ()
      [G] a ~ () => [G] a ~ Bool => [W] Bool ~ a
 
 By the time we get to the Wanted we have:
-    inert:  [G] a ~ Bool    (CEqCan)
-            [G] () ~ Bool   (CIrredCan)
+    inert:  [G] a ~# Bool    (CEqCan)
+            [G] () ~# Bool   (CIrredCan)
     work: [W] Bool ~ a
 
-We rewrite with the CEqCan to get [W] Bool ~ (), which is
-insoluble, and which we decline to solve from [G] () ~ Bool
+We rewrite with the CEqCan to get [W] Bool ~ (); we reduce that
+to [W] Bool ~# (). That is insoluble, but we solve it from [G] () ~# Bool
 -}
 
 unsafe2 :: a ~ b => Z b -> Z a -> a


=====================================
testsuite/tests/gadt/T3651.stderr
=====================================
@@ -1,14 +1,33 @@
 
-T3651.hs:11:15: error: [GHC-83865]
-    • Couldn't match type ‘()’ with ‘Bool’
-      Expected: a
-        Actual: ()
-    • In the expression: ()
+T3651.hs:11:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘unsafe1’: unsafe1 B U = ...
+
+T3651.hs:11:11: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
+    • Inaccessible code in
+        a pattern with constructor: U :: Z (), in an equation for ‘unsafe1’
+      Couldn't match type ‘Bool’ with ‘()’
+    • In the pattern: U
       In an equation for ‘unsafe1’: unsafe1 B U = ()
 
-T3651.hs:27:15: error: [GHC-83865]
-    • Couldn't match type ‘()’ with ‘Bool’
-      Expected: a
-        Actual: ()
-    • In the expression: ()
+T3651.hs:27:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘unsafe2’: unsafe2 B U = ...
+
+T3651.hs:27:11: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
+    • Inaccessible code in
+        a pattern with constructor: U :: Z (), in an equation for ‘unsafe2’
+      Couldn't match type ‘Bool’ with ‘()’
+    • In the pattern: U
       In an equation for ‘unsafe2’: unsafe2 B U = ()
+
+T3651.hs:30:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘unsafe3’: unsafe3 B U = ...
+
+T3651.hs:30:11: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
+    • Inaccessible code in
+        a pattern with constructor: U :: Z (), in an equation for ‘unsafe3’
+      Couldn't match type ‘Bool’ with ‘()’
+    • In the pattern: U
+      In an equation for ‘unsafe3’: unsafe3 B U = True


=====================================
testsuite/tests/gadt/T7558.hs
=====================================
@@ -6,3 +6,11 @@ data T a b where
 
 f :: T a a -> Bool
 f (MkT x y) = [x,y] `seq` True
+
+{- We get
+
+[G] a ~ Maybe a
+[W] a ~ Maybe a
+
+We can solve the Wanted from the Given
+-}
\ No newline at end of file


=====================================
testsuite/tests/gadt/T7558.stderr
=====================================
@@ -1,14 +1,19 @@
 
-T7558.hs:8:18: error: [GHC-25897]
-    • Couldn't match expected type ‘a’ with actual type ‘Maybe a’
+T7558.hs:8:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘f’: f (MkT x y) = ...
+
+T7558.hs:8:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
+    • Inaccessible code in
+        a pattern with constructor:
+          MkT :: forall a b. (a ~ Maybe b) => a -> Maybe b -> T a b,
+        in an equation for ‘f’
+      Couldn't match type ‘a’ with ‘Maybe a’
       ‘a’ is a rigid type variable bound by
         the type signature for:
           f :: forall a. T a a -> Bool
         at T7558.hs:7:1-18
-    • In the expression: y
-      In the first argument of ‘seq’, namely ‘[x, y]’
-      In the expression: [x, y] `seq` True
+    • In the pattern: MkT x y
+      In an equation for ‘f’: f (MkT x y) = [x, y] `seq` True
     • Relevant bindings include
-        y :: Maybe a (bound at T7558.hs:8:10)
-        x :: a (bound at T7558.hs:8:8)
         f :: T a a -> Bool (bound at T7558.hs:8:1)


=====================================
testsuite/tests/gadt/all.T
=====================================
@@ -93,7 +93,7 @@ test('T2151', normal, compile, [''])
 test('T3013', normal, compile, [''])
 test('T3163', normal, compile_fail, [''])
 test('gadt25', normal, compile, [''])
-test('T3651', normal, compile_fail, [''])
+test('T3651', normal, compile, [''])
 test('T3638', normal, compile, [''])
 
 test('gadtSyntax001', normal, compile, [''])
@@ -110,7 +110,7 @@ test('T7293', normal, compile_fail, ['-Werror'])
 test('T7294', normal, compile, [''])
 test('T7321', [], makefile_test, [])
 test('T7974', normal, compile, [''])
-test('T7558', normal, compile_fail, [''])
+test('T7558', normal, compile, [''])
 test('T9380', normal, compile_and_run, [''])
 test('T12087', normal, compile_fail, [''])
 test('T12468', normal, compile_fail, [''])


=====================================
testsuite/tests/ghci/scripts/Defer02.stderr
=====================================
@@ -1,5 +1,5 @@
 
-Defer01.hs:11:40: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+Defer01.hs:10:40: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match type ‘Char’ with ‘[Char]’
       Expected: String
         Actual: Char
@@ -7,16 +7,16 @@ Defer01.hs:11:40: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
       In the second argument of ‘(>>)’, namely ‘putStr ','’
       In the expression: putStr "Hello World" >> putStr ','
 
-Defer01.hs:14:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+Defer01.hs:13:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Int’ with actual type ‘Char’
     • In the expression: 'p'
       In an equation for ‘a’: a = 'p'
 
-Defer01.hs:25:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+Defer01.hs:24:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
     Pattern match has inaccessible right hand side
     In an equation for ‘c’: c (C2 x) = ...
 
-Defer01.hs:25:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
+Defer01.hs:24:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
     • Inaccessible code in
         a pattern with constructor: C2 :: Bool -> C Bool,
         in an equation for ‘c’
@@ -24,49 +24,44 @@ Defer01.hs:25:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
     • In the pattern: C2 x
       In an equation for ‘c’: c (C2 x) = True
 
-Defer01.hs:31:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+Defer01.hs:30:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Char -> t’ with actual type ‘Char’
     • The function ‘e’ is applied to one value argument,
         but its type ‘Char’ has none
       In the expression: e 'q'
       In an equation for ‘f’: f = e 'q'
-    • Relevant bindings include f :: t (bound at Defer01.hs:31:1)
+    • Relevant bindings include f :: t (bound at Defer01.hs:30:1)
 
-Defer01.hs:34:8: warning: [GHC-25897] [-Wdeferred-type-errors (in -Wdefault)]
+Defer01.hs:33:8: warning: [GHC-25897] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Char’ with actual type ‘a’
       ‘a’ is a rigid type variable bound by
         the type signature for:
           h :: forall a. a -> (Char, Char)
-        at Defer01.hs:33:1-21
+        at Defer01.hs:32:1-21
     • In the expression: x
       In the expression: (x, 'c')
       In an equation for ‘h’: h x = (x, 'c')
     • Relevant bindings include
-        x :: a (bound at Defer01.hs:34:3)
-        h :: a -> (Char, Char) (bound at Defer01.hs:34:1)
+        x :: a (bound at Defer01.hs:33:3)
+        h :: a -> (Char, Char) (bound at Defer01.hs:33:1)
 
-Defer01.hs:39:17: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+Defer01.hs:38:17: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Bool’ with actual type ‘T a’
     • In the first argument of ‘not’, namely ‘(K a)’
       In the first argument of ‘seq’, namely ‘(not (K a))’
       In the expression: seq (not (K a)) ()
     • Relevant bindings include
-        a :: a (bound at Defer01.hs:39:3)
-        i :: a -> () (bound at Defer01.hs:39:1)
+        a :: a (bound at Defer01.hs:38:3)
+        i :: a -> () (bound at Defer01.hs:38:1)
 
-Defer01.hs:47:7: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
-    • Couldn't match expected type ‘Bool’ with actual type ‘Int’
-    • In the expression: x
-      In an equation for ‘k’: k x = x
-
-Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+Defer01.hs:49:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type: IO a0
                   with actual type: Char -> IO ()
     • Probable cause: ‘putChar’ is applied to too few arguments
       In the first argument of ‘(>>)’, namely ‘putChar’
       In the expression: putChar >> putChar 'p'
       In an equation for ‘l’: l = putChar >> putChar 'p'
-*** Exception: Defer01.hs:11:40: error: [GHC-83865]
+*** Exception: Defer01.hs:10:40: error: [GHC-83865]
     • Couldn't match type ‘Char’ with ‘[Char]’
       Expected: String
         Actual: Char
@@ -74,12 +69,12 @@ Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
       In the second argument of ‘(>>)’, namely ‘putStr ','’
       In the expression: putStr "Hello World" >> putStr ','
 (deferred type error)
-*** Exception: Defer01.hs:14:5: error: [GHC-83865]
+*** Exception: Defer01.hs:13:5: error: [GHC-83865]
     • Couldn't match expected type ‘Int’ with actual type ‘Char’
     • In the expression: 'p'
       In an equation for ‘a’: a = 'p'
 (deferred type error)
-*** Exception: Defer01.hs:18:9: error: [GHC-39999]
+*** Exception: Defer01.hs:17:9: error: [GHC-39999]
     • No instance for ‘Eq B’ arising from a use of ‘==’
     • In the expression: x == x
       In an equation for ‘b’: b x = x == x
@@ -92,43 +87,43 @@ Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • In the first argument of ‘c’, namely ‘(C2 True)’
       In the first argument of ‘print’, namely ‘(c (C2 True))’
       In the expression: print (c (C2 True))
-*** Exception: Defer01.hs:28:5: error: [GHC-39999]
+*** Exception: Defer01.hs:27:5: error: [GHC-39999]
     • No instance for ‘Num (a -> a)’ arising from the literal ‘1’
         (maybe you haven't applied a function to enough arguments?)
     • In the expression: 1
       In an equation for ‘d’: d = 1
 (deferred type error)
-*** Exception: Defer01.hs:31:5: error: [GHC-83865]
+*** Exception: Defer01.hs:30:5: error: [GHC-83865]
     • Couldn't match expected type ‘Char -> t’ with actual type ‘Char’
     • The function ‘e’ is applied to one value argument,
         but its type ‘Char’ has none
       In the expression: e 'q'
       In an equation for ‘f’: f = e 'q'
-    • Relevant bindings include f :: t (bound at Defer01.hs:31:1)
+    • Relevant bindings include f :: t (bound at Defer01.hs:30:1)
 (deferred type error)
-*** Exception: Defer01.hs:34:8: error: [GHC-25897]
+*** Exception: Defer01.hs:33:8: error: [GHC-25897]
     • Couldn't match expected type ‘Char’ with actual type ‘a’
       ‘a’ is a rigid type variable bound by
         the type signature for:
           h :: forall a. a -> (Char, Char)
-        at Defer01.hs:33:1-21
+        at Defer01.hs:32:1-21
     • In the expression: x
       In the expression: (x, 'c')
       In an equation for ‘h’: h x = (x, 'c')
     • Relevant bindings include
-        x :: a (bound at Defer01.hs:34:3)
-        h :: a -> (Char, Char) (bound at Defer01.hs:34:1)
+        x :: a (bound at Defer01.hs:33:3)
+        h :: a -> (Char, Char) (bound at Defer01.hs:33:1)
 (deferred type error)
-*** Exception: Defer01.hs:39:17: error: [GHC-83865]
+*** Exception: Defer01.hs:38:17: error: [GHC-83865]
     • Couldn't match expected type ‘Bool’ with actual type ‘T a’
     • In the first argument of ‘not’, namely ‘(K a)’
       In the first argument of ‘seq’, namely ‘(not (K a))’
       In the expression: seq (not (K a)) ()
     • Relevant bindings include
-        a :: a (bound at Defer01.hs:39:3)
-        i :: a -> () (bound at Defer01.hs:39:1)
+        a :: a (bound at Defer01.hs:38:3)
+        i :: a -> () (bound at Defer01.hs:38:1)
 (deferred type error)
-*** Exception: Defer01.hs:43:5: error: [GHC-39999]
+*** Exception: Defer01.hs:42:5: error: [GHC-39999]
     • No instance for ‘MyClass a1’ arising from a use of ‘myOp’
     • In the expression: myOp 23
       In an equation for ‘j’: j = myOp 23
@@ -139,7 +134,7 @@ Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • In the first argument of ‘print’, namely ‘(k 2)’
       In the expression: print (k 2)
       In an equation for ‘it’: it = print (k 2)
-*** Exception: Defer01.hs:50:5: error: [GHC-83865]
+*** Exception: Defer01.hs:49:5: error: [GHC-83865]
     • Couldn't match expected type: IO a0
                   with actual type: Char -> IO ()
     • Probable cause: ‘putChar’ is applied to too few arguments


=====================================
testsuite/tests/indexed-types/should_fail/T13674.stderr
=====================================
@@ -17,20 +17,3 @@ T13674.hs:56:21: error: [GHC-25897]
         y :: GF m (bound at T13674.hs:56:17)
         x :: GF m (bound at T13674.hs:56:6)
         bar :: GF m -> GF m -> GF m (bound at T13674.hs:56:1)
-
-T13674.hs:56:31: error: [GHC-25897]
-    • Couldn't match type ‘m’ with ‘Lcm m m’
-      Expected: GF m
-        Actual: GF (Lcm m m)
-      ‘m’ is a rigid type variable bound by
-        the type signature for:
-          bar :: forall (m :: Nat). KnownNat m => GF m -> GF m -> GF m
-        at T13674.hs:55:1-44
-    • In the first argument of ‘(\\)’, namely ‘foo y x’
-      In the first argument of ‘(\\)’, namely ‘foo y x \\ lcmNat @m @m’
-      In the second argument of ‘(-)’, namely
-        ‘foo y x \\ lcmNat @m @m \\ Sub @() (lcmIsIdempotent @m)’
-    • Relevant bindings include
-        y :: GF m (bound at T13674.hs:56:17)
-        x :: GF m (bound at T13674.hs:56:6)
-        bar :: GF m -> GF m -> GF m (bound at T13674.hs:56:1)


=====================================
testsuite/tests/pmcheck/should_compile/T12957a.stderr
=====================================
@@ -11,15 +11,3 @@ T12957a.hs:25:35: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)]
       In a record update at field ‘sFields’,
       with type constructor ‘S’
       and data constructor ‘S’.
-
-T12957a.hs:25:35: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
-    • Couldn't match type ‘B’ with ‘A’
-      Expected: Fields A
-        Actual: Fields B
-    • In a record update at field ‘list’,
-      with type constructor ‘Fields’
-      and data constructor ‘BFields’.
-      In the expression: emptyA {list = [a]}
-      In a record update at field ‘sFields’,
-      with type constructor ‘S’
-      and data constructor ‘S’.


=====================================
testsuite/tests/pmcheck/should_compile/T15450.hs
=====================================
@@ -1,6 +1,5 @@
 {-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}   -- To avoid rejecting the inaccessible types
 
 module T15450 where
 


=====================================
testsuite/tests/pmcheck/should_compile/T15450.stderr
=====================================
@@ -1,11 +1,11 @@
 
-T15450.hs:8:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
+T15450.hs:7:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative:
         Patterns of type ‘Bool’ not matched:
             False
             True
 
-T15450.hs:11:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
+T15450.hs:10:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
     In a case alternative: Patterns of type ‘Bool’ not matched: False


=====================================
testsuite/tests/typecheck/should_fail/GivenForallLoop.hs
=====================================
@@ -1,5 +1,4 @@
 {-# LANGUAGE TypeFamilies, ImpredicativeTypes #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}  -- Allow insoluble signature for loopy
 
 module GivenForallLoop where
 


=====================================
testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr
=====================================
@@ -1,20 +1,20 @@
 
-GivenForallLoop.hs:9:11: error: [GHC-25897]
+GivenForallLoop.hs:8:11: error: [GHC-25897]
     • Could not deduce ‘a ~ b’
       from the context: a ~ (forall b1. F a b1)
         bound by the type signature for:
                    loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
-        at GivenForallLoop.hs:8:1-42
+        at GivenForallLoop.hs:7:1-42
       ‘a’ is a rigid type variable bound by
         the type signature for:
           loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
-        at GivenForallLoop.hs:8:1-42
+        at GivenForallLoop.hs:7:1-42
       ‘b’ is a rigid type variable bound by
         the type signature for:
           loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b
-        at GivenForallLoop.hs:8:1-42
+        at GivenForallLoop.hs:7:1-42
     • In the expression: x
       In an equation for ‘loopy’: loopy x = x
     • Relevant bindings include
-        x :: a (bound at GivenForallLoop.hs:9:7)
-        loopy :: a -> b (bound at GivenForallLoop.hs:9:1)
+        x :: a (bound at GivenForallLoop.hs:8:7)
+        loopy :: a -> b (bound at GivenForallLoop.hs:8:1)


=====================================
testsuite/tests/typecheck/should_fail/T14325.hs
=====================================
@@ -9,3 +9,12 @@ foo x = x
 
 hm3 :: C (f b) b => b -> f b
 hm3 x = foo x
+
+{- Typechecking hm3
+~~~~~~~~~~~~~~~~~~~
+[G] C (f b) b
+[G] f b ~# b    -- Superclass; but Irred because occurs check
+[W] C b (f b)
+
+So the wanted can't be solved and is reported
+-}
\ No newline at end of file


=====================================
testsuite/tests/typecheck/should_fail/T14325.stderr
=====================================
@@ -1,14 +1,9 @@
 
-T14325.hs:11:9: error: [GHC-25897]
-    • Couldn't match type ‘b’ with ‘f b’
-        arising from a superclass required to satisfy ‘C b (f b)’,
-        arising from a use of ‘foo’
-      ‘b’ is a rigid type variable bound by
-        the type signature for:
-          hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b
+T14325.hs:11:9: error: [GHC-39999]
+    • Could not deduce ‘C b (f b)’ arising from a use of ‘foo’
+      from the context: C (f b) b
+        bound by the type signature for:
+                   hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b
         at T14325.hs:10:1-28
     • In the expression: foo x
       In an equation for ‘hm3’: hm3 x = foo x
-    • Relevant bindings include
-        x :: b (bound at T14325.hs:11:5)
-        hm3 :: b -> f b (bound at T14325.hs:11:1)


=====================================
testsuite/tests/typecheck/should_fail/T20189.hs
=====================================
@@ -1,6 +1,5 @@
 {-# LANGUAGE ImpredicativeTypes #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}   -- Dodgy: allow the strange (illegal) signature
 module T20189 where
 
 y :: (t ~ (forall x . Show x => x -> IO ())) => t


=====================================
testsuite/tests/typecheck/should_fail/T20189.stderr
=====================================
@@ -1,12 +1,12 @@
 
-T20189.hs:7:5: error: [GHC-88464]
+T20189.hs:6:5: error: [GHC-88464]
     • Found hole: _ :: t
       Where: ‘t’ is a rigid type variable bound by
                the type signature for:
                  y :: forall t. (t ~ (forall x. Show x => x -> IO ())) => t
-               at T20189.hs:6:1-49
+               at T20189.hs:5:1-49
     • In an equation for ‘y’: y = _
-    • Relevant bindings include y :: t (bound at T20189.hs:7:1)
+    • Relevant bindings include y :: t (bound at T20189.hs:6:1)
       Constraints include
-        t ~ (forall x. Show x => x -> IO ()) (from T20189.hs:6:1-49)
-      Valid hole fits include y :: t (bound at T20189.hs:7:1)
+        t ~ (forall x. Show x => x -> IO ()) (from T20189.hs:5:1-49)
+      Valid hole fits include y :: t (bound at T20189.hs:6:1)


=====================================
testsuite/tests/typecheck/should_run/Defer01.hs
=====================================
@@ -2,7 +2,6 @@
 -- Should compile and run
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}  -- Allows the strange type for `k`
 {-# OPTIONS_GHC -fdefer-type-errors #-}
 
 module Main where



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6aab81509fc261cc986dde5c2c619140ad226667

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6aab81509fc261cc986dde5c2c619140ad226667
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/20230519/112c8d8a/attachment-0001.html>


More information about the ghc-commits mailing list