summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2019-07-16 00:28:18 +0300
committerVladislav Zavialov <vlad.z.4096@gmail.com>2019-07-16 12:14:04 +0300
commit98bfa18784fd575593994f1f307fa091cc3e375b (patch)
tree92089bcdd4e50a3d9e83f7ea0eea406dc552eb04
parent52f755aa203c55e44dce79c9ac1abc245977b000 (diff)
downloadhaskell-wip/16941.tar.gz
Drop the orphan roles check (#16941)wip/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.
-rw-r--r--compiler/rename/RnSource.hs45
-rw-r--r--compiler/typecheck/TcRnTypes.hs6
2 files changed, 13 insertions, 38 deletions
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 2aa5afbbd2..a9b3c3f283 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -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) }
where
- 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)
where
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).
-}
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 7e28359c36..45fbfd9f95 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -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