[Git][ghc/ghc][wip/T21730-import] 5 commits: Add ImpDeclSpec.is_implicit

30 Apr 2025


      Brandon Chinn pushed to branch wip/T21730-import at Glasgow Haskell Compiler / GHC


Commits:
e19c0006 by Brandon Chinn at 2025-04-29T21:34:20-07:00
Add ImpDeclSpec.is_implicit

- - - - -
7c3b4022 by Brandon Chinn at 2025-04-29T21:34:20-07:00
Handle implicit imports separately in ImportMap

- - - - -
66ee95b4 by Brandon Chinn at 2025-04-29T21:34:20-07:00
Use full RealSrcSpan in ImportMap

- - - - -
eec0bf4f by Brandon Chinn at 2025-04-29T21:34:20-07:00
Add failing test for #21730

- - - - -
f125a173 by Brandon Chinn at 2025-04-29T21:34:20-07:00
Handle generated imports in ImportMap

- - - - -


14 changed files:

- compiler/GHC.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Types/Name/Reader.hs
- testsuite/tests/plugins/Makefile
- + testsuite/tests/plugins/T21730-plugin/Makefile
- + testsuite/tests/plugins/T21730-plugin/Setup.hs
- + testsuite/tests/plugins/T21730-plugin/T21730-plugin.cabal
- + testsuite/tests/plugins/T21730-plugin/T21730_Plugin.hs
- + testsuite/tests/plugins/T21730.hs
- testsuite/tests/plugins/all.T


Changes:

=====================================
compiler/GHC.hs
=====================================
@@ -1503,7 +1503,8 @@ availsToGlobalRdrEnv hsc_env mod avails
       -- all the specified modules into the global interactive module
     imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
     decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
-                         is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
+                         is_qual = False, is_implicit = False,
+                         is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
                          is_dloc = srcLocSpan interactiveSrcLoc,
                          is_level = NormalLevel }
 


=====================================
compiler/GHC/Hs/ImpExp.hs
=====================================
@@ -80,14 +80,19 @@ type instance XCImportDecl  GhcTc = DataConCantHappen
 data XImportDeclPass = XImportDeclPass
     { ideclAnn        :: EpAnn EpAnnImportDecl
     , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"
-    , ideclImplicit   :: Bool
-        -- ^ GHC generates an `ImportDecl` to represent the invisible `import Prelude`
-        -- that appears in any file that omits `import Prelude`, setting
-        -- this field to indicate that the import doesn't appear in the
-        -- original source. True => implicit import (of Prelude)
+    , ideclImplicit   :: Bool -- ^ See Note [Implicit imports]
     }
     deriving (Data)
 
+{- Note [Implicit imports]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+GHC generates an `ImportDecl` to represent the invisible `import Prelude`
+that appears in any file that omits `import Prelude`, setting
+this field to indicate that the import doesn't appear in the
+original source. True => implicit import (of Prelude)
+-}
+
 type instance XXImportDecl  (GhcPass _) = DataConCantHappen
 
 type instance Anno ModuleName = SrcSpanAnnA


=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -1982,6 +1982,7 @@ lookupQualifiedNameGHCi fos rdr_name
                              , is_as = moduleName mod
                              , is_pkg_qual = NoPkgQual
                              , is_qual = True
+                             , is_implicit = False
                              , is_isboot = NotBoot
                              , is_dloc = noSrcSpan
                              , is_level = NormalLevel }


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -391,7 +391,7 @@ rnImportDecl this_mod
 
     let imp_mod = mi_module iface
         qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
-        imp_spec  = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only,
+        imp_spec  = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only, is_implicit = implicit,
                                   is_dloc = locA loc, is_as = qual_mod_name,
                                   is_pkg_qual = pkg_qual, is_isboot = want_boot,
                                   is_level = convImportLevel import_level }
@@ -2014,40 +2014,38 @@ The ImportMap is a short-lived intermediate data structure records, for
 each import declaration, what stuff brought into scope by that
 declaration is actually used in the module.
 
