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 )
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
-- 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
-- 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
-- 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
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}
-- | 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
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}
-- | 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
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
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}