X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FDataCon.lhs;h=805ef73c597c1fbfdf752fcbe79b89afefa09406;hp=61c71d6d7dd17603796fec39ebc1481fb13f01f7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hpb=4e94cbc42227ecb187e5c2d03831ca49549095eb diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs index 61c71d6..805ef73 100644 --- a/ghc/compiler/basicTypes/DataCon.lhs +++ b/ghc/compiler/basicTypes/DataCon.lhs @@ -5,46 +5,44 @@ \begin{code} module DataCon ( - DataCon, + DataCon, DataConIds(..), ConTag, fIRST_TAG, mkDataCon, dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon, - dataConArgTys, dataConOrigArgTys, dataConInstOrigArgTys, - dataConRepArgTys, dataConTheta, - dataConFieldLabels, dataConStrictMarks, + dataConTyVars, dataConResTys, + dataConStupidTheta, + dataConInstArgTys, dataConOrigArgTys, dataConInstResTy, + dataConInstOrigArgTys, dataConRepArgTys, + dataConFieldLabels, dataConFieldType, + dataConStrictMarks, dataConExStricts, dataConSourceArity, dataConRepArity, - dataConNumInstArgs, - dataConWorkId, dataConWrapId, dataConWrapId_maybe, + dataConIsInfix, + dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds, dataConRepStrictness, - isNullaryDataCon, isTupleCon, isUnboxedTupleCon, - isExistentialDataCon, classDataCon, dataConExistentialTyVars, + isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon, + isVanillaDataCon, classDataCon, splitProductType_maybe, splitProductType, ) where #include "HsVersions.h" -import {-# SOURCE #-} Subst( substTyWith ) -import {-# SOURCE #-} PprType( pprType ) - -import Type ( Type, ThetaType, +import Type ( Type, ThetaType, substTyWith, substTy, zipOpenTvSubst, mkForAllTys, mkFunTys, mkTyConApp, - mkTyVarTys, splitTyConApp_maybe, repType, - mkPredTys, isStrictType + splitTyConApp_maybe, + mkPredTys, isStrictPred, pprType ) -import TyCon ( TyCon, tyConDataCons, tyConDataCons, isProductTyCon, - isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon ) +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, StrictnessMark(..) ) import Outputable import Unique ( Unique, Uniquable(..) ) -import CmdLineOpts ( opt_UnboxStrictFields ) -import Maybes ( orElse ) import ListSetOps ( assoc ) -import Util ( zipEqual, zipWithEqual, notNull ) +import Util ( zipEqual, zipWithEqual ) +import Maybes ( expectJust ) \end{code} @@ -89,7 +87,7 @@ Each data constructor C has two, and possibly three, Names associated with it: --------------------------------------------------------------------------- * 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) + * 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 @@ -105,10 +103,10 @@ The data con has one or two Ids associated with it: - strict args may be flattened The worker is very like a primop, in that it has no binding. - Newtypes currently do get a worker-Id, but it is never used. + Newtypes have no worker Id - The "wrapper Id", $wC, whose type is exactly what it looks like + 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. @@ -141,17 +139,34 @@ 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). + 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. -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. %************************************************************************ %* * @@ -161,48 +176,51 @@ in an expression or in a pattern. \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 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. - - -- 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 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 - - dcStupidTheta :: ThetaType, -- This is a "thinned" version of the context of - -- the data decl. + -- 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 @@ -210,52 +228,93 @@ data DataCon -- "Stupid", because the dictionaries aren't used for anything. -- -- Indeed, [as of March 02] they are no - -- longer in the type of the dcWrapId, because + -- 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) - dcExTyVars :: [TyVar], -- Ditto for the context of the constructor, - dcExTheta :: ThetaType, -- the existentially quantified stuff + 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 - - dcRepStrictness :: [StrictnessMark], -- One for each representation argument - - 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 dcStrictMarks :: [StrictnessMark], - -- Strictness annotations as deduced by the compiler. - -- Has no MarkedUserStrict; they have been changed to MarkedStrict - -- or MarkedUnboxed by the compiler. - -- *Includes the existential dictionaries* - -- length = length dcExTheta + dataConSourceArity dataCon + -- 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; -- 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, - dcWorkId :: Id, -- The corresponding worker Id - -- Takes dcRepArgTys as its arguments - -- Perhaps this should be a 'Maybe'; not reqd for newtype constructors - - dcWrapId :: Maybe Id -- The wrapper Id, if it's necessary - -- It's deemed unnecessary if it performs the - -- identity function + 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 @@ -319,30 +378,30 @@ instance Show DataCon where \begin{code} mkDataCon :: Name + -> Bool -- Declared infix + -> Bool -- Vanilla (see notes with dcVanilla) -> [StrictnessMark] -> [FieldLabel] - -> [TyVar] -> ThetaType - -> [TyVar] -> ThetaType - -> [Type] -> TyCon - -> Id -> Maybe Id -- Worker and possible wrapper + -> [TyVar] -> ThetaType -> ThetaType + -> [Type] -> TyCon -> [Type] + -> DataConIds -> DataCon -- Can get the tag from the TyCon -mkDataCon name - arg_stricts -- Use [] to mean 'all non-strict' +mkDataCon name declared_infix vanilla + arg_stricts -- Must match orig_arg_tys 1-1 fields - tyvars theta ex_tyvars ex_theta orig_arg_tys tycon - work_id wrap_id + tyvars stupid_theta theta orig_arg_tys tycon res_tys + ids = con where con = MkData {dcName = name, - dcUnique = nameUnique name, - dcTyVars = tyvars, dcStupidTheta = theta, - dcOrigArgTys = orig_arg_tys, + 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, - dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts, - dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty, - dcWorkId = work_id, dcWrapId = wrap_id} + 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*, @@ -351,25 +410,21 @@ mkDataCon name -- The 'arg_stricts' passed to mkDataCon are simply those for the -- source-language arguments. We add extra ones for the -- dictionary arguments right here. - ex_dict_tys = mkPredTys ex_theta - real_stricts = map mk_dict_strict_mark ex_dict_tys ++ - zipWith (chooseBoxingStrategy tycon) - orig_arg_tys - (arg_stricts ++ repeat NotMarkedStrict) - real_arg_tys = ex_dict_tys ++ orig_arg_tys + 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 ty | isStrictType ty = MarkedStrict - | otherwise = NotMarkedStrict +mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict + | otherwise = NotMarkedStrict \end{code} \begin{code} @@ -385,28 +440,49 @@ dataConTyCon = dcTyCon dataConRepType :: DataCon -> Type dataConRepType = dcRepType +dataConIsInfix :: DataCon -> Bool +dataConIsInfix = dcInfix + +dataConTyVars :: DataCon -> [TyVar] +dataConTyVars = dcTyVars + dataConWorkId :: DataCon -> Id -dataConWorkId = dcWorkId +dataConWorkId dc = case dcIds dc of + AlgDC _ wrk_id -> wrk_id + NewDC _ -> pprPanic "dataConWorkId" (ppr dc) dataConWrapId_maybe :: DataCon -> Maybe Id -dataConWrapId_maybe = dcWrapId +dataConWrapId_maybe dc = case dcIds dc of + AlgDC mb_wrap _ -> mb_wrap + NewDC wrap -> Just wrap dataConWrapId :: DataCon -> Id -- Returns an Id which looks like the Haskell-source constructor --- If there is no dcWrapId it's because there is no need for a --- wrapper, so the worker is the Right Thing -dataConWrapId dc = dcWrapId dc `orElse` dcWorkId dc +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 = 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 @@ -418,7 +494,9 @@ dataConSourceArity dc = length (dcOrigArgTys dc) -- 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 -> [StrictnessMark] -- Give the demands on the arguments of a @@ -426,38 +504,41 @@ dataConRepStrictness :: DataCon -> [StrictnessMark] dataConRepStrictness dc = dcRepStrictness dc dataConSig :: DataCon -> ([TyVar], ThetaType, - [TyVar], ThetaType, - [Type], TyCon) - -dataConSig (MkData {dcTyVars = tyvars, dcStupidTheta = 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 - -- 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 (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys + [Type], TyCon, [Type]) -dataConTheta :: DataCon -> ThetaType -dataConTheta dc = dcStupidTheta dc +dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta, + dcOrigArgTys = arg_tys, dcTyCon = tycon, dcResTys = res_tys}) + = (tyvars, theta, arg_tys, tycon, res_tys) -dataConExistentialTyVars :: DataCon -> [TyVar] -dataConExistentialTyVars dc = dcExTyVars dc +dataConStupidTheta :: DataCon -> ThetaType +dataConStupidTheta dc = dcStupidTheta dc --- And the same deal for the original arg tys: +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 +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, - dcExTyVars = ex_tyvars}) inst_tys - = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys +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, @@ -484,8 +565,8 @@ isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc isUnboxedTupleCon :: DataCon -> Bool isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc -isExistentialDataCon :: DataCon -> Bool -isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs +isVanillaDataCon :: DataCon -> Bool +isVanillaDataCon dc = dcVanilla dc \end{code} @@ -524,7 +605,7 @@ splitProductType_maybe ty Just (tycon,ty_args) | isProductTyCon tycon -- Includes check for non-existential, -- and for constructors visible - -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args) + -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args) where data_con = head (tyConDataCons tycon) other -> Nothing @@ -534,39 +615,8 @@ splitProductType str ty Just stuff -> stuff Nothing -> pprPanic (str ++ ": not a product") (pprType 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. - -chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark - -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict -chooseBoxingStrategy tycon arg_ty strict - = case strict of - MarkedUserStrict - | opt_UnboxStrictFields - && unbox arg_ty -> MarkedUnboxed - | otherwise -> MarkedStrict - other -> strict - where - -- beware: repType will go into a loop if we try this on a recursive - -- type (for reasons unknown...), hence the check for recursion below. - unbox ty = - case splitTyConApp_maybe ty of - Nothing -> False - Just (arg_tycon, _) - | isRecursiveTyCon arg_tycon -> False - | otherwise -> - case splitTyConApp_maybe (repType ty) of - Nothing -> False - Just (arg_tycon, _) -> isProductTyCon arg_tycon computeRep :: [StrictnessMark] -- Original arg strictness - -- [after strategy choice; can't be MarkedUserStrict] -> [Type] -- and types -> ([StrictnessMark], -- Representation arg strictness [Type]) -- And type @@ -578,5 +628,5 @@ computeRep stricts tys 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" (repType ty) + (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" ty \end{code}