Don't generate datacon wrappers for `type data` declarations

Data constructor wrappers only make sense for _value_-level data constructors,
but data constructors for `type data` declarations only exist at the _type_
level. This patch does the following:

* The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data
  constructor receives a wrapper now consider whether or not its parent data
  type was declared with `type data`, omitting a wrapper if this is the case.

* Now that `type data` data constructors no longer receive wrappers, there is a
  spot of code in `refineDefaultAlt` that panics when it encounters a value
  headed by a `type data` type constructor. I've fixed this with a special case
  in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]`
  to explain why we do this.

Fixes #22948.

(cherry picked from commit 4327d63594f73939a2b8ab015c1cb44eafd4b460)

7 files changed, 91 insertions, 6 deletions

diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 889bfbf5b4..d373153ef8 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -730,9 +730,8 @@ 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)      -- 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!
+  , not (isNewTyCon tycon)      -- Exception 1 in Note [Refine DEFAULT case alternatives]
+  , not (isTypeDataTyCon tycon) -- Exception 2 in Note [Refine DEFAULT case alternatives]
   , 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
@@ -817,6 +816,39 @@ 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!
+
 Note [Combine identical alternatives]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If several alternatives are identical, merge them into a single
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 1d6bfb9212..ff4f3cce8e 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2139,6 +2139,21 @@ The main parts of the implementation are:
   `type data` declarations.  When these are converted back to Hs types
   in a splice, the constructors are placed in the TcCls namespace.
 
+* A `type data` declaration _never_ generates wrappers for its data
+  constructors, as they only make sense for value-level data constructors.
+  See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where
+  this check is implemented.
+
+  This includes `type data` declarations implemented as GADTs, such as
+  this example from #22948:
+
+    type data T a where
+      A :: T Int
+      B :: T a
+
+  If `T` were an ordinary `data` declaration, then `A` would have a wrapper
+  to account for the GADT-like equality in its return type. Because `T` is
+  declared as a `type data` declaration, however, the wrapper is omitted.
 -}
 
 warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 90213cea90..d11f55c33b 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -784,20 +784,40 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
     (unboxers, boxers) = unzip wrappers
     (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
 
+    -- This is True if the data constructor or class dictionary constructor
+    -- needs a wrapper. This wrapper is injected into the program later in the
+    -- CoreTidy pass. See Note [Injecting implicit bindings] in GHC.Iface.Tidy,
+    -- along with the accompanying implementation in getTyConImplicitBinds.
     wrapper_reqd =
         (not new_tycon
                      -- (Most) newtypes have only a worker, with the exception
-                     -- of some newtypes written with GADT syntax. See below.
+                     -- of some newtypes written with GADT syntax.
+                     -- See dataConUserTyVarsNeedWrapper below.
          && (any isBanged (ev_ibangs ++ arg_ibangs)))
                      -- Some forcing/unboxing (includes eq_spec)
       || isFamInstTyCon tycon -- Cast result
-      || dataConUserTyVarsNeedWrapper data_con
+      || (dataConUserTyVarsNeedWrapper data_con
                      -- If the data type was written with GADT syntax and
                      -- orders the type variables differently from what the
                      -- worker expects, it needs a data con wrapper to reorder
                      -- the type variables.
                      -- See Note [Data con wrappers and GADT syntax].
-                     -- NB: All GADTs return true from this function
+                     --
+                     -- NB: All GADTs return true from this function, but there
+                     -- is one exception that we must check below.
+         && not (isTypeDataTyCon tycon))
+                     -- An exception to this rule is `type data` declarations.
+                     -- Their data constructors only live at the type level and
+                     -- therefore do not need wrappers.
+                     -- See Note [Type data declarations] in GHC.Rename.Module.
+                     --
+                     -- Note that the other checks in this definition will
+                     -- return False for `type data` declarations, as:
+                     --
+                     -- - They cannot be newtypes
+                     -- - They cannot have strict fields
+                     -- - They cannot be data family instances
+                     -- - They cannot have datatype contexts
       || not (null stupid_theta)
                      -- If the data constructor has a datatype context,
                      -- we need a wrapper in order to drop the stupid arguments.
diff --git a/testsuite/tests/type-data/should_compile/T22948b.hs b/testsuite/tests/type-data/should_compile/T22948b.hs
new file mode 100644
index 0000000000..3f6bed9f50
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/T22948b.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeData #-}
+module T22948b where
+
+type data T a where
+  A :: T Int
+
+f :: T a -> ()
+f !x = ()
diff --git a/testsuite/tests/type-data/should_compile/all.T b/testsuite/tests/type-data/should_compile/all.T
index 7042676613..b1299c4951 100644
--- a/testsuite/tests/type-data/should_compile/all.T
+++ b/testsuite/tests/type-data/should_compile/all.T
@@ -5,3 +5,4 @@ test('TDGoodConsConstraints', normal, compile, [''])
 test('TDVector', normal, compile, [''])
 test('TD_TH_splice', normal, compile, [''])
 test('T22315a', [extra_files(['T22315a/'])], multimod_compile, ['T22315a.Lib T22315a.Main', '-v0'])
+test('T22948b', normal, compile, [''])
diff --git a/testsuite/tests/type-data/should_run/T22948a.hs b/testsuite/tests/type-data/should_run/T22948a.hs
new file mode 100644
index 0000000000..b146158edd
--- /dev/null
+++ b/testsuite/tests/type-data/should_run/T22948a.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeData #-}
+module Main where
+
+type data T a where
+  A :: T Int
+  B :: T a
+
+main = return ()
diff --git a/testsuite/tests/type-data/should_run/all.T b/testsuite/tests/type-data/should_run/all.T
index cc1bb25df1..a929da530b 100644
--- a/testsuite/tests/type-data/should_run/all.T
+++ b/testsuite/tests/type-data/should_run/all.T
@@ -1,3 +1,4 @@
 test('T22332a', exit_code(1), compile_and_run, [''])
 test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script'])
 test('T22500', normal, compile_and_run, [''])
+test('T22948a', normal, compile_and_run, [''])