[Git][ghc/ghc][wip/T18566] 2 commits: users-guide: A bit of clean-up in profiling flag documentation
Ben Gamari
gitlab at gitlab.haskell.org
Wed Nov 11 21:18:29 UTC 2020
Ben Gamari pushed to branch wip/T18566 at Glasgow Haskell Compiler / GHC
Commits:
d9639d62 by Ben Gamari at 2020-11-11T15:56:13-05:00
users-guide: A bit of clean-up in profiling flag documentation
- - - - -
44927a55 by Ben Gamari at 2020-11-11T16:17:53-05:00
Add CALLER_CC pragma
- - - - -
11 changed files:
- compiler/GHC/Core/Lint.hs
- + compiler/GHC/Core/Opt/CallerCC.hs
- + compiler/GHC/Core/Opt/CallerCC.hs-boot
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Recomp/Flags.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.2.1-notes.rst
- docs/users_guide/profiling.rst
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -355,6 +355,7 @@ coreDumpFlag CoreTidy = Just Opt_D_dump_simpl
coreDumpFlag CorePrep = Just Opt_D_dump_prep
coreDumpFlag CoreOccurAnal = Just Opt_D_dump_occur_anal
+coreDumpFlag CoreAddCallerCcs = Nothing
coreDumpFlag CoreDoPrintCore = Nothing
coreDumpFlag (CoreDoRuleCheck {}) = Nothing
coreDumpFlag CoreDoNothing = Nothing
=====================================
compiler/GHC/Core/Opt/CallerCC.hs
=====================================
@@ -0,0 +1,221 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TupleSections #-}
+
+-- | Adds cost-centers to call sites selected with the @-fprof-caller=...@
+-- flag.
+module GHC.Core.Opt.CallerCC
+ ( addCallerCostCentres
+ , CallerCcFilter
+ , parseCallerCcFilter
+ ) where
+
+import Data.Bifunctor
+import Data.Word (Word8)
+import Data.Maybe
+import qualified Text.Parsec as P
+
+import Control.Applicative
+import Control.Monad.Trans.State.Strict
+import Data.Either
+import Control.Monad
+
+import GHC.Prelude
+import GHC.Utils.Outputable as Outputable
+import GHC.Driver.Session
+import GHC.Driver.Ppr
+import GHC.Types.CostCentre
+import GHC.Types.CostCentre.State
+import GHC.Types.Name hiding (varName)
+import GHC.Unit.Module.Name
+import GHC.Unit.Module.ModGuts
+import GHC.Types.SrcLoc
+import GHC.Types.Var
+import GHC.Unit.Types
+import GHC.Data.FastString
+import GHC.Core
+import GHC.Core.Opt.Monad
+import GHC.Utils.Panic
+import qualified GHC.Utils.Binary as B
+
+addCallerCostCentres :: ModGuts -> CoreM ModGuts
+addCallerCostCentres guts = do
+ dflags <- getDynFlags
+ let filters = callerCcFilters dflags
+ let env :: Env
+ env = Env
+ { thisModule = mg_module guts
+ , ccState = newCostCentreState
+ , dflags = dflags
+ , revParents = []
+ , filters = filters
+ }
+ let guts' = guts { mg_binds = doCoreProgram env (mg_binds guts)
+ }
+ return guts'
+
+doCoreProgram :: Env -> CoreProgram -> CoreProgram
+doCoreProgram env binds = flip evalState newCostCentreState $ do
+ mapM (doBind env) binds
+
+doBind :: Env -> CoreBind -> M CoreBind
+doBind env (NonRec b rhs) = NonRec b <$> doExpr (addParent b env) rhs
+doBind env (Rec bs) = Rec <$> mapM doPair bs
+ where
+ doPair (b,rhs) = (b,) <$> doExpr (addParent b env) rhs
+
+doExpr :: Env -> CoreExpr -> M CoreExpr
+doExpr env e@(Var v)
+ | needsCallSiteCostCentre env v = do
+ let nameDoc :: SDoc
+ nameDoc = hcat (punctuate dot (map ppr (parents env))) <> parens (text "calling " <> ppr v)
+
+ ccName :: CcName
+ ccName = mkFastString $ showSDoc (dflags env) nameDoc
+ ccIdx <- getCCIndex' ccName
+ let span = case revParents env of
+ top:_ -> nameSrcSpan $ varName top
+ _ -> noSrcSpan
+ cc = NormalCC (ExprCC ccIdx) ccName (thisModule env) span
+ tick :: Tickish Id
+ tick = ProfNote cc True True
+ pure $ Tick tick e
+ | otherwise = pure e
+doExpr _env e@(Lit _) = pure e
+doExpr env (f `App` x) = App <$> doExpr env f <*> doExpr env x
+doExpr env (Lam b x) = Lam b <$> doExpr env x
+doExpr env (Let b rhs) = Let <$> doBind env b <*> doExpr env rhs
+doExpr env (Case scrut b ty alts) =
+ Case <$> doExpr env scrut <*> pure b <*> pure ty <*> mapM doAlt alts
+ where
+ doAlt (con, bs, rhs) = (con, bs,) <$> doExpr env rhs
+doExpr env (Cast expr co) = Cast <$> doExpr env expr <*> pure co
+doExpr env (Tick t e) = Tick t <$> doExpr env e
+doExpr _env e@(Type _) = pure e
+doExpr _env e@(Coercion _) = pure e
+
+type M = State CostCentreState
+
+getCCIndex' :: FastString -> M CostCentreIndex
+getCCIndex' name = state (getCCIndex name)
+
+data Env = Env
+ { thisModule :: Module
+ , dflags :: DynFlags
+ , ccState :: CostCentreState
+ , revParents :: [Id]
+ , filters :: [CallerCcFilter]
+ }
+
+addParent :: Id -> Env -> Env
+addParent i env = env { revParents = i : revParents env }
+
+parents :: Env -> [Id]
+parents env = reverse (revParents env)
+
+needsCallSiteCostCentre :: Env -> Id -> Bool
+needsCallSiteCostCentre env i =
+ any matches (filters env)
+ where
+ matches :: CallerCcFilter -> Bool
+ matches ccf =
+ checkModule && checkFunc
+ where
+ checkModule =
+ case ccfModuleName ccf of
+ Just modFilt
+ | Just iMod <- nameModule_maybe (varName i)
+ -> moduleName iMod == modFilt
+ | otherwise -> False
+ Nothing -> True
+ checkFunc =
+ occNameMatches (ccfFuncName ccf) (getOccName i)
+
+data NamePattern
+ = PChar Char NamePattern
+ | PWildcard NamePattern
+ | PEnd
+
+instance Outputable NamePattern where
+ ppr (PChar c rest) = char c <> ppr rest
+ ppr (PWildcard rest) = char '*' <> ppr rest
+ ppr PEnd = Outputable.empty
+
+instance B.Binary NamePattern where
+ get bh = do
+ tag <- B.get bh
+ case tag :: Word8 of
+ 0 -> PChar <$> B.get bh <*> B.get bh
+ 1 -> PWildcard <$> B.get bh
+ 2 -> pure PEnd
+ _ -> panic "Binary(NamePattern): Invalid tag"
+ put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y
+ put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x
+ put_ bh PEnd = B.put_ bh (2 :: Word8)
+
+occNameMatches :: NamePattern -> OccName -> Bool
+occNameMatches pat = go pat . occNameString
+ where
+ go :: NamePattern -> String -> Bool
+ go PEnd "" = True
+ go (PChar c rest) (d:s)
+ = d == c && go rest s
+ go (PWildcard rest) s
+ = go rest s || go (PWildcard rest) (tail s)
+ go _ _ = False
+
+type Parser = P.Parsec String ()
+
+parseNamePattern :: Parser NamePattern
+parseNamePattern = star <|> wildcard <|> char <|> end
+ where
+ star = PChar "*" <$ P.string "\\*"
+ wildcard = do
+ void $ P.char '*'
+ PWildcard <$> parseNamePattern
+ char = PChar <$> P.anyChar <*> parseNamePattern
+ end = PEnd <$ P.eof
+
+data CallerCcFilter
+ = CallerCcFilter { ccfModuleName :: Maybe ModuleName
+ , ccfFuncName :: NamePattern
+ }
+
+instance Outputable CallerCcFilter where
+ ppr ccf =
+ maybe (char '*') ppr (ccfModuleName ccf)
+ <> char '.'
+ <> ppr (ccfFuncName ccf)
+
+instance B.Binary CallerCcFilter where
+ get bh = CallerCcFilter <$> B.get bh <*> B.get bh
+ put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y
+
+parseCallerCcFilter :: String -> Either String CallerCcFilter
+parseCallerCcFilter =
+ first show . P.parse parseCallerCcFilter' "caller-CC filter"
+
+parseCallerCcFilter' :: Parser CallerCcFilter
+parseCallerCcFilter' =
+ CallerCcFilter
+ <$> moduleFilter
+ <* P.char '.'
+ <*> parseNamePattern
+ where
+ moduleFilter :: Parser (Maybe ModuleName)
+ moduleFilter =
+ (Just . mkModuleName <$> moduleName)
+ <|>
+ (Nothing <$ P.char '*')
+
+ moduleName :: Parser String
+ moduleName = do
+ c <- P.upper
+ cs <- some $ P.upper <|> P.lower <|> P.digit <|> P.oneOf "_"
+ rest <- optional $ P.try $ P.char '.' >> fmap ('.':) moduleName
+ return $ c : (cs ++ fromMaybe "" rest)
+
=====================================
compiler/GHC/Core/Opt/CallerCC.hs-boot
=====================================
@@ -0,0 +1,8 @@
+module GHC.Core.Opt.CallerCC where
+
+import GHC.Prelude
+
+-- Necessary due to import in GHC.Driver.Session.
+data CallerCcFilter
+
+parseCallerCcFilter :: String -> Either String CallerCcFilter
=====================================
compiler/GHC/Core/Opt/Monad.hs
=====================================
@@ -129,6 +129,7 @@ data CoreToDo -- These are diff core-to-core passes,
| CoreTidy
| CorePrep
+ | CoreAddCallerCcs
| CoreOccurAnal
instance Outputable CoreToDo where
@@ -149,6 +150,7 @@ instance Outputable CoreToDo where
ppr CoreDesugar = text "Desugar (before optimization)"
ppr CoreDesugarOpt = text "Desugar (after optimization)"
ppr CoreTidy = text "Tidy Core"
+ ppr CoreAddCallerCcs = text "Add caller cost-centres"
ppr CorePrep = text "CorePrep"
ppr CoreOccurAnal = text "Occurrence analysis"
ppr CoreDoPrintCore = text "Print core"
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -44,6 +44,7 @@ import GHC.Core.Opt.CprAnal ( cprAnalProgram )
import GHC.Core.Opt.CallArity ( callArityAnalProgram )
import GHC.Core.Opt.Exitify ( exitifyProgram )
import GHC.Core.Opt.WorkWrap ( wwTopBinds )
+import GHC.Core.Opt.CallerCC ( addCallerCostCentres )
import GHC.Core.Seq (seqBinds)
import GHC.Core.FamInstEnv
@@ -156,6 +157,7 @@ getCoreToDo dflags
pre_inline_on = gopt Opt_SimplPreInlining dflags
ww_on = gopt Opt_WorkerWrapper dflags
static_ptrs = xopt LangExt.StaticPointers dflags
+ profiling = gopt Opt_ProfCallerCcs dflags
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
@@ -222,12 +224,16 @@ getCoreToDo dflags
}
]
+ add_caller_ccs =
+ runWhen (profiling && not (null $ callerCcFilters dflags)) CoreAddCallerCcs
+
core_todo =
if opt_level == 0 then
[ static_ptrs_float_outwards,
CoreDoSimplify max_iter
(base_mode { sm_phase = FinalPhase
, sm_names = ["Non-opt simplification"] })
+ , add_caller_ccs
]
else {- opt_level >= 1 -} [
@@ -371,7 +377,9 @@ getCoreToDo dflags
-- can become /exponentially/ more expensive. See #11731, #12996.
runWhen (strictness || late_dmd_anal) CoreDoDemand,
- maybe_rule_check FinalPhase
+ maybe_rule_check FinalPhase,
+
+ add_caller_ccs
]
-- Remove 'CoreDoNothing' and flatten 'CoreDoPasses' for clarity.
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -216,6 +216,7 @@ data GeneralFlag
-- profiling opts
| Opt_AutoSccsOnIndividualCafs
| Opt_ProfCountEntries
+ | Opt_ProfCallerCcs
-- misc opts
| Opt_Pp
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -263,6 +263,7 @@ import GHC.Utils.Fingerprint
import GHC.Utils.Outputable
import GHC.Settings
import GHC.CmmToAsm.CFG.Weight
+import {-# SOURCE #-} GHC.Core.Opt.CallerCC
import GHC.Types.Error
import {-# SOURCE #-} GHC.Utils.Error
@@ -700,6 +701,7 @@ data DynFlags = DynFlags {
-- | what kind of {-# SCC #-} to add automatically
profAuto :: ProfAuto,
+ callerCcFilters :: [CallerCcFilter],
interactivePrint :: Maybe String,
@@ -1314,6 +1316,7 @@ defaultDynFlags mySettings llvmConfig =
canUseColor = False,
colScheme = Col.defaultScheme,
profAuto = NoProfAuto,
+ callerCcFilters = [],
interactivePrint = Nothing,
nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
sseVersion = Nothing,
@@ -2948,6 +2951,10 @@ dynamic_flags_deps = [
, make_ord_flag defGhcFlag "fno-prof-auto"
(noArg (\d -> d { profAuto = NoProfAuto } ))
+ -- Caller-CC
+ , make_ord_flag defGhcFlag "fprof-callers"
+ (HasArg setCallerCcFilters)
+
------ Compiler flags -----------------------------------------------
, make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend NCG))
@@ -3468,6 +3475,7 @@ fFlagsDeps = [
flagSpec "print-typechecker-elaboration" Opt_PrintTypecheckerElaboration,
flagSpec "prof-cafs" Opt_AutoSccsOnIndividualCafs,
flagSpec "prof-count-entries" Opt_ProfCountEntries,
+ flagSpec "prof-callers" Opt_ProfCallerCcs,
flagSpec "regs-graph" Opt_RegsGraph,
flagSpec "regs-iterative" Opt_RegsIterative,
depFlagSpec' "rewrite-rules" Opt_EnableRewriteRules
@@ -3787,6 +3795,7 @@ defaultFlags settings
Opt_OmitYields,
Opt_PrintBindContents,
Opt_ProfCountEntries,
+ Opt_ProfCallerCcs,
Opt_SharedImplib,
Opt_SimplPreInlining,
Opt_VersionMacros
@@ -4542,6 +4551,12 @@ checkOptLevel n dflags
| otherwise
= Right dflags
+setCallerCcFilters :: String -> DynP ()
+setCallerCcFilters arg =
+ case parseCallerCcFilter arg of
+ Right filt -> upd $ \d -> d { callerCcFilters = filt : callerCcFilters d }
+ Left err -> addErr err
+
setMainIs :: String -> DynP ()
setMainIs arg
| not (null main_fn) && isLower (head main_fn)
=====================================
compiler/GHC/Iface/Recomp/Flags.hs
=====================================
@@ -17,7 +17,7 @@ import GHC.Types.Name
import GHC.Types.SafeHaskell
import GHC.Utils.Fingerprint
import GHC.Iface.Recomp.Binary
--- import GHC.Utils.Outputable
+import GHC.Core.Opt.CallerCC () -- for Binary instances
import GHC.Data.EnumSet as EnumSet
import System.FilePath (normalise)
@@ -61,7 +61,7 @@ fingerprintDynFlags dflags at DynFlags{..} this_mod nameio =
ticky =
map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk]
- flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel))
+ flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters))
in -- pprTrace "flags" (ppr flags) $
computeFingerprint nameio flags
=====================================
compiler/ghc.cabal.in
=====================================
@@ -71,6 +71,7 @@ Library
hpc == 0.6.*,
transformers == 0.5.*,
exceptions == 0.10.*,
+ parsec,
ghc-boot == @ProjectVersionMunged@,
ghc-heap == @ProjectVersionMunged@,
ghci == @ProjectVersionMunged@
@@ -301,6 +302,7 @@ Library
GHC.Core.Multiplicity
GHC.Core.Opt.Arity
GHC.Core.Opt.CallArity
+ GHC.Core.Opt.CallerCC
GHC.Core.Opt.ConstantFold
GHC.Core.Opt.CprAnal
GHC.Core.Opt.CSE
=====================================
docs/users_guide/9.2.1-notes.rst
=====================================
@@ -40,6 +40,10 @@ Compiler
- GHCi's ``:kind!`` command now expands through type synonyms in addition to type
families. See :ghci-cmd:`:kind`.
+- GHC now supports a flag, :ghc-flag:`-prof-callers=<name>`, for requesting
+ that the compiler automatically insert cost-centres on all call-sites of
+ the named function.
+
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/profiling.rst
=====================================
@@ -332,19 +332,68 @@ Compiler options for profiling
Without a :ghc-flag:`-prof` option, your ``SCC``\ s are ignored; so you can
compile ``SCC``-laden code without changing it.
+.. ghc-flag:: -fno-prof-count-entries
+ :shortdesc: Do not collect entry counts
+ :type: dynamic
+ :reverse: -fprof-count-entries
+ :category:
+
+ Tells GHC not to collect information about how often functions are
+ entered at runtime (the "entries" column of the time profile), for
+ this module. This tends to make the profiled code run faster, and
+ hence closer to the speed of the unprofiled code, because GHC is
+ able to optimise more aggressively if it doesn't have to maintain
+ correct entry counts. This option can be useful if you aren't
+ interested in the entry counts (for example, if you only intend to
+ do heap profiling).
+
+
There are a few other profiling-related compilation options. Use them
*in addition to* :ghc-flag:`-prof`. These do not have to be used consistently
for all modules in a program.
+Automatically placing cost-centres
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+GHC has a number of flags for automatically inserting cost-centres into the
+compiled program.
+
+.. ghc-flag:: -fprof-callers=⟨name⟩
+ :shortdesc: Auto-add ``SCC``\\ s to all call-sites of the named function.
+ :type: dynamic
+ :category:
+
+ Automatically enclose all occurrences of the named function in an ``SCC``.
+ In addition to plain module-qualified names (e.g. ``Data.List.map``),
+ ⟨name⟩ also accepts a small globbing language using ``*`` as a wildcard
+ symbol:
+
+ .. code-block::
+
+ pattern := <module> '.' <identifier>
+ module := '*'
+ | <Haskell module name>
+ identifier := <ident_char>
+ ident
+
+ For instance, the following are all valid patterns:
+
+ * ``Data.List.map``
+ * ``*.map``
+ * ``*.parse*``
+ * ``*.<\\*>``
+
+ The ``*`` character can be used literally by escaping (e.g. ``\\*``).
+
.. ghc-flag:: -fprof-auto
:shortdesc: Auto-add ``SCC``\\ s to all bindings not marked INLINE
:type: dynamic
:reverse: -fno-prof-auto
:category:
- *All* bindings not marked INLINE, whether exported or not, top level
- or nested, will be given automatic ``SCC`` annotations. Functions
- marked INLINE must be given a cost centre manually.
+ *All* bindings not marked :pragma:`INLINE`, whether exported or not, top
+ level or nested, will be given automatic ``SCC`` annotations. Functions
+ marked :pragma:`INLINE` must be given a cost centre manually.
.. ghc-flag:: -fprof-auto-top
:shortdesc: Auto-add ``SCC``\\ s to all top-level bindings not marked INLINE
@@ -356,11 +405,11 @@ for all modules in a program.
single: cost centres; automatically inserting
GHC will automatically add ``SCC`` annotations for all top-level
- bindings not marked INLINE. If you want a cost centre on an INLINE
- function, you have to add it manually.
+ bindings not marked :pragma:`INLINE`. If you want a cost centre on an
+ :pragma:`INLINE` function, you have to add it manually.
.. ghc-flag:: -fprof-auto-exported
- :shortdesc: Auto-add ``SCC``\\ s to all exported bindings not marked INLINE
+ :shortdesc: Auto-add ``SCC``\\ s to all exported bindings not marked :pragma:`INLINE`
:type: dynamic
:reverse: -fno-prof-auto
:category:
@@ -369,8 +418,8 @@ for all modules in a program.
single: cost centres; automatically inserting
GHC will automatically add ``SCC`` annotations for all exported
- functions not marked INLINE. If you want a cost centre on an INLINE
- function, you have to add it manually.
+ functions not marked :pragma:`INLINE`. If you want a cost centre on an
+ :pragma:`INLINE` function, you have to add it manually.
.. ghc-flag:: -fprof-auto-calls
:shortdesc: Auto-add ``SCC``\\ s to all call sites
@@ -392,41 +441,7 @@ for all modules in a program.
The costs of all CAFs in a module are usually attributed to one
"big" CAF cost-centre. With this option, all CAFs get their own
- cost-centre. An “if all else fails” option…
-
-.. ghc-flag:: -fno-prof-auto
- :shortdesc: Disables any previous :ghc-flag:`-fprof-auto`,
- :ghc-flag:`-fprof-auto-top`, or :ghc-flag:`-fprof-auto-exported` options.
- :type: dynamic
- :reverse: -fprof-auto
- :category:
-
- Disables any previous :ghc-flag:`-fprof-auto`, :ghc-flag:`-fprof-auto-top`, or
- :ghc-flag:`-fprof-auto-exported` options.
-
-.. ghc-flag:: -fno-prof-cafs
- :shortdesc: Disables any previous :ghc-flag:`-fprof-cafs` option.
- :type: dynamic
- :reverse: -fprof-cafs
- :category:
-
- Disables any previous :ghc-flag:`-fprof-cafs` option.
-
-.. ghc-flag:: -fno-prof-count-entries
- :shortdesc: Do not collect entry counts
- :type: dynamic
- :reverse: -fprof-count-entries
- :category:
-
- Tells GHC not to collect information about how often functions are
- entered at runtime (the "entries" column of the time profile), for
- this module. This tends to make the profiled code run faster, and
- hence closer to the speed of the unprofiled code, because GHC is
- able to optimise more aggressively if it doesn't have to maintain
- correct entry counts. This option can be useful if you aren't
- interested in the entry counts (for example, if you only intend to
- do heap profiling).
-
+ cost-centre. An "if all else fails" option…
.. ghc-flag:: -auto-all
:shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-auto`
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fca2cb54f882608a45247b1cf5e1d55e874e0390...44927a552865a7d5ebeb1d572dad3336b557ae44
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fca2cb54f882608a45247b1cf5e1d55e874e0390...44927a552865a7d5ebeb1d572dad3336b557ae44
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/20201111/18775409/attachment-0001.html>
More information about the ghc-commits
mailing list