[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix BCO creation setting caps when -j > -N
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Mar 17 13:36:02 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00
Fix BCO creation setting caps when -j > -N
* Remove calls to 'setNumCapabilities' in 'createBCOs'
These calls exist to ensure that 'createBCOs' can benefit from
parallelism. But this is not the right place to call
`setNumCapabilities`. Furthermore the logic differs from that in the
driver causing the capability count to be raised and lowered at each TH
call if -j > -N.
* Remove 'BCOOpts'
No longer needed as it was only used to thread the job count down to `createBCOs`
Resolves #23049
- - - - -
5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00
Add changelog entry for #23049
- - - - -
6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00
configure: Fix FIND_CXX_STD_LIB test on Darwin
Annoyingly, Darwin's <cstddef> includes <version> and APFS is
case-insensitive. Consequently, it will end up #including the
`VERSION` file generated by the `configure` script on the second
and subsequent runs of the `configure` script.
See #23116.
- - - - -
19d6d039 by sheaf at 2023-03-16T21:31:22+01:00
ghci: only keep the GlobalRdrEnv in ModInfo
The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo,
which includes a TypeEnv. This can easily cause space leaks as we
have no way of forcing everything in a type environment.
In GHC, we only use the GlobalRdrEnv, which we can force completely.
So we only store that instead of a fully-fledged ModuleInfo.
- - - - -
2bfa89e0 by Torsten Schmits at 2023-03-17T09:35:48-04:00
Add structured error messages for GHC.Tc.Utils.Backpack
Tracking ticket: #20119
MR: !10127
This converts uses of `mkTcRnUnknownMessage` to newly added constructors
of `TcRnMessage`.
One occurrence, when handing a nested error from the interface loading
machinery, was omitted. It will be handled by a subsequent changeset
that addresses interface errors.
- - - - -
24 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Name/Shape.hs
- docs/users_guide/9.8.1-notes.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- ghc/GHCi/UI/Monad.hs
- m4/fp_find_cxx_std_lib.m4
- testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
- testsuite/tests/backpack/should_fail/bkpfail01.stderr
- testsuite/tests/backpack/should_fail/bkpfail05.stderr
- testsuite/tests/backpack/should_fail/bkpfail09.stderr
- testsuite/tests/backpack/should_fail/bkpfail16.stderr
- testsuite/tests/backpack/should_fail/bkpfail20.stderr
- testsuite/tests/backpack/should_fail/bkpfail21.stderr
- testsuite/tests/backpack/should_fail/bkpfail35.stderr
- testsuite/tests/backpack/should_fail/bkpfail37.stderr
- testsuite/tests/backpack/should_fail/bkpfail38.stderr
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -1304,8 +1304,7 @@ compileCore simplify fn = do
else
return $ Right mod_guts
- Nothing -> panic "compileToCoreModule: target FilePath not found in\
- module dependency graph"
+ Nothing -> panic "compileToCoreModule: target FilePath not found in module dependency graph"
where -- two versions, based on whether we simplify (thus run tidyProgram,
-- which returns a (CgGuts, ModDetails) pair, or not (in which case
-- we just have a ModGuts.
=====================================
compiler/GHC/Driver/Config.hs
=====================================
@@ -2,7 +2,6 @@
module GHC.Driver.Config
( initOptCoercionOpts
, initSimpleOpts
- , initBCOOpts
, initEvalOpts
)
where
@@ -12,12 +11,8 @@ import GHC.Prelude
import GHC.Driver.Session
import GHC.Core.SimpleOpt
import GHC.Core.Coercion.Opt
-import GHC.Runtime.Interpreter (BCOOpts(..))
import GHCi.Message (EvalOpts(..))
-import GHC.Conc (getNumProcessors)
-import Control.Monad.IO.Class
-
-- | Initialise coercion optimiser configuration from DynFlags
initOptCoercionOpts :: DynFlags -> OptCoercionOpts
initOptCoercionOpts dflags = OptCoercionOpts
@@ -32,16 +27,6 @@ initSimpleOpts dflags = SimpleOpts
, so_eta_red = gopt Opt_DoEtaReduction dflags
}
--- | Extract BCO options from DynFlags
-initBCOOpts :: DynFlags -> IO BCOOpts
-initBCOOpts dflags = do
- -- Serializing ResolvedBCO is expensive, so if we're in parallel mode
- -- (-j<n>) parallelise the serialization.
- n_jobs <- case parMakeCount dflags of
- Nothing -> liftIO getNumProcessors
- Just n -> return n
- return $ BCOOpts n_jobs
-
-- | Extract GHCi options from DynFlags and step
initEvalOpts :: DynFlags -> Bool -> EvalOpts
initEvalOpts dflags step =
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -43,7 +43,6 @@ import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Ppr
-import GHC.Driver.Config
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
@@ -598,8 +597,7 @@ loadExpr interp hsc_env span root_ul_bco = do
nobreakarray = error "no break array"
bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)]
resolved <- linkBCO interp le bco_ix nobreakarray root_ul_bco
- bco_opts <- initBCOOpts (hsc_dflags hsc_env)
- [root_hvref] <- createBCOs interp bco_opts [resolved]
+ [root_hvref] <- createBCOs interp [resolved]
fhv <- mkFinalizedHValue interp root_hvref
return (pls, fhv)
where
@@ -946,8 +944,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do
, addr_env = plusNameEnv (addr_env le) bc_strs }
-- Link the necessary packages and linkables
- bco_opts <- initBCOOpts (hsc_dflags hsc_env)
- new_bindings <- linkSomeBCOs bco_opts interp le2 [cbc]
+ new_bindings <- linkSomeBCOs interp le2 [cbc]
nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings
let ce2 = extendClosureEnv (closure_env le2) nms_fhvs
!pls2 = pls { linker_env = le2 { closure_env = ce2 } }
@@ -995,7 +992,6 @@ loadModuleLinkables interp hsc_env pls linkables
let (objs, bcos) = partition isObjectLinkable
(concatMap partitionLinkable linkables)
- bco_opts <- initBCOOpts (hsc_dflags hsc_env)
-- Load objects first; they can't depend on BCOs
(pls1, ok_flag) <- loadObjects interp hsc_env pls objs
@@ -1003,7 +999,7 @@ loadModuleLinkables interp hsc_env pls linkables
if failed ok_flag then
return (pls1, Failed)
else do
- pls2 <- dynLinkBCOs bco_opts interp pls1 bcos
+ pls2 <- dynLinkBCOs interp pls1 bcos
return (pls2, Succeeded)
@@ -1156,8 +1152,8 @@ rmDupLinkables already ls
********************************************************************* -}
-dynLinkBCOs :: BCOOpts -> Interp -> LoaderState -> [Linkable] -> IO LoaderState
-dynLinkBCOs bco_opts interp pls bcos = do
+dynLinkBCOs :: Interp -> LoaderState -> [Linkable] -> IO LoaderState
+dynLinkBCOs interp pls bcos = do
let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
pls1 = pls { bcos_loaded = bcos_loaded' }
@@ -1173,7 +1169,7 @@ dynLinkBCOs bco_opts interp pls bcos = do
ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs)
le2 = le1 { itbl_env = ie2, addr_env = ae2 }
- names_and_refs <- linkSomeBCOs bco_opts interp le2 cbcs
+ names_and_refs <- linkSomeBCOs interp le2 cbcs
-- We only want to add the external ones to the ClosureEnv
let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs
@@ -1187,8 +1183,7 @@ dynLinkBCOs bco_opts interp pls bcos = do
return $! pls1 { linker_env = le2 { closure_env = ce2 } }
-- Link a bunch of BCOs and return references to their values
-linkSomeBCOs :: BCOOpts
- -> Interp
+linkSomeBCOs :: Interp
-> LinkerEnv
-> [CompiledByteCode]
-> IO [(Name,HValueRef)]
@@ -1196,7 +1191,7 @@ linkSomeBCOs :: BCOOpts
-- the incoming unlinked BCOs. Each gives the
-- value of the corresponding unlinked BCO
-linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods []
+linkSomeBCOs interp le mods = foldr fun do_link mods []
where
fun CompiledByteCode{..} inner accum =
case bc_breaks of
@@ -1211,7 +1206,7 @@ linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods []
bco_ix = mkNameEnv (zip names [0..])
resolved <- sequence [ linkBCO interp le bco_ix breakarray bco
| (breakarray, bco) <- flat ]
- hvrefs <- createBCOs interp bco_opts resolved
+ hvrefs <- createBCOs interp resolved
return (zip names hvrefs)
-- | Useful to apply to the result of 'linkSomeBCOs'
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -11,7 +11,6 @@ module GHC.Runtime.Interpreter
( module GHC.Runtime.Interpreter.Types
-- * High-level interface to the interpreter
- , BCOOpts (..)
, evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
, resumeStmt
, abandonStmt
@@ -329,26 +328,11 @@ mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCent
mkCostCentres interp mod ccs =
interpCmd interp (MkCostCentres mod ccs)
-newtype BCOOpts = BCOOpts
- { bco_n_jobs :: Int -- ^ Number of parallel jobs doing BCO serialization
- }
-
-- | Create a set of BCOs that may be mutually recursive.
-createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef]
-createBCOs interp opts rbcos = do
- let n_jobs = bco_n_jobs opts
- -- Serializing ResolvedBCO is expensive, so if we support doing it in parallel
- if (n_jobs == 1)
- then
- interpCmd interp (CreateBCOs [runPut (put rbcos)])
- else do
- old_caps <- getNumCapabilities
- if old_caps == n_jobs
- then void $ evaluate puts
- else bracket_ (setNumCapabilities n_jobs)
- (setNumCapabilities old_caps)
- (void $ evaluate puts)
- interpCmd interp (CreateBCOs puts)
+createBCOs :: Interp -> [ResolvedBCO] -> IO [HValueRef]
+createBCOs interp rbcos = do
+ -- Serializing ResolvedBCO is expensive, so we do it in parallel
+ interpCmd interp (CreateBCOs puts)
where
puts = parMap doChunk (chunkList 100 rbcos)
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -73,6 +73,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
+import GHC.Types.Fixity (defaultFixity)
import GHC.Unit.State (pprWithUnitState, UnitState)
import GHC.Unit.Module
@@ -994,6 +995,32 @@ instance Diagnostic TcRnMessage where
TcRnIllegalHsigDefaultMethods name meths
-> mkSimpleDecorated $
text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file"
+ TcRnHsigFixityMismatch real_thing real_fixity sig_fixity
+ ->
+ let ppr_fix f = ppr f <+> if f == defaultFixity then parens (text "default") else empty
+ in mkSimpleDecorated $
+ vcat [ppr real_thing <+> text "has conflicting fixities in the module",
+ text "and its hsig file",
+ text "Main module:" <+> ppr_fix real_fixity,
+ text "Hsig file:" <+> ppr_fix sig_fixity]
+ TcRnHsigShapeMismatch (HsigShapeSortMismatch info1 info2)
+ -> mkSimpleDecorated $
+ text "While merging export lists, could not combine"
+ <+> ppr info1 <+> text "with" <+> ppr info2
+ <+> parens (text "one is a type, the other is a plain identifier")
+ TcRnHsigShapeMismatch (HsigShapeNotUnifiable name1 name2 notHere)
+ ->
+ let extra = if notHere
+ then text "Neither name variable originates from the current signature."
+ else empty
+ in mkSimpleDecorated $
+ text "While merging export lists, could not unify"
+ <+> ppr name1 <+> text "with" <+> ppr name2 $$ extra
+ TcRnHsigMissingModuleExport occ unit_state impl_mod
+ -> mkSimpleDecorated $
+ quotes (ppr occ)
+ <+> text "is exported by the hsig file, but not exported by the implementing module"
+ <+> quotes (pprWithUnitState unit_state $ ppr impl_mod)
TcRnBadGenericMethod clas op
-> mkSimpleDecorated $
hsep [text "Class", quotes (ppr clas),
@@ -1726,6 +1753,12 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnWarningsDeprecations
TcRnIllegalHsigDefaultMethods{}
-> ErrorWithoutFlag
+ TcRnHsigFixityMismatch{}
+ -> ErrorWithoutFlag
+ TcRnHsigShapeMismatch{}
+ -> ErrorWithoutFlag
+ TcRnHsigMissingModuleExport{}
+ -> ErrorWithoutFlag
TcRnBadGenericMethod{}
-> ErrorWithoutFlag
TcRnWarningMinimalDefIncomplete{}
@@ -2196,6 +2229,12 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnIllegalHsigDefaultMethods{}
-> noHints
+ TcRnHsigFixityMismatch{}
+ -> noHints
+ TcRnHsigShapeMismatch{}
+ -> noHints
+ TcRnHsigMissingModuleExport{}
+ -> noHints
TcRnBadGenericMethod{}
-> noHints
TcRnWarningMinimalDefIncomplete{}
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -91,6 +91,7 @@ module GHC.Tc.Errors.Types (
, DeclSort(..)
, NonStandardGuards(..)
, RuleLhsErrReason(..)
+ , HsigShapeMismatchReason(..)
) where
import GHC.Prelude
@@ -105,6 +106,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol)
, FixedRuntimeRepOrigin(..) )
import GHC.Tc.Types.Rank (Rank)
import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType)
+import GHC.Types.Avail (AvailInfo)
import GHC.Types.Error
import GHC.Types.Hint (UntickedPromotedThing(..))
import GHC.Types.ForeignCall (CLabelString)
@@ -2239,10 +2241,39 @@ data TcRnMessage where
Test case:
bkpfail40
-}
-
TcRnIllegalHsigDefaultMethods :: !Name -- ^ 'Name' of the class
-> NE.NonEmpty (LHsBind GhcRn) -- ^ default methods
-> TcRnMessage
+
+ {-| TcRnHsigFixityMismatch is an error indicating that the fixity decl in a
+ Backpack signature file differs from the one in the source file for the same
+ operator.
+
+ Test cases:
+ bkpfail37, bkpfail38
+ -}
+ TcRnHsigFixityMismatch :: !TyThing -- ^ The operator whose fixity is defined
+ -> !Fixity -- ^ the fixity used in the source file
+ -> !Fixity -- ^ the fixity used in the signature
+ -> TcRnMessage
+
+ {-| TcRnHsigShapeMismatch is a group of errors related to mismatches between
+ backpack signatures.
+ -}
+ TcRnHsigShapeMismatch :: !HsigShapeMismatchReason
+ -> TcRnMessage
+
+ {-| TcRnHsigMissingModuleExport is an error indicating that a module doesn't
+ export a name exported by its signature.
+
+ Test cases:
+ bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06
+ -}
+ TcRnHsigMissingModuleExport :: !OccName -- ^ The missing name
+ -> !UnitState -- ^ The module's unit state
+ -> !Module -- ^ The implementation module
+ -> TcRnMessage
+
{-| TcRnBadGenericMethod
This test ensures that if you provide a "more specific" type signatures
for the default method, you must also provide a binding.
@@ -4419,3 +4450,24 @@ data NonStandardGuards where
data RuleLhsErrReason
= UnboundVariable RdrName NotInScopeError
| IllegalExpression
+
+data HsigShapeMismatchReason =
+ {-| HsigShapeSortMismatch is an error indicating that an item in the
+ export list of a signature doesn't match the item of the same name in
+ another signature when merging the two – one is a type while the other is a
+ plain identifier.
+
+ Test cases:
+ none
+ -}
+ HsigShapeSortMismatch !AvailInfo !AvailInfo
+ |
+ {-| HsigShapeNotUnifiable is an error indicating that a name in the
+ export list of a signature cannot be unified with a name of the same name in
+ another signature when merging the two.
+
+ Test cases:
+ bkpfail20, bkpfail21
+ -}
+ HsigShapeNotUnifiable !Name !Name !Bool
+ deriving (Generic)
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -88,21 +88,6 @@ import Data.List (find)
import {-# SOURCE #-} GHC.Tc.Module
-
-fixityMisMatch :: TyThing -> Fixity -> Fixity -> TcRnMessage
-fixityMisMatch real_thing real_fixity sig_fixity =
- mkTcRnUnknownMessage $ mkPlainError noHints $
- vcat [ppr real_thing <+> text "has conflicting fixities in the module",
- text "and its hsig file",
- text "Main module:" <+> ppr_fix real_fixity,
- text "Hsig file:" <+> ppr_fix sig_fixity]
- where
- ppr_fix f =
- ppr f <+>
- (if f == defaultFixity
- then parens (text "default")
- else empty)
-
checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn ()
checkHsigDeclM sig_iface sig_thing real_thing = do
let name = getName real_thing
@@ -115,7 +100,7 @@ checkHsigDeclM sig_iface sig_thing real_thing = do
Just f -> f
when (real_fixity /= sig_fixity) $
addErrAt (nameSrcSpan name)
- (fixityMisMatch real_thing real_fixity sig_fixity)
+ (TcRnHsigFixityMismatch real_thing real_fixity sig_fixity)
-- | Given a 'ModDetails' of an instantiated signature (note that the
-- 'ModDetails' must be knot-tied consistently with the actual implementation)
@@ -677,7 +662,7 @@ mergeSignatures
-- 3(d). Extend the name substitution (performing shaping)
mb_r <- extend_ns nsubst as2
case mb_r of
- Left err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err)
+ Left err -> failWithTc (TcRnHsigShapeMismatch err)
Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces)
nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)
ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0))
@@ -1004,10 +989,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
-- we need. (Notice we IGNORE the Modules in the AvailInfos.)
forM_ (exportOccs (mi_exports isig_iface)) $ \occ ->
case lookupGlobalRdrEnv impl_gr occ of
- [] -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $
- quotes (ppr occ)
- <+> text "is exported by the hsig file, but not exported by the implementing module"
- <+> quotes (pprWithUnitState unit_state $ ppr impl_mod)
+ [] -> addErr $ TcRnHsigMissingModuleExport occ unit_state impl_mod
_ -> return ()
failIfErrsM
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -471,6 +471,11 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl" = 50649
GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods" = 93006
+ GhcDiagnosticCode "TcRnHsigFixityMismatch" = 93007
+ GhcDiagnosticCode "HsigShapeSortMismatch" = 93008
+ GhcDiagnosticCode "HsigShapeNotUnifiable" = 93009
+ GhcDiagnosticCode "TcRnHsigNoIface" = 93010
+ GhcDiagnosticCode "TcRnHsigMissingModuleExport" = 93011
GhcDiagnosticCode "TcRnBadGenericMethod" = 59794
GhcDiagnosticCode "TcRnWarningMinimalDefIncomplete" = 13511
GhcDiagnosticCode "TcRnDefaultMethodForPragmaLacksBinding" = 28587
@@ -691,6 +696,7 @@ type family ConRecursInto con where
ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn)
ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError
ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason
+ ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason
--
-- TH errors
=====================================
compiler/GHC/Types/Name/Shape.hs
=====================================
@@ -25,8 +25,8 @@ import GHC.Types.Name.Env
import GHC.Tc.Utils.Monad
import GHC.Iface.Env
+import GHC.Tc.Errors.Types
-import GHC.Utils.Outputable
import GHC.Utils.Panic.Plain
import Control.Monad
@@ -106,7 +106,7 @@ mkNameShape mod_name as =
-- restricted notion of shaping than in Backpack'14: we do shaping
-- *as* we do type-checking. Thus, once we shape a signature, its
-- exports are *final* and we're not allowed to refine them further,
-extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape)
+extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either HsigShapeMismatchReason NameShape)
extendNameShape hsc_env ns as =
case uAvailInfos (ns_mod_name ns) (ns_exports ns) as of
Left err -> return (Left err)
@@ -224,7 +224,7 @@ mergeAvails as1 as2 =
-- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@,
-- with only name holes from @flexi@ unifiable (all other name holes rigid.)
-uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst
+uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either HsigShapeMismatchReason ShNameSubst
uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $
let mkOE as = listToUFM $ do a <- as
n <- availNames a
@@ -236,34 +236,27 @@ uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $
-- | Unify two 'AvailInfo's, given an existing substitution @subst@,
-- with only name holes from @flexi@ unifiable (all other name holes rigid.)
uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo
- -> Either SDoc ShNameSubst
+ -> Either HsigShapeMismatchReason ShNameSubst
uAvailInfo flexi subst (Avail (NormalGreName n1)) (Avail (NormalGreName n2)) = uName flexi subst n1 n2
uAvailInfo flexi subst (AvailTC n1 _) (AvailTC n2 _) = uName flexi subst n1 n2
-uAvailInfo _ _ a1 a2 = Left $ text "While merging export lists, could not combine"
- <+> ppr a1 <+> text "with" <+> ppr a2
- <+> parens (text "one is a type, the other is a plain identifier")
+uAvailInfo _ _ a1 a2 = Left $ HsigShapeSortMismatch a1 a2
-- | Unify two 'Name's, given an existing substitution @subst@,
-- with only name holes from @flexi@ unifiable (all other name holes rigid.)
-uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
+uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either HsigShapeMismatchReason ShNameSubst
uName flexi subst n1 n2
| n1 == n2 = Right subst
| isFlexi n1 = uHoleName flexi subst n1 n2
| isFlexi n2 = uHoleName flexi subst n2 n1
- | otherwise = Left (text "While merging export lists, could not unify"
- <+> ppr n1 <+> text "with" <+> ppr n2 $$ extra)
+ | otherwise = Left (HsigShapeNotUnifiable n1 n2 (isHoleName n1 || isHoleName n2))
where
isFlexi n = isHoleName n && moduleName (nameModule n) == flexi
- extra | isHoleName n1 || isHoleName n2
- = text "Neither name variable originates from the current signature."
- | otherwise
- = empty
-- | Unify a name @h@ which 'isHoleName' with another name, given an existing
-- substitution @subst@, with only name holes from @flexi@ unifiable (all
-- other name holes rigid.)
uHoleName :: ModuleName -> ShNameSubst -> Name {- hole name -} -> Name
- -> Either SDoc ShNameSubst
+ -> Either HsigShapeMismatchReason ShNameSubst
uHoleName flexi subst h n =
assert (isHoleName h) $
case lookupNameEnv subst h of
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -32,6 +32,9 @@ Compiler
the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket
#22448 for further details.
+- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``.
+ See GHC ticket #23049.
+
GHCi
~~~~
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2346,8 +2346,12 @@ typeAtCmd str = runExceptGhciMonad $ do
(span',sample) <- exceptT $ parseSpanArg str
infos <- lift $ mod_infos <$> getGHCiState
(info, ty) <- findType infos span' sample
- lift $ printForUserModInfo (modinfoInfo info)
- (sep [text sample,nest 2 (dcolon <+> ppr ty)])
+ let mb_rdr_env = case modinfoRdrEnv info of
+ Strict.Just rdrs -> Just rdrs
+ Strict.Nothing -> Nothing
+ lift $ printForUserGlobalRdrEnv
+ mb_rdr_env
+ (sep [text sample,nest 2 (dcolon <+> ppr ty)])
-----------------------------------------------------------------------------
-- | @:uses@ command
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -42,6 +42,7 @@ import GHC.Driver.Monad
import GHC.Driver.Env
import GHC.Driver.Ppr
import GHC.Types.Name
+import GHC.Types.Name.Reader
import GHC.Types.Name.Set
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
@@ -58,9 +59,8 @@ data ModInfo = ModInfo
-- ^ Generated set of information about all spans in the
-- module that correspond to some kind of identifier for
-- which there will be type info and/or location info.
- , modinfoInfo :: !ModuleInfo
- -- ^ Again, useful from GHC for accessing information
- -- (exports, instances, scope) from a module.
+ , modinfoRdrEnv :: !(Strict.Maybe GlobalRdrEnv)
+ -- ^ What's in scope in the module.
, modinfoLastUpdate :: !UTCTime
-- ^ The timestamp of the file used to generate this record.
}
@@ -174,9 +174,9 @@ findName infos span0 mi string =
UnhelpfulSpan {} -> tryExternalModuleResolution
RealSrcSpan {} -> return (getName name)
where
+ rdrs = modInfo_rdrs mi
tryExternalModuleResolution =
- case find (matchName $ mkFastString string)
- (fromMaybe [] (modInfoTopLevelScope (modinfoInfo mi))) of
+ case find (matchName $ mkFastString string) rdrs of
Nothing -> throwE "Couldn't resolve to any modules."
Just imported -> resolveNameFromModule infos imported
@@ -198,8 +198,10 @@ resolveNameFromModule infos name = do
ppr modL)) return $
M.lookup (moduleName modL) infos
+ let all_names = modInfo_rdrs info
+
maybe (throwE "No matching export in any local modules.") return $
- find (matchName name) (modInfoExports (modinfoInfo info))
+ find (matchName name) all_names
where
matchName :: Name -> Name -> Bool
matchName x y = occNameFS (getOccName x) ==
@@ -311,9 +313,25 @@ getModInfo name = do
p <- parseModule m
typechecked <- typecheckModule p
let allTypes = processAllTypeCheckedModule typechecked
- let i = tm_checked_module_info typechecked
+ module_info = tm_checked_module_info typechecked
+ !rdr_env = case modInfoRdrEnv module_info of
+ Just rdrs -> Strict.Just rdrs
+ Nothing -> Strict.Nothing
ts <- liftIO $ getModificationTime $ srcFilePath m
- return (ModInfo m allTypes i ts)
+ return $
+ ModInfo
+ { modinfoSummary = m
+ , modinfoSpans = allTypes
+ , modinfoRdrEnv = rdr_env
+ , modinfoLastUpdate = ts
+ }
+
+-- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any.
+modInfo_rdrs :: ModInfo -> [Name]
+modInfo_rdrs mi =
+ case modinfoRdrEnv mi of
+ Strict.Nothing -> []
+ Strict.Just env -> map greMangledName $ globalRdrEnvElts env
-- | Get ALL source spans in the module.
processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo]
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -24,7 +24,8 @@ module GHCi.UI.Monad (
runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
ActionStats(..), runAndPrintStats, runWithStats, printStats,
- printForUserNeverQualify, printForUserModInfo,
+ printForUserNeverQualify,
+ printForUserModInfo, printForUserGlobalRdrEnv,
printForUser, printForUserPartWay, prettyLocations,
compileGHCiExpr,
@@ -41,6 +42,7 @@ import GHC.Driver.Monad hiding (liftIO)
import GHC.Utils.Outputable
import qualified GHC.Driver.Ppr as Ppr
import GHC.Types.Name.Occurrence
+import GHC.Types.Name.Reader
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Driver.Env
@@ -49,6 +51,7 @@ import GHC.Types.SafeHaskell
import GHC.Driver.Make (ModIfaceCache(..))
import GHC.Unit
import GHC.Types.Name.Reader as RdrName (mkOrig)
+import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx )
import GHC.Builtin.Names (gHC_GHCI_HELPERS)
import GHC.Runtime.Interpreter
import GHC.Runtime.Context
@@ -362,11 +365,20 @@ printForUserNeverQualify doc = do
liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
-printForUserModInfo info doc = do
+printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info)
+
+printForUserGlobalRdrEnv :: GhcMonad m => Maybe GlobalRdrEnv -> SDoc -> m ()
+printForUserGlobalRdrEnv mb_rdr_env doc = do
dflags <- GHC.getInteractiveDynFlags
- m_name_ppr_ctx <- GHC.mkNamePprCtxForModule info
- name_ppr_ctx <- maybe GHC.getNamePprCtx return m_name_ppr_ctx
+ name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env
liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc
+ where
+ mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx
+ mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) =
+ withSession $ \ hsc_env ->
+ let unit_env = hsc_unit_env hsc_env
+ ptc = initPromotionTickContext dflags
+ in return $ Ppr.mkNamePprCtx ptc unit_env rdr_env
printForUser :: GhcMonad m => SDoc -> m ()
printForUser doc = do
=====================================
m4/fp_find_cxx_std_lib.m4
=====================================
@@ -4,6 +4,14 @@
# Identify which C++ standard library implementation the C++ toolchain links
# against.
AC_DEFUN([FP_FIND_CXX_STD_LIB],[
+ # Annoyingly, Darwin's <cstddef> includes <version> and APFS is
+ # case-insensitive. Consequently, it will end up #including the
+ # VERSION file generated by the configure script on the second
+ # and subsequent runs of the configure script.
+ # See #23116.
+ mkdir -p actest.tmp
+ cd actest.tmp
+
# If this is non-empty then assume that the user has specified these
# manually.
if test -z "$CXX_STD_LIB_LIBS"; then
@@ -87,6 +95,9 @@ EOF
rm -f actest.cpp actest.o actest
fi
+ cd ..
+ rm -R actest.tmp
+
AC_SUBST([CXX_STD_LIB_LIBS])
AC_SUBST([CXX_STD_LIB_LIB_DIRS])
AC_SUBST([CXX_STD_LIB_DYN_LIB_DIRS])
=====================================
testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
=====================================
@@ -1,4 +1,4 @@
-sig/P.hsig:1:1: error:
+sig/P.hsig:1:1: error: [GHC-93011]
• ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:impl:P’
• while checking that bkpcabal06-0.1.0.0:impl:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P]
=====================================
testsuite/tests/backpack/should_fail/bkpfail01.stderr
=====================================
@@ -10,10 +10,10 @@
Instantiating p[H=q:H]
[1 of 2] Compiling H[sig] ( p/H.hsig, nothing )
-bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error:
+bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
-bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error:
+bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
=====================================
testsuite/tests/backpack/should_fail/bkpfail05.stderr
=====================================
@@ -18,6 +18,6 @@
Instantiating h[H=h-impl:H]
[1 of 1] Compiling H[sig] ( h/H.hsig, bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/H.o )
-bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error:
+bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: [GHC-93011]
• ‘T1’ is exported by the hsig file, but not exported by the implementing module ‘h-impl:H’
• while checking that h-impl:H implements signature H in h[H=h-impl:H]
=====================================
testsuite/tests/backpack/should_fail/bkpfail09.stderr
=====================================
@@ -8,10 +8,10 @@
[1 of 3] Compiling H2[sig] ( r/H2.hsig, nothing )
[2 of 3] Instantiating p
-Command line argument: -unit-id p[H=H]:0:0: error:
+Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
-Command line argument: -unit-id p[H=H]:0:0: error:
+Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
=====================================
testsuite/tests/backpack/should_fail/bkpfail16.stderr
=====================================
@@ -6,6 +6,6 @@
Instantiating p[ShouldFail=base-4.13.0.0:Data.Bool]
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o )
-bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error:
+bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: [GHC-93011]
• ‘Booly’ is exported by the hsig file, but not exported by the implementing module ‘Data.Bool’
• while checking that Data.Bool implements signature ShouldFail in p[ShouldFail=Data.Bool]
=====================================
testsuite/tests/backpack/should_fail/bkpfail20.stderr
=====================================
@@ -5,7 +5,7 @@
[3 of 3] Processing r
[1 of 3] Compiling B[sig] ( r/B.hsig, nothing )
-bkpfail20.bkp:1:1: error:
+bkpfail20.bkp:1:1: error: [GHC-93009]
• While merging export lists, could not unify Data.STRef.Lazy.newSTRef with GHC.STRef.newSTRef
• while merging the signatures from:
• p[A=<B>]:A
=====================================
testsuite/tests/backpack/should_fail/bkpfail21.stderr
=====================================
@@ -9,7 +9,7 @@
[2 of 5] Compiling H1[sig] ( r/H1.hsig, nothing )
[3 of 5] Compiling H3[sig] ( r/H3.hsig, nothing )
-bkpfail21.bkp:1:1: error:
+bkpfail21.bkp:1:1: error: [GHC-93009]
• While merging export lists, could not unify {H1.T} with {H2.T}
Neither name variable originates from the current signature.
• while merging the signatures from:
=====================================
testsuite/tests/backpack/should_fail/bkpfail35.stderr
=====================================
@@ -13,6 +13,6 @@
Instantiating q[A=aimpl:A]
[1 of 1] Compiling A[sig] ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o )
-bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error:
+bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: [GHC-93011]
• ‘y’ is exported by the hsig file, but not exported by the implementing module ‘aimpl:A’
• while checking that aimpl:A implements signature A in q[A=aimpl:A]
=====================================
testsuite/tests/backpack/should_fail/bkpfail37.stderr
=====================================
@@ -9,7 +9,7 @@
Instantiating p[A=q:A]
[1 of 1] Compiling A[sig] ( p/A.hsig, bkpfail37.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o )
-bkpfail37.bkp:9:9: error:
+bkpfail37.bkp:9:9: error: [GHC-93007]
• Identifier ‘op’ has conflicting fixities in the module
and its hsig file
Main module: infixr 4
=====================================
testsuite/tests/backpack/should_fail/bkpfail38.stderr
=====================================
@@ -5,7 +5,7 @@
[3 of 3] Processing r
[1 of 3] Compiling A[sig] ( r/A.hsig, nothing )
-bkpfail38.bkp:8:9: error:
+bkpfail38.bkp:8:9: error: [GHC-93007]
• Identifier ‘op’ has conflicting fixities in the module
and its hsig file
Main module: infixr 4
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/148d155cf7da201cbec96be9b5686f8441fd8492...2bfa89e054ce4297de2fba1023545c9238a2d46f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/148d155cf7da201cbec96be9b5686f8441fd8492...2bfa89e054ce4297de2fba1023545c9238a2d46f
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/20230317/d6a01180/attachment-0001.html>
More information about the ghc-commits
mailing list