-The SrcLoc is the location of the END of a particular 'import'
-declaration.  Why *END*?  Because we don't want to get confused
-by the implicit Prelude import. Consider (#7476) the module
-    import Foo( foo )
-    main = print foo
-There is an implicit 'import Prelude(print)', and it gets a SrcSpan
-of line 1:1 (just the point, not a span). If we use the *START* of
-the SrcSpan to identify the import decl, we'll confuse the implicit
-import Prelude with the explicit 'import Foo'.  So we use the END.
-It's just a cheap hack; we could equally well use the Span too.
-
 The [GlobalRdrElt] are the things imported from that decl.
 -}
 
-type ImportMap = Map RealSrcLoc [GlobalRdrElt]  -- See [The ImportMap]
-     -- If loc :-> gres, then
-     --   'loc' = the end loc of the bestImport of each GRE in 'gres'
+data ImportMap = ImportMap
+  { im_imports :: Map RealSrcSpan [GlobalRdrElt]
+    -- ^ See [The ImportMap]
+    -- If loc :-> gres, then
+    --   'loc' = the end loc of the bestImport of each GRE in 'gres'
+  , im_implicitImports :: Map ModuleName [GlobalRdrElt]
+  , im_generatedImports :: Map ModuleName [GlobalRdrElt]
+  }
 
 mkImportMap :: [GlobalRdrElt] -> ImportMap
 -- For each of a list of used GREs, find all the import decls that brought
 -- it into scope; choose one of them (bestImport), and record
 -- the RdrName in that import decl's entry in the ImportMap
-mkImportMap = foldr insertImportMap Map.empty
+mkImportMap = foldr insertImportMap $ ImportMap Map.empty Map.empty Map.empty
 
 insertImportMap :: GlobalRdrElt -> ImportMap -> ImportMap
-insertImportMap gre@(GRE { gre_imp = imp_specs }) importMap =
-  case toImportMapSrcLoc (is_dloc (is_decl best_imp_spec)) of
-    Just decl_loc -> insertElem decl_loc gre importMap
-    Nothing -> importMap
+insertImportMap gre@(GRE { gre_imp = imp_specs }) importMap
+  | is_implicit best_imp_spec =
+      importMap{im_implicitImports = insertElem (moduleName $ is_mod best_imp_spec) gre $ im_implicitImports importMap}
+  | RealSrcSpan importSpan _ <- is_dloc best_imp_spec =
+      importMap{im_imports = insertElem importSpan gre $ im_imports importMap}
+  | UnhelpfulSpan UnhelpfulGenerated <- is_dloc best_imp_spec =
+      importMap{im_generatedImports = insertElem (moduleName $ is_mod best_imp_spec) gre $ im_generatedImports importMap}
+  | otherwise = importMap
   where
     best_imp_spec =
       case bagToList imp_specs of
         []     -> pprPanic "mkImportMap: GRE with no ImportSpecs" (ppr gre)
-        is:iss -> bestImport (is NE.:| iss)
+        is:iss -> is_decl $ bestImport (is NE.:| iss)
 
     -- https://github.com/haskell/containers/issues/784
     insertElem :: Ord k => k -> v -> Map k [v] -> Map k [v]
@@ -2056,16 +2054,14 @@ insertImportMap gre@(GRE { gre_imp = imp_specs }) importMap =
       Nothing -> Just [v]
 
 lookupImportMap :: LImportDecl GhcRn -> ImportMap -> [GlobalRdrElt]
-lookupImportMap (L srcSpan _) importMap =
+lookupImportMap (L srcSpan ImportDecl{ideclName = L _ modName}) importMap =
   fromMaybe [] $
