Commit 98bfa187 authored by Vladislav Zavialov's avatar Vladislav Zavialov

Drop the orphan roles check (#16941)

9366e019 introduced a check for orphan roles to fix #8485

6ab5da99 changed the lookup code and made the check redundant.

Now it is removed.
parent 52f755aa
Pipeline #8381 passed with stages
in 326 minutes and 46 seconds
......@@ -1310,8 +1310,8 @@ rnTyClDecls tycl_ds
, group_roles = []
, group_instds = init_inst_ds }]
((final_inst_ds, orphan_roles), groups)
= mapAccumL mk_group (rest_inst_ds, role_annot_env) tycl_sccs
(final_inst_ds, groups)
= mapAccumL (mk_group role_annot_env) rest_inst_ds tycl_sccs
all_fvs = plusFV (foldr (plusFV . snd) emptyFVs tycls_w_fvs)
......@@ -1319,24 +1319,23 @@ rnTyClDecls tycl_ds
all_groups = first_group ++ groups
; ASSERT2( null final_inst_ds, ppr instds_w_fvs $$ ppr inst_ds_map
; MASSERT2( null final_inst_ds, ppr instds_w_fvs $$ ppr inst_ds_map
$$ ppr (flattenSCCs tycl_sccs) $$ ppr final_inst_ds )
mapM_ orphanRoleAnnotErr (nameEnvElts orphan_roles)
; traceRn "rnTycl dependency analysis made groups" (ppr all_groups)
; return (all_groups, all_fvs) }
mk_group :: (InstDeclFreeVarsMap, RoleAnnotEnv)
mk_group :: RoleAnnotEnv
-> InstDeclFreeVarsMap
-> SCC (LTyClDecl GhcRn)
-> ( (InstDeclFreeVarsMap, RoleAnnotEnv)
, TyClGroup GhcRn )
mk_group (inst_map, role_env) scc
= ((inst_map', role_env'), group)
-> (InstDeclFreeVarsMap, TyClGroup GhcRn)
mk_group role_env inst_map scc
= (inst_map', group)
tycl_ds = flattenSCC scc
bndrs = map (tcdName . unLoc) tycl_ds
roles = getRoleAnnots bndrs role_env
(inst_ds, inst_map') = getInsts bndrs inst_map
(roles, role_env') = getRoleAnnots bndrs role_env
group = TyClGroup { group_ext = noExtField
, group_tyclds = tycl_ds
, group_roles = roles
......@@ -1422,15 +1421,6 @@ dupRoleAnnotErr list
cmp_annot (dL->L loc1 _) (dL->L loc2 _) = loc1 `compare` loc2
orphanRoleAnnotErr :: LRoleAnnotDecl GhcRn -> RnM ()
orphanRoleAnnotErr (dL->L loc decl)
= addErrAt loc $
hang (text "Role annotation for a type previously declared:")
2 (ppr decl) $$
parens (text "The role annotation must be given where" <+>
quotes (ppr $ roleAnnotDeclName decl) <+>
text "is declared.")
{- Note [Role annotations in the renamer]
......@@ -1446,21 +1436,8 @@ to do the check *before* renaming to avoid calling all unbound names duplicates
of one another.
The renaming process, as usual, might identify and report errors for unbound
names. We exclude the annotations for unbound names in the annotation
environment to avoid spurious errors for orphaned annotations.
We then (in rnTyClDecls) do a check for orphan role annotations (role
annotations without an accompanying type decl). The check works by folding
over components (of type [[Either (TyClDecl Name) (InstDecl Name)]]), selecting
out the relevant role declarations for each group, as well as diminishing the
annotation environment. After the fold is complete, anything left over in the
name environment must be an orphan, and errors are generated.
An earlier version of this algorithm short-cut the orphan check by renaming
only with names declared in this module. But, this check is insufficient in
the case of staged module compilation (Template Haskell, GHCi).
See #8485. With the new lookup process (which includes types declared in other
modules), we get better error messages, too.
names. This is done by using lookupSigCtxtOccRn in rnRoleAnnots (using
lookupGlobalOccRn led to #8485).
......@@ -3975,8 +3975,6 @@ emptyRoleAnnotEnv = emptyNameEnv
lookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)
lookupRoleAnnot = lookupNameEnv
getRoleAnnots :: [Name] -> RoleAnnotEnv
-> ([LRoleAnnotDecl GhcRn], RoleAnnotEnv)
getRoleAnnots :: [Name] -> RoleAnnotEnv -> [LRoleAnnotDecl GhcRn]
getRoleAnnots bndrs role_env
= ( mapMaybe (lookupRoleAnnot role_env) bndrs
, delListFromNameEnv role_env bndrs )
= mapMaybe (lookupRoleAnnot role_env) bndrs
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