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

Fix Trac #3323: naughty record selectors again

I boobed when I decoupled record selectors from their data types.
The most straightforward and robust fix means attaching the TyCon
of a record selector to its IfaceIdInfo, so 

   you'll need to rebuild all .hi files

That said, the fix is easy.
parent dce2394f
......@@ -1110,15 +1110,16 @@ instance Binary IfaceBinding where
return (IfaceRec ac)
instance Binary IfaceIdDetails where
put_ bh IfVanillaId = putByte bh 0
put_ bh (IfRecSelId b) = do { putByte bh 1; put_ bh b }
put_ bh IfDFunId = putByte bh 2
put_ bh IfVanillaId = putByte bh 0
put_ bh (IfRecSelId a b) = do { putByte bh 1; put_ bh a; put_ bh b }
put_ bh IfDFunId = putByte bh 2
get bh = do
h <- getByte bh
case h of
0 -> return IfVanillaId
1 -> do a <- get bh
return (IfRecSelId a)
b <- get bh
return (IfRecSelId a b)
_ -> return IfDFunId
instance Binary IfaceIdInfo where
......
......@@ -183,7 +183,7 @@ type IfaceAnnTarget = AnnTarget OccName
data IfaceIdDetails
= IfVanillaId
| IfRecSelId Bool
| IfRecSelId IfaceTyCon Bool
| IfDFunId
data IfaceIdInfo
......@@ -649,8 +649,8 @@ instance Outputable IfaceConAlt where
------------------
instance Outputable IfaceIdDetails where
ppr IfVanillaId = empty
ppr (IfRecSelId b) = ptext (sLit "RecSel")
<> if b then ptext (sLit "<naughty>") else empty
ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
<+> if b then ptext (sLit "<naughty>") else empty
ppr IfDFunId = ptext (sLit "DFunId")
instance Outputable IfaceIdInfo where
......
......@@ -1453,7 +1453,8 @@ toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails VanillaId = IfVanillaId
toIfaceIdDetails DFunId = IfVanillaId
toIfaceIdDetails (RecSelId { sel_naughty = n }) = IfRecSelId n
toIfaceIdDetails (RecSelId { sel_naughty = n
, sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
IfVanillaId -- Unexpected
......
......@@ -19,7 +19,6 @@ import LoadIface
import IfaceEnv
import BuildTyCl
import TcRnMonad
import TcType ( tcSplitSigmaTy )
import Type
import TypeRep
import HscTypes
......@@ -418,7 +417,7 @@ tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
ifIdDetails = details, ifIdInfo = info})
= do { name <- lookupIfaceTop occ_name
; ty <- tcIfaceType iface_type
; details <- tcIdDetails ty details
; details <- tcIdDetails details
; info <- tcIdInfo ignore_prags name ty info
; return (AnId (mkGlobalId details name ty info)) }
......@@ -966,16 +965,12 @@ do_one (IfaceRec pairs) thing_inside
%************************************************************************
\begin{code}
tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails _ IfVanillaId = return VanillaId
tcIdDetails _ IfDFunId = return DFunId
tcIdDetails ty (IfRecSelId naughty)
= return (RecSelId { sel_tycon = tc, sel_naughty = naughty })
where
(_, _, tau) = tcSplitSigmaTy ty
tc = tyConAppTyCon (funArgTy tau)
-- A bit fragile. Relies on the selector type looking like
-- forall abc. (stupid-context) => T a b c -> blah
tcIdDetails :: IfaceIdDetails -> IfL IdDetails
tcIdDetails IfVanillaId = return VanillaId
tcIdDetails IfDFunId = return DFunId
tcIdDetails (IfRecSelId tc naughty)
= do { tc' <- tcIfaceTyCon tc
; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo ignore_prags name ty info
......
......@@ -457,12 +457,22 @@ field isn't part of the existential. For example, this should be ok.
data T a where { MkT { f1::a, f2::b->b } :: T a }
f :: T a -> b -> T b
f t b = t { f1=b }
The criterion we use is this:
The types of the updated fields
mention only the universally-quantified type variables
of the data constructor
NB: this is not (quite) the same as being a "naughty" record selector
(See Note [Naughty record selectors]) in TcTyClsDecls), at least
in the case of GADTs. Consider
data T a where { MkT :: { f :: a } :: T [a] }
Then f is not "naughty" because it has a well-typed record selector.
But we don't allow updates for 'f'. (One could consider trying to
allow this, but it makes my head hurt. Badly. And no one has asked
for it.)
In principle one could go further, and allow
g :: T a -> T a
g t = t { f2 = \x -> x }
......
......@@ -1239,7 +1239,7 @@ mkRecSelBind (tycon, sel_name)
data_tvs = tyVarsOfType data_ty
is_naughty = not (tyVarsOfType field_ty `subVarSet` data_tvs)
(field_tvs, field_theta, field_tau) = tcSplitSigmaTy field_ty
sel_ty | is_naughty = unitTy
sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors]
| otherwise = mkForAllTys (varSetElems data_tvs ++ field_tvs) $
mkPhiTy (dataConStupidTheta con1) $ -- Urgh!
mkPhiTy field_theta $ -- Urgh!
......@@ -1302,10 +1302,12 @@ 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.
In general, a field is naughty if its type mentions a type variable that
isn't in the result type of the constructor.
In general, a field is "naughty" if its type mentions a type variable that
isn't in the result type of the constructor. Note that this *allows*
GADT record selectors (Note [GADT record selectors]) whose types may look
like sel :: T [a] -> a
We make a dummy binding
For naughty selectors we make a dummy binding
sel = ()
for naughty selectors, so that the later type-check will add them to the
environment, and they'll be exported. The function is never called, because
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment