X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=406d02a9df17207d3fc43c4f9ac81fd0cfa20a04;hp=af30dd1853d5a8c58446a3da594f40e233da017d;hb=215ce9f15215399ce30ae55c9521087847d78646;hpb=3517c53d8a66149dcc3f971cf0577719e99d6d70 diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index af30dd1..406d02a 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -51,10 +51,10 @@ import Outputable import Unique import ListSetOps import Util -import Maybes import FastString import Module +import qualified Data.Data as Data import Data.Char import Data.Word import Data.List ( partition ) @@ -98,12 +98,12 @@ Note [Data Constructor Naming] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each data constructor C has two, and possibly up to four, Names associated with it: - OccName Name space Name of - --------------------------------------------------------------------------- - * The "data con itself" C DataName DataCon - * The "worker data con" C VarName Id (the worker) - * The "wrapper data con" \$WC VarName Id (the wrapper) - * The "newtype coercion" :CoT TcClsName TyCon + 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 @@ -271,8 +271,9 @@ data DataCon -- 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 @@ -326,7 +327,7 @@ data DataCon -- 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 @@ -341,7 +342,8 @@ data DataCon -- 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 @@ -454,6 +456,15 @@ instance Outputable DataCon where 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} @@ -467,7 +478,7 @@ instance Show DataCon where -- | Build a new data constructor mkDataCon :: Name -> Bool -- ^ Is the constructor declared infix? - -> [StrictnessMark] -- ^ Strictness annotations written in the source file + -> [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 @@ -547,9 +558,9 @@ mkDataCon name declared_infix eqSpecPreds :: [(TyVar,Type)] -> ThetaType eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ] -mk_dict_strict_mark :: PredType -> StrictnessMark -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} @@ -652,11 +663,11 @@ dataConFieldType con 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 -> [StrictnessMark] +dataConStrictMarks :: DataCon -> [HsBang] dataConStrictMarks = dcStrictMarks -- | Strictness of /existential/ arguments only -dataConExStricts :: DataCon -> [StrictnessMark] +dataConExStricts :: DataCon -> [HsBang] -- Usually empty, so we don't bother to cache this dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc @@ -902,7 +913,7 @@ deepSplitProductType str ty Nothing -> pprPanic (str ++ ": not a product") (pprType ty) -- | Compute the representation type strictness and type suitable for a 'DataCon' -computeRep :: [StrictnessMark] -- ^ Original argument strictness +computeRep :: [HsBang] -- ^ Original argument strictness -> [Type] -- ^ Original argument types -> ([StrictnessMark], -- Representation arg strictness [Type]) -- And type @@ -910,10 +921,11 @@ computeRep :: [StrictnessMark] -- ^ Original argument strictness 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}