summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename
diff options
context:
space:
mode:
authorsheaf <sam.derbyshire@gmail.com>2023-04-07 18:36:56 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-04-07 22:30:07 -0400
commit3ba77b369a170ba68f4eb5c8f3ae13e03dcbb28d (patch)
treec1296a7fc789c66bc79ee1b345f67d2a0841ae48 /compiler/GHC/Rename
parent6a788f0ad465cf49673b187c5feeae80b738ce54 (diff)
downloadhaskell-3ba77b369a170ba68f4eb5c8f3ae13e03dcbb28d.tar.gz
Renamer: don't call addUsedGRE on an exact Name
When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r--compiler/GHC/Rename/Env.hs19
-rw-r--r--compiler/GHC/Rename/Names.hs5
2 files changed, 14 insertions, 10 deletions
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 2b4ecf2bc7..49fdde1bc6 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -534,30 +534,29 @@ lookupRecFieldOcc mb_con rdr_name
= return $ mk_unbound_rec_fld con
| Just con <- mb_con
= do { let lbl = FieldLabelString $ occNameFS (rdrNameOcc rdr_name)
- ; res <- lookupExactOrOrig rdr_name ensure_recfld $ -- See Note [Record field names and Template Haskell]
+ ; mb_nm <- lookupExactOrOrig rdr_name ensure_recfld $ -- See Note [Record field names and Template Haskell]
do { flds <- lookupConstructorFields con
; env <- getGlobalRdrEnv
- ; let lbl = FieldLabelString $ occNameFS (rdrNameOcc rdr_name)
- mb_gre = do fl <- find ((== lbl) . flLabel) flds
+ ; let mb_gre = do fl <- find ((== lbl) . flLabel) flds
-- We have the label, now check it is in scope. If
-- there is a qualifier, use pickGREs to check that
-- the qualifier is correct, and return the filtered
-- GRE so we get import usage right (see #17853).
gre <- lookupGRE_FieldLabel env fl
if isQual rdr_name
- then listToMaybe (pickGREs rdr_name [gre])
+ then listToMaybe $ pickGREs rdr_name [gre]
else return gre
; traceRn "lookupRecFieldOcc" $
vcat [ text "mb_con:" <+> ppr mb_con
, text "rdr_name:" <+> ppr rdr_name
, text "flds:" <+> ppr flds
, text "mb_gre:" <+> ppr mb_gre ]
- ; return mb_gre }
- ; case res of
+ ; mapM_ (addUsedGRE True) mb_gre
+ ; return $ flSelector . fieldGRELabel <$> mb_gre }
+ ; case mb_nm of
{ Nothing -> do { addErr (badFieldConErr con lbl)
; return $ mk_unbound_rec_fld con }
- ; Just gre -> do { addUsedGRE True gre
- ; return (flSelector $ fieldGRELabel gre) } } }
+ ; Just nm -> return nm } }
| otherwise -- Can't use the data constructor to disambiguate
= greName <$> lookupGlobalOccRn' (IncludeFields WantField) rdr_name
@@ -572,7 +571,9 @@ lookupRecFieldOcc mb_con rdr_name
mkRecFieldOccFS (getOccFS con) (occNameFS occ)
occ = rdrNameOcc rdr_name
- ensure_recfld gre = do { guard (isRecFldGRE gre) ; return gre }
+ ensure_recfld :: GlobalRdrElt -> Maybe Name
+ ensure_recfld gre = do { guard (isRecFldGRE gre)
+ ; return $ greName gre }
{- Note [DisambiguateRecordFields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index e46d803287..aae3fe497b 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1855,7 +1855,10 @@ mkImportMap gres
RealSrcLoc decl_loc _ -> Map.insertWith add decl_loc [gre] imp_map
UnhelpfulLoc _ -> imp_map
where
- best_imp_spec = bestImport (bagToList imp_specs)
+ best_imp_spec =
+ case bagToList imp_specs of
+ [] -> pprPanic "mkImportMap: GRE with no ImportSpecs" (ppr gre)
+ is:iss -> bestImport (is NE.:| iss)
add _ gres = gre : gres
warnUnusedImport :: WarningFlag -> GlobalRdrEnv