Repository : ssh://[email protected]/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e30c84cb5adcd35e4b8301804af39df605ffcc7f/ghc
>--------------------------------------------------------------- commit e30c84cb5adcd35e4b8301804af39df605ffcc7f Author: Simon Peyton Jones <[email protected]> Date: Wed Sep 4 12:07:01 2013 +0100 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. >--------------------------------------------------------------- e30c84cb5adcd35e4b8301804af39df605ffcc7f compiler/typecheck/TcTyClsDecls.lhs | 16 +++++++++------- compiler/typecheck/TcTyDecls.lhs | 22 +++++++++++++++++++--- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 70e72f5..f4e4dab 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -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 diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index bea2cd1..5091cab 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -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 _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
