[Git][ghc/ghc][wip/amg/renamer-refactor] 2 commits: Simplify IncorrectParent
Adam Gundry
gitlab at gitlab.haskell.org
Wed Dec 2 22:57:46 UTC 2020
Adam Gundry pushed to branch wip/amg/renamer-refactor at Glasgow Haskell Compiler / GHC
Commits:
7542d353 by Adam Gundry at 2020-12-02T22:55:54+00:00
Simplify IncorrectParent
- - - - -
913a5076 by Adam Gundry at 2020-12-02T22:55:54+00:00
Clean up now that #18452 is fixed
- - - - -
3 changed files:
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Head.hs
Changes:
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -644,14 +644,13 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
case original_gres of
[] -> return NameNotFound
[g] -> return $ IncorrectParent parent
- (gre_name g) (ppr $ gre_name g)
+ (gre_child g)
[p | Just p <- [getParent g]]
gss@(g:_:_) ->
if all isRecFldGRE gss && overload_ok
then return $
IncorrectParent parent
- (gre_name g)
- (ppr $ expectJust "noMatchingParentErr" (greLabel g))
+ (gre_child g)
[p | x <- gss, Just p <- [getParent x]]
else mkNameClashErr gss
@@ -731,8 +730,7 @@ instance Monoid DisambigInfo where
data ChildLookupResult
= NameNotFound -- We couldn't find a suitable name
| IncorrectParent Name -- Parent
- Name -- Name of thing we were looking for
- SDoc -- How to print the name
+ Child -- Child we were looking for
[Name] -- List of possible parents
| FoundChild Parent Child -- We resolved to a child
@@ -748,8 +746,8 @@ combineChildLookupResult (x:xs) = do
instance Outputable ChildLookupResult where
ppr NameNotFound = text "NameNotFound"
ppr (FoundChild p n) = text "Found:" <+> ppr p <+> ppr n
- ppr (IncorrectParent p n td ns) = text "IncorrectParent"
- <+> hsep [ppr p, ppr n, td, ppr ns]
+ ppr (IncorrectParent p n ns) = text "IncorrectParent"
+ <+> hsep [ppr p, ppr n, ppr ns]
lookupSubBndrOcc :: Bool
-> Name -- Parent
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -525,7 +525,7 @@ lookupChildrenExport spec_parent rdr_items =
ChildField fl -> Right (L (getLoc n) fl)
ChildName name -> Left (replaceLWrappedName n name)
}
- IncorrectParent p g td gs -> failWithDcErr p g td gs
+ IncorrectParent p c gs -> failWithDcErr p c gs
-- Note: [Typing Pattern Synonym Exports]
@@ -613,7 +613,7 @@ checkPatSynParent parent NoParent child
AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p
- _ -> failWithDcErr parent mpat_syn (ppr child) [] }
+ _ -> failWithDcErr parent child [] }
where
psErr = exportErrCtxt "pattern synonym"
selErr = exportErrCtxt "pattern synonym record selector"
@@ -805,11 +805,11 @@ dcErrMsg ty_con what_is thing parents =
[_] -> text "Parent:"
_ -> text "Parents:") <+> fsep (punctuate comma parents)
-failWithDcErr :: Name -> Name -> SDoc -> [Name] -> TcM a
-failWithDcErr parent thing thing_doc parents = do
- ty_thing <- tcLookupGlobal thing
+failWithDcErr :: Name -> Child -> [Name] -> TcM a
+failWithDcErr parent child parents = do
+ ty_thing <- tcLookupGlobal (childName child)
failWithTc $ dcErrMsg parent (tyThingCategory' ty_thing)
- thing_doc (map ppr parents)
+ (ppr child) (map ppr parents)
where
tyThingCategory' :: TyThing -> String
tyThingCategory' (AnId i)
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -493,11 +493,12 @@ tc_rec_sel_id lbl sel_name
= do { thing <- tcLookup sel_name
; case thing of
ATcId { tct_id = id }
- -> do { check_local_id occ id
+ -> do { check_naughty occ id
+ ; check_local_id id
; return id }
AGlobal (AnId id)
- -> do { check_global_id occ id
+ -> do { check_naughty occ id
; return id }
-- A global cannot possibly be ill-staged
-- nor does it need the 'lifting' treatment
@@ -758,12 +759,14 @@ tc_infer_id id_name
; global_env <- getGlobalRdrEnv
; case thing of
ATcId { tct_id = id }
- -> do { check_local_id occ id
+ -> do { check_local_id id
; return_id id }
AGlobal (AnId id)
- -> do { check_global_id occ id
- ; return_id id }
+ -> return_id id
+ -- A global cannot possibly be ill-staged
+ -- nor does it need the 'lifting' treatment
+ -- Hence no checkTh stuff here
AGlobal (AConLike cl) -> case cl of
RealDataCon con -> return_data_con con
@@ -798,8 +801,6 @@ tc_infer_id id_name
= text "Illegal term-level use of the type constructor"
<+> quotes (ppr (tyConName ty_con))
- occ = nameOccName id_name
-
return_id id = return (HsVar noExtField (noLoc id), idType id)
return_data_con con
@@ -845,19 +846,11 @@ tc_infer_id id_name
, mkInvisForAllTys tvs $ mkInvisFunTysMany theta $ mkVisFunTys scaled_arg_tys res)
}
-check_local_id :: OccName -> Id -> TcM ()
-check_local_id occ id
- = do { check_naughty occ id -- See Note [HsVar: naughty record selectors]
- ; checkThLocalId id
+check_local_id :: Id -> TcM ()
+check_local_id id
+ = do { checkThLocalId id
; tcEmitBindingUsage $ unitUE (idName id) One }
-check_global_id :: OccName -> Id -> TcM ()
-check_global_id occ id
- = check_naughty occ id -- See Note [HsVar: naughty record selectors]
- -- A global cannot possibly be ill-staged
- -- nor does it need the 'lifting' treatment
- -- Hence no checkTh stuff here
-
check_naughty :: OccName -> TcId -> TcM ()
check_naughty lbl id
| isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl)
@@ -868,15 +861,7 @@ nonBidirectionalErr name = failWithTc $
text "non-bidirectional pattern synonym"
<+> quotes (ppr name) <+> text "used in an expression"
-{- Note [HsVar: naughty record selectors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-All record selectors should really be HsRecFld (ambiguous or
-unambiguous), but currently not all of them are: see #18452. So we
-need to check for naughty record selectors in tc_infer_id, as well as
-in tc_rec_sel_id.
-
-Remove this code when fixing #18452.
-
+{-
Note [Linear fields generalization]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As per Note [Polymorphisation of linear fields], linear field of data
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/655acd4deacffc5432d9b6615ff30cb9c6bc9f33...913a5076f54face20f249a224599ba7a1f50fbcd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/655acd4deacffc5432d9b6615ff30cb9c6bc9f33...913a5076f54face20f249a224599ba7a1f50fbcd
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/20201202/29740b17/attachment-0001.html>
More information about the ghc-commits
mailing list