Commit e30c84cb authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Make role inference work on the source type of a data con

When inferring roles it is Much More Kosher to work on the source
type, as written by the user, rather than the representation type as
computed by GHC.  Error messages may be better and, more subtly, the
representation type is the result of a pretty complicated calculation
and I'm worried about accidental cycles.
parent 4db3679c
......@@ -1524,14 +1524,16 @@ checkValidRoles tc
= return ()
where
check_dc_roles datacon
= let univ_tvs = dataConUnivTyVars datacon
ex_tvs = dataConExTyVars datacon
args = dataConRepArgTys datacon
univ_roles = zipVarEnv univ_tvs (tyConRoles tc)
= do { traceTc "check_dc_roles" (ppr datacon <+> ppr (tyConRoles tc))
; mapM_ (check_ty_roles role_env Representational) $
eqSpecPreds eq_spec ++ theta ++ arg_tys }
-- See Note [Role-checking data constructor arguments] in TcTyDecls
where
(univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig datacon
univ_roles = zipVarEnv univ_tvs (tyConRoles tc)
-- zipVarEnv uses zipEqual, but we don't want that for ex_tvs
ex_roles = mkVarEnv (zip ex_tvs (repeat Nominal))
role_env = univ_roles `plusVarEnv` ex_roles in
mapM_ (check_ty_roles role_env Representational) args
ex_roles = mkVarEnv (zip ex_tvs (repeat Nominal))
role_env = univ_roles `plusVarEnv` ex_roles
check_ty_roles env role (TyVarTy tv)
= case lookupVarEnv env tv of
......
......@@ -615,6 +615,19 @@ roles(~#) = N, N
With -dcore-lint on, the output of this algorithm is checked in checkValidRoles,
called from checkValidTycon.
Note [Role-checking data constructor arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data T a where
MkT :: Eq b => F a -> (a->a) -> T (G a)
Then we want to check the roles at which 'a' is used
in MkT's type. We want to work on the user-written type,
so we need to take into account
* the arguments: (F a) and (a->a)
* the context: C a b
* the result type: (G a) -- this is in the eq_spec
\begin{code}
type RoleEnv = NameEnv [Role] -- from tycon names to roles
type RoleAnnots = NameEnv [Maybe Role] -- from tycon names to role annotations,
......@@ -695,9 +708,12 @@ irClass tc_name cls
-- See Note [Role inference]
irDataCon :: Name -> DataCon -> RoleM ()
irDataCon tc_name datacon
= addRoleInferenceInfo tc_name (dataConUnivTyVars datacon) $
let ex_var_set = mkVarSet $ dataConExTyVars datacon in
mapM_ (irType ex_var_set) (dataConRepArgTys datacon)
= addRoleInferenceInfo tc_name univ_tvs $
mapM_ (irType ex_var_set) (eqSpecPreds eq_spec ++ theta ++ arg_tys)
-- See Note [Role-checking data constructor arguments]
where
(univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig datacon
ex_var_set = mkVarSet ex_tvs
irType :: VarSet -> Type -> RoleM ()
irType = go
......
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