[Git][ghc/ghc][master] GHCi: Support local Prelude
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jul 4 15:14:27 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
977b6b64 by Max Ulidtko at 2024-07-04T11:11:11-04:00
GHCi: Support local Prelude
Fixes #10920, an issue where GHCi bails out when started alongside a
file named Prelude.hs or Prelude.lhs (even empty file suffices).
The in-source Note [GHCi and local Preludes] documents core reasoning.
Supplementary changes:
* add debug traces for module lookups under -ddump-if-trace;
* drop stale comment in GHC.Iface.Load;
* reduce noise in -v3 traces from GHC.Utils.TmpFs;
* new test, which also exercizes HomeModError.
- - - - -
13 changed files:
- compiler/GHC.hs
- compiler/GHC/Iface/Env.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Utils/TmpFs.hs
- docs/users_guide/9.12.1-notes.rst
- ghc/GHCi/UI.hs
- testsuite/tests/diagnostic-codes/codes.stdout
- + testsuite/tests/ghci/should_run/LocalPrelude/Prelude.hs
- + testsuite/tests/ghci/should_run/T10920.hs
- + testsuite/tests/ghci/should_run/T10920.script
- + testsuite/tests/ghci/should_run/T10920.stderr
- + testsuite/tests/ghci/should_run/T10920.stdout
- testsuite/tests/ghci/should_run/all.T
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -365,6 +365,7 @@ import GHC.Parser.Lexer
import GHC.Parser.Annotation
import GHC.Parser.Utils
+import GHC.Iface.Env ( trace_if )
import GHC.Iface.Load ( loadSysInterface )
import GHC.Hs
import GHC.Builtin.Types.Prim ( alphaTyVars )
@@ -1713,6 +1714,7 @@ findModule mod_name maybe_pkg = do
findQualifiedModule :: GhcMonad m => PkgQual -> ModuleName -> m Module
findQualifiedModule pkgqual mod_name = withSession $ \hsc_env -> do
+ liftIO $ trace_if (hsc_logger hsc_env) (text "findQualifiedModule" <+> ppr mod_name <+> ppr pkgqual)
let mhome_unit = hsc_home_unit_maybe hsc_env
let dflags = hsc_dflags hsc_env
case pkgqual of
@@ -1775,7 +1777,8 @@ lookupQualifiedModule NoPkgQual mod_name = withSession $ \hsc_env -> do
lookupQualifiedModule pkgqual mod_name = findQualifiedModule pkgqual mod_name
lookupLoadedHomeModule :: GhcMonad m => UnitId -> ModuleName -> m (Maybe Module)
-lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env ->
+lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env -> do
+ liftIO $ trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModule" <+> ppr mod_name <+> ppr uid)
case lookupHug (hsc_HUG hsc_env) uid mod_name of
Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
_not_a_home_module -> return Nothing
=====================================
compiler/GHC/Iface/Env.hs
=====================================
@@ -269,9 +269,9 @@ newIfaceNames occs
| (occ,uniq) <- occs `zip` uniqs] }
trace_if :: Logger -> SDoc -> IO ()
-{-# INLINE trace_if #-}
+{-# INLINE trace_if #-} -- see Note [INLINE conditional tracing utilities]
trace_if logger doc = when (logHasDumpFlag logger Opt_D_dump_if_trace) $ putMsg logger doc
trace_hi_diffs :: Logger -> SDoc -> IO ()
-{-# INLINE trace_hi_diffs #-}
+{-# INLINE trace_hi_diffs #-} -- see Note [INLINE conditional tracing utilities]
trace_hi_diffs logger doc = when (logHasDumpFlag logger Opt_D_dump_hi_diffs) $ putMsg logger doc
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -444,9 +444,6 @@ loadInterface doc_str mod from
; case lookupIfaceByModule hug (eps_PIT eps) mod of {
Just iface
-> return (Succeeded iface) ; -- Already loaded
- -- The (src_imp == mi_boot iface) test checks that the already-loaded
- -- interface isn't a boot iface. This can conceivably happen,
- -- if an earlier import had a before we got to real imports. I think.
_ -> do {
-- READ THE MODULE IN
=====================================
compiler/GHC/Utils/TmpFs.hs
=====================================
@@ -377,18 +377,27 @@ the process id).
This is ok, as the temporary directory used contains the pid (see getTempDir).
-}
+
+manyWithTrace :: Logger -> String -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
+manyWithTrace _ _ _ [] = pure () -- do silent nothing on zero filepaths
+manyWithTrace logger phase act paths
+ = traceCmd logger phase ("Deleting: " ++ unwords paths) (act paths)
+
removeTmpDirs :: Logger -> [FilePath] -> IO ()
-removeTmpDirs logger ds
- = traceCmd logger "Deleting temp dirs"
- ("Deleting: " ++ unwords ds)
- (mapM_ (removeWith logger removeDirectory) ds)
+removeTmpDirs logger
+ = manyWithTrace logger "Deleting temp dirs"
+ (mapM_ (removeWith logger removeDirectory))
+
+removeTmpSubdirs :: Logger -> [FilePath] -> IO ()
+removeTmpSubdirs logger
+ = manyWithTrace logger "Deleting temp subdirs"
+ (mapM_ (removeWith logger removeDirectory))
removeTmpFiles :: Logger -> [FilePath] -> IO ()
removeTmpFiles logger fs
= warnNon $
- traceCmd logger "Deleting temp files"
- ("Deleting: " ++ unwords deletees)
- (mapM_ (removeWith logger removeFile) deletees)
+ manyWithTrace logger "Deleting temp files"
+ (mapM_ (removeWith logger removeFile)) deletees
where
-- Flat out refuse to delete files that are likely to be source input
-- files (is there a worse bug than having a compiler delete your source
@@ -405,12 +414,6 @@ removeTmpFiles logger fs
(non_deletees, deletees) = partition isHaskellUserSrcFilename fs
-removeTmpSubdirs :: Logger -> [FilePath] -> IO ()
-removeTmpSubdirs logger fs
- = traceCmd logger "Deleting temp subdirs"
- ("Deleting: " ++ unwords fs)
- (mapM_ (removeWith logger removeDirectory) fs)
-
removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO ()
removeWith logger remover f = remover f `Exception.catchIO`
(\e ->
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -85,6 +85,9 @@ Compiler
GHCi
~~~~
+- Fix a bug where GHCi would not start alongside a local file called ``Prelude.hs``
+ or ``Prelude.lhs`` (:ghc-ticket:`10920`).
+
Runtime system
~~~~~~~~~~~~~~
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2255,7 +2255,7 @@ keepPackageImports = filterM is_pkg_import
is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool
is_pkg_import (IIModule _) = return False
is_pkg_import (IIDecl d)
- = do pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
+ = do pkgqual <- GHC.renameRawPkgQualM mod_name (ideclPkgQual d)
e <- MC.try $ GHC.findQualifiedModule pkgqual mod_name
case e :: Either SomeException Module of
Left _ -> return False
@@ -2263,7 +2263,30 @@ keepPackageImports = filterM is_pkg_import
where
mod_name = unLoc (ideclName d)
+{- Note [GHCi and local Preludes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHC's compilation manager has no issues when the package being compiled
+defines its own local Prelude module. It'll just shadow the Prelude from base.
+GHCi however must check this condition, when it calls setContext ["Prelude"]
+to prepopulate the interactive session's scope. This is because of two facts.
+
+1. setContext must use previously compiled .hi interfaces only; it cannot
+recurse into compiling .hs modules (even with LinkIntoMemory), simply because
+it's not the right phase to do it. Import resolution happens way before GHC
+properly "loads" modules (GHC.Linker.Loader.loadModule, GHC.load & siblings);
+or in other words, at time of setContext the linker isn't even initialized yet.
+
+2. The local Prelude.hs (or .lhs) may've never been compiled before, so its
+interface file Prelude.hi can be outdated or altogether missing.
+
+Thankfully, there's a simple solution: just let CM load the local Prelude normally
+(either as a :load target, or as a dependency of another target) later. To do that,
+detect if the implicit `import Prelude` resolves to the "home unit" (i.e. not base),
+and if so, omit it from the early setContext call.
+
+If we don't, a HomeModError will be (correctly) thrown. See #10920.
+-}
modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> LoadType -> m ()
modulesLoadedMsg ok mods load_type = do
@@ -2827,7 +2850,7 @@ checkAdd ii = do
m <- GHC.lookupQualifiedModule pkgqual modname
when safe $ do
t <- GHC.isModuleTrusted m
- when (not t) $ throwGhcException $ ProgramError $ ""
+ unless t $ throwGhcException $ ProgramError $ ""
-- -----------------------------------------------------------------------------
-- Update the GHC API's view of the context
@@ -2881,7 +2904,8 @@ getImplicitPreludeImports iidecls = do
, not (any (sameImpModule imp) iidecls) ]
else []
- return prel_iidecls
+ -- See Note [GHCi and local Preludes]
+ keepPackageImports prel_iidecls
-- -----------------------------------------------------------------------------
-- Utils on InteractiveImport
=====================================
testsuite/tests/diagnostic-codes/codes.stdout
=====================================
@@ -92,7 +92,6 @@
[GHC-41843] is untested (constructor = IOResultExpected)
[GHC-07641] is untested (constructor = AtLeastOneArgExpected)
[GHC-64852] is untested (constructor = BadSourceImport)
-[GHC-58427] is untested (constructor = HomeModError)
[GHC-94559] is untested (constructor = CouldntFindInFiles)
[GHC-22211] is untested (constructor = MissingPackageFiles)
[GHC-88719] is untested (constructor = MissingPackageWayFiles)
=====================================
testsuite/tests/ghci/should_run/LocalPrelude/Prelude.hs
=====================================
@@ -0,0 +1,9 @@
+module Prelude
+ (storefront, module Reexport) where
+
+import Data.Semigroup as Reexport ((<>))
+import System.IO as Reexport (putStrLn)
+
+storefront = "A project-local Prelude"
+
+backyard = "unexported local definition -- shall be visible only after *-import"
=====================================
testsuite/tests/ghci/should_run/T10920.hs
=====================================
@@ -0,0 +1,5 @@
+module Main where
+
+-- implicitly imports a custom Prelude module under LocalPrelude/
+
+main = putStrLn ("it's fine: " <> storefront)
=====================================
testsuite/tests/ghci/should_run/T10920.script
=====================================
@@ -0,0 +1,47 @@
+--
+-- Tests that we can don't crash with a local Prelude module present (bug #10920).
+--
+
+-- this is default, but the test makes zero sense with NoImplicitPrelude, it should *not* be set here
+:seti -XImplicitPrelude
+-- this is default too, (ab)used in the following macro
+:seti -fimplicit-import-qualified
+-- for a bit neater output
+:def! section \title -> let echo=System.IO.putStrLn in (echo "" GHC.Base.>> echo title GHC.Base.>> GHC.Base.return "")
+
+:section -- should not crash with local prelude
+:load T10920.hs
+:main
+:show imports
+:show modules
+
+:load
+:section -- unless loaded, HomeModError is expected (on stderr)
+import Prelude
+:show imports
+
+:load
+:section -- but if loaded, can be imported
+:load T10920
+import Prelude
+:t Prelude.storefront
+:show imports
+:show modules
+
+:load
+:section -- can also be star-imported
+:load T10920
+:module *Prelude
+:t Prelude.backyard
+:show imports
+:show modules
+
+-- also test ghci-script similar to what stack repl generates...
+-- the sequence is a tad weird, but it is what it is.
+:load
+:section -- double-loading is fine as well
+:add Prelude ./T10920.hs
+:module + Prelude
+:show imports
+:show modules
+:main
=====================================
testsuite/tests/ghci/should_run/T10920.stderr
=====================================
@@ -0,0 +1,3 @@
+<interactive>:1:1: error: [GHC-58427]
+ attempting to use module ‘main:Prelude’ (./Prelude.hs) which is not loaded
+
=====================================
testsuite/tests/ghci/should_run/T10920.stdout
=====================================
@@ -0,0 +1,28 @@
+
+-- should not crash with local prelude
+it's fine: A project-local Prelude
+:module +*Main -- added automatically
+Main ( T10920.hs, interpreted )
+Prelude ( Prelude.hs, interpreted )
+
+-- unless loaded, HomeModError is expected (on stderr)
+
+-- but if loaded, can be imported
+Prelude.storefront :: GHC.Internal.Base.String
+import Prelude
+:module +*Main -- added automatically
+Main ( T10920.hs, interpreted )
+Prelude ( Prelude.hs, interpreted )
+
+-- can also be star-imported
+Prelude.backyard :: GHC.Internal.Base.String
+:module +*Prelude
+Main ( T10920.hs, interpreted )
+Prelude ( Prelude.hs, interpreted )
+
+-- double-loading is fine as well
+import Prelude
+:module +*Main -- added automatically
+Main ( T10920.hs, interpreted )
+Prelude ( Prelude.hs, interpreted )
+it's fine: A project-local Prelude
=====================================
testsuite/tests/ghci/should_run/all.T
=====================================
@@ -94,3 +94,5 @@ test('GhciMainIs', just_ghci, compile_and_run, ['-main-is otherMain'])
test('LargeBCO', [extra_files(['LargeBCO_A.hs']), req_interp, extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, [''])
test('T24115', just_ghci + [extra_run_opts("-e ':add T24115.hs'")], ghci_script, ['T24115.script'])
+
+test('T10920', [only_ways(ghci_ways), extra_files(['LocalPrelude/Prelude.hs'])], ghci_script, ['T10920.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/977b6b64e184795f3f12ac5b2637707f0696457c
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/977b6b64e184795f3f12ac5b2637707f0696457c
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/20240704/ba1b3de9/attachment-0001.html>
More information about the ghc-commits
mailing list