-    toImportMapSrcLoc (locA srcSpan) >>= (`Map.lookup` importMap)
-
-toImportMapSrcLoc :: SrcSpan -> Maybe RealSrcLoc
-toImportMapSrcLoc srcSpan =
-  -- see Note [The ImportMap] for why we're using srcSpanEnd
-  case srcSpanEnd srcSpan of
-    RealSrcLoc loc _ -> Just loc
-    UnhelpfulLoc _ -> Nothing
+    -- should match logic in insertImportMap
+    case locA srcSpan of
+      _ | Just gres <- modName `Map.lookup` im_implicitImports importMap -> Just gres
+      RealSrcSpan realSrcSpan _ -> realSrcSpan `Map.lookup` im_imports importMap
+      UnhelpfulSpan UnhelpfulGenerated -> modName `Map.lookup` im_generatedImports importMap
+      _ -> Nothing
 
 warnUnusedImport :: GlobalRdrEnv -> ImportDeclUsage -> RnM ()
 warnUnusedImport rdr_env (L loc decl, used, unused)


=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -354,7 +354,8 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
                 Just iface -> do
                     -- Try and find the required name in the exports
                     let decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod_name, is_pkg_qual = NoPkgQual
-                                                , is_qual = False, is_dloc = noSrcSpan, is_isboot = NotBoot, is_level = SpliceLevel }
+                                                , is_qual = False, is_implicit = False
+                                                , is_dloc = noSrcSpan, is_isboot = NotBoot, is_level = SpliceLevel }
                         imp_spec = ImpSpec decl_spec ImpAll
                         env = mkGlobalRdrEnv
                             $ gresFromAvails hsc_env (Just imp_spec) (mi_exports iface)


=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -633,6 +633,7 @@ mergeSignatures
                                             is_as       = mod_name,
                                             is_pkg_qual = NoPkgQual,
                                             is_qual     = False,
+                                            is_implicit = False,
                                             is_isboot   = NotBoot,
                                             is_dloc     = locA loc,
                                             is_level    = NormalLevel


=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -1821,6 +1821,7 @@ shadowNames drop_only_qualified env new_gres = minusOccEnv_C_Ns do_shadowing env
                                    , is_as = old_mod_name
                                    , is_pkg_qual = NoPkgQual
                                    , is_qual = True
+                                   , is_implicit = False
                                    , is_level = NormalLevel -- MP: Not 100% sure this is correct
                                    , is_isboot = NotBoot
                                    , is_dloc = greDefinitionSrcSpan old_gre }
@@ -1983,6 +1984,7 @@ data ImpDeclSpec
         is_as       :: !ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
         is_pkg_qual :: !PkgQual,    -- ^ Was this a package import?
         is_qual     :: !Bool,       -- ^ Was this import qualified?
+        is_implicit :: !Bool,       -- ^ Was this import implicit? See Note [Implicit imports]
         is_dloc     :: !SrcSpan,    -- ^ The location of the entire import declaration
         is_isboot   :: !IsBootInterface, -- ^ Was this a SOURCE import?
         is_level    :: !ImportLevel -- ^ Was this import level modified? splice/quote +-1
@@ -1995,11 +1997,12 @@ instance NFData ImpDeclSpec where
 
 
 instance Binary ImpDeclSpec where
-  put_ bh (ImpDeclSpec mod as pkg_qual qual _dloc isboot isstage) = do
+  put_ bh (ImpDeclSpec mod as pkg_qual qual implicit _dloc isboot isstage) = do
     put_ bh mod
     put_ bh as
     put_ bh pkg_qual
     put_ bh qual
+    put_ bh implicit
     put_ bh isboot
     put_ bh (fromEnum isstage)
 
@@ -2008,9 +2011,10 @@ instance Binary ImpDeclSpec where
     as <- get bh
     pkg_qual <- get bh
     qual <- get bh
+    implicit <- get bh
     isboot <- get bh
     isstage <- toEnum <$> get bh
-    return (ImpDeclSpec mod as pkg_qual qual noSrcSpan isboot isstage)
+    return (ImpDeclSpec mod as pkg_qual qual implicit noSrcSpan isboot isstage)
 
 -- | Import Item Specification
 --


