Commit f2d1b7fc authored by Simon Peyton Jones's avatar Simon Peyton Jones

Support unboxing for GADT product types

Beofre this commit we never unboxed GADT, even if they
are perfectly civilised products.

This patch liberalises unboxing slightly.
See Note [Product types] in TyCon.

Still to come
 - for strictness, we could maybe deal with existentials too
 - todo: unboxing constructor arguments
parent d12c7cb9
......@@ -928,11 +928,11 @@ dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality
-- class dictionary, with superclasses)
-> [Type] -- ^ Instantiated at these types
-> [Type]
dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs}) inst_tys
= ASSERT2( length univ_tvs == length inst_tys
, ptext (sLit "dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
ASSERT2( null ex_tvs && null eq_spec, ppr dc )
ASSERT2( null ex_tvs, ppr dc )
map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
-- | Returns just the instantiated /value/ argument types of a 'DataCon',
......
module DataCon where
import Var( TyVar )
import Name( Name, NamedThing )
import {-# SOURCE #-} TyCon( TyCon )
import Unique ( Uniquable )
......@@ -8,7 +9,7 @@ data DataCon
data DataConRep
dataConName :: DataCon -> Name
dataConTyCon :: DataCon -> TyCon
isVanillaDataCon :: DataCon -> Bool
dataConExTyVars :: DataCon -> [TyVar]
instance Eq DataCon
instance Ord DataCon
......
......@@ -422,7 +422,7 @@ dataConCPR :: DataCon -> DmdResult
dataConCPR con
| isDataTyCon tycon -- Real data types only; that is,
-- not unboxed tuples or newtypes
, isVanillaDataCon con -- No existentials
, null (dataConExTyVars con) -- No existentials
, wkr_arity > 0
, wkr_arity <= mAX_CPR_SIZE
= if is_prod then vanillaCprProdRes (dataConRepArity con)
......@@ -430,8 +430,8 @@ dataConCPR con
| otherwise
= topRes
where
is_prod = isProductTyCon tycon
tycon = dataConTyCon con
is_prod = isProductTyCon tycon
tycon = dataConTyCon con
wkr_arity = dataConRepArity con
mAX_CPR_SIZE :: Arity
......
......@@ -211,7 +211,7 @@ dmdAnal' env dmd (Lam var body)
dmdAnal' env dmd (Case scrut case_bndr ty [(DataAlt dc, bndrs, rhs)])
-- Only one alternative with a product constructor
| let tycon = dataConTyCon dc
, isProductTyCon tycon
, isJust (isDataProductTyCon_maybe tycon)
, Just rec_tc' <- checkRecTc (ae_rec_tc env) tycon
= let
env_w_tc = env { ae_rec_tc = rec_tc' }
......@@ -257,6 +257,9 @@ dmdAnal' env dmd (Case scrut case_bndr ty alts)
(alt_tys, alts') = mapAndUnzip (dmdAnalAlt env dmd case_bndr) alts
(scrut_ty, scrut') = dmdAnal env cleanEvalDmd scrut
(alt_ty, case_bndr') = annotateBndr env (foldr lubDmdType botDmdType alt_tys) case_bndr
-- NB: Base case is botDmdType, for empty case alternatives
-- This is a unit for lubDmdType, and the right result
-- when there really are no alternatives
res_ty = alt_ty `bothDmdType` toBothDmdArg scrut_ty
in
-- pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut
......
......@@ -95,7 +95,7 @@ module TyCon(
#include "HsVersions.h"
import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
import {-# SOURCE #-} DataCon ( DataCon, dataConExTyVars )
import Var
import Class
......@@ -1262,10 +1262,11 @@ unwrapNewTyConEtad_maybe _ = Nothing
isProductTyCon :: TyCon -> Bool
-- True of datatypes or newtypes that have
-- one, vanilla, data constructor
-- one, non-existential, data constructor
-- See Note [Product types]
isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
DataTyCon{ data_cons = [data_con] }
-> isVanillaDataCon data_con
-> null (dataConExTyVars data_con)
NewTyCon {} -> True
_ -> False
isProductTyCon (TupleTyCon {}) = True
......@@ -1275,14 +1276,41 @@ isProductTyCon _ = False
isDataProductTyCon_maybe :: TyCon -> Maybe DataCon
-- True of datatypes (not newtypes) with
-- one, vanilla, data constructor
-- See Note [Product types]
isDataProductTyCon_maybe (AlgTyCon { algTcRhs = DataTyCon { data_cons = cons } })
| [con] <- cons -- Singleton
, isVanillaDataCon con -- Vanilla
| [con] <- cons -- Singleton
, null (dataConExTyVars con) -- non-existential
= Just con
isDataProductTyCon_maybe (TupleTyCon { dataCon = con })
= Just con
isDataProductTyCon_maybe _ = Nothing
{- Note [Product types]
~~~~~~~~~~~~~~~~~~~~~~~
A product type is
* A data type (not a newtype)
* With one, boxed data constructor
* That binds no existential type variables
The main point is that product types are amenable to unboxing for
* Strict function calls; we can transform
f (D a b) = e
to
fw a b = e
via the worker/wrapper transformation. (Question: couldn't this
work for existentials too?)
* CPR for function results; we can transform
f x y = let ... in D a b
to
fw x y = let ... in (# a, b #)
Note that the data constructor /can/ have evidence arguments: equality
constraints, type classes etc. So it can be GADT. These evidence
arguments are simply value arguments, and should not get in the way.
-}
-- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?
isTypeSynonymTyCon :: TyCon -> Bool
isTypeSynonymTyCon (SynonymTyCon {}) = True
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment