Commit 9ffadf21 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Make record selectors into ordinary functions

This biggish patch addresses Trac #2670.  The main effect is to make
record selectors into ordinary functions, whose unfoldings appear in
interface files, in contrast to their previous existence as magic
"implicit Ids".  This means that the usual machinery of optimisation,
analysis, and inlining applies to them, which was failing before when
the selector was somewhat complicated.  (Which it can be when
strictness annotations, unboxing annotations, and GADTs are involved.)

The change involves the following points

* Changes in Var.lhs to the representation of Var.  Now a LocalId can
  have an IdDetails as well as a GlobalId.  In particular, the
  information that an Id is a record selector is kept in the
  IdDetails.  While compiling the current module, the record selector
  *must* be a LocalId, so that it participates properly in compilation
  (free variables etc).

  This led me to change the (hidden) representation of Var, so that there
  is now only one constructor for Id, not two.

* The IdDetails is persisted into interface files, so that an
  importing module can see which Ids are records selectors.

* In TcTyClDecls, we generate the record-selector bindings in renamed,
  but not typechecked form.  In this way, we can get the typechecker
  to add all the types and so on, which is jolly helpful especially
  when GADTs or type families are involved.  Just like derived
  instance declarations.

  This is the big new chunk of 180 lines of code (much of which is
  commentary).  A call to the same function, mkAuxBinds, is needed in
  TcInstDcls for associated types.

* The typechecker therefore has to pin the correct IdDetails on to 
  the record selector, when it typechecks it.  There was a neat way
  to do this, by adding a new sort of signature to HsBinds.Sig, namely
  IdSig.  This contains an Id (with the correct Name, Type, and IdDetails);
  the type checker uses it as the binder for the final binding.  This
  worked out rather easily.

* Record selectors are no longer "implicit ids", which entails changes to
     IfaceSyn.ifaceDeclSubBndrs
     HscTypes.implicitTyThings
     TidyPgm.getImplicitBinds
  (These three functions must agree.)

* MkId.mkRecordSelectorId is deleted entirely, some 300+ lines (incl
  comments) of very error prone code.  Happy days.

* A TyCon no longer contains the list of record selectors: 
  algTcSelIds is gone

The renamer is unaffected, including the way that import and export of
record selectors is handled.

Other small things

* IfaceSyn.ifaceDeclSubBndrs had a fragile test for whether a data
  constructor had a wrapper.  I've replaced that with an explicit flag
  in the interface file. More robust I hope.

