{- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1998 \section[ConLike]{@ConLike@: Constructor-like things} -}{-# LANGUAGE CPP #-}moduleConLike(ConLike (..),conLikeArity ,conLikeFieldLabels ,conLikeInstOrigArgTys ,conLikeExTyCoVars ,conLikeName ,conLikeStupidTheta ,conLikeWrapId_maybe ,conLikeImplBangs ,conLikeFullSig ,conLikeResTy ,conLikeFieldType ,conLikesWithFields ,conLikeIsInfix )where#include "HsVersions.h" importGhcPrelude importDataCon importPatSyn importOutputable importUnique importUtil importName importBasicTypes importTyCoRep (Type ,ThetaType )importVar importType (mkTyConApp )importqualifiedData.DataasData{- ************************************************************************ * * \subsection{Constructor-like things} * * ************************************************************************ -}-- | A constructor-like thingdataConLike =RealDataCon DataCon |PatSynCon PatSyn {- ************************************************************************ * * \subsection{Instances} * * ************************************************************************ -}instanceEqConLike where(== )=eqConLike eqConLike::ConLike ->ConLike ->BooleqConLike x y =getUnique x ==getUnique y -- There used to be an Ord ConLike instance here that used Unique for ordering.-- It was intentionally removed to prevent determinism problems.-- See Note [Unique Determinism] in Unique.instanceUniquable ConLike wheregetUnique (RealDataCon dc )=getUnique dc getUnique(PatSynCon ps )=getUnique ps instanceNamedThing ConLike wheregetName (RealDataCon dc )=getName dc getName(PatSynCon ps )=getName ps instanceOutputable ConLike whereppr (RealDataCon dc )=ppr dc ppr(PatSynCon ps )=ppr ps instanceOutputableBndr ConLike wherepprInfixOcc (RealDataCon dc )=pprInfixOcc dc pprInfixOcc(PatSynCon ps )=pprInfixOcc ps pprPrefixOcc (RealDataCon dc )=pprPrefixOcc dc pprPrefixOcc(PatSynCon ps )=pprPrefixOcc ps instanceData.DataConLike where-- don't traverse?toConstr _=abstractConstr "ConLike"gunfold __=error"gunfold"dataTypeOf _=mkNoRepType"ConLike"-- | Number of argumentsconLikeArity::ConLike ->Arity conLikeArity (RealDataCon data_con )=dataConSourceArity data_con conLikeArity(PatSynCon pat_syn )=patSynArity pat_syn -- | Names of fields used for selectorsconLikeFieldLabels::ConLike ->[FieldLabel ]conLikeFieldLabels (RealDataCon data_con )=dataConFieldLabels data_con conLikeFieldLabels(PatSynCon pat_syn )=patSynFieldLabels pat_syn -- | Returns just the instantiated /value/ argument types of a 'ConLike',-- (excluding dictionary args)conLikeInstOrigArgTys::ConLike ->[Type ]->[Type ]conLikeInstOrigArgTys (RealDataCon data_con )tys =dataConInstOrigArgTys data_con tys conLikeInstOrigArgTys(PatSynCon pat_syn )tys =patSynInstArgTys pat_syn tys -- | Existentially quantified type/coercion variablesconLikeExTyCoVars::ConLike ->[TyCoVar ]conLikeExTyCoVars (RealDataCon dcon1 )=dataConExTyCoVars dcon1 conLikeExTyCoVars(PatSynCon psyn1 )=patSynExTyVars psyn1 conLikeName::ConLike ->Name conLikeName (RealDataCon data_con )=dataConName data_con conLikeName(PatSynCon pat_syn )=patSynName pat_syn -- | The \"stupid theta\" of the 'ConLike', such as @data Eq a@ in:---- > data Eq a => T a = ...-- It is empty for `PatSynCon` as they do not allow such contexts.conLikeStupidTheta::ConLike ->ThetaType conLikeStupidTheta (RealDataCon data_con )=dataConStupidTheta data_con conLikeStupidTheta(PatSynCon {})=[]-- | Returns the `Id` of the wrapper. This is also known as the builder in-- some contexts. The value is Nothing only in the case of unidirectional-- pattern synonyms.conLikeWrapId_maybe::ConLike ->MaybeId conLikeWrapId_maybe (RealDataCon data_con )=Just$dataConWrapId data_con conLikeWrapId_maybe(PatSynCon pat_syn )=fst<$>patSynBuilder pat_syn -- | Returns the strictness information for each constructorconLikeImplBangs::ConLike ->[HsImplBang ]conLikeImplBangs (RealDataCon data_con )=dataConImplBangs data_con conLikeImplBangs(PatSynCon pat_syn )=replicate(patSynArity pat_syn )HsLazy -- | Returns the type of the whole patternconLikeResTy::ConLike ->[Type ]->Type conLikeResTy (RealDataCon con )tys =mkTyConApp (dataConTyCon con )tys conLikeResTy(PatSynCon ps )tys =patSynInstResTy ps tys -- | The \"full signature\" of the 'ConLike' returns, in order:---- 1) The universally quantified type variables---- 2) The existentially quantified type/coercion variables---- 3) The equality specification---- 4) The provided theta (the constraints provided by a match)---- 5) The required theta (the constraints required for a match)---- 6) The original argument types (i.e. before-- any change of the representation of the type)---- 7) The original result typeconLikeFullSig::ConLike ->([TyVar ],[TyCoVar ],[EqSpec ]-- Why tyvars for universal but tycovars for existential?-- See Note [Existential coercion variables] in DataCon,ThetaType ,ThetaType ,[Type ],Type )conLikeFullSig (RealDataCon con )=let(univ_tvs ,ex_tvs ,eq_spec ,theta ,arg_tys ,res_ty )=dataConFullSig con -- Required theta is empty as normal data cons require no additional-- constraints for a matchin(univ_tvs ,ex_tvs ,eq_spec ,theta ,[],arg_tys ,res_ty )conLikeFullSig(PatSynCon pat_syn )=let(univ_tvs ,req ,ex_tvs ,prov ,arg_tys ,res_ty )=patSynSig pat_syn -- eqSpec is emptyin(univ_tvs ,ex_tvs ,[],prov ,req ,arg_tys ,res_ty )-- | Extract the type for any given labelled field of the 'ConLike'conLikeFieldType::ConLike ->FieldLabelString ->Type conLikeFieldType (PatSynCon ps )label=patSynFieldType ps labelconLikeFieldType(RealDataCon dc )label=dataConFieldType dc label-- | The ConLikes that have *all* the given fieldsconLikesWithFields::[ConLike ]->[FieldLabelString ]->[ConLike ]conLikesWithFields con_likes lbls =filterhas_flds con_likes wherehas_flds dc =all(has_fld dc )lbls has_fld dc lbl =any(\fl ->flLabelfl ==lbl )(conLikeFieldLabels dc )conLikeIsInfix::ConLike ->BoolconLikeIsInfix (RealDataCon dc )=dataConIsInfix dc conLikeIsInfix(PatSynCon ps )=patSynIsInfix ps