Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 05094993 by Luite Stegeman at 2026-03-27T04:45:12-04:00 Don't refine DEFAULT alt for unary typeclasses A non-DEFAULT data alt for a unary typeclass dictionary would interfere with Unary Class Magic, leading to segfaults. fixes #27071 - - - - - 7 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - + testsuite/tests/simplCore/should_run/T27071.hs - + testsuite/tests/simplCore/should_run/T27071.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -286,7 +286,9 @@ data Alt b -- See Note [GHC Formalism] in GHC.Core.Lint data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@. - -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@ + -- Invariant: the 'DataCon' is always from a @data@ type, + -- and never from a @newtype@ or a unary class. + -- See Note [DataAlt restrictions] | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@ -- Invariant: always an *unlifted* literal @@ -330,6 +332,63 @@ mkBinds Recursive binds = [Rec binds] mkBinds NonRecursive binds = map (uncurry NonRec) binds {- +Note [DataAlt restrictions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The DataCon in a DataAlt is subject to three restrictions: + +(DALT1) It is never from a newtype. + + Newtypes are always represented via coercions, never by pattern matching + on their data constructor. We can still have a case expression over a + newtype scrutinee if we are just doing an eval: + + case x of { DEFAULT -> e } + + but we must not match on the newtype constructor. + +(DALT2) It is never from a `type data` declaration. + + The constructors of a `type data` declaration (see + Note [Type data declarations] in GHC.Rename.Module) exist only at the + type level and have no value-level representation. Nevertheless, it is + possible to strictly evaluate a value whose type is a `type data` + declaration. For example (from test type-data/should_compile/T2294b.hs): + + type data T a where + A :: T Int + + f :: T a -> () + f !x = () + + We want to generate the following Core for f: + + f = \(@a) (x :: T a) -> + case x of { __DEFAULT -> () } + + Namely we do _not_ want to match on `A`, as it doesn't exist at the value + level! See wrinkle (W2b) in Note [Type data declarations] in + GHC.Rename.Module. + +(DALT3) It is never from a unary class (#27071). + + Unary class constructors are erased at runtime: the dictionary IS the + single method (or superclass), with no wrapper. Matching on the dictionary + constructor is therefore illegal in Core; case expressions over unary + class dictionaries must use DEFAULT. For example, given + + class C a where { op :: a -> a } + + a case on a C dictionary looks like: + + case d of bndr { DEFAULT -> ...bndr... } + not: + case d of { C:C op -> ...op... } -- WRONG + + See (UCM13) in Note [Unary class magic] in GHC.Core.TyCon. + +All three restrictions are checked by Core Lint, and they each give rise +to a special case in `GHC.Core.Utils.refineDefaultAlt`. + Note [Literal alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Literal alternatives (LitAlt lit) are always for *un-lifted* literals. ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1720,11 +1720,13 @@ lintCoreAlt case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) lit_ty = literalType lit lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rhs) - | isNewTyCon (dataConTyCon con) + | isNewTyCon (dataConTyCon con) -- (DALT1) in Note [DataAlt restrictions] in GHC.Core = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) + | isUnaryClassTyCon (dataConTyCon con) -- (DALT3) in Note [DataAlt restrictions] in GHC.Core + = zeroUE <$ addErrL (mkUnaryClassDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { checkTypeDataConOcc "pattern" con + { checkTypeDataConOcc "pattern" con -- (DALT2) in Note [DataAlt restrictions] in GHC.Core ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) -- Instantiate the universally quantified @@ -3806,6 +3808,11 @@ mkNewTyDataConAltMsg scrut_ty alt text "Scrutinee type:" <+> ppr scrut_ty, text "Alternative:" <+> pprCoreAlt alt ] +mkUnaryClassDataConAltMsg :: Type -> CoreAlt -> SDoc +mkUnaryClassDataConAltMsg scrut_ty alt + = vcat [ text "Data alternative for unary class datacon" + , text "Scrutinee type:" <+> ppr scrut_ty + , text "Alternative:" <+> pprCoreAlt alt ] ------------------------------------------------------ -- Other error messages ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -1584,6 +1584,20 @@ There are a number of wrinkles a black hole when rehydrating interface the interface file. Easiest just to store the bit! See `ifUnary` in GHC.Iface.Synatax.IfaceClassBody. +(UCM13) In Core, a case expression must never pattern-match on a unary class + data constructor (#27071). Since the constructor is erased at runtime, the + only valid form is: + + case d of bndr { DEFAULT -> ...bndr... } + + See (DALT3) Note [DataAlt restrictions] in GHC.Core. + + Generally, class dictionaries are only taken apart by the method + selectors, which are never inlined; see Note [ClassOp/DFun selection] + in GHC.Tc.TyCl.Instance. However the demand analyser can add `seq` forcing + on strict arguments (see Note [Which Ids should be strictified] in + GHC.Core.Utils), so we must be careful not to "fill in" the DEFAULT to mention + the data constructor; see GHC.Core.Utils.refineDefaultAlt. Note [Representing unary classes with newtypes: bad, bad, bad] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -858,8 +858,9 @@ refineDefaultAlt :: [Unique] -- ^ Uniques for constructing new binders refineDefaultAlt us mult tycon tys imposs_deflt_cons all_alts | Alt DEFAULT _ rhs : rest_alts <- all_alts , isAlgTyCon tycon -- It's a data type, tuple, or unboxed tuples. - , not (isNewTyCon tycon) -- Exception 1 in Note [Refine DEFAULT case alternatives] - , not (isTypeDataTyCon tycon) -- Exception 2 in Note [Refine DEFAULT case alternatives] + , not (isNewTyCon tycon) -- (DALT1) in Note [DataAlt restrictions] in GHC.Core + , not (isTypeDataTyCon tycon) -- (DALT2) in Note [DataAlt restrictions] in GHC.Core + , not (isUnaryClassTyCon tycon) -- (DALT3) in Note [DataAlt restrictions] in GHC.Core , Just all_cons <- tyConDataCons_maybe tycon , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type, so we can use @@ -1200,38 +1201,9 @@ with a specific constructor is desirable. `imposs_deflt_cons` argument is populated with constructors which are matched elsewhere. -There are two exceptions where we avoid refining a DEFAULT case: - -* Exception 1: Newtypes - - We can have a newtype, if we are just doing an eval: - - case x of { DEFAULT -> e } - - And we don't want to fill in a default for them! - -* Exception 2: `type data` declarations - - The data constructors for a `type data` declaration (see - Note [Type data declarations] in GHC.Rename.Module) do not exist at the - value level. Nevertheless, it is possible to strictly evaluate a value - whose type is a `type data` declaration. Test case - type-data/should_compile/T2294b.hs contains an example: - - type data T a where - A :: T Int - - f :: T a -> () - f !x = () - - We want to generate the following Core for f: - - f = \(@a) (x :: T a) -> - case x of - __DEFAULT -> () - - Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module +We must not refine the DEFAULT into a DataAlt for newtypes, `type data` +declarations, or unary classes, since none of these have a data constructor +that can appear in a DataAlt. See Note [DataAlt restrictions] in GHC.Core. Note [Combine identical alternatives] ===================================== testsuite/tests/simplCore/should_run/T27071.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -O -fworker-wrapper-cbv #-} +module Main where + +class MyClass a where + myVal :: Int + +instance MyClass Bool where + myVal = 0 + +showMyVal :: forall a. MyClass a => String +showMyVal = show (myVal @a) +{-# NOINLINE showMyVal #-} + +main :: IO () +main = putStrLn (showMyVal @Bool) ===================================== testsuite/tests/simplCore/should_run/T27071.stdout ===================================== @@ -0,0 +1 @@ +0 ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -121,3 +121,4 @@ test('T25096', normal, compile_and_run, ['-O -dcore-lint']) test('AppIsHNF', normal, compile_and_run, ['-O']) test('T24359b', normal, compile_and_run, ['-O']) test('T23429', normal, compile_and_run, ['-O']) +test('T27071', normal, compile_and_run, ['-O -fworker-wrapper-cbv']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05094993774191ede5c96770d8c91e82... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05094993774191ede5c96770d8c91e82... You're receiving this email because of your account on gitlab.haskell.org.