\begin{code}
module DataCon (
- DataCon,
+ DataCon, DataConIds(..),
ConTag, fIRST_TAG,
mkDataCon,
dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
- dataConArgTys, dataConOrigArgTys,
- dataConRepArgTys, dataConTheta,
- dataConFieldLabels, dataConStrictMarks,
+ dataConTyVars, dataConResTys,
+ dataConStupidTheta,
+ dataConInstArgTys, dataConOrigArgTys, dataConInstResTy,
+ dataConInstOrigArgTys, dataConRepArgTys,
+ dataConFieldLabels, dataConFieldType,
+ dataConStrictMarks, dataConExStricts,
dataConSourceArity, dataConRepArity,
- dataConNumInstArgs, dataConId, dataConWrapId, dataConRepStrictness,
- isNullaryDataCon, isTupleCon, isUnboxedTupleCon, isDynDataCon,
- isExistentialDataCon,
+ dataConIsInfix,
+ dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
+ dataConRepStrictness,
+ isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
+ isVanillaDataCon, classDataCon,
splitProductType_maybe, splitProductType,
-
- StrictnessMark(..), -- Representation visible to MkId only
- markedStrict, notMarkedStrict, markedUnboxed, maybeMarkedUnboxed
) where
#include "HsVersions.h"
-import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
-
-import CmdLineOpts ( opt_DictsStrict )
-import TysPrim
-import Type ( Type, ThetaType, TauType, ClassContext,
- mkForAllTys, mkFunTys, mkTyConApp,
- mkTyVarTys, mkDictTy,
- splitAlgTyConApp_maybe, classesToPreds
+import Type ( Type, ThetaType, substTyWith, substTy, zipOpenTvSubst,
+ mkForAllTys, mkFunTys, mkTyConApp,
+ splitTyConApp_maybe,
+ mkPredTys, isStrictPred, pprType
)
-import TyCon ( TyCon, tyConDataCons, isDataTyCon, isProductTyCon,
- isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
-import Class ( classTyCon )
-import Name ( Name, NamedThing(..), nameUnique, isDynName, isLocallyDefined )
+import TyCon ( TyCon, FieldLabel, tyConDataCons,
+ isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon )
+import Class ( Class, classTyCon )
+import Name ( Name, NamedThing(..), nameUnique )
import Var ( TyVar, Id )
-import FieldLabel ( FieldLabel )
-import BasicTypes ( Arity )
-import Demand ( Demand, wwStrict, wwLazy )
+import BasicTypes ( Arity, StrictnessMark(..) )
import Outputable
import Unique ( Unique, Uniquable(..) )
-import CmdLineOpts ( opt_UnboxStrictFields )
-import PprType () -- Instances
-import UniqSet
-import Maybes ( maybeToBool )
-import Maybe
-import Util ( assoc )
+import ListSetOps ( assoc )
+import Util ( zipEqual, zipWithEqual )
+import Maybes ( expectJust )
\end{code}
-Stuff about data constructors
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Every constructor, C, comes with a
+Data constructor representation
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the following Haskell data type declaration
- *wrapper*, called C, whose type is exactly what it looks like
- in the source program. It is an ordinary function,
- and it gets a top-level binding like any other function
+ data T = T !Int ![Int]
+
+Using the strictness annotations, GHC will represent this as
+
+ data T = T Int# [Int]
+
+That is, the Int has been unboxed. Furthermore, the Haskell source construction
+
+ T e1 e2
+
+is translated to
+
+ case e1 of { I# x ->
+ case e2 of { r ->
+ T x r }}
+
+That is, the first argument is unboxed, and the second is evaluated. Finally,
+pattern matching is translated too:
+
+ case e of { T a b -> ... }
- *worker*, called $wC, which is the actual data constructor.
- Its type may be different to C, because:
+becomes
+
+ case e of { T a' b -> let a = I# a' in ... }
+
+To keep ourselves sane, we name the different versions of the data constructor
+differently, as follows.
+
+
+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
+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).
+
+The data con has one or two Ids associated with it:
+
+ The "worker Id", is the actual data constructor.
+ Its type may be different to the Haskell source constructor
+ because:
- useless dict args are dropped
- strict args may be flattened
- It does not have a binding.
+ The worker is very like a primop, in that it has no binding.
+
+ Newtypes have no worker Id
- The worker is very like a primop, in that it has no binding,
+ The "wrapper Id", $WC, whose type is exactly what it looks like
+ in the source program. It is an ordinary function,
+ and it gets a top-level binding like any other function.
+
+ The wrapper Id isn't generated for a data type if the worker
+ and wrapper are identical. It's always generated for a newtype.
+
+A note about the stupid context
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Data types can have a context:
+
+ data (Eq a, Ord b) => T a b = T1 a b | T2 a
+
+and that makes the constructors have a context too
+(notice that T2's context is "thinned"):
+
+ T1 :: (Eq a, Ord b) => a -> b -> T a b
+ T2 :: (Eq a) => a -> T a b
+
+Furthermore, this context pops up when pattern matching
+(though GHC hasn't implemented this, but it is in H98, and
+I've fixed GHC so that it now does):
+
+ f (T2 x) = x
+gets inferred type
+ f :: Eq a => T a b -> a
+
+I say the context is "stupid" because the dictionaries passed
+are immediately discarded -- they do nothing and have no benefit.
+It's a flaw in the language.
+
+ Up to now [March 2002] I have put this stupid context into the
+ type of the "wrapper" constructors functions, T1 and T2, but
+ that turned out to be jolly inconvenient for generics, and
+ record update, and other functions that build values of type T
+ (because they don't have suitable dictionaries available).
+
+ So now I've taken the stupid context out. I simply deal with
+ it separately in the type checker on occurrences of a
+ constructor, either in an expression or in a pattern.
+
+ [May 2003: actually I think this decision could evasily be
+ reversed now, and probably should be. Generics could be
+ disabled for types with a stupid context; record updates now
+ (H98) needs the context too; etc. It's an unforced change, so
+ I'm leaving it for now --- but it does seem odd that the
+ wrapper doesn't include the stupid context.]
+
+[July 04] With the advent of generalised data types, it's less obvious
+what the "stupid context" is. Consider
+ C :: forall a. Ord a => a -> a -> T (Foo a)
+Does the C constructor in Core contain the Ord dictionary? Yes, it must:
+
+ f :: T b -> Ordering
+ f = /\b. \x:T b.
+ case x of
+ C a (d:Ord a) (p:a) (q:a) -> compare d p q
+
+Note that (Foo a) might not be an instance of Ord.
+
%************************************************************************
%* *
\subsection{Data constructors}
\begin{code}
data DataCon
- = MkData { -- Used for data constructors only;
- -- there *is* no constructor for a newtype
- dcName :: Name,
- dcUnique :: Unique, -- Cached from Name
+ = 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,
-- Running example:
--
-- data Eq a => T a = forall b. Ord b => MkT a [b]
- dcRepType :: Type, -- Type of the constructor
- -- forall ab . Ord b => a -> [b] -> MkT a
- -- (this is *not* of the constructor Id:
- -- see notes after this data type declaration)
-
-- The next six fields express the type of the constructor, in pieces
-- e.g.
--
- -- dcTyVars = [a]
- -- dcTheta = [Eq a]
- -- dcExTyVars = [b]
- -- dcExTheta = [Ord b]
- -- dcOrigArgTys = [a,List b]
- -- dcTyCon = T
-
- dcTyVars :: [TyVar], -- Type vars and context for the data type decl
- -- These are ALWAYS THE SAME AS THE TYVARS
- -- FOR THE PARENT TyCon. We occasionally rely on
- -- this just to avoid redundant instantiation
- dcTheta :: ClassContext,
-
- dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
- dcExTheta :: ClassContext, -- the existentially quantified stuff
+ -- dcTyVars = [a,b]
+ -- dcStupidTheta = [Eq a]
+ -- dcTheta = [Ord b]
+ -- dcOrigArgTys = [a,List b]
+ -- dcTyCon = T
+ -- dcTyArgs = [a,b]
+
+ 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 GADTs, nothing.
+ --
+ -- NB1: the order of the forall'd variables does matter;
+ -- for a vanilla constructor, we assume that if the result
+ -- type is (T t1 ... tn) then we can instantiate the constr
+ -- at types [t1, ..., tn]
+ --
+ -- NB2: a vanilla constructor can still be declared in GADT-style
+ -- syntax, provided its type looks like the above.
+
+ dcTyVars :: [TyVar], -- Universally-quantified type vars
+ -- for the data constructor.
+ -- See NB1 on dcVanilla for the conneciton between dcTyVars and dcResTys
+ --
+ -- In general, the dcTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
+ -- FOR THE PARENT TyCon. With GADTs the data con might not even have
+ -- the same number of type variables.
+ -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
+ -- have the same type variables as their parent TyCon, but that seems ugly.]
+
+ dcStupidTheta :: ThetaType, -- This is a "thinned" version of
+ -- the context of the data decl.
+ -- "Thinned", because the Report says
+ -- to eliminate any constraints that don't mention
+ -- tyvars free in the arg types for this constructor
+ --
+ -- "Stupid", because the dictionaries aren't used for anything.
+ --
+ -- Indeed, [as of March 02] they are no
+ -- longer in the type of the wrapper Id, because
+ -- that makes it harder to use the wrap-id to rebuild
+ -- values after record selection or in generics.
+ --
+ -- Fact: the free tyvars of dcStupidTheta are a subset of
+ -- the free tyvars of dcResTys
+ -- Reason: dcStupidTeta is gotten by instantiating the
+ -- stupid theta from the tycon (see BuildTyCl.mkDataConStupidTheta)
+
+ dcTheta :: ThetaType, -- The existentially quantified stuff
dcOrigArgTys :: [Type], -- Original argument types
-- (before unboxing and flattening of
-- strict fields)
- dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
- -- and including existential dictionaries
-
- dcTyCon :: TyCon, -- Result tycon
+ -- Result type of constructor is T t1..tn
+ dcTyCon :: TyCon, -- Result tycon, T
+ dcResTys :: [Type], -- Result type args, t1..tn
-- Now the strictness annotations and field labels of the constructor
- dcUserStricts :: [StrictnessMark],
- -- Strictness annotations, as placed on the data type defn,
- -- in the same order as the argument types;
+ dcStrictMarks :: [StrictnessMark],
+ -- Strictness annotations as decided by the compiler.
+ -- Does *not* include the existential dictionaries
-- length = dataConSourceArity dataCon
- dcRealStricts :: [StrictnessMark],
- -- Strictness annotations as deduced by the compiler. May
- -- include some MarkedUnboxed fields that are merely MarkedStrict
- -- in dcUserStricts. Also includes the existential dictionaries.
- -- length = length dcExTheta + dataConSourceArity dataCon
-
dcFields :: [FieldLabel],
-- Field labels for this constructor, in the
-- same order as the argument types;
-- length = 0 (if not a record) or dataConSourceArity.
+ -- Constructor representation
+ dcRepArgTys :: [Type], -- Final, representation argument types,
+ -- after unboxing and flattening,
+ -- and *including* existential dictionaries
+
+ dcRepStrictness :: [StrictnessMark], -- One for each *representation* argument
+
+ dcRepType :: Type, -- Type of the constructor
+ -- forall a b . Ord b => a -> [b] -> MkT a
+ -- (this is *not* of the constructor wrapper Id:
+ -- see notes after this data type declaration)
+ --
+ -- 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]) -> ... }
+ -- It's convenient to apply the rep-type of MkT to 't', to get
+ -- forall b. Ord b => ...
+ -- and use that to check the pattern. Mind you, this is really only
+ -- use in CoreLint.
+
+
-- Finally, 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.
--
-- An entirely separate wrapper function is built in TcTyDecls
+ dcIds :: DataConIds,
- dcId :: Id, -- The corresponding worker Id
- -- Takes dcRepArgTys as its arguments
-
- dcWrapId :: Id -- The wrapper Id
+ dcInfix :: Bool -- True <=> declared infix
+ -- Used for Template Haskell and 'deriving' only
+ -- The actual fixity is stored elsewhere
}
+data DataConIds
+ = NewDC Id -- Newtypes have only a wrapper, but no worker
+ | AlgDC (Maybe Id) Id -- Algebraic data types always have a worker, and
+ -- may or may not have a wrapper, depending on whether
+ -- the wrapper does anything.
+
+ -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
+
+ -- The wrapper takes dcOrigArgTys as its arguments
+ -- The worker takes dcRepArgTys as its arguments
+ -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
+
+ -- The 'Nothing' case of AlgDC is important
+ -- Not only is this efficient,
+ -- but it also ensures that the wrapper is replaced
+ -- by the worker (becuase it *is* the wroker)
+ -- even when there are no args. E.g. in
+ -- f (:) x
+ -- the (:) *is* the worker.
+ -- This is really important in rule matching,
+ -- (We could match on the wrappers,
+ -- but that makes it less likely that rules will match
+ -- when we bring bits of unfoldings together.)
+
type ConTag = Int
fIRST_TAG :: ConTag
%************************************************************************
%* *
-\subsection{Strictness indication}
-%* *
-%************************************************************************
-
-\begin{code}
-data StrictnessMark = MarkedStrict
- | MarkedUnboxed DataCon [Type]
- | NotMarkedStrict
-
-markedStrict = MarkedStrict
-notMarkedStrict = NotMarkedStrict
-markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
-
-maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
-maybeMarkedUnboxed other = Nothing
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection{Instances}
%* *
%************************************************************************
%************************************************************************
%* *
-\subsection{Consruction}
+\subsection{Construction}
%* *
%************************************************************************
\begin{code}
-mkDataCon :: Name
+mkDataCon :: Name
+ -> Bool -- Declared infix
+ -> Bool -- Vanilla (see notes with dcVanilla)
-> [StrictnessMark] -> [FieldLabel]
- -> [TyVar] -> ClassContext
- -> [TyVar] -> ClassContext
- -> [TauType] -> TyCon
- -> Id -> Id
+ -> [TyVar] -> ThetaType -> ThetaType
+ -> [Type] -> TyCon -> [Type]
+ -> DataConIds
-> DataCon
-- Can get the tag from the TyCon
-mkDataCon name arg_stricts fields
- tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
- work_id wrap_id
- = ASSERT(length arg_stricts == length orig_arg_tys)
- -- The 'stricts' passed to mkDataCon are simply those for the
- -- source-language arguments. We add extra ones for the
- -- dictionary arguments right here.
- con
+mkDataCon name declared_infix vanilla
+ arg_stricts -- Must match orig_arg_tys 1-1
+ fields
+ tyvars stupid_theta theta orig_arg_tys tycon res_tys
+ ids
+ = con
where
- con = MkData {dcName = name, dcUnique = nameUnique name,
- dcTyVars = tyvars, dcTheta = theta,
- dcOrigArgTys = orig_arg_tys,
+ con = MkData {dcName = name,
+ dcUnique = nameUnique name, dcVanilla = vanilla,
+ dcTyVars = tyvars, dcStupidTheta = stupid_theta, dcTheta = theta,
+ dcOrigArgTys = orig_arg_tys, dcTyCon = tycon, dcResTys = res_tys,
dcRepArgTys = rep_arg_tys,
- dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
- dcRealStricts = all_stricts, dcUserStricts = user_stricts,
- dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
- dcId = work_id, dcWrapId = wrap_id}
-
- (real_arg_stricts, strict_arg_tyss)
- = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
- rep_arg_tys = [mkDictTy cls tys | (cls,tys) <- ex_theta] ++ concat strict_arg_tyss
-
- ex_dict_stricts = map mk_dict_strict_mark ex_theta
- -- Add a strictness flag for the existential dictionary arguments
- all_stricts = ex_dict_stricts ++ real_arg_stricts
- user_stricts = ex_dict_stricts ++ arg_stricts
+ dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
+ dcFields = fields, dcTag = tag, dcRepType = ty,
+ dcIds = ids, dcInfix = declared_infix}
+
+ -- Strictness marks for source-args
+ -- *after unboxing choices*,
+ -- but *including existential dictionaries*
+ --
+ -- 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
+
+ -- Representation arguments and demands
+ (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
- ty = mkForAllTys (tyvars ++ ex_tyvars)
- (mkFunTys rep_arg_tys result_ty)
+ ty = mkForAllTys tyvars (mkFunTys rep_arg_tys result_ty)
-- NB: the existential dict args are already in rep_arg_tys
- result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
+ result_ty = mkTyConApp tycon res_tys
-mk_dict_strict_mark (clas,tys)
- | opt_DictsStrict &&
- -- Don't mark newtype things as strict!
- isDataTyCon (classTyCon clas) = MarkedStrict
- | otherwise = NotMarkedStrict
+mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
+ | otherwise = NotMarkedStrict
\end{code}
\begin{code}
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
-dataConId :: DataCon -> Id
-dataConId = dcId
+dataConIsInfix :: DataCon -> Bool
+dataConIsInfix = dcInfix
+
+dataConTyVars :: DataCon -> [TyVar]
+dataConTyVars = dcTyVars
+
+dataConWorkId :: DataCon -> Id
+dataConWorkId dc = case dcIds dc of
+ AlgDC _ wrk_id -> wrk_id
+ NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
+
+dataConWrapId_maybe :: DataCon -> Maybe Id
+dataConWrapId_maybe dc = case dcIds dc of
+ AlgDC mb_wrap _ -> mb_wrap
+ NewDC wrap -> Just wrap
dataConWrapId :: DataCon -> Id
-dataConWrapId = dcWrapId
+-- Returns an Id which looks like the Haskell-source constructor
+dataConWrapId dc = case dcIds dc of
+ AlgDC (Just wrap) _ -> wrap
+ AlgDC Nothing wrk -> wrk -- worker=wrapper
+ NewDC wrap -> wrap
+
+dataConImplicitIds :: DataCon -> [Id]
+dataConImplicitIds dc = case dcIds dc of
+ AlgDC (Just wrap) work -> [wrap,work]
+ AlgDC Nothing work -> [work]
+ NewDC wrap -> [wrap]
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields
+dataConFieldType :: DataCon -> FieldLabel -> Type
+dataConFieldType con label = expectJust "unexpected label" $
+ lookup label (dcFields con `zip` dcOrigArgTys con)
+
dataConStrictMarks :: DataCon -> [StrictnessMark]
-dataConStrictMarks = dcRealStricts
+dataConStrictMarks = dcStrictMarks
--- Number of type-instantiation arguments
--- All the remaining arguments of the DataCon are (notionally)
--- stored in the DataCon, and are matched in a case expression
-dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
+dataConExStricts :: DataCon -> [StrictnessMark]
+-- Strictness of *existential* arguments only
+-- Usually empty, so we don't bother to cache this
+dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
dataConSourceArity :: DataCon -> Arity
-- Source-level arity of the data constructor
-- dictionaries
dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
-isNullaryDataCon con = dataConRepArity con == 0
+isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
+isNullarySrcDataCon dc = null (dcOrigArgTys dc)
+isNullaryRepDataCon dc = null (dcRepArgTys dc)
-dataConRepStrictness :: DataCon -> [Demand]
- -- Give the demands on the arguments of a
+dataConRepStrictness :: DataCon -> [StrictnessMark]
+ -- Give the demands on the arguments of a
-- Core constructor application (Con dc args)
-dataConRepStrictness dc
- = go (dcRealStricts dc)
- where
- go [] = []
- go (MarkedStrict : ss) = wwStrict : go ss
- go (NotMarkedStrict : ss) = wwLazy : go ss
- go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
-
-dataConSig :: DataCon -> ([TyVar], ClassContext,
- [TyVar], ClassContext,
- [TauType], TyCon)
-
-dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
- dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
- dcOrigArgTys = arg_tys, dcTyCon = tycon})
- = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
-
-dataConArgTys :: DataCon
- -> [Type] -- Instantiated at these types
- -- NB: these INCLUDE the existentially quantified arg types
- -> [Type] -- Needs arguments of these types
+dataConRepStrictness dc = dcRepStrictness dc
+
+dataConSig :: DataCon -> ([TyVar], ThetaType,
+ [Type], TyCon, [Type])
+
+dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
+ dcOrigArgTys = arg_tys, dcTyCon = tycon, dcResTys = res_tys})
+ = (tyvars, theta, arg_tys, tycon, res_tys)
+
+dataConStupidTheta :: DataCon -> ThetaType
+dataConStupidTheta dc = dcStupidTheta dc
+
+dataConResTys :: DataCon -> [Type]
+dataConResTys dc = dcResTys dc
+
+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
-
-dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
- dcExTyVars = ex_tyvars}) inst_tys
- = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
-
-dataConTheta (MkData {dcTheta = theta}) = theta
+dataConInstArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
+ = ASSERT( length tyvars == length inst_tys )
+ map (substTyWith tyvars inst_tys) arg_tys
+
+dataConInstResTy :: DataCon -> [Type] -> Type
+dataConInstResTy (MkData {dcTyVars = tyvars, dcTyCon = tc, dcResTys = res_tys}) inst_tys
+ = ASSERT( length tyvars == length inst_tys )
+ substTy (zipOpenTvSubst tyvars inst_tys) (mkTyConApp tc res_tys)
+ -- res_tys can't currently contain any foralls,
+ -- but might in future; hence zipOpenTvSubst
+
+-- And the same deal for the original arg tys
+dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
+dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
+ = ASSERT( length tyvars == length inst_tys )
+ map (substTyWith tyvars inst_tys) arg_tys
\end{code}
These two functions get the real argument types of the constructor,
-without substituting for any type variables.
+without substituting for any type variables.
dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
dataConOrigArgTys :: DataCon -> [Type]
dataConOrigArgTys dc = dcOrigArgTys dc
-dataConRepArgTys :: DataCon -> [TauType]
+dataConRepArgTys :: DataCon -> [Type]
dataConRepArgTys dc = dcRepArgTys dc
\end{code}
isUnboxedTupleCon :: DataCon -> Bool
isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
-isExistentialDataCon :: DataCon -> Bool
-isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
-
-isDynDataCon :: DataCon -> Bool
-isDynDataCon con = isDynName (dataConName con)
+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
+\end{code}
+
%************************************************************************
%* *
\subsection{Splitting products}
%* *
%************************************************************************
-\begin{code}
+\begin{code}
splitProductType_maybe
:: Type -- A product type, perhaps
-> Maybe (TyCon, -- The type constructor
DataCon, -- The data constructor
[Type]) -- Its *representation* arg types
- -- Returns (Just ...) for any
+ -- Returns (Just ...) for any
+ -- concrete (i.e. constructors visible)
-- single-constructor
-- not existentially quantified
-- type whether a data type or a new type
-- it through till someone finds it's important.
splitProductType_maybe ty
- = case splitAlgTyConApp_maybe ty of
- Just (tycon,ty_args,[data_con])
- | isProductTyCon tycon -- Includes check for non-existential
- -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
+ = case splitTyConApp_maybe ty of
+ Just (tycon,ty_args)
+ | isProductTyCon tycon -- Includes check for non-existential,
+ -- and for constructors visible
+ -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
+ where
+ data_con = head (tyConDataCons tycon)
other -> Nothing
splitProductType str ty
= case splitProductType_maybe ty of
Just stuff -> stuff
- Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
-
--- We attempt to unbox/unpack a strict field when either:
--- (i) The tycon is imported, and the field is marked '! !', or
--- (ii) The tycon is defined in this module, the field is marked '!',
--- and the -funbox-strict-fields flag is on.
---
--- This ensures that if we compile some modules with -funbox-strict-fields and
--- some without, the compiler doesn't get confused about the constructor
--- representations.
-
-unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
-
-unbox_strict_arg_ty tycon strict_mark ty
- | case strict_mark of
- NotMarkedStrict -> False
- MarkedUnboxed _ _ -> True
- MarkedStrict -> opt_UnboxStrictFields &&
- isLocallyDefined tycon &&
- maybeToBool maybe_product &&
- not (isRecursiveTyCon tycon) &&
- isDataTyCon arg_tycon
- -- We can't look through newtypes in arguments (yet)
- = (MarkedUnboxed con arg_tys, arg_tys)
-
- | otherwise
- = (strict_mark, [ty])
+ Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
- where
- maybe_product = splitProductType_maybe ty
- Just (arg_tycon, _, con, arg_tys) = maybe_product
-\end{code}
+computeRep :: [StrictnessMark] -- Original arg strictness
+ -> [Type] -- and 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
+ (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" ty
+\end{code}
projects / ghc-hetmet.git / blobdiff