[Git][ghc/ghc][master] Don't generate wrappers for `type data` constructors with StrictData

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Apr 12 17:14:52 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
5e4f4ba8 by Simon Peyton Jones at 2024-04-12T13:14:20-04:00
Don't generate wrappers for `type data` constructors with StrictData

Previously, the logic for checking if a data constructor needs a wrapper or not
would take into account whether the constructor's fields have explicit
strictness (e.g., `data T = MkT !Int`), but the logic would _not_ take into
account whether `StrictData` was enabled. This meant that something like `type
data T = MkT Int` would incorrectly generate a wrapper for `MkT` if
`StrictData` was enabled, leading to the horrible errors seen in #24620. To fix
this, we disable generating wrappers for `type data` constructors altogether.

Fixes #24620.

Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com>

- - - - -


5 changed files:

- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Types/Id/Make.hs
- + testsuite/tests/type-data/should_run/T24620.hs
- testsuite/tests/type-data/should_run/all.T


Changes:

=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -645,8 +645,11 @@ getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc
 
 getTyConImplicitBinds :: TyCon -> [CoreBind]
 getTyConImplicitBinds tc
-  | isNewTyCon tc = []  -- See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make
-  | otherwise     = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
+  | isDataTyCon tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
+  | otherwise      = []
+    -- The 'otherwise' includes family TyCons of course, but also (less obviously)
+    --  * Newtypes: see Note [Compulsory newtype unfolding] in GHC.Types.Id.Make
+    --  * type data: we don't want any code for type-only stuff (#24620)
 
 getClassImplicitBinds :: Class -> [CoreBind]
 getClassImplicitBinds cls


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1972,6 +1972,8 @@ Wrinkles:
      is never used (invariant (I1)), so it barely makes sense to talk about
      the worker. A `type data` constructor only shows up in types, where it
      appears as a TyCon, specifically a PromotedDataCon -- no Id in sight.
+     See #24620 for an example of what happens if you accidentally include
+     a wrapper.
 
      See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where
      this check is implemented.


=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -902,15 +902,25 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
     -- 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
+    wrapper_reqd
+      | isTypeDataTyCon tycon
+        -- `type data` declarations never have data-constructor wrappers
+        -- Their data constructors only live at the type level, in the
+        -- form of PromotedDataCon, and therefore do not need wrappers.
+        -- See wrinkle (W0) in Note [Type data declarations] in GHC.Rename.Module.
+      = False
+
+      | otherwise
+      = (not new_tycon
                      -- (Most) newtypes have only a worker, with the exception
                      -- 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
@@ -919,19 +929,7 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
                      --
                      -- 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.


=====================================
testsuite/tests/type-data/should_run/T24620.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TypeData #-}
+
+module Main where
+
+type data Nat = Zero | Succ Nat
+
+main :: IO ()
+main = pure ()


=====================================
testsuite/tests/type-data/should_run/all.T
=====================================
@@ -2,3 +2,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, [''])
+test('T24620', normal, compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e4f4ba835fd24135759ee7a2d0d5c636a8a1505

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e4f4ba835fd24135759ee7a2d0d5c636a8a1505
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/20240412/69d922cd/attachment-0001.html>


More information about the ghc-commits mailing list