Commit ef26182e authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari
Browse files

Track the order of user-written tyvars in DataCon

After typechecking a data constructor's type signature, its type
variables are partitioned into two distinct groups: the universally
quantified type variables and the existentially quantified type
variables. Then, when prompted for the type of the data constructor,
GHC gives this:

```lang=haskell
MkT :: forall <univs> <exis>. (...)
```

For H98-style datatypes, this is a fine thing to do. But for GADTs,
this can sometimes produce undesired results with respect to
`TypeApplications`. For instance, consider this datatype:

```lang=haskell
data T a where
  MkT :: forall b a. b -> T a
```

Here, the user clearly intended to have `b` be available for visible
type application before `a`. That is, the user would expect
`MkT @Int @Char` to be of type `Int -> T Char`, //not//
`Char -> T Int`. But alas, up until now that was not how GHC
operated—regardless of the order in which the user actually wrote
the tyvars, GHC would give `MkT` the type:

```lang=haskell
Mk...
parent 8d647450
......@@ -523,7 +523,8 @@ rnIfaceConDecls IfAbstractTyCon = pure IfAbstractTyCon
rnIfaceConDecl :: Rename IfaceConDecl
rnIfaceConDecl d = do
con_name <- rnIfaceGlobal (ifConName d)
con_ex_tvs <- mapM rnIfaceForAllBndr (ifConExTvs d)
con_ex_tvs <- mapM rnIfaceTvBndr (ifConExTvs d)
con_user_tvbs <- mapM rnIfaceForAllBndr (ifConUserTvBinders d)
let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t
con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d)
con_ctxt <- mapM rnIfaceType (ifConCtxt d)
......@@ -534,6 +535,7 @@ rnIfaceConDecl d = do
con_stricts <- mapM rnIfaceBang (ifConStricts d)
return d { ifConName = con_name
, ifConExTvs = con_ex_tvs
, ifConUserTvBinders = con_user_tvbs
, ifConEqSpec = con_eq_spec
, ifConCtxt = con_ctxt
, ifConArgTys = con_arg_tys
......
......@@ -31,9 +31,8 @@ module DataCon (
dataConName, dataConIdentity, dataConTag, dataConTagZ,
dataConTyCon, dataConOrigTyCon,
dataConUserType,
dataConUnivTyVars, dataConUnivTyVarBinders,
dataConExTyVars, dataConExTyVarBinders,
dataConAllTyVars,
dataConUnivTyVars, dataConExTyVars, dataConUnivAndExTyVars,
dataConUserTyVars, dataConUserTyVarBinders,
dataConEqSpec, dataConTheta,
dataConStupidTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
......@@ -52,6 +51,7 @@ module DataCon (
isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,
isUnboxedSumCon,
isVanillaDataCon, classDataCon, dataConCannotMatch,
dataConUserTyVarsArePermuted,
isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
......@@ -88,6 +88,7 @@ import qualified Data.Data as Data
import Data.Char
import Data.Word
import Data.List( mapAccumL, find )
import qualified Data.Set as Set
{-
Data constructor representation
......@@ -278,7 +279,7 @@ data DataCon
--
-- *** As declared by the user
-- data T a where
-- MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)
-- MkT :: forall y x. (x~y,Ord x) => x -> y -> T (x,y)
-- *** As represented internally
-- data T a where
......@@ -287,17 +288,26 @@ data DataCon
-- The next six fields express the type of the constructor, in pieces
-- e.g.
--
-- dcUnivTyVars = [a]
-- dcExTyVars = [x,y]
-- dcEqSpec = [a~(x,y)]
-- dcOtherTheta = [x~y, Ord x]
-- dcOrigArgTys = [x,y]
-- dcRepTyCon = T
-- dcUnivTyVars = [a]
-- dcExTyVars = [x,y]
-- dcUserTyVarBinders = [y,x]
-- dcEqSpec = [a~(x,y)]
-- dcOtherTheta = [x~y, Ord x]
-- dcOrigArgTys = [x,y]
-- dcRepTyCon = T
-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
-- FOR THE PARENT TyCon. (This is a change (Oct05): previously, vanilla
-- datacons guaranteed to have the same type variables as their parent TyCon,
-- but that seems ugly.)
-- but that seems ugly.) They can be different in the case where a GADT
-- constructor uses different names for the universal tyvars than does
-- the tycon. For example:
--
-- data H a where
-- MkH :: b -> H b
--
-- Here, the tyConTyVars of H will be [a], but the dcUnivTyVars of MkH
-- will be [b].
dcVanilla :: Bool, -- True <=> This is a vanilla Haskell 98 data constructor
-- Its type is of form
......@@ -314,14 +324,21 @@ data DataCon
-- INVARIANT: result type of data con worker is exactly (T a b c)
-- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with
-- the tyConTyVars of the parent TyCon
dcUnivTyVars :: [TyVarBinder],
dcUnivTyVars :: [TyVar],
-- Existentially-quantified type vars [x,y]
dcExTyVars :: [TyVarBinder],
dcExTyVars :: [TyVar],
-- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
-- Reason: less confusing, and easier to generate IfaceSyn
-- The type vars in the order the user wrote them [y,x]
-- INVARIANT: the set of tyvars in dcUserTyVarBinders is exactly the
-- set of dcExTyVars unioned with the set of dcUnivTyVars
-- whose tyvars do not appear in dcEqSpec
-- See Note [DataCon user type variable binders]
dcUserTyVarBinders :: [TyVarBinder],
dcEqSpec :: [EqSpec], -- Equalities derived from the result type,
-- _as written by the programmer_
......@@ -432,6 +449,9 @@ we can construct the right type for the DataCon with its foralls
attributed the correct visibility. That in turn governs whether you
can use visible type application at a call of the data constructor.
See also [DataCon user type variable binders] for an extended discussion on the
order in which TyVarBinders appear in a DataCon.
Note [DataCon arities]
~~~~~~~~~~~~~~~~~~~~~~
dcSourceArity does not take constraints into account,
......@@ -439,6 +459,83 @@ but dcRepArity does. For example:
MkT :: Ord a => a -> T a
dcSourceArity = 1
dcRepArity = 2
Note [DataCon user type variable binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In System FC, data constructor type signatures always quantify over all of
their universal type variables, followed by their existential type variables.
Normally, this isn't a problem, as most datatypes naturally quantify their type
variables in this order anyway. For example:
data T a b = forall c. MkT b c
Here, we have `MkT :: forall {k} (a :: k) (b :: *) (c :: *). b -> c -> T a b`,
where k, a, and b are universal and c is existential. (The inferred variable k
isn't available for TypeApplications, hence why it's in braces.) This is a
perfectly reasonable order to use, as the syntax of H98-style datatypes
(+ ExistentialQuantification) suggests it.
Things become more complicated when GADT syntax enters the picture. Consider
this example:
data X a where
MkX :: forall b a. b -> Proxy a -> X a
If we adopt the earlier approach of quantifying all the universal variables
followed by all the existential ones, GHC would come up with this type
signature for MkX:
MkX :: forall {k} (a :: k) (b :: *). b -> Proxy a -> X a
But this is not what we want at all! After all, if a user were to use
TypeApplications on MkX, they would expect to instantiate `b` before `a`,
as that's the order in which they were written in the `forall`. (See #11721.)
Instead, we'd like GHC to come up with this type signature:
MkX :: forall {k} (b :: *) (a :: k). b -> Proxy a -> X a
In fact, even if we left off the explicit forall:
data X a where
MkX :: b -> Proxy a -> X a
Then a user should still expect `b` to be quantified before `a`, since
according to the rules of TypeApplications, in the absence of `forall` GHC
performs a stable topological sort on the type variables in the user-written
type signature, which would place `b` before `a`.
But as noted above, enacting this behavior is not entirely trivial, as System
FC demands the variables go in universal-then-existential order under the hood.
Our solution is thus to equip DataCon with two different sets of type
variables:
* dcUnivTyVars and dcExTyVars, for the universal and existential type
variables, respectively. Their order is irrelevant for the purposes of
TypeApplications, and as a consequence, they do not come equipped with
visibilities (that is, they are TyVars instead of TyVarBinders).
* dcUserTyVarBinders, for the type variables binders in the order in which they
originally arose in the user-written type signature. Their order *does*
matter for TypeApplications, so they are full TyVarBinders, complete
with visibilities.
This encoding has some redundancy. The set of tyvars in dcUserTyVarBinders
consists precisely of:
* The set of tyvars in dcUnivTyVars whose type variables do not appear in
dcEqSpec, unioned with:
* The set of tyvars in dcExTyVars
The word "set" is used above because the order in which the tyvars
appear in dcUserTyVarBinders can be completely different from the order in
dcUnivTyVars or dcExTyVars. That is, the tyvars in dcUserTyVarBinders are a
permutation of (dcExTyVars + a subset of dcUnivTyVars). But aside from the
ordering, they in fact share the same type variables (with the same Uniques).
We sometimes refer to this as "the dcUserTyVarBinders invariant".
dcUserTyVarBinders, as the name suggests, is the one that users will see most
of the time. It's used when computing the type signature of a data constructor
(see dataConUserType), and as a result, it's what matters from a
TypeApplications perspective.
-}
-- | Data Constructor Representation
......@@ -570,13 +667,12 @@ substEqSpec subst (EqSpec tv ty)
where
tv' = getTyVar "substEqSpec" (substTyVar subst tv)
-- | Filter out any TyBinders mentioned in an EqSpec
filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
-- | Filter out any 'TyVar's mentioned in an 'EqSpec'.
filterEqSpec :: [EqSpec] -> [TyVar] -> [TyVar]
filterEqSpec eq_spec
= filter not_in_eq_spec
where
not_in_eq_spec bndr = let var = binderVar bndr in
all (not . (== var) . eqSpecTyVar) eq_spec
not_in_eq_spec var = all (not . (== var) . eqSpecTyVar) eq_spec
instance Outputable EqSpec where
ppr (EqSpec tv ty) = ppr (tv, ty)
......@@ -754,9 +850,11 @@ mkDataCon :: Name
-> [HsSrcBang] -- ^ Strictness/unpack annotations, from user
-> [FieldLabel] -- ^ Field labels for the constructor,
-- if it is a record, otherwise empty
-> [TyVarBinder] -- ^ Universals. See Note [TyVarBinders in DataCons]
-> [TyVarBinder] -- ^ Existentials.
-- (These last two must be Named and Inferred/Specified)
-> [TyVar] -- ^ Universals.
-> [TyVar] -- ^ Existentials.
-> [TyVarBinder] -- ^ User-written 'TyVarBinder's.
-- These must be Inferred/Specified.
-- See @Note [TyVarBinders in DataCons]@
-> [EqSpec] -- ^ GADT equalities
-> ThetaType -- ^ Theta-type occuring before the arguments proper
-> [Type] -- ^ Original argument types
......@@ -773,11 +871,11 @@ mkDataCon :: Name
mkDataCon name declared_infix prom_info
arg_stricts -- Must match orig_arg_tys 1-1
fields
univ_tvs ex_tvs
univ_tvs ex_tvs user_tvbs
eq_spec theta
orig_arg_tys orig_res_ty rep_info rep_tycon
stupid_theta work_id rep
-- Warning: mkDataCon is not a good place to check invariants.
-- Warning: mkDataCon is not a good place to check certain invariants.
-- If the programmer writes the wrong result type in the decl, thus:
-- data T a where { MkT :: S }
-- then it's possible that the univ_tvs may hit an assertion failure
......@@ -788,10 +886,20 @@ mkDataCon name declared_infix prom_info
= con
where
is_vanilla = null ex_tvs && null eq_spec && null theta
-- Check the dcUserTyVarBinders invariant
-- (see Note [DataCon user type variable binders])
user_tvbs_invariant =
Set.fromList (filterEqSpec eq_spec univ_tvs ++ ex_tvs)
== Set.fromList (binderVars user_tvbs)
user_tvbs' =
ASSERT2( user_tvbs_invariant
, ppr univ_tvs $$ ppr ex_tvs $$ ppr user_tvbs )
user_tvbs
con = MkData {dcName = name, dcUnique = nameUnique name,
dcVanilla = is_vanilla, dcInfix = declared_infix,
dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs,
dcUserTyVarBinders = user_tvbs',
dcEqSpec = eq_spec,
dcOtherTheta = theta,
dcStupidTheta = stupid_theta,
......@@ -812,13 +920,20 @@ mkDataCon name declared_infix prom_info
tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
rep_arg_tys = dataConRepArgTys con
rep_ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
mkFunTys rep_arg_tys $
mkTyConApp rep_tycon (mkTyVarTys (binderVars univ_tvs))
mk_rep_for_all_tys =
case rep of
-- If the DataCon has no wrapper, then the worker's type *is* the
-- user-facing type, so we can simply use user_tvbs.
NoDataConRep -> mkForAllTys user_tvbs'
-- If the DataCon has a wrapper, then the worker's type is never seen
-- by the user. The visibilities we pick do not matter here.
DCR{} -> mkInvForAllTys univ_tvs . mkInvForAllTys ex_tvs
rep_ty = mk_rep_for_all_tys $ mkFunTys rep_arg_tys $
mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
-- See Note [Promoted data constructors] in TyCon
prom_tv_bndrs = [ mkNamedTyConBinder vis tv
| TvBndr tv vis <- filterEqSpec eq_spec univ_tvs ++ ex_tvs ]
| TvBndr tv vis <- user_tvbs' ]
prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
prom_res_kind = orig_res_ty
......@@ -892,24 +1007,27 @@ dataConIsInfix = dcInfix
-- | The universally-quantified type variables of the constructor
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = binderVars tvbs
-- | 'TyBinder's for the universally-quantified type variables
dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
dataConUnivTyVarBinders = dcUnivTyVars
dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = tvbs
-- | The existentially-quantified type variables of the constructor
dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVars (MkData { dcExTyVars = tvbs }) = binderVars tvbs
-- | 'TyBinder's for the existentially-quantified type variables
dataConExTyVarBinders :: DataCon -> [TyVarBinder]
dataConExTyVarBinders = dcExTyVars
dataConExTyVars (MkData { dcExTyVars = tvbs }) = tvbs
-- | Both the universal and existential type variables of the constructor
dataConAllTyVars :: DataCon -> [TyVar]
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
= binderVars (univ_tvs ++ ex_tvs)
dataConUnivAndExTyVars :: DataCon -> [TyVar]
dataConUnivAndExTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
= univ_tvs ++ ex_tvs
-- See Note [DataCon user type variable binders]
-- | The type variables of the constructor, in the order the user wrote them
dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVars (MkData { dcUserTyVarBinders = tvbs }) = binderVars tvbs
-- See Note [DataCon user type variable binders]
-- | 'TyVarBinder's for the type variables of the constructor, in the order the
-- user wrote them
dataConUserTyVarBinders :: DataCon -> [TyVarBinder]
dataConUserTyVarBinders = dcUserTyVarBinders
-- | Equalities derived from the result type of the data constructor, as written
-- by the programmer in any GADT declaration. This includes *all* GADT-like
......@@ -1039,7 +1157,7 @@ dataConBoxer _ = Nothing
-- | The \"signature\" of the 'DataCon' returns, in order:
--
-- 1) The result of 'dataConAllTyVars',
-- 1) The result of 'dataConUnivAndExTyVars',
--
-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
-- parameter - whatever)
......@@ -1049,7 +1167,7 @@ dataConBoxer _ = Nothing
-- 4) The /original/ result type of the 'DataCon'
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
dataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
= (dataConAllTyVars con, dataConTheta con, arg_tys, res_ty)
= (dataConUnivAndExTyVars con, dataConTheta con, arg_tys, res_ty)
dataConInstSig
:: DataCon
......@@ -1066,9 +1184,8 @@ dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
, substTheta subst (eqSpecPreds eq_spec ++ theta)
, substTys subst arg_tys)
where
univ_subst = zipTvSubst (binderVars univ_tvs) univ_tys
(subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst $
binderVars ex_tvs
univ_subst = zipTvSubst univ_tvs univ_tys
(subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst ex_tvs
-- | The \"full signature\" of the 'DataCon' returns, in order:
......@@ -1090,7 +1207,7 @@ dataConFullSig :: DataCon
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
dcEqSpec = eq_spec, dcOtherTheta = theta,
dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
= (binderVars univ_tvs, binderVars ex_tvs, eq_spec, theta, arg_tys, res_ty)
= (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
dataConOrigResTy :: DataCon -> Type
dataConOrigResTy dc = dcOrigResTy dc
......@@ -1111,14 +1228,15 @@ dataConUserType :: DataCon -> Type
--
-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
--
-- The type variables are quantified in the order that the user wrote them.
-- See @Note [DataCon user type variable binders]@.
--
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
dataConUserType (MkData { dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
dataConUserType (MkData { dcUserTyVarBinders = user_tvbs,
dcOtherTheta = theta, dcOrigArgTys = arg_tys,
dcOrigResTy = res_ty })
= mkForAllTys (filterEqSpec eq_spec univ_tvs) $
mkForAllTys ex_tvs $
= mkForAllTys user_tvbs $
mkFunTys theta $
mkFunTys arg_tys $
res_ty
......@@ -1137,7 +1255,7 @@ dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
= ASSERT2( univ_tvs `equalLength` inst_tys
, text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
ASSERT2( null ex_tvs, ppr dc )
map (substTyWith (binderVars univ_tvs) inst_tys) (dataConRepArgTys dc)
map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
-- | Returns just the instantiated /value/ argument types of a 'DataCon',
-- (excluding dictionary args)
......@@ -1155,7 +1273,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
, text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
map (substTyWith tyvars inst_tys) arg_tys
where
tyvars = binderVars (univ_tvs ++ ex_tvs)
tyvars = univ_tvs ++ ex_tvs
-- | Returns the argument types of the wrapper, excluding all dictionary arguments
-- and without substituting for any type variables
......@@ -1245,6 +1363,23 @@ dataConCannotMatch tys con
| eq `hasKey` eqTyConKey -> [(ty1, ty2)]
_ -> []
-- | Were the type variables of the data con written in a different order
-- than the regular order (universal tyvars followed by existential tyvars)?
--
-- This is not a cheap test, so we minimize its use in GHC as much as possible.
-- Currently, its only call site in the GHC codebase is in 'mkDataConRep' in
-- "MkId", and so 'dataConUserTyVarsArePermuted' is only called at most once
-- during a data constructor's lifetime.
-- See Note [DataCon user type variable binders], as well as
-- Note [Data con wrappers and GADT syntax] for an explanation of what
-- mkDataConRep is doing with this function.
dataConUserTyVarsArePermuted :: DataCon -> Bool
dataConUserTyVarsArePermuted (MkData { dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
dcUserTyVarBinders = user_tvbs }) =
(filterEqSpec eq_spec univ_tvs ++ ex_tvs) /= binderVars user_tvbs
{-
%************************************************************************
%* *
......
......@@ -13,13 +13,13 @@ import {-# SOURCE #-} TyCoRep ( Type, ThetaType )
data DataCon
data DataConRep
data EqSpec
filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
filterEqSpec :: [EqSpec] -> [TyVar] -> [TyVar]
dataConName :: DataCon -> Name
dataConTyCon :: DataCon -> TyCon
dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVarBinders :: DataCon -> [TyVarBinder]
dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVarBinders :: DataCon -> [TyVarBinder]
dataConSourceArity :: DataCon -> Arity
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
......
......@@ -278,7 +278,7 @@ mkDictSelId name clas
sel_names = map idName (classAllSelIds clas)
new_tycon = isNewTyCon tycon
[data_con] = tyConDataCons tycon
tyvars = dataConUnivTyVarBinders data_con
tyvars = dataConUserTyVarBinders data_con
n_ty_args = length tyvars
arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
val_index = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
......@@ -553,7 +553,6 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
-- Passing Nothing here allows the wrapper to inline when
-- unsaturated.
wrap_unf = mkInlineUnfolding wrap_rhs
wrap_tvs = (univ_tvs `minusList` map eqSpecTyVar eq_spec) ++ ex_tvs
wrap_rhs = mkLams wrap_tvs $
mkLams wrap_args $
wrapFamInstBody tycon res_ty_args $
......@@ -568,6 +567,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
where
(univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)
= dataConFullSig data_con
wrap_tvs = dataConUserTyVars data_con
res_ty_args = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs
tycon = dataConTyCon data_con -- The representation TyCon (not family)
......@@ -595,11 +595,20 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
(unboxers, boxers) = unzip wrappers
(rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
wrapper_reqd = not (isNewTyCon tycon) -- Newtypes have only a worker
&& (any isBanged (ev_ibangs ++ arg_ibangs)
-- Some forcing/unboxing (includes eq_spec)
|| isFamInstTyCon tycon -- Cast result
|| (not $ null eq_spec)) -- GADT
wrapper_reqd =
(not (isNewTyCon 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)
-- Some forcing/unboxing (includes eq_spec)
|| isFamInstTyCon tycon -- Cast result
|| (not $ null eq_spec))) -- GADT
|| dataConUserTyVarsArePermuted 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].
initial_wrap_app = Var (dataConWorkId data_con)
`mkTyApps` res_ty_args
......@@ -677,6 +686,40 @@ For a start, it's still to generate a no-op. But worse, since wrappers
are currently injected at TidyCore, we don't even optimise it away!
So the stupid case expression stays there. This actually happened for
the Integer data type (see Trac #1600 comment:66)!
Note [Data con wrappers and GADT syntax]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider these two very similar data types:
data T1 a b = MkT1 b
data T2 a b where
MkT2 :: forall b a. b -> T2 a b
Despite their similar appearance, T2 will have a data con wrapper but T1 will
not. What sets them apart? The types of their constructors, which are:
MkT1 :: forall a b. b -> T1 a b
MkT2 :: forall b a. b -> T2 a b
MkT2's use of GADT syntax allows it to permute the order in which `a` and `b`
would normally appear. See Note [DataCon user type variable binders] in DataCon
for further discussion on this topic.
The worker data cons for T1 and T2, however, both have types such that `a` is
expected to come before `b` as arguments. Because MkT2 permutes this order, it
needs a data con wrapper to swizzle around the type variables to be in the
order the worker expects.
A somewhat surprising consequence of this is that *newtypes* can have data con
wrappers! After all, a newtype can also be written with GADT syntax:
newtype T3 a b where
MkT3 :: forall b a. b -> T3 a b
Again, this needs a wrapper data con to reorder the type variables. It does
mean that this newtype constructor requires another level of indirection when
being called, but the inliner should make swift work of that.
-}
-------------------------
......
......@@ -72,9 +72,12 @@ mkNewTyConRhs tycon_name tycon con
where
tvs = tyConTyVars tycon
roles = tyConRoles tycon
inst_con_ty = piResultTys (dataConUserType con) (mkTyVarTys tvs)
rhs_ty = ASSERT( isFunTy inst_con_ty ) funArgTy inst_con_ty
-- Instantiate the data con with the
con_arg_ty = case dataConRepArgTys con of
[arg_ty] -> arg_ty
tys -> pprPanic "mkNewTyConRhs" (ppr con <+> ppr tys)
rhs_ty = substTyWith (dataConUnivTyVars con)
(mkTyVarTys tvs) con_arg_ty
-- Instantiate the newtype's RHS with the
-- type variables from the tycon
-- NB: a newtype DataCon has a type that must look like
-- forall tvs. <arg-ty> -> T tvs
......@@ -109,8 +112,9 @@ buildDataCon :: FamInstEnvs
-> Maybe [HsImplBang]
-- See Note [Bangs on imported data constructors] in MkId
-> [FieldLabel] -- Field labels
-> [TyVarBinder] -- Universals
-> [TyVarBinder] -- Existentials
-> [TyVar] -- Universals
-> [TyVar] -- Existentials
-> [TyVarBinder] -- User-written 'TyVarBinder's
-> [EqSpec] -- Equality spec
-> ThetaType -- Does not include the "stupid theta"
-- or the GADT equalities
......@@ -122,7 +126,7 @@ buildDataCon :: FamInstEnvs
-- b) makes the wrapper Id if necessary, including
-- allocating its unique (hence monadic)
buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs field_lbls
univ_tvs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon
univ_tvs ex_tvs user_tvbs eq_spec ctxt arg_tys res_ty rep_tycon
= do { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
; work_name <- newImplicitBinder src_name mkDataConWorkerOcc
-- This last one takes the name of the data constructor in the source
......@@ -135,7 +139,7 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
; let stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
data_con = mkDataCon src_name declared_infix prom_info
src_bangs field_lbls
univ_tvs ex_tvs eq_spec ctxt
univ_tvs ex_tvs user_tvbs eq_spec ctxt
arg_tys res_ty NoRRI rep_tycon
stupid_ctxt dc_wrk dc_rep
dc_wrk = mkDataConWorkId work_name data_con
......@@ -150,13 +154,13 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
-- the type variables mentioned in the arg_tys
-- ToDo: Or functionally dependent on?
-- This whole stupid theta thing is, well, stupid.
mkDataConStupidTheta :: TyCon -> [Type] -> [TyVarBinder] -> [PredType]
mkDataConStupidTheta :: TyCon -> [Type] -> [TyVar] -> [PredType]
mkDataConStupidTheta tycon arg_tys univ_tvs
| null stupid_theta = [] -- The common case
| otherwise = filter in_arg_tys stupid_theta
where
tc_subst = zipTvSubst (tyConTyVars tycon)
(mkTyVarTys (binderVars univ_tvs))
(mkTyVarTys univ_tvs)
stupid_theta = substTheta tc_subst (tyConStupidTheta tycon)
-- Start by instantiating the master copy of the
-- stupid theta, taken from the TyCon
......@@ -308,8 +312,9 @@ buildClass tycon_name binders roles fds
(map (const no_bang) args)
(Just (map (const HsLazy) args))
[{- No fields -}]
univ_bndrs
univ_tvs
[{- no existentials -}]
univ_bndrs
[{- No GADT equalities -}]
[{- No theta -}]
arg_tys
......
......@@ -66,7 +66,7 @@ import Binary
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import Var( TyVarBndr(..) )