[Git][ghc/ghc][wip/T22948] Don't generate datacon wrappers for `type data` declarations
Ryan Scott (@RyanGlScott)
gitlab at gitlab.haskell.org
Fri Feb 10 14:53:42 UTC 2023
Ryan Scott pushed to branch wip/T22948 at Glasgow Haskell Compiler / GHC
Commits:
e07c7fd1 by Ryan Scott at 2023-02-10T09:53:30-05:00
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:
* Modifies the criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data
constructor receives a wrapper to factor in whether or not its parent data
type was declared with `type data`.
* Deletes some redundant wrapper-checking criteria in
`GHC.Iface.Tidy.getTyConImplicitBinds`, as these are subsumed by
`mkDataConRep`. After this patch, all of the criteria are listed in
`mkDataConRep`.
Fixes #22948.
- - - - -
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/T22948.hs
- testsuite/tests/type-data/should_run/all.T
Changes:
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -614,9 +614,8 @@ getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc
cls_binds = maybe [] getClassImplicitBinds (tyConClass_maybe 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))
+getTyConImplicitBinds tc =
+ map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
getClassImplicitBinds :: Class -> [CoreBind]
getClassImplicitBinds cls
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -2132,6 +2132,20 @@ 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.
+ This extends to `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.
+ See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where
+ this check is implemented.
-}
warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -789,20 +789,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.
- && (any isBanged (ev_ibangs ++ arg_ibangs)))
+ && (any isBanged (ev_ibangs ++ arg_ibangs))
-- Some forcing/unboxing (includes eq_spec)
- || isFamInstTyCon tycon -- Cast result
- || dataConUserTyVarsNeedWrapper data_con
+ && isFamInstTyCon tycon)
+ -- Cast the result. Note that we _don't_ need to do this
+ -- for newtype instances—see
+ -- Note [Compulsory newtype unfolding].
+ || (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
+ && not (isTypeDataTyCon tycon))
+ -- An exception to this rule are `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 all of the other disjuncts in the definition
+ -- of wrapper_reqd will be False for `type data`
+ -- declarations, as:
+ --
+ -- - They cannot be newtypes or 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/T22948.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeData #-}
+module Main where
+
+type data T a where
+ A :: T Int
+ B :: T a
+
+main = return ()
=====================================
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('T22948', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e07c7fd12738a4b5f411d9c5d5e6a700d1e144d4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e07c7fd12738a4b5f411d9c5d5e6a700d1e144d4
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/20230210/d41b242d/attachment-0001.html>
More information about the ghc-commits
mailing list