[Git][ghc/ghc][wip/mi_top_env_serialise] 5 commits: compiler: Add export list to GHC.SysTools.Tasks
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Mon Mar 3 11:51:56 UTC 2025
Matthew Pickering pushed to branch wip/mi_top_env_serialise at Glasgow Haskell Compiler / GHC
Commits:
90f1190e by Ben Gamari at 2025-02-28T20:53:53-05:00
compiler: Add export list to GHC.SysTools.Tasks
- - - - -
ec826009 by Ben Gamari at 2025-02-28T20:53:53-05:00
compiler: Pass --target to llvm-as
As noted in #25793, this is necessary due to potential ambiguity on
Apple machines with Rosetta.
- - - - -
9c1647d1 by Andreas Klebinger at 2025-02-28T20:54:30-05:00
cmmMachOpFoldM: Add missing pattern matches for bitcasts.
Fixes #25771
- - - - -
edef8db7 by Matthew Pickering at 2025-03-03T11:51:31+00:00
ghci: Serialise mi_top_env
When loading core from interface files (or from a bytecode object in
future) it's important to store what the top-level context of a module
is.
Otherwise, when you load the module into GHCi from the interface files,
only exported identifiers from the top-level module are in scope on the
repl.
See the added test which demonstrates what this enables.
The context at the GHCi prompt is everything that's in-scope in the
TopEnvIface module. Since TopEnvIface imports identifier "a", we can
evaluate "a" in the repl.
In addition to all this, we can use this information in order to
implement reifyModule in a more principled manner.
This becomes even more important when you're debugging and what to set
break-points on functions which are not imported.
- - - - -
a5de39de by Matthew Pickering at 2025-03-03T11:51:31+00:00
Implement reifyModule in terms of mi_top_env
mi_top_env provides precisely the information that reifyModule needs,
the user written imports.
This is important as it unblocks !9604 and #22188
Fixes #8489
- - - - -
26 changed files:
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Types/Avail.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/PkgQual.hs
- compiler/GHC/Unit/Module/ModIface.hs
- distrib/configure.ac.in
- hadrian/bindist/Makefile
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- m4/fp_settings.m4
- testsuite/tests/ghci/should_run/Makefile
- + testsuite/tests/ghci/should_run/TopEnvIface.hs
- + testsuite/tests/ghci/should_run/TopEnvIface.stdout
- + testsuite/tests/ghci/should_run/TopEnvIface2.hs
- testsuite/tests/ghci/should_run/all.T
Changes:
=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -63,18 +63,23 @@ cmmMachOpFoldM _ (MO_VF_Broadcast lg _w) exprs =
[CmmLit l] -> Just $! CmmLit (CmmVec $ replicate lg l)
_ -> Nothing
cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
- = Just $! case op of
- MO_S_Neg _ -> CmmLit (CmmInt (narrowS rep (-x)) rep)
- MO_Not _ -> CmmLit (CmmInt (complement x) rep)
+ = case op of
+ MO_S_Neg _ -> Just $! CmmLit (CmmInt (narrowS rep (-x)) rep)
+ MO_Not _ -> Just $! CmmLit (CmmInt (complement x) rep)
-- these are interesting: we must first narrow to the
-- "from" type, in order to truncate to the correct size.
-- The final narrow/widen to the destination type
-- is implicit in the CmmLit.
- MO_SF_Round _frm to -> CmmLit (CmmFloat (fromInteger x) to)
- MO_SS_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
- MO_UU_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
- MO_XX_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
+ MO_SF_Round _frm to -> Just $! CmmLit (CmmFloat (fromInteger x) to)
+ MO_SS_Conv from to -> Just $! CmmLit (CmmInt (narrowS from x) to)
+ MO_UU_Conv from to -> Just $! CmmLit (CmmInt (narrowU from x) to)
+ MO_XX_Conv from to -> Just $! CmmLit (CmmInt (narrowS from x) to)
+
+ -- Not as simply as it seems, since CmmFloat uses Rational, so skipping those
+ -- for now ...
+ MO_WF_Bitcast _w -> Nothing
+ MO_FW_Bitcast _w -> Nothing
_ -> panic $ "cmmMachOpFoldM: unknown unary op: " ++ show op
-- Eliminate shifts that are wider than the shiftee
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -47,7 +47,6 @@ import GHC.Core.RoughMap ( RoughMatchTc(..) )
import GHC.Driver.Config.HsToCore.Usage
import GHC.Driver.Env
-import GHC.Driver.Backend
import GHC.Driver.DynFlags
import GHC.Driver.Plugins
@@ -342,7 +341,7 @@ mkIface_ hsc_env
trust_info = setSafeMode safe_mode
annotations = map mkIfaceAnnotation anns
icomplete_matches = map mkIfaceCompleteMatch complete_matches
- !rdrs = maybeGlobalRdrEnv rdr_env
+ !rdrs = mkIfaceTopEnv rdr_env
emptyPartialModIface this_mod
-- Need to record this because it depends on the -instantiated-with flag
@@ -395,15 +394,11 @@ mkIface_ hsc_env
-- Desugar.addExportFlagsAndRules). The mi_top_env field is used
-- by GHCi to decide whether the module has its full top-level
-- scope available. (#5534)
- maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe IfaceTopEnv
- maybeGlobalRdrEnv rdr_env
- | backendWantsGlobalBindings (backend dflags)
- = Just $! let !exports = forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)
- !imports = mkIfaceImports import_decls
- in IfaceTopEnv exports imports
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
- | otherwise
- = Nothing
+ mkIfaceTopEnv :: GlobalRdrEnv -> IfaceTopEnv
+ mkIfaceTopEnv rdr_env
+ = let !exports = sortAvails $ gresToAvailInfo $ globalRdrEnvElts $ globalRdrEnvLocal rdr_env
+ !imports = mkIfaceImports import_decls
+ in IfaceTopEnv exports imports
ifFamInstTcName = ifFamInstFam
@@ -515,8 +510,8 @@ mkIfaceImports :: [ImportUserSpec] -> [IfaceImport]
mkIfaceImports = map go
where
go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll
- go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))
- go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)
+ go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (sortAvails env))
+ go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut (nameSetElemsStable ns))
mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
mkIfaceExports as = case sortAvails as of DefinitelyDeterministicAvails sas -> sas
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -26,7 +26,8 @@ module GHC.Iface.Syntax (
IfaceCompleteMatch(..),
IfaceLFInfo(..), IfaceTopBndrInfo(..),
IfaceImport(..),
- ImpIfaceList(..),
+ ifImpModule,
+ ImpIfaceList(..), IfaceExport,
-- * Binding names
IfaceTopBndr,
@@ -69,6 +70,7 @@ import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.CostCentre
import GHC.Types.Literal
+import GHC.Types.Avail
import GHC.Types.ForeignCall
import GHC.Types.Annotations( AnnPayload, AnnTarget )
import GHC.Types.Basic
@@ -112,12 +114,48 @@ infixl 3 &&&
************************************************************************
-}
+type IfaceExport = AvailInfo
+
data IfaceImport = IfaceImport ImpDeclSpec ImpIfaceList
data ImpIfaceList
= ImpIfaceAll -- ^ no user import list
- | ImpIfaceExplicit !IfGlobalRdrEnv
- | ImpIfaceEverythingBut !NameSet
+ | ImpIfaceExplicit !DetOrdAvails
+ | ImpIfaceEverythingBut ![Name]
+
+
+-- | Extract the imported module from an IfaceImport
+ifImpModule :: IfaceImport -> Module
+ifImpModule (IfaceImport declSpec _) = is_mod declSpec
+
+instance Binary IfaceImport where
+ put_ bh (IfaceImport declSpec ifaceList) = do
+ put_ bh declSpec
+ put_ bh ifaceList
+ get bh = do
+ declSpec <- get bh
+ ifaceList <- get bh
+ return (IfaceImport declSpec ifaceList)
+
+instance Binary ImpIfaceList where
+ put_ bh ImpIfaceAll = putByte bh 0
+ put_ bh (ImpIfaceExplicit env) = do
+ putByte bh 1
+ put_ bh env
+ put_ bh (ImpIfaceEverythingBut ns) = do
+ putByte bh 2
+ put_ @[Name] bh ns
+ get bh = do
+ tag <- getByte bh
+ case tag of
+ 0 -> return ImpIfaceAll
+ 1 -> do
+ env <- get bh
+ return (ImpIfaceExplicit env)
+ 2 -> do
+ ns <- get @[Name] bh
+ return (ImpIfaceEverythingBut ns)
+ _ -> fail "instance Binary ImpIfaceList: Invalid tag"
-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -104,6 +104,7 @@ import GHC.Types.SourceText
import GHC.Types.Basic hiding ( SuccessFlag(..) )
import GHC.Types.CompleteMatch
import GHC.Types.SrcLoc
+import GHC.Types.Avail
import GHC.Types.TypeEnv
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet ( mkUniqDSet )
@@ -114,7 +115,7 @@ import GHC.Types.Literal
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Name
-import GHC.Types.Name.Reader
+import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Types.DefaultEnv ( ClassDefaults(..), defaultEnv )
import GHC.Types.Id
@@ -2242,9 +2243,7 @@ hydrateCgBreakInfo CgBreakInfo{..} = do
-- | This function is only used to construct the environment for GHCi,
-- so we make up fake locations
-tcIfaceImport :: HscEnv -> IfaceImport -> ImportUserSpec
-tcIfaceImport _ (IfaceImport spec ImpIfaceAll) = ImpUserSpec spec ImpUserAll
-tcIfaceImport _ (IfaceImport spec (ImpIfaceEverythingBut ns)) = ImpUserSpec spec (ImpUserEverythingBut ns)
-tcIfaceImport hsc_env (IfaceImport spec (ImpIfaceExplicit gre)) = ImpUserSpec spec (ImpUserExplicit (hydrateGlobalRdrEnv get_GRE_info gre))
- where
- get_GRE_info nm = tyThingGREInfo <$> lookupGlobal hsc_env nm
+tcIfaceImport :: IfaceImport -> ImportUserSpec
+tcIfaceImport (IfaceImport spec ImpIfaceAll) = ImpUserSpec spec ImpUserAll
+tcIfaceImport (IfaceImport spec (ImpIfaceEverythingBut ns)) = ImpUserSpec spec (ImpUserEverythingBut (mkNameSet ns))
+tcIfaceImport (IfaceImport spec (ImpIfaceExplicit gre)) = ImpUserSpec spec (ImpUserExplicit (getDetOrdAvails gre))
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -2015,6 +2015,8 @@ lookupGREInfo hsc_env nm
-- and looks up the TyThing in the type environment.
--
-- See Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo.
+ -- Note: This function is very similar to 'tcIfaceGlobal', it would be better to
+ -- use that if possible.
= case nameModule_maybe nm of
Nothing -> UnboundGRE
Just mod ->
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -1189,7 +1189,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
(gres, imp_user_list) = case want_hiding of
Exactly ->
let gre_env = mkGlobalRdrEnv $ concatMap (gresFromIE decl_spec) items2
- in (gre_env, ImpUserExplicit gre_env)
+ in (gre_env, ImpUserExplicit (gresToAvailInfo $ globalRdrEnvElts $ gre_env))
EverythingBut ->
let hidden_names = mkNameSet $ concatMap (map greName . snd) items2
in (importsFromIface hsc_env iface decl_spec (Just hidden_names), ImpUserEverythingBut hidden_names)
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -53,7 +53,7 @@ import GHC.Driver.DynFlags
import GHC.Driver.Ppr
import GHC.Driver.Config
-import GHC.Rename.Names (importsFromIface)
+import GHC.Rename.Names (importsFromIface, gresFromAvails)
import GHC.Runtime.Eval.Types
import GHC.Runtime.Interpreter as GHCi
@@ -113,6 +113,7 @@ import GHC.Types.TyThing
import GHC.Types.Breakpoint
import GHC.Types.Unique.Map
+import GHC.Types.Avail
import GHC.Unit
import GHC.Unit.Module.Graph
import GHC.Unit.Module.ModIface
@@ -122,7 +123,7 @@ import GHC.Unit.Home.PackageTable
import GHC.Tc.Module ( runTcInteractive, tcRnType, loadUnqualIfaces )
import GHC.Tc.Solver (simplifyWantedsTcM)
-import GHC.Tc.Utils.Env (tcGetInstEnvs, lookupGlobal)
+import GHC.Tc.Utils.Env (tcGetInstEnvs)
import GHC.Tc.Utils.Instantiate (instDFunType)
import GHC.Tc.Utils.Monad
import GHC.Tc.Zonk.Env ( ZonkFlexi (SkolemiseFlexi) )
@@ -848,21 +849,25 @@ mkTopLevEnv hsc_env modl
Nothing -> pure $ Left "not a home module"
Just details ->
case mi_top_env (hm_iface details) of
- Nothing -> pure $ Left "not interpreted"
- Just (IfaceTopEnv exports imports) -> do
+ (IfaceTopEnv exports imports) -> do
imports_env <-
runInteractiveHsc hsc_env
$ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env
$ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv)
$ forM imports $ \iface_import -> do
- let ImpUserSpec spec details = tcIfaceImport hsc_env iface_import
+ let ImpUserSpec spec details = tcIfaceImport iface_import
iface <- loadSrcInterface (text "imported by GHCi") (moduleName $ is_mod spec) (is_isboot spec) (is_pkg_qual spec)
pure $ case details of
ImpUserAll -> importsFromIface hsc_env iface spec Nothing
ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns)
- ImpUserExplicit x -> x
- let get_GRE_info nm = tyThingGREInfo <$> lookupGlobal hsc_env nm
- let exports_env = hydrateGlobalRdrEnv get_GRE_info exports
+ ImpUserExplicit x ->
+ -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y).
+ -- It is only used for error messages. It seems dubious even to add an import context to these GREs as
+ -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that
+ -- the test case produce the same output as before.
+ let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } }
+ in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x
+ let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing (getDetOrdAvails exports)
pure $ Right $ plusGlobalRdrEnv imports_env exports_env
where
hpt = hsc_HPT hsc_env
@@ -880,8 +885,8 @@ moduleIsInterpreted :: GhcMonad m => Module -> m Bool
moduleIsInterpreted modl = withSession $ \h ->
if notHomeModule (hsc_home_unit h) modl
then return False
- else liftIO (lookupHpt (hsc_HPT h) (moduleName modl)) >>= \case
- Just details -> return (isJust (mi_top_env (hm_iface details)))
+ else liftIO (HUG.lookupHugByModule modl (hsc_HUG h)) >>= \case
+ Just hmi -> return (isJust $ homeModInfoByteCode hmi)
_not_a_home_module -> return False
-- | Looks up an identifier in the current interactive context (for :info)
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -168,6 +168,7 @@ initSettings top_dir = do
lc_prog <- getSetting "LLVM llc command"
lo_prog <- getSetting "LLVM opt command"
las_prog <- getSetting "LLVM llvm-as command"
+ las_args <- map Option . unescapeArgs <$> getSetting "LLVM llvm-as flags"
let iserv_prog = libexec "ghc-iserv"
@@ -225,7 +226,7 @@ initSettings top_dir = do
, toolSettings_pgm_ranlib = ranlib_path
, toolSettings_pgm_lo = (lo_prog,[])
, toolSettings_pgm_lc = (lc_prog,[])
- , toolSettings_pgm_las = (las_prog, [])
+ , toolSettings_pgm_las = (las_prog, las_args)
, toolSettings_pgm_i = iserv_prog
, toolSettings_opt_L = []
, toolSettings_opt_P = []
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -7,7 +7,26 @@
-- (c) The GHC Team 2017
--
-----------------------------------------------------------------------------
-module GHC.SysTools.Tasks where
+module GHC.SysTools.Tasks
+ ( runUnlit
+ , SourceCodePreprocessor(..)
+ , runSourceCodePreprocessor
+ , runPp
+ , runCc
+ , askLd
+ , runAs
+ , runLlvmOpt
+ , runLlvmLlc
+ , runLlvmAs
+ , runEmscripten
+ , figureLlvmVersion
+ , runMergeObjects
+ , runAr
+ , askOtool
+ , runInstallNameTool
+ , runRanlib
+ , runWindres
+ ) where
import GHC.Prelude
import GHC.ForeignSrcLang
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -124,7 +124,7 @@ import GHC.Serialized
import GHC.Unit.Finder
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
-import GHC.Unit.Module.Deps
+import GHC.Iface.Syntax
import GHC.Utils.Misc
import GHC.Utils.Panic as Panic
@@ -2887,16 +2887,12 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
reifyFromIface reifMod = do
iface <- loadInterfaceForModule (text "reifying module from TH for" <+> ppr reifMod) reifMod
- let usages = [modToTHMod m | usage <- mi_usages iface,
- Just m <- [usageToModule (moduleUnit reifMod) usage] ]
+ let IfaceTopEnv _ imports = mi_top_env iface
+ -- Convert IfaceImport to module names
+ usages = [modToTHMod (ifImpModule imp) | imp <- imports]
return $ TH.ModuleInfo usages
- usageToModule :: Unit -> Usage -> Maybe Module
- usageToModule _ (UsageFile {}) = Nothing
- usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn
- usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m
- usageToModule _ (UsageMergedRequirement { usg_mod = m }) = Just m
- usageToModule this_pkg (UsageHomeModuleInterface { usg_mod_name = mn }) = Just $ mkModule this_pkg mn
+
------------------------------
mkThAppTs :: TH.Type -> [TH.Type] -> TH.Type
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -206,7 +206,7 @@ data ImportUserSpec
data ImpUserList
= ImpUserAll -- ^ no user import list
- | ImpUserExplicit !GlobalRdrEnv
+ | ImpUserExplicit ![AvailInfo]
| ImpUserEverythingBut !NameSet
-- | A 'NameShape' is a substitution on 'Name's that can be used
=====================================
compiler/GHC/Types/Avail.hs
=====================================
@@ -22,7 +22,8 @@ module GHC.Types.Avail (
filterAvails,
nubAvails,
sortAvails,
- DetOrdAvails(DetOrdAvails, DefinitelyDeterministicAvails)
+ DetOrdAvails(DetOrdAvails, getDetOrdAvails, DefinitelyDeterministicAvails),
+ emptyDetOrdAvails
) where
import GHC.Prelude
@@ -74,7 +75,7 @@ type Avails = [AvailInfo]
-- We guarantee a deterministic order by either using the order explicitly
-- given by the user (e.g. in an explicit constructor export list) or instead
-- by sorting the avails with 'sortAvails'.
-newtype DetOrdAvails = DefinitelyDeterministicAvails Avails
+newtype DetOrdAvails = DefinitelyDeterministicAvails { getDetOrdAvails :: Avails }
deriving newtype (Binary, Outputable, NFData)
-- | It's always safe to match on 'DetOrdAvails'
@@ -245,3 +246,7 @@ instance Binary AvailInfo where
instance NFData AvailInfo where
rnf (Avail n) = rnf n
rnf (AvailTC a b) = rnf a `seq` rnf b
+
+-- | Create an empty DetOrdAvails
+emptyDetOrdAvails :: DetOrdAvails
+emptyDetOrdAvails = DefinitelyDeterministicAvails []
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -133,6 +133,7 @@ import GHC.Unit.Module
import GHC.Utils.Misc as Utils
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Binary
import Control.DeepSeq
import Control.Monad ( guard )
@@ -1946,6 +1947,22 @@ data ImpDeclSpec
instance NFData ImpDeclSpec where
rnf = rwhnf -- Already strict in all fields
+instance Binary ImpDeclSpec where
+ put_ bh (ImpDeclSpec mod as pkg_qual qual _dloc isboot) = do
+ put_ bh mod
+ put_ bh as
+ put_ bh pkg_qual
+ put_ bh qual
+ put_ bh isboot
+
+ get bh = do
+ mod <- get bh
+ as <- get bh
+ pkg_qual <- get bh
+ qual <- get bh
+ isboot <- get bh
+ return (ImpDeclSpec mod as pkg_qual qual noSrcSpan isboot)
+
-- | Import Item Specification
--
-- Describes import info a particular Name
=====================================
compiler/GHC/Types/PkgQual.hs
=====================================
@@ -6,6 +6,7 @@ module GHC.Types.PkgQual where
import GHC.Prelude
import GHC.Types.SourceText
import GHC.Unit.Types
+import GHC.Utils.Binary
import GHC.Utils.Outputable
import Data.Data
@@ -38,4 +39,22 @@ instance Outputable PkgQual where
ThisPkg u -> doubleQuotes (ppr u)
OtherPkg u -> doubleQuotes (ppr u)
+instance Binary PkgQual where
+ put_ bh NoPkgQual = putByte bh 0
+ put_ bh (ThisPkg u) = do
+ putByte bh 1
+ put_ bh u
+ put_ bh (OtherPkg u) = do
+ putByte bh 2
+ put_ bh u
+
+ get bh = do
+ tag <- getByte bh
+ case tag of
+ 0 -> return NoPkgQual
+ 1 -> do u <- get bh
+ return (ThisPkg u)
+ 2 -> do u <- get bh
+ return (OtherPkg u)
+ _ -> fail "instance Binary PkgQual: Invalid tag"
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -111,7 +111,6 @@ import GHC.Types.Fixity
import GHC.Types.Fixity.Env
import GHC.Types.HpcInfo
import GHC.Types.Name
-import GHC.Types.Name.Reader (IfGlobalRdrEnv)
import GHC.Types.SafeHaskell
import GHC.Types.SourceFile
import GHC.Types.Unique.DSet
@@ -299,7 +298,7 @@ data ModIface_ (phase :: ModIfacePhase)
mi_defaults_ :: [IfaceDefault],
-- ^ default declarations exported by the module
- mi_top_env_ :: !(Maybe IfaceTopEnv),
+ mi_top_env_ :: IfaceTopEnv,
-- ^ Just enough information to reconstruct the top level environment in
-- the /original source/ code for this module. which
-- is NOT the same as mi_exports, nor mi_decls (which
@@ -365,13 +364,23 @@ data ModIface_ (phase :: ModIfacePhase)
-- Enough information to reconstruct the top level environment for a module
data IfaceTopEnv
= IfaceTopEnv
- { ifaceTopExports :: !IfGlobalRdrEnv -- ^ all top level things in this module, including unexported stuff
+ { ifaceTopExports :: !DetOrdAvails -- ^ all top level things in this module, including unexported stuff
, ifaceImports :: ![IfaceImport] -- ^ all the imports in this module
}
instance NFData IfaceTopEnv where
rnf (IfaceTopEnv a b) = rnf a `seq` rnf b
+instance Binary IfaceTopEnv where
+ put_ bh (IfaceTopEnv exports imports) = do
+ put_ bh exports
+ put_ bh imports
+ get bh = do
+ exports <- get bh
+ imports <- get bh
+ return (IfaceTopEnv exports imports)
+
+
{-
Note [Strictness in ModIface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -479,6 +488,7 @@ instance Binary ModIface where
mi_trust_ = trust,
mi_trust_pkg_ = trust_pkg,
mi_complete_matches_ = complete_matches,
+ mi_top_env_ = top_env,
mi_docs_ = docs,
mi_ext_fields_ = _ext_fields, -- Don't `put_` this in the instance so we
-- can deal with it's pointer in the header
@@ -526,6 +536,7 @@ instance Binary ModIface where
put_ bh trust
put_ bh trust_pkg
put_ bh complete_matches
+ lazyPut bh top_env
lazyPutMaybe bh docs
get bh = do
@@ -560,6 +571,7 @@ instance Binary ModIface where
trust <- get bh
trust_pkg <- get bh
complete_matches <- get bh
+ top_env <- lazyGet bh
docs <- lazyGetMaybe bh
return (PrivateModIface {
mi_module_ = mod,
@@ -582,7 +594,6 @@ instance Binary ModIface where
mi_decls_ = decls,
mi_extra_decls_ = extra_decls,
mi_foreign_ = foreign_,
- mi_top_env_ = Nothing,
mi_defaults_ = defaults,
mi_insts_ = insts,
mi_fam_insts_ = fam_insts,
@@ -593,6 +604,7 @@ instance Binary ModIface where
-- And build the cached values
mi_complete_matches_ = complete_matches,
mi_docs_ = docs,
+ mi_top_env_ = top_env,
mi_ext_fields_ = emptyExtensibleFields, -- placeholder because this is dealt
-- with specially when the file is read
mi_final_exts_ = ModIfaceBackend {
@@ -613,8 +625,6 @@ instance Binary ModIface where
}})
--- | The original names declared of a certain module that are exported
-type IfaceExport = AvailInfo
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface mod
@@ -638,7 +648,7 @@ emptyPartialModIface mod
mi_decls_ = [],
mi_extra_decls_ = Nothing,
mi_foreign_ = emptyIfaceForeign,
- mi_top_env_ = Nothing,
+ mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] ,
mi_hpc_ = False,
mi_trust_ = noIfaceTrustInfo,
mi_trust_pkg_ = False,
@@ -817,8 +827,7 @@ addSourceFingerprint val iface = iface { mi_src_hash_ = val }
-- the in-memory byte array buffer 'mi_hi_bytes'.
restoreFromOldModIface :: ModIface_ phase -> ModIface_ phase -> ModIface_ phase
restoreFromOldModIface old new = new
- { mi_top_env_ = mi_top_env_ old
- , mi_hsc_src_ = mi_hsc_src_ old
+ { mi_hsc_src_ = mi_hsc_src_ old
, mi_src_hash_ = mi_src_hash_ old
}
@@ -879,7 +888,7 @@ set_mi_extra_decls val iface = clear_mi_hi_bytes $ iface { mi_extra_decls_ = val
set_mi_foreign :: IfaceForeign -> ModIface_ phase -> ModIface_ phase
set_mi_foreign foreign_ iface = clear_mi_hi_bytes $ iface { mi_foreign_ = foreign_ }
-set_mi_top_env :: Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
+set_mi_top_env :: IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val }
set_mi_hpc :: AnyHpcUsage -> ModIface_ phase -> ModIface_ phase
@@ -996,7 +1005,7 @@ pattern ModIface ::
[IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings ->
[IfaceAnnotation] -> [IfaceDeclExts phase] ->
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign ->
- [IfaceDefault] -> Maybe IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
+ [IfaceDefault] -> IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] ->
AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs ->
IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase ->
ModIface_ phase
=====================================
distrib/configure.ac.in
=====================================
@@ -214,6 +214,13 @@ FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion])
LlvmAsCmd="$LLVMAS"
AC_SUBST([LlvmAsCmd])
+dnl We know that `clang` supports `--target` and it is necessary to pass it
+dnl lest we see #25793.
+if test -z "$LlvmAsFlags" ; then
+ LlvmAsFlags="--target=$LlvmTarget"
+fi
+AC_SUBST([LlvmAsFlags])
+
dnl ** Check gcc version and flags we need to pass it **
FP_GCC_VERSION
FP_GCC_SUPPORTS_NO_PIE
=====================================
hadrian/bindist/Makefile
=====================================
@@ -131,6 +131,7 @@ lib/settings : config.mk
@echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@
@echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@
@echo ',("LLVM llvm-as command", "$(SettingsLlvmAsCommand)")' >> $@
+ @echo ',("LLVM llvm-as flags", "$(SettingsLlvmAsFlags)")' >> $@
@echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@
@echo
@echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -85,6 +85,7 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@
settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
settings-llvm-as-command = @SettingsLlvmAsCommand@
+settings-llvm-as-flags = @SettingsLlvmAsFlags@
settings-use-distro-mingw = @SettingsUseDistroMINGW@
target-has-libm = @TargetHasLibm@
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -91,6 +91,7 @@ data ToolchainSetting
| ToolchainSetting_LlcCommand
| ToolchainSetting_OptCommand
| ToolchainSetting_LlvmAsCommand
+ | ToolchainSetting_LlvmAsFlags
| ToolchainSetting_DistroMinGW
-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
@@ -144,6 +145,7 @@ settingsFileSetting key = lookupSystemConfig $ case key of
ToolchainSetting_LlcCommand -> "settings-llc-command"
ToolchainSetting_OptCommand -> "settings-opt-command"
ToolchainSetting_LlvmAsCommand -> "settings-llvm-as-command"
+ ToolchainSetting_LlvmAsFlags -> "settings-llvm-as-flags"
ToolchainSetting_DistroMinGW -> "settings-use-distro-mingw" -- ROMES:TODO: This option doesn't seem to be in ghc-toolchain yet. It corresponds to EnableDistroToolchain
-- | An expression that looks up the value of a 'Setting' in @cfg/system.config@,
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -528,6 +528,7 @@ generateSettings settingsFile = do
, ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand)
, ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand)
, ("LLVM llvm-as command", expr $ settingsFileSetting ToolchainSetting_LlvmAsCommand)
+ , ("LLVM llvm-as flags", expr $ settingsFileSetting ToolchainSetting_LlvmAsFlags)
, ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW)
, ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs)
=====================================
m4/fp_settings.m4
=====================================
@@ -89,6 +89,7 @@ AC_DEFUN([FP_SETTINGS],
SettingsLlcCommand="$LlcCmd"
SettingsOptCommand="$OptCmd"
SettingsLlvmAsCommand="$LlvmAsCmd"
+ SettingsLlvmAsFlags="$LlvmAsCmd"
if test "$EnableDistroToolchain" = "YES"; then
# If the user specified --enable-distro-toolchain then we just use the
@@ -131,6 +132,7 @@ AC_DEFUN([FP_SETTINGS],
SUBST_TOOLDIR([SettingsLlcCommand])
SUBST_TOOLDIR([SettingsOptCommand])
SUBST_TOOLDIR([SettingsLlvmAsCommand])
+ SUBST_TOOLDIR([SettingsLlvmAsFlags])
fi
# Mac-only tools
@@ -171,5 +173,6 @@ AC_DEFUN([FP_SETTINGS],
AC_SUBST(SettingsLlcCommand)
AC_SUBST(SettingsOptCommand)
AC_SUBST(SettingsLlvmAsCommand)
+ AC_SUBST(SettingsLlvmAsFlags)
AC_SUBST(SettingsUseDistroMINGW)
])
=====================================
testsuite/tests/ghci/should_run/Makefile
=====================================
@@ -7,3 +7,9 @@ T3171:
echo "do Control.Concurrent.threadDelay 3000000; putStrLn \"threadDelay was not interrupted\"" | \
"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) & \
sleep 2; kill -INT $$!; wait
+
+TopEnvIface:
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) TopEnvIface -v1 -e "a" -e ":q" -fwrite-if-simplified-core -fwrite-interface
+ # Second compilation starts from interface files, but still can print "a"
+ "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) TopEnvIface -v1 -e "a" -e ":q" -fwrite-if-simplified-core -fwrite-interface
+
=====================================
testsuite/tests/ghci/should_run/TopEnvIface.hs
=====================================
@@ -0,0 +1,4 @@
+module TopEnvIface where
+
+import TopEnvIface2
+
=====================================
testsuite/tests/ghci/should_run/TopEnvIface.stdout
=====================================
@@ -0,0 +1,8 @@
+[1 of 2] Compiling TopEnvIface2 ( TopEnvIface2.hs, interpreted )
+[2 of 2] Compiling TopEnvIface ( TopEnvIface.hs, interpreted )
+Ok, two modules loaded.
+"I should be printed twice"
+Leaving GHCi.
+Ok, two modules loaded.
+"I should be printed twice"
+Leaving GHCi.
=====================================
testsuite/tests/ghci/should_run/TopEnvIface2.hs
=====================================
@@ -0,0 +1,3 @@
+module TopEnvIface2 where
+
+a = "I should be printed twice"
=====================================
testsuite/tests/ghci/should_run/all.T
=====================================
@@ -96,3 +96,4 @@ test('LargeBCO', [extra_files(['LargeBCO_A.hs']), req_interp, extra_hc_opts("-O
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'])
+test('TopEnvIface', [only_ways(ghci_ways)], makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1af21fd68dce20985cdb6701cfeb926a8f631884...a5de39dec43ad4fb91234235ca7a22c9ea3c9d0c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1af21fd68dce20985cdb6701cfeb926a8f631884...a5de39dec43ad4fb91234235ca7a22c9ea3c9d0c
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/20250303/4028e6fe/attachment-0001.html>
More information about the ghc-commits
mailing list