=====================================
testsuite/tests/plugins/Makefile
=====================================
@@ -234,3 +234,7 @@ test-late-plugin:
 	ContainsLateBinding=$$(echo $$SHOW_IFACE | grep -o 222222) ; \
 	echo "$$ContainsLateBinding" ; \
 	[ "$$ContainsEarlyBinding" = "111111" ] && [ "$$ContainLateBinding" = "" ]
+
+.PHONY: T21730
+T21730:
+	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T21730.hs -package-db T21730-plugin/pkg.T21730-plugin/local.package.conf


=====================================
testsuite/tests/plugins/T21730-plugin/Makefile
=====================================
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean.%:
+	rm -rf pkg.$*
+
+HERE := $(abspath .)
+$(eval $(call canonicalise,HERE))
+
+package.%:
+	$(MAKE) -s --no-print-directory clean.$*
+	mkdir pkg.$*
+	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+	"$(GHC_PKG)" init pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+	pkg.$*/setup build     --distdir pkg.$*/dist -v0
+	pkg.$*/setup install   --distdir pkg.$*/dist -v0


=====================================
testsuite/tests/plugins/T21730-plugin/Setup.hs
=====================================
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain


=====================================
testsuite/tests/plugins/T21730-plugin/T21730-plugin.cabal
=====================================
@@ -0,0 +1,9 @@
+Name:           T21730-plugin
+Version:        0.1
+Synopsis:       For testing
+Cabal-Version:  >= 1.2
+Build-Type:     Simple
+
+Library
+    Build-Depends: base, ghc
+    Exposed-Modules: T21730_Plugin


=====================================
testsuite/tests/plugins/T21730-plugin/T21730_Plugin.hs
=====================================
@@ -0,0 +1,39 @@
+module T21730_Plugin (plugin) where
+
+import GHC.Hs
+import GHC.Plugins
+import GHC.Types.Fixity
+import qualified GHC.Types.Name.Occurrence as NameSpace
+
+plugin :: Plugin
+plugin = defaultPlugin
+  { parsedResultAction = \_ _ parsedResult ->
+      pure $ parsedResult
+        { parsedResultModule =
+            let modl = parsedResultModule parsedResult
+            in modl { hpm_module = update <$> hpm_module modl }
+        }
+  }
+  where
+    update modl =
+      modl
+        { hsmodImports = newImport : hsmodImports modl
+        , hsmodDecls = newDecl : hsmodDecls modl
+        }
+
+    newImport = genLoc $ simpleImportDecl $ mkModuleName "Data.Char"
+    newFuncName = genLoc $ mkRdrName "toLower2"
+    newDecl =
+      genLoc . ValD NoExtField $
+        mkFunBind (Generated OtherExpansion SkipPmc) newFuncName $
+          [ mkSimpleMatch
+              (mkPrefixFunRhs newFuncName noAnn)
+              (L noAnn [])
+              (nlHsVar (mkRdrName "toLower"))
+          ]
+
+genLoc :: (NoAnn ann) => e -> GenLocated (EpAnn ann) e
+genLoc = L (noAnnSrcSpan generatedSrcSpan)
+
+mkRdrName :: String -> RdrName
+mkRdrName = mkRdrUnqual . mkOccName NameSpace.varName


=====================================
testsuite/tests/plugins/T21730.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -fplugin T21730_Plugin #-}
+{-# OPTIONS_GHC -Werror=unused-imports #-}
+
+main :: IO ()
+main = return ()


=====================================
testsuite/tests/plugins/all.T
=====================================
@@ -376,3 +376,9 @@ test('test-late-plugin',
      [extra_files(['late-plugin/LatePlugin.hs']), ignore_stdout],
      makefile_test,
      [])
+
+test('T21730',
+     [extra_files(['T21730-plugin/']),
+      pre_cmd('$MAKE -s --no-print-directory -C T21730-plugin package.T21730-plugin TOP={top}')
+      ],
+     makefile_test, [])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/923bdb73686bd3c7e9d187ea9e77c21...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/923bdb73686bd3c7e9d187ea9e77c21...
You're receiving this email because of your account on gitlab.haskell.org.

    

Brandon Chinn (＠brandonchinn178)

tags

participants (1)