* I renamed isIdVar to isId, which touched a few otherwise-unrelated files.
parent 24a5fdb5
......@@ -318,7 +318,6 @@ data DataCon
dcOrigArgTys :: [Type], -- Original argument types
-- (before unboxing and flattening of strict fields)
dcOrigResTy :: Type, -- Original result type, as seen by the user
-- INVARIANT: mentions only dcUnivTyVars
-- NB: for a data instance, the original user result type may
-- differ from the DataCon's representation TyCon. Example
-- data instance T [a] where MkT :: a -> T [a]
......@@ -636,8 +635,10 @@ dataConFieldLabels = dcFields
-- | Extract the type for any given labelled field of the 'DataCon'
dataConFieldType :: DataCon -> FieldLabel -> Type
dataConFieldType con label = expectJust "unexpected label" $
lookup label (dcFields con `zip` dcOrigArgTys con)
dataConFieldType con label
= case lookup label (dcFields con `zip` dcOrigArgTys con) of
Just ty -> ty
Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr 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'
......@@ -726,7 +727,7 @@ dataConUserType :: DataCon -> Type
--
-- rather than:
--
-- > T :: forall a c. forall b. (c=[a]) => a -> b -> T c
-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
--
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
......
......@@ -27,14 +27,14 @@ module Id (
-- ** Simple construction
mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
mkLocalId, mkLocalIdWithInfo,
mkLocalId, mkLocalIdWithInfo, mkExportedLocalId,
mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,
mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
mkWorkerId, mkExportedLocalId,
mkWorkerId,
-- ** Taking an Id apart
idName, idType, idUnique, idInfo,
isId, globalIdDetails, idPrimRep,
idName, idType, idUnique, idInfo, idDetails,
isId, idPrimRep,
recordSelectorFieldLabel,
-- ** Modifying an Id
......@@ -104,8 +104,13 @@ import CoreSyn ( CoreRule, Unfolding )
import IdInfo
import BasicTypes
-- Imported and re-exported
import Var( Id, DictId,
idInfo, idDetails, globaliseId,
isId, isLocalId, isGlobalId, isExportedId )
import qualified Var
import Var
import TyCon
import Type
import TcType
......@@ -156,26 +161,19 @@ idName :: Id -> Name
idName = Var.varName
idUnique :: Id -> Unique
idUnique = varUnique
idUnique = Var.varUnique
idType :: Id -> Kind
idType = varType
idInfo :: Id -> IdInfo
idInfo = varIdInfo
idType = Var.varType
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep (idType id)
globalIdDetails :: Id -> GlobalIdDetails
globalIdDetails = globalIdVarDetails
setIdName :: Id -> Name -> Id
setIdName = setVarName
setIdName = Var.setVarName
setIdUnique :: Id -> Unique -> Id
setIdUnique = setVarUnique
setIdUnique = Var.setVarUnique
-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
-- reduce space usage
......@@ -183,10 +181,10 @@ setIdType :: Id -> Type -> Id
setIdType id ty = seqType ty `seq` Var.setVarType id ty
setIdExported :: Id -> Id
setIdExported = setIdVarExported
setIdExported = Var.setIdExported
setIdNotExported :: Id -> Id
setIdNotExported = setIdVarNotExported
setIdNotExported = Var.setIdNotExported
localiseId :: Id -> Id
-- Make an with the same unique and type as the
......@@ -199,11 +197,8 @@ localiseId id
where
name = idName id
globaliseId :: GlobalIdDetails -> Id -> Id
globaliseId = globaliseIdVar
lazySetIdInfo :: Id -> IdInfo -> Id
lazySetIdInfo = lazySetVarIdInfo
lazySetIdInfo = Var.lazySetIdInfo
setIdInfo :: Id -> IdInfo -> Id
setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
......@@ -240,8 +235,8 @@ Anyway, we removed it in March 2008.
\begin{code}
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = mkGlobalIdVar
mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = Var.mkGlobalVar
-- | Make a global 'Id' without any extra information at all
mkVanillaGlobal :: Name -> Type -> Id
......@@ -249,7 +244,7 @@ mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
-- | Make a global 'Id' with no global information but some generic 'IdInfo'
mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
mkVanillaGlobalWithInfo = mkGlobalId VanillaGlobal
mkVanillaGlobalWithInfo = mkGlobalId VanillaId
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
......@@ -257,16 +252,18 @@ mkLocalId :: Name -> Type -> Id
mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
mkLocalIdWithInfo = mkLocalIdVar
mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
-- Note [Free type variables]
-- | Create a local 'Id' that is marked as exported. This prevents things attached to it from being removed as dead code.
-- | Create a local 'Id' that is marked as exported.
-- This prevents things attached to it from being removed as dead code.
mkExportedLocalId :: Name -> Type -> Id
mkExportedLocalId name ty = mkExportedLocalIdVar name ty vanillaIdInfo
mkExportedLocalId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
-- Note [Free type variables]
-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal") that are created by the compiler out of thin air
-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
-- that are created by the compiler out of thin air
mkSysLocal :: FastString -> Unique -> Type -> Id
mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
......@@ -309,29 +306,6 @@ mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
\end{code}
%************************************************************************
%* *
\subsection{Basic predicates on @Id@s}
%* *
%************************************************************************
\begin{code}
isId :: Id -> Bool
isId = isIdVar
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
isLocalId :: Id -> Bool
isLocalId = isLocalIdVar
-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
isGlobalId :: Id -> Bool
isGlobalId = isGlobalIdVar
-- | Determines whether an 'Id' is marked as exported and hence will not be considered dead code
isExportedId :: Id -> Bool
isExportedId = isExportedIdVar
\end{code}
%************************************************************************
%* *
\subsection{Special Ids}
......@@ -342,8 +316,8 @@ isExportedId = isExportedIdVar
-- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
recordSelectorFieldLabel id
= case globalIdDetails id of
RecordSelId { sel_tycon = tycon, sel_label = lbl } -> (tycon,lbl)
= case Var.idDetails id of
RecSelId { sel_tycon = tycon } -> (tycon, idName id)
_ -> panic "recordSelectorFieldLabel"
isRecordSelector :: Id -> Bool
......@@ -357,44 +331,44 @@ isPrimOpId_maybe :: Id -> Maybe PrimOp
isFCallId_maybe :: Id -> Maybe ForeignCall
isDataConWorkId_maybe :: Id -> Maybe DataCon
isRecordSelector id = case globalIdDetails id of
RecordSelId {} -> True
isRecordSelector id = case Var.idDetails id of
RecSelId {} -> True
_ -> False
isNaughtyRecordSelector id = case globalIdDetails id of
RecordSelId { sel_naughty = n } -> n
isNaughtyRecordSelector id = case Var.idDetails id of
RecSelId { sel_naughty = n } -> n
_ -> False
isClassOpId_maybe id = case globalIdDetails id of
isClassOpId_maybe id = case Var.idDetails id of
ClassOpId cls -> Just cls
_other -> Nothing
isPrimOpId id = case globalIdDetails id of
isPrimOpId id = case Var.idDetails id of
PrimOpId _ -> True
_ -> False
isPrimOpId_maybe id = case globalIdDetails id of
isPrimOpId_maybe id = case Var.idDetails id of
PrimOpId op -> Just op
_ -> Nothing
isFCallId id = case globalIdDetails id of
isFCallId id = case Var.idDetails id of
FCallId _ -> True
_ -> False
isFCallId_maybe id = case globalIdDetails id of
isFCallId_maybe id = case Var.idDetails id of
FCallId call -> Just call
_ -> Nothing
isDataConWorkId id = case globalIdDetails id of
isDataConWorkId id = case Var.idDetails id of
DataConWorkId _ -> True
_ -> False
isDataConWorkId_maybe id = case globalIdDetails id of
isDataConWorkId_maybe id = case Var.idDetails id of
DataConWorkId con -> Just con
_ -> Nothing
isDataConId_maybe :: Id -> Maybe DataCon
isDataConId_maybe id = case globalIdDetails id of
isDataConId_maybe id = case Var.idDetails id of
DataConWorkId con -> Just con
DataConWrapId con -> Just con
_ -> Nothing
......@@ -417,7 +391,7 @@ hasNoBinding :: Id -> Bool
-- they aren't any more. Instead, we inject a binding for
-- them at the CorePrep stage.
-- EXCEPT: unboxed tuples, which definitely have no binding
hasNoBinding id = case globalIdDetails id of
hasNoBinding id = case Var.idDetails id of
PrimOpId _ -> True -- See Note [Primop wrappers]
FCallId _ -> True
DataConWorkId dc -> isUnboxedTupleCon dc
......@@ -428,11 +402,10 @@ isImplicitId :: Id -> Bool
-- declarations, so we don't need to put its signature in an interface
-- file, even if it's mentioned in some other interface unfolding.
isImplicitId id
= case globalIdDetails id of
RecordSelId {} -> True
= case Var.idDetails id of
FCallId _ -> True
PrimOpId _ -> True
ClassOpId _ -> True
PrimOpId _ -> True
DataConWorkId _ -> True
DataConWrapId _ -> True
-- These are are implied by their type or class decl;
......@@ -469,13 +442,13 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
\begin{code}
isTickBoxOp :: Id -> Bool
isTickBoxOp id =
case globalIdDetails id of
case Var.idDetails id of
TickBoxOpId _ -> True
_ -> False
isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
isTickBoxOp_maybe id =
case globalIdDetails id of
case Var.idDetails id of
TickBoxOpId tick -> Just tick
_ -> Nothing
\end{code}
......
......@@ -9,8 +9,8 @@ Haskell. [WDP 94/11])
\begin{code}
module IdInfo (
-- * The GlobalIdDetails type
GlobalIdDetails(..), notGlobalId, -- Not abstract
-- * The IdDetails type
IdDetails(..), pprIdDetails,
-- * The IdInfo type
IdInfo, -- Abstract
......@@ -234,31 +234,23 @@ seqNewDemandInfo (Just dmd) = seqDemand dmd
%************************************************************************
%* *
\subsection{GlobalIdDetails}
IdDetails
%* *
%************************************************************************
This type is here (rather than in Id.lhs) mainly because there's
an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
(recursively) by Var.lhs.
\begin{code}
-- | Information pertaining to global 'Id's. See "Var#globalvslocal" for the distinction
-- between global and local in this context
data GlobalIdDetails
= VanillaGlobal -- ^ The 'Id' is imported from elsewhere or is a default method 'Id'
-- | The 'IdDetails' of an 'Id' give stable, and necessary,
-- information about the Id.
data IdDetails
= VanillaId
-- | The 'Id' for a record selector
| RecordSelId
| RecSelId
{ sel_tycon :: TyCon -- ^ For a data type family, this is the /instance/ 'TyCon'
-- not the family 'TyCon'
, sel_label :: FieldLabel
, sel_naughty :: Bool -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
--
-- > data T = forall a. MkT { x :: a }
}
-- See Note [Naughty record selectors]
-- with MkId.mkRecordSelectorId
-- data T = forall a. MkT { x :: a }
} -- See Note [Naughty record selectors] in TcTyClsDecls
| DataConWorkId DataCon -- ^ The 'Id' is for a data constructor /worker/
| DataConWrapId DataCon -- ^ The 'Id' is for a data constructor /wrapper/
......@@ -275,25 +267,29 @@ data GlobalIdDetails
| TickBoxOpId TickBoxOp -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
| NotGlobalId -- ^ Used as a convenient extra return value from 'globalIdDetails'
-- | An entirely unhelpful 'GlobalIdDetails'
notGlobalId :: GlobalIdDetails
notGlobalId = NotGlobalId
instance Outputable GlobalIdDetails where
ppr NotGlobalId = ptext (sLit "[***NotGlobalId***]")
ppr VanillaGlobal = ptext (sLit "[GlobalId]")
ppr (DataConWorkId _) = ptext (sLit "[DataCon]")
ppr (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
ppr (ClassOpId _) = ptext (sLit "[ClassOp]")
ppr (PrimOpId _) = ptext (sLit "[PrimOp]")
ppr (FCallId _) = ptext (sLit "[ForeignCall]")
ppr (TickBoxOpId _) = ptext (sLit "[TickBoxOp]")
ppr (RecordSelId {}) = ptext (sLit "[RecSel]")
| DFunId -- ^ A dictionary function. We don't use this in an essential way,
-- currently, but it's kind of nice that we can keep track of
-- which Ids are DFuns, across module boundaries too
instance Outputable IdDetails where
ppr = pprIdDetails
pprIdDetails :: IdDetails -> SDoc
pprIdDetails VanillaId = empty
pprIdDetails (RecSelId {}) = ptext (sLit "[RecSel]")
pprIdDetails (DataConWorkId _) = ptext (sLit "[DataCon]")
pprIdDetails (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
pprIdDetails (ClassOpId _) = ptext (sLit "[ClassOp]")
pprIdDetails (PrimOpId _) = ptext (sLit "[PrimOp]")
pprIdDetails (FCallId _) = ptext (sLit "[ForeignCall]")
pprIdDetails (TickBoxOpId _) = ptext (sLit "[TickBoxOp]")
pprIdDetails DFunId = ptext (sLit "[DFunId]")
\end{code}
%************************************************************************
%* *
\subsection{The main IdInfo type}
......
\begin{code}
module IdInfo where
import Outputable
data IdInfo
data GlobalIdDetails
data IdDetails
notGlobalId :: GlobalIdDetails
seqIdInfo :: IdInfo -> ()
pprIdDetails :: IdDetails -> SDoc
\end{code}
\ No newline at end of file
......@@ -24,7 +24,6 @@ module MkId (
mkDictSelId,
mkDataConIds,
mkRecordSelId,
mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
......@@ -39,7 +38,7 @@ module MkId (
mkRuntimeErrorApp,
rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
pAT_ERROR_ID, eRROR_ID,
pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID,
unsafeCoerceName
) where
......@@ -50,7 +49,6 @@ import Rules
import TysPrim
import TysWiredIn
import PrelRules
import Unify
import Type
import TypeRep
import Coercion
......@@ -67,10 +65,9 @@ import PrimOp
import ForeignCall
import DataCon
import Id
import Var ( Var, TyVar, mkCoVar)
import Var ( Var, TyVar, mkCoVar, mkExportedLocalVar )
import IdInfo
import NewDemand
import DmdAnal
import CoreSyn
import Unique
import Maybes
......@@ -113,6 +110,7 @@ wiredInIds
nO_METHOD_BINDING_ERROR_ID,
pAT_ERROR_ID,
rEC_CON_ERROR_ID,
rEC_SEL_ERROR_ID,
lazyId
] ++ ghcPrimIds
......@@ -280,24 +278,14 @@ mkDataConIds wrap_name wkr_name data_con
nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
`setArityInfo` 1 -- Arity 1
`setUnfoldingInfo` newtype_unf
newtype_unf = -- The assertion below is no longer correct:
-- there may be a dict theta rather than a singleton orig_arg_ty
-- ASSERT( isVanillaDataCon data_con &&
-- isSingleton orig_arg_tys )
--
-- No existentials on a newtype, but it can have a context
-- e.g. newtype Eq a => T a = MkT (...)
id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
newtype_unf = ASSERT2( isVanillaDataCon data_con &&
isSingleton orig_arg_tys, ppr data_con )
-- Note [Newtype datacons]
mkCompulsoryUnfolding $
mkLams wrap_tvs $ Lam id_arg1 $
wrapNewTypeBody tycon res_ty_args
(Var id_arg1)
wrapNewTypeBody tycon res_ty_args (Var id_arg1)
id_arg1 = mkTemplateLocal 1
(if null orig_arg_tys
then ASSERT(not (null $ dataConDictTheta data_con))
mkPredTy $ head (dataConDictTheta data_con)
else head orig_arg_tys
)
----------- Wrapper --------------
-- We used to include the stupid theta in the wrapper's args
......@@ -396,301 +384,106 @@ mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
n = length tys
\end{code}
Note [Newtype datacons]
~~~~~~~~~~~~~~~~~~~~~~~
The "data constructor" for a newtype should always be vanilla. At one
point this wasn't true, because the newtype arising from
class C a => D a
looked like
newtype T:D a = D:D (C a)
so the data constructor for T:C had a single argument, namely the
predicate (C a). But now we treat that as an ordinary argument, not
part of the theta-type, so all is well.
%************************************************************************
%* *
\subsection{Record selectors}
\subsection{Dictionary selectors}
%* *
%************************************************************************
We're going to build a record selector unfolding that looks like this:
data T a b c = T1 { ..., op :: a, ...}
| T2 { ..., op :: a, ...}
| T3
sel = /\ a b c -> \ d -> case d of
T1 ... x ... -> x
T2 ... x ... -> x
other -> error "..."
Similarly for newtypes
newtype N a = MkN { unN :: a->a }
unN :: N a -> a -> a
unN n = coerce (a->a) n
We need to take a little care if the field has a polymorphic type:
data R = R { f :: forall a. a->a }
Then we want
f :: forall a. R -> a -> a
f = /\ a \ r = case r of
R f -> f a
(not f :: R -> forall a. a->a, which gives the type inference mechanism
problems at call sites)
Similarly for (recursive) newtypes
newtype N = MkN { unN :: forall a. a->a }
unN :: forall b. N -> b -> b
unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
Selecting a field for a dictionary. If there is just one field, then
there's nothing to do.
Note [Naughty record selectors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A "naughty" field is one for which we can't define a record
selector, because an existential type variable would escape. For example:
data T = forall a. MkT { x,y::a }
We obviously can't define
x (MkT v _) = v
Nevertheless we *do* put a RecordSelId into the type environment
so that if the user tries to use 'x' as a selector we can bleat
helpfully, rather than saying unhelpfully that 'x' is not in scope.
Hence the sel_naughty flag, to identify record selectors that don't really exist.
Dictionary selectors may get nested forall-types. Thus:
In general, a field is naughty if its type mentions a type variable that
isn't in the result type of the constructor.
class Foo a where
op :: forall b. Ord b => a -> b -> b
Note [GADT record selectors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For GADTs, we require that all constructors with a common field 'f' have the same
result type (modulo alpha conversion). [Checked in TcTyClsDecls.checkValidTyCon]
E.g.
data T where
T1 { f :: Maybe a } :: T [a]
T2 { f :: Maybe a, y :: b } :: T [a]
Then the top-level type for op is
and now the selector takes that result type as its argument:
f :: forall a. T [a] -> Maybe a
op :: forall a. Foo a =>
forall b. Ord b =>
a -> b -> b
Details: the "real" types of T1,T2 are:
T1 :: forall r a. (r~[a]) => a -> T r
T2 :: forall r a b. (r~[a]) => a -> b -> T r
This is unlike ordinary record selectors, which have all the for-alls
at the outside. When dealing with classes it's very convenient to
recover the original type signature from the class op selector.
So the selector loooks like this:
f :: forall a. T [a] -> Maybe a
f (a:*) (t:T [a])
= case t of
T1 c (g:[a]~[c]) (v:Maybe c) -> v `cast` Maybe (right (sym g))
T2 c d (g:[a]~[c]) (v:Maybe c) (w:d) -> v `cast` Maybe (right (sym g))
\begin{code}
mkDictSelId :: Bool -- True <=> don't include the unfolding
-- Little point on imports without -O, because the
-- dictionary itself won't be visible
-> Name -> Class -> Id
mkDictSelId no_unf name clas
= mkGlobalId (ClassOpId clas) name sel_ty info
where
sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
-- We can't just say (exprType rhs), because that would give a type
-- C a -> C a
-- for a single-op class (after all, the selector is the identity)
-- But it's type must expose the representation of the dictionary
-- to get (say) C a -> (a -> a)
Note the forall'd tyvars of the selector are just the free tyvars
of the result type; there may be other tyvars in the constructor's
type (e.g. 'b' in T2).
info = noCafIdInfo
`setArityInfo` 1
`setAllStrictnessInfo` Just strict_sig
`setUnfoldingInfo` (if no_unf then noUnfolding
else mkImplicitUnfolding rhs)
Note the need for casts in the result!
-- We no longer use 'must-inline' on record selectors. They'll
-- inline like crazy if they scrutinise a constructor
Note [Selector running example]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's OK to combine GADTs and type families. Here's a running example:
-- The strictness signature is of the form U(AAAVAAAA) -> T
-- where the V depends on which item we are selecting
-- It's worth giving one, so that absence info etc is generated
-- even if the selector isn't inlined
strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
arg_dmd | isNewTyCon tycon = evalDmd
| otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
| id <- arg_ids ])
data instance T [a] where
T1 { fld :: b } :: T [Maybe b]
tycon = classTyCon clas
[data_con] = tyConDataCons tycon
tyvars = dataConUnivTyVars data_con
arg_tys = {- ASSERT( isVanillaDataCon data_con ) -} dataConRepArgTys data_con
eq_theta = dataConEqTheta data_con
the_arg_id = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` arg_ids) name
The representation type looks like this
data :R7T a where
T1 { fld :: b } :: :R7T (Maybe b)
pred = mkClassPred clas (mkTyVarTys tyvars)
dict_id = mkTemplateLocal 1 $ mkPredTy pred
(eq_ids,n) = mkCoVarLocals 2 $ mkPredTys eq_theta
arg_ids = mkTemplateLocalsNum n arg_tys