-\begin{code}
-dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
-dataConTag (Id {idDetails = AlgConId tag _ _ _ _ _ _ _ _}) = tag
-dataConTag (Id {idDetails = TupleConId _}) = fIRST_TAG
-
-dataConTyCon :: DataCon -> TyCon -- will panic if not a DataCon
-dataConTyCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tycon}) = tycon
-dataConTyCon (Id {idDetails = TupleConId a}) = tupleTyCon a
-
-dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
- -- will panic if not a DataCon
-
-dataConSig (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
- = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
-
-dataConSig (Id {idDetails = TupleConId arity})
- = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
- where
- tyvars = take arity alphaTyVars
- tyvar_tys = mkTyVarTys tyvars
-
-
--- dataConRepType returns the type of the representation of a contructor
--- This may differ from the type of the contructor Id itself for two reasons:
--- a) the constructor Id may be overloaded, but the dictionary isn't stored
--- e.g. data Eq a => T a = MkT a a
---
--- b) the constructor may store an unboxed version of a strict field.
---
--- Here's an example illustrating both:
--- data Ord a => T a = MkT Int! a
--- Here
--- T :: Ord a => Int -> a -> T a
--- but the rep type is
--- Trep :: Int# -> a -> T a
--- Actually, the unboxed part isn't implemented yet!
-
-dataConRepType :: Id -> Type
-dataConRepType (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
- = mkForAllTys (tyvars++con_tyvars)
- (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
-dataConRepType other_id
- = ASSERT( isDataCon other_id )
- idType other_id
-
-dataConFieldLabels :: DataCon -> [FieldLabel]
-dataConFieldLabels (Id {idDetails = AlgConId _ _ fields _ _ _ _ _ _}) = fields
-dataConFieldLabels (Id {idDetails = TupleConId _}) = []
-#ifdef DEBUG
-dataConFieldLabels x@(Id {idDetails = idt}) =
- panic ("dataConFieldLabel: " ++
- (case idt of
- VanillaId _ -> "l"
- PrimitiveId _ -> "p"
- RecordSelId _ -> "r"))
-#endif
-
-dataConStrictMarks :: DataCon -> [StrictnessMark]
-dataConStrictMarks (Id {idDetails = AlgConId _ stricts _ _ _ _ _ _ _}) = stricts
-dataConStrictMarks (Id {idDetails = TupleConId arity}) = nOfThem arity NotMarkedStrict
-
-dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
-dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
-
-dataConArgTys :: DataCon
- -> [Type] -- Instantiated at these types
- -> [Type] -- Needs arguments of these types
-dataConArgTys con_id inst_tys
- = map (instantiateTy tenv) arg_tys
- where
- (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
- tenv = zipTyVarEnv tyvars inst_tys
-\end{code}
-
-\begin{code}
-recordSelectorFieldLabel :: Id -> FieldLabel
-recordSelectorFieldLabel (Id {idDetails = RecordSelId lbl}) = lbl
-
-isRecordSelector (Id {idDetails = RecordSelId lbl}) = True
-isRecordSelector other = False