[commit: ghc] master: Support unboxing for GADT product types (f2d1b7f)
git at git.haskell.org
git at git.haskell.org
Tue Apr 21 08:18:28 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/f2d1b7fcbbc55e33375a7321222a9f4ee189aa38/ghc
>---------------------------------------------------------------
commit f2d1b7fcbbc55e33375a7321222a9f4ee189aa38
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Apr 20 16:00:49 2015 +0100
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
>---------------------------------------------------------------
f2d1b7fcbbc55e33375a7321222a9f4ee189aa38
compiler/basicTypes/DataCon.hs | 4 ++--
compiler/basicTypes/DataCon.hs-boot | 3 ++-
compiler/basicTypes/MkId.hs | 6 +++---
compiler/stranal/DmdAnal.hs | 5 ++++-
compiler/types/TyCon.hs | 38 ++++++++++++++++++++++++++++++++-----
5 files changed, 44 insertions(+), 12 deletions(-)
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index a6db5ac..46d79d8 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -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',
diff --git a/compiler/basicTypes/DataCon.hs-boot b/compiler/basicTypes/DataCon.hs-boot
index 5370a87..4f19ffc 100644
--- a/compiler/basicTypes/DataCon.hs-boot
+++ b/compiler/basicTypes/DataCon.hs-boot
@@ -1,4 +1,5 @@
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
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 98e6847..365ed82 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -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
diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index 4117eae..21a71de 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -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
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index ea219c1..4db72f6 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -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
More information about the ghc-commits
mailing list