%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[DataCon]{@DataCon@: Data Constructors}
\begin{code}
module DataCon (
+ -- * Main data types
DataCon, DataConIds(..),
- ConTag, fIRST_TAG,
- mkDataCon,
+ ConTag,
+
+ -- ** Type construction
+ mkDataCon, fIRST_TAG,
+
+ -- ** Type deconstruction
dataConRepType, dataConSig, dataConFullSig,
- dataConName, dataConTag, dataConTyCon, dataConUserType,
- dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
- dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta,
- dataConInstArgTys, dataConOrigArgTys,
+ dataConName, dataConIdentity, dataConTag, dataConTyCon,
+ dataConOrigTyCon, dataConUserType,
+ dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
+ dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta,
+ dataConStupidTheta,
+ dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType,
dataConStrictMarks, dataConExStricts,
dataConIsInfix,
dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
dataConRepStrictness,
+
+ -- ** Predicates on DataCons
isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
isVanillaDataCon, classDataCon,
+ -- * Splitting product types
splitProductType_maybe, splitProductType, deepSplitProductType,
deepSplitProductType_maybe
) where
#include "HsVersions.h"
-import Type ( Type, ThetaType,
- substTyWith, substTyVar, mkTopTvSubst,
- mkForAllTys, mkFunTys, mkTyConApp, mkTyVarTy, mkTyVarTys,
- splitTyConApp_maybe, newTyConInstRhs,
- mkPredTys, isStrictPred, pprType, mkPredTy
- )
-import Coercion ( isEqPred, mkEqPred )
-import TyCon ( TyCon, FieldLabel, tyConDataCons,
- isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon,
- isNewTyCon, isRecursiveTyCon )
-import Class ( Class, classTyCon )
-import Name ( Name, NamedThing(..), nameUnique, mkSysTvName, mkSystemName )
-import Var ( TyVar, CoVar, Id, mkTyVar, tyVarKind, setVarUnique,
- mkCoVar )
-import BasicTypes ( Arity, StrictnessMark(..) )
+import Type
+import Coercion
+import TyCon
+import Class
+import Name
+import Var
+import BasicTypes
import Outputable
-import Unique ( Unique, Uniquable(..) )
-import ListSetOps ( assoc, minusList )
-import Util ( zipEqual, zipWithEqual )
-import List ( partition )
-import Maybes ( expectJust )
+import Unique
+import ListSetOps
+import Util
import FastString
+import Module
+
+import qualified Data.Data as Data
+import Data.Char
+import Data.Word
+import Data.List ( partition )
\end{code}
Note [Data Constructor Naming]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Each data constructor C has two, and possibly three, Names associated with it:
-
- OccName Name space Used for
- ---------------------------------------------------------------------------
- * The "source data con" C DataName The DataCon itself
- * The "real data con" C VarName Its worker Id
- * The "wrapper data con" $WC VarName Wrapper Id (optional)
-
-Each of these three has a distinct Unique. The "source data con" name
+Each data constructor C has two, and possibly up to four, Names associated with it:
+
+ OccName Name space Name of Notes
+ ---------------------------------------------------------------------------
+ The "data con itself" C DataName DataCon In dom( GlobalRdrEnv )
+ The "worker data con" C VarName Id The worker
+ The "wrapper data con" $WC VarName Id The wrapper
+ The "newtype coercion" :CoT TcClsName TyCon
+
+EVERY data constructor (incl for newtypes) has the former two (the
+data con itself, and its worker. But only some data constructors have a
+wrapper (see Note [The need for a wrapper]).
+
+Each of these three has a distinct Unique. The "data con itself" name
appears in the output of the renamer, and names the Haskell-source
data constructor. The type checker translates it into either the wrapper Id
(if it exists) or worker Id (otherwise).
does a cast, e.g.
newtype T = MkT Int
The worker for MkT has unfolding
- \(x:Int). x `cast` sym CoT
+ \\(x:Int). x `cast` sym CoT
Here CoT is the type constructor, witnessing the FC axiom
axiom CoT : T = Int
-The "wrapper Id", $WC, goes as follows
+The "wrapper Id", \$WC, goes as follows
* Its type is exactly what it looks like in the source program.
* The wrapper Id isn't generated for a data type if there is
nothing for the wrapper to do. That is, if its defn would be
- $wC = C
+ \$wC = C
+Note [The need for a wrapper]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Why might the wrapper have anything to do? Two reasons:
* Unboxing strict fields (with -funbox-strict-fields)
data T = MkT !(Int,Int)
- $wMkT :: (Int,Int) -> T
- $wMkT (x,y) = MkT x y
+ \$wMkT :: (Int,Int) -> T
+ \$wMkT (x,y) = MkT x y
Notice that the worker has two fields where the wapper has
just one. That is, the worker has type
MkT :: Int -> Int -> T
MkT :: forall a b. (a=[b]) => b -> T a
The wrapper has the programmer-specified type:
- $wMkT :: a -> T [a]
- $wMkT a x = MkT [a] a [a] x
+ \$wMkT :: a -> T [a]
+ \$wMkT a x = MkT [a] a [a] x
The third argument is a coerion
- [a] :: [a]:=:[a]
+ [a] :: [a]~[a]
+INVARIANT: the dictionary constructor for a class
+ never has a wrapper.
A note about the stupid context
%************************************************************************
\begin{code}
+-- | A data constructor
data DataCon
= MkData {
dcName :: Name, -- This is the name of the *source data con*
-- (see "Note [Data Constructor Naming]" above)
dcUnique :: Unique, -- Cached from Name
- dcTag :: ConTag,
+ dcTag :: ConTag, -- ^ Tag, used for ordering 'DataCon's
-- Running example:
--
-- *** As declared by the user
-- data T a where
- -- MkT :: forall x y. (Ord x) => x -> y -> T (x,y)
+ -- MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)
-- *** As represented internally
-- data T a where
- -- MkT :: forall a. forall x y. (a:=:(x,y), Ord x) => x -> y -> T a
+ -- MkT :: forall a. forall x y. (a~(x,y),x~y,Ord x) => x -> y -> T a
--
-- The next six fields express the type of the constructor, in pieces
-- e.g.
--
-- dcUnivTyVars = [a]
-- dcExTyVars = [x,y]
- -- dcEqSpec = [a:=:(x,y)]
- -- dcTheta = [Ord x]
+ -- dcEqSpec = [a~(x,y)]
+ -- dcEqTheta = [x~y]
+ -- dcDictTheta = [Ord x]
-- dcOrigArgTys = [a,List b]
- -- dcTyCon = T
+ -- dcRepTyCon = T
dcVanilla :: Bool, -- True <=> This is a vanilla Haskell 98 data constructor
-- Its type is of form
-- forall a1..an . t1 -> ... tm -> T a1..an
-- No existentials, no coercions, nothing.
- -- That is: dcExTyVars = dcEqSpec = dcTheta = []
+ -- That is: dcExTyVars = dcEqSpec = dcEqTheta = dcDictTheta = []
-- NB 1: newtypes always have a vanilla data con
-- NB 2: a vanilla constructor can still be declared in GADT-style
-- syntax, provided its type looks like the above.
-- The declaration format is held in the TyCon (algTcGadtSyntax)
- dcUnivTyVars :: [TyVar], -- Universally-quantified type vars
+ dcUnivTyVars :: [TyVar], -- Universally-quantified type vars [a,b,c]
+ -- INVARIANT: length matches arity of the dcRepTyCon
+ --- result type of (rep) data con is exactly (T a b c)
+
dcExTyVars :: [TyVar], -- Existentially-quantified type vars
-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
-- FOR THE PARENT TyCon. With GADTs the data con might not even have
-- [This is a change (Oct05): previously, vanilla datacons guaranteed to
-- have the same type variables as their parent TyCon, but that seems ugly.]
+ -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
+ -- Reason: less confusing, and easier to generate IfaceSyn
+
dcEqSpec :: [(TyVar,Type)], -- Equalities derived from the result type,
- -- *as written by the programmer*
+ -- _as written by the programmer_
-- This field allows us to move conveniently between the two ways
-- of representing a GADT constructor's type:
- -- MkT :: forall a b. (a :=: [b]) => b -> T a
+ -- MkT :: forall a b. (a ~ [b]) => b -> T a
-- MkT :: forall b. b -> T [b]
- -- Each equality is of the form (a :=: ty), where 'a' is one of
+ -- Each equality is of the form (a ~ ty), where 'a' is one of
-- the universally quantified type variables
- dcTheta :: ThetaType, -- The context of the constructor
+ -- The next two fields give the type context of the data constructor
+ -- (aside from the GADT constraints,
+ -- which are given by the dcExpSpec)
-- In GADT form, this is *exactly* what the programmer writes, even if
-- the context constrains only universally quantified variables
- -- MkT :: forall a. Eq a => a -> T a
- -- It may contain user-written equality predicates too
+ -- MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
+ dcEqTheta :: ThetaType, -- The *equational* constraints
+ dcDictTheta :: ThetaType, -- The *type-class and implicit-param* constraints
dcStupidTheta :: ThetaType, -- The context of the data type declaration
-- data Eq a => T a = ...
dcOrigArgTys :: [Type], -- Original argument types
-- (before unboxing and flattening of strict fields)
-
- -- Result type of constructor is T t1..tn
- dcTyCon :: TyCon, -- Result tycon, T
+ dcOrigResTy :: Type, -- Original result type, as seen by the user
+ -- NB: for a data instance, the original user result type may
+ -- differ from the DataCon's representation TyCon. Example
+ -- data instance T [a] where MkT :: a -> T [a]
+ -- The OrigResTy is T [a], but the dcRepTyCon might be :T123
-- Now the strictness annotations and field labels of the constructor
- dcStrictMarks :: [StrictnessMark],
+ dcStrictMarks :: [HsBang],
-- Strictness annotations as decided by the compiler.
-- Does *not* include the existential dictionaries
-- length = dataConSourceArity dataCon
dcFields :: [FieldLabel],
-- Field labels for this constructor, in the
- -- same order as the argument types;
+ -- same order as the dcOrigArgTys;
-- length = 0 (if not a record) or dataConSourceArity.
-- Constructor representation
-- after unboxing and flattening,
-- and *including* existential dictionaries
- dcRepStrictness :: [StrictnessMark], -- One for each *representation* argument
+ dcRepStrictness :: [StrictnessMark],
+ -- One for each *representation* *value* argument
+ -- See also Note [Data-con worker strictness] in MkId.lhs
+
+ -- Result type of constructor is T t1..tn
+ dcRepTyCon :: TyCon, -- Result tycon, T
dcRepType :: Type, -- Type of the constructor
- -- forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a
+ -- forall a x y. (a~(x,y), x~y, Ord x) =>
+ -- x -> y -> T a
-- (this is *not* of the constructor wrapper Id:
-- see Note [Data con representation] below)
-- Notice that the existential type parameters come *second*.
-- Reason: in a case expression we may find:
- -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
+ -- case (e :: T t) of
+ -- MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
-- It's convenient to apply the rep-type of MkT to 't', to get
- -- forall b. Ord b => ...
+ -- forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
-- and use that to check the pattern. Mind you, this is really only
- -- use in CoreLint.
+ -- used in CoreLint.
- -- Finally, the curried worker function that corresponds to the constructor
+ -- The curried worker function that corresponds to the constructor:
-- It doesn't have an unfolding; the code generator saturates these Ids
-- and allocates a real constructor when it finds one.
--
-- The actual fixity is stored elsewhere
}
+-- | Contains the Ids of the data constructor functions
data DataConIds
= DCIds (Maybe Id) Id -- Algebraic data types always have a worker, and
-- may or may not have a wrapper, depending on whether
-- The 'Nothing' case of DCIds is important
-- Not only is this efficient,
-- but it also ensures that the wrapper is replaced
- -- by the worker (becuase it *is* the wroker)
+ -- by the worker (because it *is* the worker)
-- even when there are no args. E.g. in
-- f (:) x
-- the (:) *is* the worker.
-- but that makes it less likely that rules will match
-- when we bring bits of unfoldings together.)
+-- | Type of the tags associated with each constructor possibility
type ConTag = Int
fIRST_TAG :: ConTag
-fIRST_TAG = 1 -- Tags allocated from here for real constructors
+-- ^ Tags are allocated from here for real constructors
+fIRST_TAG = 1
\end{code}
Note [Data con representation]
instance Show DataCon where
showsPrec p con = showsPrecSDoc p (ppr con)
+
+instance Data.Typeable DataCon where
+ typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
+
+instance Data.Data DataCon where
+ -- don't traverse?
+ toConstr _ = abstractConstr "DataCon"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "DataCon"
\end{code}
%************************************************************************
\begin{code}
+-- | Build a new data constructor
mkDataCon :: Name
- -> Bool -- Declared infix
- -> [StrictnessMark] -> [FieldLabel]
- -> [TyVar] -> [TyVar]
- -> [(TyVar,Type)] -> ThetaType
- -> [Type] -> TyCon
- -> ThetaType -> DataConIds
+ -> Bool -- ^ Is the constructor declared infix?
+ -> [HsBang] -- ^ Strictness annotations written in the source file
+ -> [FieldLabel] -- ^ Field labels for the constructor, if it is a record,
+ -- otherwise empty
+ -> [TyVar] -- ^ Universally quantified type variables
+ -> [TyVar] -- ^ Existentially quantified type variables
+ -> [(TyVar,Type)] -- ^ GADT equalities
+ -> ThetaType -- ^ Theta-type occuring before the arguments proper
+ -> [Type] -- ^ Original argument types
+ -> Type -- ^ Original result type
+ -> TyCon -- ^ Representation type constructor
+ -> ThetaType -- ^ The "stupid theta", context of the data declaration
+ -- e.g. @data Eq a => T a ...@
+ -> DataConIds -- ^ The Ids of the actual builder functions
-> DataCon
-- Can get the tag from the TyCon
fields
univ_tvs ex_tvs
eq_spec theta
- orig_arg_tys tycon
+ orig_arg_tys orig_res_ty rep_tycon
stupid_theta ids
- = ASSERT( not (any isEqPred theta) )
+-- Warning: mkDataCon is not a good place to check 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
+-- if you pull on univ_tvs. This case is checked by checkValidDataCon,
+-- so the error is detected properly... it's just that asaertions here
+-- are a little dodgy.
+
+ = -- ASSERT( not (any isEqPred theta) )
-- We don't currently allow any equality predicates on
-- a data constructor (apart from the GADT ones in eq_spec)
con
where
is_vanilla = null ex_tvs && null eq_spec && null theta
- con = ASSERT( is_vanilla || not (isNewTyCon tycon) )
- -- Invariant: newtypes have a vanilla data-con
- MkData {dcName = name, dcUnique = nameUnique name,
+ con = MkData {dcName = name, dcUnique = nameUnique name,
dcVanilla = is_vanilla, dcInfix = declared_infix,
dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
dcEqSpec = eq_spec,
- dcStupidTheta = stupid_theta, dcTheta = theta,
- dcOrigArgTys = orig_arg_tys, dcTyCon = tycon,
+ dcStupidTheta = stupid_theta,
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta,
+ dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
+ dcRepTyCon = rep_tycon,
dcRepArgTys = rep_arg_tys,
- dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
+ dcStrictMarks = arg_stricts,
+ dcRepStrictness = rep_arg_stricts,
dcFields = fields, dcTag = tag, dcRepType = ty,
dcIds = ids }
-- The 'arg_stricts' passed to mkDataCon are simply those for the
-- source-language arguments. We add extra ones for the
-- dictionary arguments right here.
- dict_tys = mkPredTys theta
- real_arg_tys = dict_tys ++ orig_arg_tys
- real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
+ (eq_theta,dict_theta) = partition isEqPred theta
+ dict_tys = mkPredTys dict_theta
+ real_arg_tys = dict_tys ++ orig_arg_tys
+ real_stricts = map mk_dict_strict_mark dict_theta ++ arg_stricts
-- Representation arguments and demands
-- To do: eliminate duplication with MkId
(rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
- tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
+ tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
+ mkFunTys (mkPredTys eq_theta) $
-- NB: the dict args are already in rep_arg_tys
-- because they might be flattened..
-- but the equality predicates are not
mkFunTys rep_arg_tys $
- mkTyConApp tycon (mkTyVarTys univ_tvs)
+ mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
eqSpecPreds :: [(TyVar,Type)] -> ThetaType
eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
-mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
- | otherwise = NotMarkedStrict
+mk_dict_strict_mark :: PredType -> HsBang
+mk_dict_strict_mark pred | isStrictPred pred = HsStrict
+ | otherwise = HsNoBang
\end{code}
\begin{code}
+-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
dataConName :: DataCon -> Name
dataConName = dcName
+-- | The tag used for ordering 'DataCon's
dataConTag :: DataCon -> ConTag
dataConTag = dcTag
+-- | The type constructor that we are building via this data constructor
dataConTyCon :: DataCon -> TyCon
-dataConTyCon = dcTyCon
-
+dataConTyCon = dcRepTyCon
+
+-- | The original type constructor used in the definition of this data
+-- constructor. In case of a data family instance, that will be the family
+-- type constructor.
+dataConOrigTyCon :: DataCon -> TyCon
+dataConOrigTyCon dc
+ | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
+ | otherwise = dcRepTyCon dc
+
+-- | The representation type of the data constructor, i.e. the sort
+-- type that will represent values of this type at runtime
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
+-- | Should the 'DataCon' be presented infix?
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = dcInfix
+-- | The universally-quantified type variables of the constructor
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars = dcUnivTyVars
+-- | The existentially-quantified type variables of the constructor
dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVars = dcExTyVars
+-- | Both the universal and existentiatial type variables of the constructor
dataConAllTyVars :: DataCon -> [TyVar]
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
= univ_tvs ++ ex_tvs
+-- | Equalities derived from the result type of the data constructor, as written
+-- by the programmer in any GADT declaration
dataConEqSpec :: DataCon -> [(TyVar,Type)]
dataConEqSpec = dcEqSpec
-dataConTheta :: DataCon -> ThetaType
-dataConTheta = dcTheta
+-- | The equational constraints on the data constructor type
+dataConEqTheta :: DataCon -> ThetaType
+dataConEqTheta = dcEqTheta
+
+-- | The type class and implicit parameter contsraints on the data constructor type
+dataConDictTheta :: DataCon -> ThetaType
+dataConDictTheta = dcDictTheta
+-- | Get the Id of the 'DataCon' worker: a function that is the "actual"
+-- constructor and has no top level binding in the program. The type may
+-- be different from the obvious one written in the source program. Panics
+-- if there is no such 'Id' for this 'DataCon'
dataConWorkId :: DataCon -> Id
dataConWorkId dc = case dcIds dc of
DCIds _ wrk_id -> wrk_id
+-- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
+-- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
+-- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor
+-- and also for a newtype (whose constructor is inlined compulsorily)
dataConWrapId_maybe :: DataCon -> Maybe Id
--- Returns Nothing if there is no wrapper for an algebraic data con
--- and also for a newtype (whose constructor is inlined compulsorily)
dataConWrapId_maybe dc = case dcIds dc of
DCIds mb_wrap _ -> mb_wrap
+-- | Returns an Id which looks like the Haskell-source constructor by using
+-- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to
+-- the worker (see 'dataConWorkId')
dataConWrapId :: DataCon -> Id
--- Returns an Id which looks like the Haskell-source constructor
dataConWrapId dc = case dcIds dc of
DCIds (Just wrap) _ -> wrap
DCIds Nothing wrk -> wrk -- worker=wrapper
+-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
+-- the union of the 'dataConWorkId' and the 'dataConWrapId'
dataConImplicitIds :: DataCon -> [Id]
dataConImplicitIds dc = case dcIds dc of
DCIds (Just wrap) work -> [wrap,work]
DCIds Nothing work -> [work]
+-- | The labels for the fields of this particular 'DataCon'
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields
+-- | Extract the type for any given labelled field of the 'DataCon'
dataConFieldType :: DataCon -> FieldLabel -> Type
-dataConFieldType con label = expectJust "unexpected label" $
- lookup label (dcFields con `zip` dcOrigArgTys con)
-
-dataConStrictMarks :: DataCon -> [StrictnessMark]
+dataConFieldType con label
+ = case lookup label (dcFields con `zip` dcOrigArgTys con) of
+ Just ty -> ty
+ Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
+
+-- | The strictness markings decided on by the compiler. Does not include those for
+-- existential dictionaries. The list is in one-to-one correspondence with the arity of the 'DataCon'
+dataConStrictMarks :: DataCon -> [HsBang]
dataConStrictMarks = dcStrictMarks
-dataConExStricts :: DataCon -> [StrictnessMark]
--- Strictness of *existential* arguments only
+-- | Strictness of /existential/ arguments only
+dataConExStricts :: DataCon -> [HsBang]
-- Usually empty, so we don't bother to cache this
-dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
+dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc
+-- | Source-level arity of the data constructor
dataConSourceArity :: DataCon -> Arity
- -- Source-level arity of the data constructor
dataConSourceArity dc = length (dcOrigArgTys dc)
--- dataConRepArity gives the number of actual fields in the
--- {\em representation} of the data constructor. This may be more than appear
--- in the source code; the extra ones are the existentially quantified
--- dictionaries
+-- | Gives the number of actual fields in the /representation/ of the
+-- data constructor. This may be more than appear in the source code;
+-- the extra ones are the existentially quantified dictionaries
+dataConRepArity :: DataCon -> Int
dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
-isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
+-- | Return whether there are any argument types for this 'DataCon's original source type
+isNullarySrcDataCon :: DataCon -> Bool
isNullarySrcDataCon dc = null (dcOrigArgTys dc)
+
+-- | Return whether there are any argument types for this 'DataCon's runtime representation type
+isNullaryRepDataCon :: DataCon -> Bool
isNullaryRepDataCon dc = null (dcRepArgTys dc)
dataConRepStrictness :: DataCon -> [StrictnessMark]
- -- Give the demands on the arguments of a
- -- Core constructor application (Con dc args)
+-- ^ Give the demands on the arguments of a
+-- Core constructor application (Con dc args)
dataConRepStrictness dc = dcRepStrictness dc
-dataConSig :: DataCon -> ([TyVar], ThetaType, [Type])
+-- | The \"signature\" of the 'DataCon' returns, in order:
+--
+-- 1) The result of 'dataConAllTyVars',
+--
+-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
+-- parameter - whatever)
+--
+-- 3) The type arguments to the constructor
+--
+-- 4) The /original/ result type of the 'DataCon'
+dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
- = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys)
-
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta,
+ dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)
+
+-- | The \"full signature\" of the 'DataCon' returns, in order:
+--
+-- 1) The result of 'dataConUnivTyVars'
+--
+-- 2) The result of 'dataConExTyVars'
+--
+-- 3) The result of 'dataConEqSpec'
+--
+-- 4) The result of 'dataConDictTheta'
+--
+-- 5) The original argument types to the 'DataCon' (i.e. before
+-- any change of the representation of the type)
+--
+-- 6) The original result type of the 'DataCon'
dataConFullSig :: DataCon
- -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type])
+ -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
- = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys)
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta,
+ dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
+
+dataConOrigResTy :: DataCon -> Type
+dataConOrigResTy dc = dcOrigResTy dc
+-- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:
+--
+-- > data Eq a => T a = ...
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta dc = dcStupidTheta dc
-dataConResTys :: DataCon -> [Type]
-dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
- where
- env = mkTopTvSubst (dcEqSpec dc)
-
dataConUserType :: DataCon -> Type
--- The user-declared type of the data constructor
--- in the nice-to-read form
--- T :: forall a. a -> T [a]
--- rather than
--- T :: forall b. forall a. (a=[b]) => a -> T b
+-- ^ The user-declared type of the data constructor
+-- in the nice-to-read form:
+--
+-- > T :: forall a b. a -> b -> T [a]
+--
+-- rather than:
+--
+-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
+--
+-- 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,
- dcTheta = theta, dcOrigArgTys = arg_tys,
- dcTyCon = tycon })
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
+ dcOrigResTy = res_ty })
= mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
- mkFunTys (mkPredTys theta) $
+ mkFunTys (mkPredTys eq_theta) $
+ mkFunTys (mkPredTys dict_theta) $
mkFunTys arg_tys $
- mkTyConApp tycon (map (substTyVar subst) univ_tvs)
- where
- subst = mkTopTvSubst eq_spec
-
-dataConInstArgTys :: DataCon
- -> [Type] -- Instantiated at these types
- -- NB: these INCLUDE the existentially quantified arg types
- -> [Type] -- Needs arguments of these types
- -- NB: these INCLUDE the existentially quantified dict args
- -- but EXCLUDE the data-decl context which is discarded
- -- It's all post-flattening etc; this is a representation type
-dataConInstArgTys (MkData {dcRepArgTys = arg_tys,
- dcUnivTyVars = univ_tvs,
- dcExTyVars = ex_tvs}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
- map (substTyWith tyvars inst_tys) arg_tys
- where
- tyvars = univ_tvs ++ ex_tvs
-
-
--- And the same deal for the original arg tys
-dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
+ res_ty
+
+-- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
+-- NB: these INCLUDE any dictionary args
+-- but EXCLUDE the data-declaration context, which is discarded
+-- It's all post-flattening etc; this is a representation type
+dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality constraints
+ -- However, it can have a dcTheta (notably it can be a
+ -- class dictionary, with superclasses)
+ -> [Type] -- ^ Instantiated at these types
+ -> [Type]
+dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys,
+ dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
+ 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 )
+ map (substTyWith univ_tvs inst_tys) rep_arg_tys
+
+-- | Returns just the instantiated /value/ argument types of a 'DataCon',
+-- (excluding dictionary args)
+dataConInstOrigArgTys
+ :: DataCon -- Works for any DataCon
+ -> [Type] -- Includes existential tyvar args, but NOT
+ -- equality constraints or dicts
+ -> [Type]
+-- For vanilla datacons, it's all quite straightforward
+-- But for the call in MatchCon, we really do want just the value args
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
- dcUnivTyVars = univ_tvs,
- dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
- map (substTyWith tyvars inst_tys) arg_tys
- where
- tyvars = univ_tvs ++ ex_tvs
+ dcUnivTyVars = univ_tvs,
+ dcExTyVars = ex_tvs}) inst_tys
+ = ASSERT2( length tyvars == length inst_tys
+ , ptext (sLit "dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
+ map (substTyWith tyvars inst_tys) arg_tys
+ where
+ tyvars = univ_tvs ++ ex_tvs
\end{code}
-These two functions get the real argument types of the constructor,
-without substituting for any type variables.
-
-dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
-
-dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
-after any flattening has been done.
-
\begin{code}
+-- | Returns the argument types of the wrapper, excluding all dictionary arguments
+-- and without substituting for any type variables
dataConOrigArgTys :: DataCon -> [Type]
dataConOrigArgTys dc = dcOrigArgTys dc
+-- | Returns the arg types of the worker, including all dictionaries, after any
+-- flattening has been done and without substituting for any type variables
dataConRepArgTys :: DataCon -> [Type]
dataConRepArgTys dc = dcRepArgTys dc
\end{code}
+\begin{code}
+-- | The string @package:module.name@ identifying a constructor, which is attached
+-- to its info table and used by the GHCi debugger and the heap profiler
+dataConIdentity :: DataCon -> [Word8]
+-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
+dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++
+ fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
+ fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
+ where name = dataConName dc
+ mod = ASSERT( isExternalName name ) nameModule name
+\end{code}
\begin{code}
isTupleCon :: DataCon -> Bool
-isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
+isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
isUnboxedTupleCon :: DataCon -> Bool
-isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
+isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
+-- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon dc = dcVanilla dc
\end{code}
-
\begin{code}
classDataCon :: Class -> DataCon
classDataCon clas = case tyConDataCons (classTyCon clas) of
(dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
+ [] -> panic "classDataCon"
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
+-- | Extract the type constructor, type argument, data constructor and it's
+-- /representation/ argument types from a type if it is a product type.
+--
+-- Precisely, we return @Just@ for any type that is all of:
+--
+-- * Concrete (i.e. constructors visible)
+--
+-- * Single-constructor
+--
+-- * Not existentially quantified
+--
+-- Whether the type is a @data@ type or a @newtype@
splitProductType_maybe
- :: Type -- A product type, perhaps
+ :: Type -- ^ A product type, perhaps
-> Maybe (TyCon, -- The type constructor
[Type], -- Type args of the tycon
DataCon, -- The data constructor
- [Type]) -- Its *representation* arg types
+ [Type]) -- Its /representation/ arg types
- -- Returns (Just ...) for any
- -- concrete (i.e. constructors visible)
- -- single-constructor
- -- not existentially quantified
- -- type whether a data type or a new type
- --
-- Rejecing existentials is conservative. Maybe some things
-- could be made to work with them, but I'm not going to sweat
-- it through till someone finds it's important.
-- and for constructors visible
-> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
where
- data_con = head (tyConDataCons tycon)
- other -> Nothing
+ data_con = ASSERT( not (null (tyConDataCons tycon)) )
+ head (tyConDataCons tycon)
+ _other -> Nothing
+-- | As 'splitProductType_maybe', but panics if the 'Type' is not a product type
+splitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
splitProductType str ty
= case splitProductType_maybe ty of
Just stuff -> stuff
Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
+-- | As 'splitProductType_maybe', but in turn instantiates the 'TyCon' returned
+-- and hence recursively tries to unpack it as far as it able to
+deepSplitProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Type])
deepSplitProductType_maybe ty
= do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
; let {result
- | isNewTyCon tycon && not (isRecursiveTyCon tycon)
- = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
- | isNewTyCon tycon = Nothing -- cannot unbox through recursive newtypes
+ | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
+ , not (isRecursiveTyCon tycon)
+ = deepSplitProductType_maybe ty' -- Ignore the coercion?
+ | isNewTyCon tycon = Nothing -- cannot unbox through recursive
+ -- newtypes nor through families
| otherwise = Just res}
; result
}
-
+
+-- | As 'deepSplitProductType_maybe', but panics if the 'Type' is not a product type
+deepSplitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
deepSplitProductType str ty
= case deepSplitProductType_maybe ty of
Just stuff -> stuff
Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
-computeRep :: [StrictnessMark] -- Original arg strictness
- -> [Type] -- and types
+-- | Compute the representation type strictness and type suitable for a 'DataCon'
+computeRep :: [HsBang] -- ^ Original argument strictness
+ -> [Type] -- ^ Original argument types
-> ([StrictnessMark], -- Representation arg strictness
[Type]) -- And type
computeRep stricts tys
= unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
where
- unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
- unbox MarkedStrict ty = [(MarkedStrict, ty)]
- unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
- where
- (tycon, tycon_args, arg_dc, arg_tys)
- = deepSplitProductType "unbox_strict_arg_ty" ty
+ unbox HsNoBang ty = [(NotMarkedStrict, ty)]
+ unbox HsStrict ty = [(MarkedStrict, ty)]
+ unbox HsUnpackFailed ty = [(MarkedStrict, ty)]
+ unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
+ where
+ (_tycon, _tycon_args, arg_dc, arg_tys)
+ = deepSplitProductType "unbox_strict_arg_ty" ty
\end{code}
projects / ghc-hetmet.git / blobdiff