[Git][ghc/ghc][wip/amg/renamer-refactor] Minor fixups
Adam Gundry
gitlab at gitlab.haskell.org
Wed Nov 18 19:45:33 UTC 2020
Adam Gundry pushed to branch wip/amg/renamer-refactor at Glasgow Haskell Compiler / GHC
Commits:
5ceb206d by Adam Gundry at 2020-11-18T19:14:44+00:00
Minor fixups
- - - - -
6 changed files:
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Types/Name/Reader.hs
Changes:
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -765,8 +765,7 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do
lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name
case res of
NameNotFound -> return (Left (unknownSubordinateErr doc rdr_name))
- FoundChild _p (ChildName n) -> return (Right n)
- FoundChild _p (ChildField fl) -> return (Right (flSelector fl)) -- AMG TODO: really?
+ FoundChild _p child -> return (Right (childName child))
IncorrectParent {}
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -960,8 +960,9 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
-- See Note [Dealing with imports]
imp_occ_env :: OccEnv (NameEnv (Child, -- the name or field
AvailInfo, -- the export item providing it
- Maybe Name)) -- TODO comment
- imp_occ_env = mkOccEnv_C (plusNameEnv_C combine) [ (occName c, mkNameEnv [(childName c, (c, a, Nothing))])
+ Maybe Name)) -- the parent of associated types
+ imp_occ_env = mkOccEnv_C (plusNameEnv_C combine)
+ [ (occName c, mkNameEnv [(childName c, (c, a, Nothing))])
| a <- all_avails
, c <- availChildren a]
-- See Note [Dealing with imports]
@@ -983,7 +984,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
(c2, a2, mb2)
= ASSERT2( c1 == c2 && isNothing mb1 && isNothing mb2 && (isAvailTC a1 || isAvailTC a2)
, ppr c1 <+> ppr c2 <+> ppr a1 <+> ppr a2 <+> ppr mb1 <+> ppr mb2 )
- if isAvailTC a1 then (c1, a1, Nothing) else (c2, a2, Nothing) -- AMG TODO: is Nothing right?
+ if isAvailTC a1 then (c1, a1, Nothing)
+ else (c1, a2, Nothing)
isAvailTC AvailTC{} = True
isAvailTC _ = False
=====================================
compiler/GHC/Tc/Errors/Hole.hs
=====================================
@@ -22,7 +22,9 @@ import GHC.Tc.Utils.TcType
import GHC.Core.Type
import GHC.Core.DataCon
import GHC.Types.Name
-import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..), globalRdrEnvElts, gre_name )
+import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..)
+ , globalRdrEnvElts, gre_name
+ , isOverloadedRecFldGRE )
import GHC.Builtin.Names ( gHC_ERR )
import GHC.Types.Id
import GHC.Types.Var.Set
@@ -470,10 +472,12 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches
holeDisp = if sMs then holeVs
else sep $ replicate (length hfMatches) $ text "_"
- occDisp = pprPrefixOcc $ case hfCand of
- GreHFCand gre -> occName gre
- NameHFCand name -> occName name
- IdHFCand id_ -> occName id_
+ occDisp = case hfCand of
+ -- AMG TODO: make OutputableBndr GlobalRdrElt instance that does the right thing?
+ GreHFCand gre | isOverloadedRecFldGRE gre -> pprPrefixOcc (occName gre)
+ | otherwise -> pprPrefixOcc (gre_name gre)
+ NameHFCand name -> pprPrefixOcc name
+ IdHFCand id_ -> pprPrefixOcc id_
tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
has = not . null
wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
@@ -787,7 +791,7 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
#if __GLASGOW_HASKELL__ <= 810
IdHFCand id -> idName id
#endif
- GreHFCand gre -> gre_name gre -- AMG TODO dubious
+ GreHFCand gre -> gre_name gre
NameHFCand name -> name
discard_it = go subs seen maxleft ty elts
keep_it eid eid_ty wrp ms = go (fit:subs) (extendVarSet seen eid)
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -526,8 +526,8 @@ lookupChildrenExport spec_parent rdr_items =
; return (Left (L l (IEName (L l ub))))}
FoundChild par child -> do { checkPatSynParent spec_parent par child
; return $ case child of
- ChildField fl -> Right (L (getLoc n) fl)
- ChildName name -> Left (replaceLWrappedName n name) -- AMG TODO
+ ChildField fl -> Right (L (getLoc n) fl)
+ ChildName name -> Left (replaceLWrappedName n name)
}
IncorrectParent p g td gs -> failWithDcErr p g td gs
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -176,7 +176,7 @@ checkHsigIface tcg_env gr sig_iface
-- be a reexport. In this case, make sure the 'Name' of the
-- reexport matches the 'Name exported here.
| [gre] <- lookupGlobalRdrEnv gr (nameOccName name) = do
- let name' = gre_name gre -- AMG TODO this looks fishy
+ let name' = gre_name gre
when (name /= name') $ do
-- See Note [Error reporting bad reexport]
-- TODO: Actually this error swizzle doesn't work
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -57,7 +57,7 @@ module GHC.Types.Name.Reader (
greRdrNames, greSrcSpan, greQualModName,
gresToAvailInfo,
greDefinitionModule, greDefinitionSrcSpan,
- gre_name, -- AMG TODO: can we get rid of export?
+ gre_name,
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrElt(..), isLocalGRE, isRecFldGRE, isOverloadedRecFldGRE, greLabel,
@@ -750,10 +750,10 @@ gresToAvailInfo gres
comb :: GlobalRdrElt -> AvailInfo -> AvailInfo
comb _ (Avail n) = Avail n -- Duplicated name, should not happen
- comb _ (AvailFL fl) = AvailFL fl -- TODO: shouldn't happen either?
+ comb _ (AvailFL fl) = AvailFL fl -- AMG TODO: shouldn't happen either?
comb gre (AvailTC m ns fls)
= case (gre_par gre, gre_child gre) of
- (NoParent, ChildName me) -> AvailTC m (me:ns) fls -- Not sure this ever happens -- TODO: AvailTC invariant?
+ (NoParent, ChildName me) -> AvailTC m (me:ns) fls -- Not sure this ever happens -- AMG TODO: AvailTC invariant?
(NoParent, ChildField fl) -> AvailTC m ns (fl:fls)
(ParentIs {}, ChildName me) -> AvailTC m (insertChildIntoChildren m ns me) fls
(ParentIs {}, ChildField fl) -> AvailTC m ns (fl:fls)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ceb206d45d7754acedc917af07e7a0646c0ef41
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ceb206d45d7754acedc917af07e7a0646c0ef41
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201118/5ea778c5/attachment-0001.html>
More information about the ghc-commits
mailing list