diff options
author | sheaf <sam.derbyshire@gmail.com> | 2023-04-07 18:36:56 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-07 22:30:07 -0400 |
commit | 3ba77b369a170ba68f4eb5c8f3ae13e03dcbb28d (patch) | |
tree | c1296a7fc789c66bc79ee1b345f67d2a0841ae48 /compiler/GHC/Rename | |
parent | 6a788f0ad465cf49673b187c5feeae80b738ce54 (diff) | |
download | haskell-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.hs | 19 | ||||
-rw-r--r-- | compiler/GHC/Rename/Names.hs | 5 |
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 |