Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC

Commits:

14 changed files:

Changes:

  • compiler/GHC/Rename/Bind.hs
    ... ... @@ -1303,14 +1303,38 @@ rnMatchGroup :: (Outputable (body GhcPs), AnnoBody body) => HsMatchContextRn
    1303 1303 
                  -> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars)
    1304 1304 
     rnMatchGroup ctxt rnBody (MG { mg_alts = L lm ms, mg_ext = origin })
    1305 1305 
              -- see Note [Empty MatchGroups]
    1306 
    -  = do { whenM ((null ms &&) <$> mustn't_be_empty) (addErr (TcRnEmptyCase ctxt))
    1306 
    +  = do { when (null ms) $ checkEmptyCase ctxt
    1307 1307 
            ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
    1308 1308 
            ; return (mkMatchGroup origin (L lm new_ms), ms_fvs) }
    1309 
    +
    1310 
    +-- Check the validity of a MatchGroup with an empty list of alternatives.
    1311 
    +--
    1312 
    +--  1. Normal `case x of {}` passes this check as long as EmptyCase is enabled.
    1313 
    +--     Ditto lambda-case `\case {}`.
    1314 
    +--
    1315 
    +--  2. Multi-case with no alternatives `\cases {}` is never valid.
    1316 
    +--
    1317 
    +--  3. Other MatchGroup contexts (FunRhs, LamAlt LamSingle, etc) are not
    1318 
    +--     considered here because there is no syntax to construct them with
    1319 
    +--     no alternatives.
    1320 
    +--
    1321 
    +-- Test case: rename/should_fail/RnEmptyCaseFail
    1322 
    +--
    1323 
    +-- Validation continues in the type checker, namely in tcMatches.
    1324 
    +-- See Note [Pattern types for EmptyCase] in GHC.Tc.Gen.Match
    1325 
    +checkEmptyCase :: HsMatchContextRn -> RnM ()
    1326 
    +checkEmptyCase ctxt
    1327 
    +  | disallowed_ctxt =
    1328 
    +      addErr (TcRnEmptyCase ctxt EmptyCaseDisallowedCtxt)
    1329 
    +  | otherwise =
    1330 
    +      unlessXOptM LangExt.EmptyCase $
    1331 
    +        addErr (TcRnEmptyCase ctxt EmptyCaseWithoutFlag)
    1309 1332 
       where
    1310 
    -    mustn't_be_empty = case ctxt of
    1311 
    -      LamAlt LamCases -> return True
    1312 
    -      ArrowMatchCtxt (ArrowLamAlt LamCases) -> return True
    1313 
    -      _ -> not <$> xoptM LangExt.EmptyCase
    1333 
    +    disallowed_ctxt =
    1334 
    +      case ctxt of
    1335 
    +        LamAlt LamCases -> True
    1336 
    +        ArrowMatchCtxt (ArrowLamAlt LamCases) -> True
    1337 
    +        _ -> False
    1314 1338
    1315 1339 
     rnMatch :: AnnoBody body
    1316 1340 
             => HsMatchContextRn

  • compiler/GHC/Tc/Errors/Ppr.hs
    ... ... @@ -55,7 +55,7 @@ import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst )
    55 55 
     import GHC.Core.InstEnv
    56 56 
     import GHC.Core.TyCo.Rep (Type(..))
    57 57 
     import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon,
    58 
    -                          pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType)
    58 
    +                          pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType, pprForAll)
    59 59 
     import GHC.Core.PatSyn ( patSynName, pprPatSynType )
    60 60 
     import GHC.Core.Predicate
    61 61 
     import GHC.Core.Type
    ... ... @@ -1299,24 +1299,27 @@ instance Diagnostic TcRnMessage where
    1299 1299 
           text "Orphan COMPLETE pragmas not supported" $$
    1300 1300 
           text "A COMPLETE pragma must mention at least one data constructor" $$
    1301 1301 
           text "or pattern synonym defined in the same module."
    1302 
    -    TcRnEmptyCase ctxt -> mkSimpleDecorated message
    1303 
    -      where
    1304 
    -        pp_ctxt = case ctxt of
    1305 
    -          CaseAlt                                -> text "case expression"
    1306 
    -          LamAlt LamCase                         -> text "\\case expression"
    1307 
    -          ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction"
    1308 
    -          ArrowMatchCtxt (ArrowLamAlt LamCase)   -> text "\\case command"
    1309 
    -          ArrowMatchCtxt ArrowCaseAlt            -> text "case command"
    1310 
    -          _                                      -> text "(unexpected)"
    1311 
    -                                                    <+> pprMatchContextNoun ctxt
    1312 
    -
    1313 
    -        message = case ctxt of
    1314 
    -          LamAlt LamCases -> lcases_msg <+> text "expression"
    1315 
    -          ArrowMatchCtxt (ArrowLamAlt LamCases) -> lcases_msg <+> text "command"
    1316 
    -          _ -> text "Empty list of alternatives in" <+> pp_ctxt
    1317 
    -
    1318 
    -        lcases_msg =
    1319 
    -          text "Empty list of alternatives is not allowed in \\cases"
    1302 
    +    TcRnEmptyCase ctxt reason -> mkSimpleDecorated $
    1303 
    +      case reason of
    1304 
    +        EmptyCaseWithoutFlag ->
    1305 
    +          text "Empty list of alternatives in" <+> pp_ctxt
    1306 
    +        EmptyCaseDisallowedCtxt ->
    1307 
    +          text "Empty list of alternatives is not allowed in" <+> pp_ctxt
    1308 
    +        EmptyCaseForall tvb ->
    1309 
    +          vcat [ text "Empty list of alternatives in" <+> pp_ctxt
    1310 
    +               , hang (text "checked against a forall-type:")
    1311 
    +                      2 (pprForAll [tvb] <+> text "...")
    1312 
    +               ]
    1313 
    +        where
    1314 
    +          pp_ctxt = case ctxt of
    1315 
    +            CaseAlt                                -> text "case expression"
    1316 
    +            LamAlt LamCase                         -> text "\\case expression"
    1317 
    +            LamAlt LamCases                        -> text "\\cases expression"
    1318 
    +            ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction"
    1319 
    +            ArrowMatchCtxt (ArrowLamAlt LamCase)   -> text "\\case command"
    1320 
    +            ArrowMatchCtxt (ArrowLamAlt LamCases)  -> text "\\cases command"
    1321 
    +            ArrowMatchCtxt ArrowCaseAlt            -> text "case command"
    1322 
    +            ctxt                                   -> text "(unexpected)" <+> pprMatchContextNoun ctxt
    1320 1323 
         TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $
    1321 1324 
           text "accepting non-standard pattern guards" $$
    1322 1325 
           nest 4 (interpp'SP guards)
    ... ... @@ -2988,10 +2991,11 @@ instance Diagnostic TcRnMessage where
    2988 2991 
           -> noHints
    2989 2992 
         TcRnOrphanCompletePragma{}
    2990 2993 
           -> noHints
    2991 
    -    TcRnEmptyCase ctxt -> case ctxt of
    2992 
    -      LamAlt LamCases -> noHints -- cases syntax doesn't support empty case.
    2993 
    -      ArrowMatchCtxt (ArrowLamAlt LamCases) -> noHints
    2994 
    -      _ -> [suggestExtension LangExt.EmptyCase]
    2994 
    +    TcRnEmptyCase _ reason ->
    2995 
    +      case reason of
    2996 
    +        EmptyCaseWithoutFlag{}    -> [suggestExtension LangExt.EmptyCase]
    2997 
    +        EmptyCaseDisallowedCtxt{} -> noHints
    2998 
    +        EmptyCaseForall{}         -> noHints
    2995 2999 
         TcRnNonStdGuards{}
    2996 3000 
           -> [suggestExtension LangExt.PatternGuards]
    2997 3001 
         TcRnDuplicateSigDecl{}

  • compiler/GHC/Tc/Errors/Types.hs
    ... ... @@ -103,6 +103,7 @@ module GHC.Tc.Errors.Types (
    103 103 
       , DisabledClassExtension(..)
    104 104 
       , TyFamsDisabledReason(..)
    105 105 
       , TypeApplication(..)
    106 
    +  , BadEmptyCaseReason(..)
    106 107 
       , HsTypeOrSigType(..)
    107 108 
       , HsTyVarBndrExistentialFlag(..)
    108 109 
       , TySynCycleTyCons
    ... ... @@ -204,7 +205,8 @@ import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst, DFunId)
    204 205 
     import GHC.Core.PatSyn (PatSyn)
    205 206 
     import GHC.Core.Predicate (EqRel, predTypeEqRel)
    206 207 
     import GHC.Core.TyCon (TyCon, Role, FamTyConFlav, AlgTyConRhs)
    207 
    -import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag)
    208 
    +import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag, ForAllTyBinder)
    209 
    +
    208 210 
     import GHC.Driver.Backend (Backend)
    209 211 
     import GHC.Unit.State (UnitState)
    210 212 
     import GHC.Utils.Misc (filterOut)
    ... ... @@ -3005,13 +3007,27 @@ data TcRnMessage where
    3005 3007 
           a case expression with an empty list of alternatives without
    3006 3008 
           enabling the EmptyCase extension.
    3007 3009
    3008 
    -     Example(s):
    3010 
    +     Example for EmptyCaseWithoutFlag:
    3011 
    +
    3012 
    +       {-# LANGUAGE NoEmptyCase #-}
    3013 
    +       f :: Void -> a
    3014 
    +       f = \case {}    -- extension not enabled
    3015 
    +
    3016 
    +     Example for EmptyCaseDisallowedCtxt:
    3009 3017
    3010 
    -       case () of
    3018 
    +       f = \cases {}   -- multi-case requires n>0 alternatives
    3019 
    +
    3020 
    +     Example for EmptyCaseForall:
    3021 
    +
    3022 
    +       f :: forall (xs :: Type) -> ()
    3023 
    +       f = \case {}    -- can't match on a type argument
    3011 3024
    3012 3025 
          Test cases: rename/should_fail/RnEmptyCaseFail
    3026 
    +                 typecheck/should_fail/T25004
    3013 3027 
       -}
    3014 
    -  TcRnEmptyCase :: HsMatchContextRn -> TcRnMessage
    3028 
    +  TcRnEmptyCase :: !HsMatchContextRn
    3029 
    +                -> !BadEmptyCaseReason
    3030 
    +                -> TcRnMessage
    3015 3031
    3016 3032 
       {-| TcRnNonStdGuards is a warning thrown when a user uses
    3017 3033 
           non-standard guards (e.g. patterns in guards) without
    ... ... @@ -6083,6 +6099,12 @@ data TypeApplication
    6083 6099 
       | TypeApplicationInPattern !(HsConPatTyArg GhcPs)
    6084 6100 
       deriving Generic
    6085 6101
    6102 
    +-- | Why was the empty case rejected?
    6103 
    +data BadEmptyCaseReason
    6104 
    +  = EmptyCaseWithoutFlag
    6105 
    +  | EmptyCaseDisallowedCtxt
    6106 
    +  | EmptyCaseForall ForAllTyBinder
    6107 
    +
    6086 6108 
     -- | Either `HsType p` or `HsSigType p`.
    6087 6109 
     --
    6088 6110 
     -- Used for reporting errors in `TcRnIllegalKind`.

  • compiler/GHC/Tc/Gen/Arrow.hs
    ... ... @@ -319,8 +319,9 @@ tcCmdMatches :: CmdEnv
    319 319 
                  -> CmdType
    320 320 
                  -> TcM (HsWrapper, MatchGroup GhcTc (LHsCmd GhcTc))
    321 321 
     tcCmdMatches env scrut_ty matches (stk, res_ty)
    322 
    -  = tcCaseMatches tc_body (unrestricted scrut_ty) matches (mkCheckExpType res_ty)
    322 
    +  = tcCaseMatches ctxt tc_body (unrestricted scrut_ty) matches (mkCheckExpType res_ty)
    323 323 
       where
    324 
    +    ctxt = ArrowMatchCtxt ArrowCaseAlt
    324 325 
         tc_body body res_ty' = do { res_ty' <- expTypeToType res_ty'
    325 326 
                                   ; tcCmd env body (stk, res_ty') }
    326 327

  • compiler/GHC/Tc/Gen/Expr.hs
    ... ... @@ -457,7 +457,7 @@ tcExpr (HsCase ctxt scrut matches) res_ty
    457 457 
             ; (scrut', scrut_ty) <- tcScalingUsage mult $ tcInferRho scrut
    458 458
    459 459 
             ; hasFixedRuntimeRep_syntactic FRRCase scrut_ty
    460 
    -        ; (mult_co_wrap, matches') <- tcCaseMatches tcBody (Scaled mult scrut_ty) matches res_ty
    460 
    +        ; (mult_co_wrap, matches') <- tcCaseMatches ctxt tcBody (Scaled mult scrut_ty) matches res_ty
    461 461 
             ; return (HsCase ctxt (mkLHsWrap mult_co_wrap scrut') matches') }
    462 462
    463 463 
     tcExpr (HsIf x pred b1 b2) res_ty

  • compiler/GHC/Tc/Gen/Match.hs
    ... ... @@ -122,11 +122,12 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
    122 122
    123 123 
                     do { traceTc "tcFunBindMatches 2" (vcat [ pprUserTypeCtxt ctxt, ppr invis_pat_tys
    124 124 
                                                           , ppr pat_tys $$ ppr rhs_ty ])
    125 
    -                   ; tcMatches tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches }
    125 
    +                   ; tcMatches mctxt tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches }
    126 126
    127 127 
             ; return (wrap_fun <.> wrap_mult, r) }
    128 128 
       where
    129 
    -    herald        = ExpectedFunTyMatches (NameThing fun_name) matches
    129 
    +    herald = ExpectedFunTyMatches (NameThing fun_name) matches
    130 
    +    mctxt  = mkPrefixFunRhs (noLocA fun_name)
    130 131
    131 132 
     funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
    132 133 
     funBindPrecondition (MG { mg_alts = L _ alts })
    ... ... @@ -146,10 +147,11 @@ tcLambdaMatches e lam_variant matches invis_pat_tys res_ty
    146 147
    147 148 
             ; (wrapper, (mult_co_wrap, r))
    148 149 
                 <- matchExpectedFunTys herald GenSigCtxt arity res_ty $ \ pat_tys rhs_ty ->
    149 
    -               tcMatches tc_body (invis_pat_tys ++ pat_tys) rhs_ty matches
    150 
    +               tcMatches ctxt tc_body (invis_pat_tys ++ pat_tys) rhs_ty matches
    150 151
    151 152 
             ; return (wrapper <.> mult_co_wrap, r) }
    152 153 
       where
    154 
    +    ctxt   = LamAlt lam_variant
    153 155 
         herald = ExpectedFunTyLam lam_variant e
    154 156 
                  -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
    155 157
    ... ... @@ -167,7 +169,8 @@ parser guarantees that each equation has exactly one argument.
    167 169 
     -}
    168 170
    169 171 
     tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc))
    170 
    -              => TcMatchAltChecker body    -- ^ Typecheck the alternative RHSS
    172 
    +              => HsMatchContextRn
    173 
    +              -> TcMatchAltChecker body    -- ^ Typecheck the alternative RHSS
    171 174 
                   -> Scaled TcSigmaTypeFRR     -- ^ Type of scrutinee
    172 175 
                   -> MatchGroup GhcRn (LocatedA (body GhcRn)) -- ^ The case alternatives
    173 176 
                   -> ExpRhoType                               -- ^ Type of the whole case expression
    ... ... @@ -175,8 +178,8 @@ tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc))
    175 178 
                     -- Translated alternatives
    176 179 
                     -- wrapper goes from MatchGroup's ty to expected ty
    177 180
    178 
    -tcCaseMatches tc_body (Scaled scrut_mult scrut_ty) matches res_ty
    179 
    -  = tcMatches tc_body [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches
    181 
    +tcCaseMatches ctxt tc_body (Scaled scrut_mult scrut_ty) matches res_ty
    182 
    +  = tcMatches ctxt tc_body [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches
    180 183
    181 184 
     -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
    182 185 
     tcGRHSsPat :: Mult -> GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType
    ... ... @@ -223,23 +226,30 @@ type AnnoBody body
    223 226
    224 227 
     -- | Type-check a MatchGroup.
    225 228 
     tcMatches :: (AnnoBody body, Outputable (body GhcTc))
    226 
    -          => TcMatchAltChecker body
    229 
    +          => HsMatchContextRn
    230 
    +          -> TcMatchAltChecker body
    227 231 
               -> [ExpPatType]             -- ^ Expected pattern types.
    228 232 
               -> ExpRhoType               -- ^ Expected result-type of the Match.
    229 233 
               -> MatchGroup GhcRn (LocatedA (body GhcRn))
    230 234 
               -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    231 235
    232 
    -tcMatches tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
    233 
    -                                     , mg_ext = origin })
    236 
    +tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
    237 
    +                                          , mg_ext = origin })
    234 238 
       | null matches  -- Deal with case e of {}
    235 239 
         -- Since there are no branches, no one else will fill in rhs_ty
    236 240 
         -- when in inference mode, so we must do it ourselves,
    237 241 
         -- here, using expTypeToType
    238 242 
       = do { tcEmitBindingUsage bottomUE
    239 
    -       ; pat_tys <- mapM scaledExpTypeToType (filter_out_forall_pat_tys pat_tys)
    243 
    +         -- See Note [Pattern types for EmptyCase]
    244 
    +       ; let vis_pat_tys = filter isVisibleExpPatType pat_tys
    245 
    +       ; pat_ty <- case vis_pat_tys of
    246 
    +           [ExpFunPatTy t]      -> scaledExpTypeToType t
    247 
    +           [ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb)
    248 
    +           []                   -> panic "tcMatches: no arguments in EmptyCase"
    249 
    +           _t1:(_t2:_ts)        -> panic "tcMatches: multiple arguments in EmptyCase"
    240 250 
            ; rhs_ty  <- expTypeToType rhs_ty
    241 251 
            ; return (idHsWrapper, MG { mg_alts = L l []
    242 
    -                                 , mg_ext = MatchGroupTc pat_tys rhs_ty origin
    252 
    +                                 , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin
    243 253 
                                      }) }
    244 254
    245 255 
       | otherwise
    ... ... @@ -262,6 +272,43 @@ tcMatches tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
    262 272 
             match_fun_pat_ty (ExpFunPatTy t)  = Just t
    263 273 
             match_fun_pat_ty ExpForAllPatTy{} = Nothing
    264 274
    275 
    +{- Note [Pattern types for EmptyCase]
    276 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    277 
    +In tcMatches, we might encounter an empty list of matches if the user wrote
    278 
    +`case x of {}` or `\case {}`.
    279 
    +
    280 
    +* First of all, both `case x of {}` and `\case {}` match on exactly one visible
    281 
    +  argument, which follows from
    282 
    +
    283 
    +    checkArgCounts :: MatchGroup GhcRn ... -> TcM VisArity
    284 
    +    checkArgCounts (MG { mg_alts = L _ [] })
    285 
    +      = return 1
    286 
    +    ...
    287 
    +
    288 
    +  So we expect vis_pat_tys to be a singleton list [pat_ty] and panic otherwise.
    289 
    +
    290 
    +  Multi-case `\cases {}` can't violate this assumption in `tcMatches` because it
    291 
    +  must have been rejected earlier in `rnMatchGroup`.
    292 
    +
    293 
    +  Other MatchGroup contexts (function equations `f x = ...`, lambdas `\a b -> ...`,
    294 
    +  etc) are not considered here because there is no syntax to construct them with
    295 
    +  an empty list of alternatives.
    296 
    +
    297 
    +* With lambda-case, we run the risk of trying to match on a type argument:
    298 
    +
    299 
    +    f :: forall (xs :: Type) -> ()
    300 
    +    f = \case {}
    301 
    +
    302 
    +  This is not valid and it used to trigger a panic in pmcMatches (#25004).
    303 
    +  We reject it by inspecting the expected pattern type:
    304 
    +
    305 
    +    ; pat_ty <- case vis_pat_tys of
    306 
    +        [ExpFunPatTy t]      -> ...    -- value argument, ok
    307 
    +        [ExpForAllPatTy tvb] -> ...    -- type argument, error!
    308 
    +
    309 
    +  Test case: typecheck/should_fail/T25004
    310 
    +-}
    311 
    +
    265 312 
     -------------
    266 313 
     tcMatch :: (AnnoBody body)
    267 314 
             => TcMatchAltChecker body

  • docs/users_guide/using-optimisation.rst
    ... ... @@ -517,16 +517,24 @@ as such you shouldn't need to set any of them explicitly. A flag
    517 517 
         Eta-expand let-bindings to increase their arity.
    518 518
    519 519 
     .. ghc-flag:: -fdo-clever-arg-eta-expansion
    520 
    -    :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O2`.
    520 
    +    :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O`.
    521 521 
         :type: dynamic
    522 522 
         :reverse: -fno-do-clever-arg-eta-expansion
    523 523 
         :category:
    524 524
    525 525 
         :default: off
    526 
    +    :since: 9.10.1
    526 527
    527 528 
         Eta-expand arguments to increase their arity to avoid allocating unnecessary
    528 529 
         thunks for them.
    529 530
    531 
    +    For example in code like `foo = f (g x)` this flag will determine which analysis
    532 
    +    is used to decide the arity of `g x`, with the goal of avoiding a thunk for `g x`
    533 
    +    in cases where `g` is a function with an arity higher than one.
    534 
    +
    535 
    +    Enabling the flag enables a more sophisticated analysis, resulting in better
    536 
    +    runtime but longer compile time.
    537 
    +
    530 538 
     .. ghc-flag:: -feager-blackholing
    531 539 
         :shortdesc: Turn on :ref:`eager blackholing <parallel-compile-options>`
    532 540 
         :type: dynamic

  • testsuite/tests/typecheck/should_compile/T25960.hs
    1 
    +{-# LANGUAGE LambdaCase #-}
    2 
    +
    3 
    +module T25960 where
    4 
    +
    5 
    +import Data.Void (Void)
    6 
    +
    7 
    +f :: (forall a. Void -> a) -> (forall a. Void -> a)
    8 
    +f g = g
    9 
    +
    10 
    +absurd :: Void -> a
    11 
    +absurd = f (\case)
    12 
    +

  • testsuite/tests/typecheck/should_compile/all.T
    ... ... @@ -926,3 +926,4 @@ test('T24566', [], makefile_test, [])
    926 926 
     test('T23739a', normal, compile, [''])
    927 927 
     test('T24810', normal, compile, [''])
    928 928 
     test('T25597', normal, compile, [''])
    929 
    +test('T25960', normal, compile, [''])

  • testsuite/tests/typecheck/should_fail/T25004.hs
    1 
    +{-# LANGUAGE RequiredTypeArguments, EmptyCase, LambdaCase #-}
    2 
    +{-# OPTIONS -Wincomplete-patterns #-}
    3 
    +
    4 
    +module T25004 where
    5 
    +
    6 
    +import Data.Kind
    7 
    +
    8 
    +f :: forall (xs :: Type) -> ()
    9 
    +f = \case {}

  • testsuite/tests/typecheck/should_fail/T25004.stderr
    1 
    +T25004.hs:9:5: error: [GHC-48010]
    2 
    +    • Empty list of alternatives in \case expression
    3 
    +      checked against a forall-type: forall xs -> ...
    4 
    +    • In the expression: \case
    5 
    +      In an equation for ‘f’: f = \case
    6 
    +

  • testsuite/tests/typecheck/should_fail/T25004k.hs
    1 
    +{-# LANGUAGE RequiredTypeArguments, EmptyCase, LambdaCase #-}
    2 
    +{-# OPTIONS -Wincomplete-patterns #-}
    3 
    +
    4 
    +module T25004k where
    5 
    +
    6 
    +import Data.Kind
    7 
    +
    8 
    +f :: ((forall k. forall (xs :: k) -> ()) -> r) -> r
    9 
    +f cont = cont (\case {})

  • testsuite/tests/typecheck/should_fail/T25004k.stderr
    1 
    +T25004k.hs:9:16: error: [GHC-48010]
    2 
    +    • Empty list of alternatives in \case expression
    3 
    +      checked against a forall-type: forall (xs :: k) -> ...
    4 
    +    • In the first argument of ‘cont’, namely ‘(\case)’
    5 
    +      In the expression: cont (\case)
    6 
    +      In an equation for ‘f’: f cont = cont (\case)
    7 
    +

  • testsuite/tests/typecheck/should_fail/all.T
    ... ... @@ -727,4 +727,6 @@ test('T24470a', normal, compile_fail, [''])
    727 727 
     test('T24553', normal, compile_fail, [''])
    728 728 
     test('T23739b', normal, compile_fail, [''])
    729 729
    730 
    -test('T25325', normal, compile_fail, [''])
    \ No newline at end of file
    730 
    +test('T25325', normal, compile_fail, [''])
    731 
    +test('T25004', normal, compile_fail, [''])
    732 
    +test('T25004k', normal, compile_fail, [''])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help