diff options
Diffstat (limited to 'compiler/GHC/Rename/Names.hs')
-rw-r--r-- | compiler/GHC/Rename/Names.hs | 126 |
1 files changed, 82 insertions, 44 deletions
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 0f6e4e1cce..99d2089799 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -665,9 +665,14 @@ extendGlobalRdrEnvRn avails new_fixities where -- See Note [Reporting duplicate local declarations] dups = filter isDupGRE (lookupGlobalRdrEnv env (greOccName gre)) - isDupGRE gre' = isLocalGRE gre' - && (not (isOverloadedRecFldGRE gre && isOverloadedRecFldGRE gre') - || (gre_name gre == gre_name gre')) + isDupGRE gre' = isLocalGRE gre' && not (isAllowedDup gre') + isAllowedDup gre' = + case (isRecFldGRE gre, isRecFldGRE gre') of + (True, True) -> gre_name gre /= gre_name gre' + && isDuplicateRecFldGRE gre' + (True, False) -> isNoFieldSelectorGRE gre + (False, True) -> isNoFieldSelectorGRE gre' + (False, False) -> False {- Note [Reporting duplicate local declarations] @@ -675,9 +680,9 @@ Note [Reporting duplicate local declarations] In general, a single module may not define the same OccName multiple times. This is checked in extendGlobalRdrEnvRn: when adding a new locally-defined GRE to the GlobalRdrEnv we report an error if there are already duplicates in the -environment. This establishes INVARIANT 1 of the GlobalRdrEnv, which says that -for a given OccName, all the GlobalRdrElts to which it maps must have distinct -'gre_name's. +environment. This establishes INVARIANT 1 (see comments on GlobalRdrEnv in +GHC.Types.Name.Reader), which says that for a given OccName, all the +GlobalRdrElts to which it maps must have distinct 'gre_name's. For example, the following will be rejected: @@ -685,17 +690,34 @@ For example, the following will be rejected: g x = x f x = x -- Duplicate! -Under what conditions will a GRE that exists already count as a duplicate of the -LocalDef GRE being added? - -* It must also be a LocalDef: the programmer is allowed to make a new local - definition that clashes with an imported one (although attempting to refer to - either may lead to ambiguity errors at use sites). For example, the following - definition is allowed: +Two GREs with the same OccName are OK iff: +------------------------------------------------------------------- + Existing GRE | Newly-defined GRE + | NormalGre FieldGre +------------------------------------------------------------------- + Imported | Always Always + | + Local NormalGre | Never NoFieldSelectors + | + Local FieldGre | NoFieldSelectors DuplicateRecordFields + | and not in same record +------------------------------------------------------------------- - +In this table "NoFieldSelectors" means "NoFieldSelectors was enabled at the +definition site of the fields; ditto "DuplicateRecordFields". These facts are +recorded in the 'FieldLabel' (but where both GREs are local, both will +necessarily have the same extensions enabled). + +More precisely: + +* The programmer is allowed to make a new local definition that clashes with an + imported one (although attempting to refer to either may lead to ambiguity + errors at use sites). For example, the following definition is allowed: import M (f) f x = x + Thus isDupGRE reports errors only if the existing GRE is a LocalDef. + * When DuplicateRecordFields is enabled, the same field label may be defined in multiple records. For example, this is allowed: @@ -704,8 +726,8 @@ LocalDef GRE being added? data S2 = MkS2 { f :: Int } Even though both fields have the same OccName, this does not violate INVARIANT - 1, because the fields have distinct selector names, which form part of the - gre_name (see Note [GreNames] in GHC.Types.Name.Reader). + 1 of the GlobalRdrEnv, because the fields have distinct selector names, which + form part of the gre_name (see Note [GreNames] in GHC.Types.Name.Reader). * However, we must be careful to reject the following (#9156): @@ -714,18 +736,32 @@ LocalDef GRE being added? In this case, both 'gre_name's are the same (because the fields belong to the same type), and adding them both to the environment would be a violation of - INVARIANT 1. Thus isDupGRE checks whether both GREs have the same gre_name. + INVARIANT 1. Thus isAllowedDup checks both GREs have distinct 'gre_name's + if they are both record fields. -* We also reject attempts to define a field and a non-field with the same - OccName (#17965): +* With DuplicateRecordFields, we reject attempts to define a field and a + non-field with the same OccName (#17965): {-# LANGUAGE DuplicateRecordFields #-} f x = x data T = MkT { f :: Int} In principle this could be supported, but the current "specification" of - DuplicateRecordFields does not allow it. Thus isDupGRE checks that *both* GREs - being compared are record fields. + DuplicateRecordFields does not allow it. Thus isAllowedDup checks for + DuplicateRecordFields only if *both* GREs being compared are record fields. + +* However, with NoFieldSelectors, it is possible by design to define a field and + a non-field with the same OccName: + + {-# LANGUAGE NoFieldSelectors #-} + f x = x + data T = MkT { f :: Int} + + Thus isAllowedDup checks for NoFieldSelectors if either the existing or the + new GRE are record fields. See Note [NoFieldSelectors] in GHC.Rename.Env. + +See also Note [Skipping ambiguity errors at use sites of local declarations] in +GHC.Rename.Utils. -} @@ -755,9 +791,10 @@ getLocalNonValBinders fixity_env hs_fords = foreign_decls }) = do { -- Process all type/class decls *except* family instances ; let inst_decls = tycl_decls >>= group_instds - ; overload_ok <- xoptM LangExt.DuplicateRecordFields + ; dup_fields_ok <- xopt_DuplicateRecordFields <$> getDynFlags + ; has_sel <- xopt_FieldSelectors <$> getDynFlags ; (tc_avails, tc_fldss) - <- fmap unzip $ mapM (new_tc overload_ok) + <- fmap unzip $ mapM (new_tc dup_fields_ok has_sel) (tyClGroupTyClDecls tycl_decls) ; traceRn "getLocalNonValBinders 1" (ppr tc_avails) ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env @@ -767,7 +804,7 @@ getLocalNonValBinders fixity_env -- Process all family instances -- to bring new data constructors into scope - ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok) + ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc dup_fields_ok has_sel) inst_decls -- Finish off with value binders: @@ -809,12 +846,12 @@ getLocalNonValBinders fixity_env new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name ; return (avail nm) } - new_tc :: Bool -> LTyClDecl GhcPs + new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) - new_tc overload_ok tc_decl -- NOT for type/data instances + new_tc dup_fields_ok has_sel tc_decl -- NOT for type/data instances = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs - ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds + ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds ; let fld_env = case unLoc tc_decl of DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds' _ -> [] @@ -851,15 +888,15 @@ getLocalNonValBinders fixity_env find (\ fl -> flLabel fl == lbl) flds where lbl = occNameFS (rdrNameOcc rdr) - new_assoc :: Bool -> LInstDecl GhcPs + new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs -> RnM ([AvailInfo], [(Name, [FieldLabel])]) - new_assoc _ (L _ (TyFamInstD {})) = return ([], []) + new_assoc _ _ (L _ (TyFamInstD {})) = return ([], []) -- type instances don't bind new names - new_assoc overload_ok (L _ (DataFamInstD _ d)) - = do { (avail, flds) <- new_di overload_ok Nothing d + new_assoc dup_fields_ok has_sel (L _ (DataFamInstD _ d)) + = do { (avail, flds) <- new_di dup_fields_ok has_sel Nothing d ; return ([avail], flds) } - new_assoc overload_ok (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty + new_assoc dup_fields_ok has_sel (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty , cid_datafam_insts = adts }))) = do -- First, attempt to grab the name of the class from the instance. -- This step could fail if the instance is not headed by a class, @@ -883,35 +920,36 @@ getLocalNonValBinders fixity_env Nothing -> pure ([], []) Just cls_nm -> do (avails, fldss) - <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts + <- mapAndUnzipM (new_loc_di dup_fields_ok has_sel (Just cls_nm)) adts pure (avails, concat fldss) - new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs + new_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> DataFamInstDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) - new_di overload_ok mb_cls dfid@(DataFamInstDecl { dfid_eqn = ti_decl }) + new_di dup_fields_ok has_sel mb_cls dfid@(DataFamInstDecl { dfid_eqn = ti_decl }) = do { main_name <- lookupFamInstName mb_cls (feqn_tycon ti_decl) ; let (bndrs, flds) = hsDataFamInstBinders dfid ; sub_names <- mapM newTopSrcBinder bndrs - ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds + ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds ; let avail = availTC (unLoc main_name) sub_names flds' -- main_name is not bound here! fld_env = mk_fld_env (feqn_rhs ti_decl) sub_names flds' ; return (avail, fld_env) } - new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs + new_loc_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> LDataFamInstDecl GhcPs -> RnM (AvailInfo, [(Name, [FieldLabel])]) - new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d + new_loc_di dup_fields_ok has_sel mb_cls (L _ d) = new_di dup_fields_ok has_sel mb_cls d -newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel -newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!" -newRecordSelector overload_ok (dc:_) (L loc (FieldOcc _ (L _ fld))) +newRecordSelector :: DuplicateRecordFields -> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel +newRecordSelector _ _ [] _ = error "newRecordSelector: datatype has no constructors!" +newRecordSelector dup_fields_ok has_sel (dc:_) (L loc (FieldOcc _ (L _ fld))) = do { selName <- newTopSrcBinder $ L loc $ field ; return $ FieldLabel { flLabel = fieldLabelString - , flIsOverloaded = overload_ok + , flHasDuplicateRecordFields = dup_fields_ok + , flHasFieldSelector = has_sel , flSelector = selName } } where fieldLabelString = occNameFS $ rdrNameOcc fld - selOccName = fieldSelectorOccName fieldLabelString (nameOccName dc) overload_ok + selOccName = fieldSelectorOccName fieldLabelString (nameOccName dc) dup_fields_ok has_sel field | isExact fld = fld -- use an Exact RdrName as is to preserve the bindings -- of an already renamer-resolved field and its use @@ -1321,8 +1359,8 @@ mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt] mkChildEnv gres = foldr add emptyNameEnv gres where add gre env = case gre_par gre of - ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre - NoParent -> env + ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre + NoParent -> env findChildren :: NameEnv [a] -> Name -> [a] findChildren env n = lookupNameEnv env n `orElse` [] |