[Git][ghc/ghc][wip/T18566] 2 commits: testsuite: Refactor CountParserDeps
Ben Gamari
gitlab at gitlab.haskell.org
Thu Nov 12 21:23:53 UTC 2020
Ben Gamari pushed to branch wip/T18566 at Glasgow Haskell Compiler / GHC
Commits:
132cffce by Ben Gamari at 2020-11-12T15:28:52-05:00
testsuite: Refactor CountParserDeps
- - - - -
74491199 by Ben Gamari at 2020-11-12T15:28:52-05:00
Introduce -fprof-callers flag
This introducing a new compiler flag to provide a convenient way to
introduce profiler cost-centers on all occurrences of the named
identifier.
Closes #18566.
- - - - -
20 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/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
- testsuite/tests/parser/should_run/CountParserDeps.hs
- + testsuite/tests/parser/should_run/CountParserDeps.stdout
- + testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample
- + testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout
- + testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample
- + testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout
- + testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample
- + testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout
- + testsuite/tests/profiling/should_run/caller-cc/Main.hs
- + testsuite/tests/profiling/should_run/caller-cc/all.T
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,223 @@
+{-# 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 = withUserStyle alwaysQualify DefaultDepth $
+ 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 = pattern
+ where
+ pattern = star <|> wildcard <|> char <|> end
+ star = PChar '*' <$ P.string "\\*" <*> pattern
+ wildcard = do
+ void $ P.char '*'
+ PWildcard <$> pattern
+ char = PChar <$> P.anyChar <*> pattern
+ 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
=====================================
@@ -16,6 +16,7 @@ import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
import GHC.Driver.Env
+import GHC.Platform.Ways ( hasWay, Way(WayProf) )
import GHC.Core
import GHC.Core.Opt.CSE ( cseProgram )
@@ -44,6 +45,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 +158,7 @@ getCoreToDo dflags
pre_inline_on = gopt Opt_SimplPreInlining dflags
ww_on = gopt Opt_WorkerWrapper dflags
static_ptrs = xopt LangExt.StaticPointers dflags
+ profiling = ways dflags `hasWay` WayProf
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
@@ -222,12 +225,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 +378,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.
@@ -510,6 +519,9 @@ doCorePass CoreDoSpecialising = {-# SCC "Specialise" #-}
doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-}
specConstrProgram
+doCorePass CoreAddCallerCcs = {-# SCC "AddCallerCcs" #-}
+ addCallerCostCentres
+
doCorePass CoreDoPrintCore = observe printCore
doCorePass (CoreDoRuleCheck phase pat) = ruleCheckPass phase pat
doCorePass CoreDoNothing = return
=====================================
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
@@ -699,6 +700,7 @@ data DynFlags = DynFlags {
-- | what kind of {-# SCC #-} to add automatically
profAuto :: ProfAuto,
+ callerCcFilters :: [CallerCcFilter],
interactivePrint :: Maybe String,
@@ -1313,6 +1315,7 @@ defaultDynFlags mySettings llvmConfig =
canUseColor = False,
colScheme = Col.defaultScheme,
profAuto = NoProfAuto,
+ callerCcFilters = [],
interactivePrint = Nothing,
nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
sseVersion = Nothing,
@@ -2947,6 +2950,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))
@@ -4548,6 +4555,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:`-fprof-callers=⟨name⟩`, for requesting
+ that the compiler automatically insert cost-centres on all call-sites of
+ the named function.
+
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
@@ -47,7 +51,7 @@ Compiler
Code using ``Void#`` now has to enable :extension:`UnboxedTuples`.
``ghc`` library
-~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~
- The ``con_args`` field of ``ConDeclGADT`` has been renamed to ``con_g_args``.
This is because the type of ``con_g_args`` is now different from the type of
=====================================
docs/users_guide/profiling.rst
=====================================
@@ -358,6 +358,38 @@ 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``.
+ Note that these cost-centres are added late in compilation (after
+ simplification) and consequently the names may be slightly different than
+ they appear in the source program (e.g. a call to ``f`` may inlined with
+ its wrapper, resulting in an occurrence of its worker, ``$wf``).
+
+ 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:: none
+
+ 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
=====================================
testsuite/tests/parser/should_run/CountParserDeps.hs
=====================================
@@ -29,12 +29,8 @@ main = do
[libdir] <- getArgs
modules <- parserDeps libdir
let num = sizeUniqSet modules
- max_num = 234
- min_num = max_num - 10 -- so that we don't forget to change the number
- -- when the number of dependencies decreases
- -- putStrLn $ "Found " ++ show num ++ " parser module dependencies"
- -- forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn
- unless (num <= max_num && num >= min_num) $ exitWith (ExitFailure num)
+ putStrLn $ "Found " ++ show num ++ " parser module dependencies"
+ forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn
parserDeps :: FilePath -> IO (UniqSet ModuleName)
parserDeps libdir =
=====================================
testsuite/tests/parser/should_run/CountParserDeps.stdout
=====================================
@@ -0,0 +1,236 @@
+Found 235 parser module dependencies
+GHC.Builtin.Names
+GHC.Builtin.PrimOps
+GHC.Builtin.Types
+GHC.Builtin.Types.Prim
+GHC.Builtin.Uniques
+GHC.ByteCode.Types
+GHC.Cmm
+GHC.Cmm.BlockId
+GHC.Cmm.CLabel
+GHC.Cmm.Dataflow.Block
+GHC.Cmm.Dataflow.Collections
+GHC.Cmm.Dataflow.Graph
+GHC.Cmm.Dataflow.Label
+GHC.Cmm.Expr
+GHC.Cmm.MachOp
+GHC.Cmm.Node
+GHC.Cmm.Switch
+GHC.Cmm.Type
+GHC.CmmToAsm.CFG.Weight
+GHC.CmmToAsm.Config
+GHC.Core
+GHC.Core.Class
+GHC.Core.Coercion
+GHC.Core.Coercion.Axiom
+GHC.Core.Coercion.Opt
+GHC.Core.ConLike
+GHC.Core.DataCon
+GHC.Core.FVs
+GHC.Core.FamInstEnv
+GHC.Core.InstEnv
+GHC.Core.Lint
+GHC.Core.Make
+GHC.Core.Map
+GHC.Core.Multiplicity
+GHC.Core.Opt.Arity
+GHC.Core.Opt.CallerCC
+GHC.Core.Opt.ConstantFold
+GHC.Core.Opt.Monad
+GHC.Core.Opt.OccurAnal
+GHC.Core.PatSyn
+GHC.Core.Ppr
+GHC.Core.Predicate
+GHC.Core.Seq
+GHC.Core.SimpleOpt
+GHC.Core.Stats
+GHC.Core.Subst
+GHC.Core.TyCo.FVs
+GHC.Core.TyCo.Ppr
+GHC.Core.TyCo.Rep
+GHC.Core.TyCo.Subst
+GHC.Core.TyCo.Tidy
+GHC.Core.TyCon
+GHC.Core.TyCon.Env
+GHC.Core.TyCon.RecWalk
+GHC.Core.Type
+GHC.Core.Unfold
+GHC.Core.Unfold.Make
+GHC.Core.Unify
+GHC.Core.UsageEnv
+GHC.Core.Utils
+GHC.CoreToIface
+GHC.Data.Bag
+GHC.Data.BooleanFormula
+GHC.Data.EnumSet
+GHC.Data.FastMutInt
+GHC.Data.FastString
+GHC.Data.FastString.Env
+GHC.Data.FiniteMap
+GHC.Data.Graph.Directed
+GHC.Data.IOEnv
+GHC.Data.List.SetOps
+GHC.Data.Maybe
+GHC.Data.OrdList
+GHC.Data.Pair
+GHC.Data.Stream
+GHC.Data.StringBuffer
+GHC.Data.TrieMap
+GHC.Driver.Backend
+GHC.Driver.Backpack.Syntax
+GHC.Driver.CmdLine
+GHC.Driver.Env
+GHC.Driver.Flags
+GHC.Driver.Hooks
+GHC.Driver.Monad
+GHC.Driver.Phases
+GHC.Driver.Pipeline.Monad
+GHC.Driver.Plugins
+GHC.Driver.Ppr
+GHC.Driver.Session
+GHC.Hs
+GHC.Hs.Binds
+GHC.Hs.Decls
+GHC.Hs.Doc
+GHC.Hs.Expr
+GHC.Hs.Extension
+GHC.Hs.ImpExp
+GHC.Hs.Instances
+GHC.Hs.Lit
+GHC.Hs.Pat
+GHC.Hs.Type
+GHC.Hs.Utils
+GHC.Iface.Ext.Fields
+GHC.Iface.Recomp.Binary
+GHC.Iface.Syntax
+GHC.Iface.Type
+GHC.Linker.Types
+GHC.Parser
+GHC.Parser.Annotation
+GHC.Parser.CharClass
+GHC.Parser.Errors
+GHC.Parser.Lexer
+GHC.Parser.PostProcess
+GHC.Parser.PostProcess.Haddock
+GHC.Parser.Types
+GHC.Platform
+GHC.Platform.ARM
+GHC.Platform.ARM64
+GHC.Platform.Constants
+GHC.Platform.NoRegs
+GHC.Platform.PPC
+GHC.Platform.Profile
+GHC.Platform.Reg
+GHC.Platform.Reg.Class
+GHC.Platform.Regs
+GHC.Platform.S390X
+GHC.Platform.SPARC
+GHC.Platform.Ways
+GHC.Platform.X86
+GHC.Platform.X86_64
+GHC.Prelude
+GHC.Runtime.Context
+GHC.Runtime.Eval.Types
+GHC.Runtime.Heap.Layout
+GHC.Runtime.Interpreter.Types
+GHC.Settings
+GHC.Settings.Config
+GHC.Settings.Constants
+GHC.Stg.Syntax
+GHC.StgToCmm.Types
+GHC.SysTools.BaseDir
+GHC.SysTools.FileCleanup
+GHC.SysTools.Terminal
+GHC.Tc.Errors.Hole.FitTypes
+GHC.Tc.Types
+GHC.Tc.Types.Constraint
+GHC.Tc.Types.Evidence
+GHC.Tc.Types.Origin
+GHC.Tc.Utils.TcType
+GHC.Types.Annotations
+GHC.Types.Avail
+GHC.Types.Basic
+GHC.Types.CompleteMatch
+GHC.Types.CostCentre
+GHC.Types.CostCentre.State
+GHC.Types.Cpr
+GHC.Types.Demand
+GHC.Types.Error
+GHC.Types.FieldLabel
+GHC.Types.Fixity
+GHC.Types.Fixity.Env
+GHC.Types.ForeignCall
+GHC.Types.ForeignStubs
+GHC.Types.HpcInfo
+GHC.Types.Id
+GHC.Types.Id.Info
+GHC.Types.Id.Make
+GHC.Types.Literal
+GHC.Types.Meta
+GHC.Types.Name
+GHC.Types.Name.Cache
+GHC.Types.Name.Env
+GHC.Types.Name.Occurrence
+GHC.Types.Name.Ppr
+GHC.Types.Name.Reader
+GHC.Types.Name.Set
+GHC.Types.RepType
+GHC.Types.SafeHaskell
+GHC.Types.SourceError
+GHC.Types.SourceFile
+GHC.Types.SourceText
+GHC.Types.SrcLoc
+GHC.Types.Target
+GHC.Types.TyThing
+GHC.Types.TypeEnv
+GHC.Types.Unique
+GHC.Types.Unique.DFM
+GHC.Types.Unique.DSet
+GHC.Types.Unique.FM
+GHC.Types.Unique.Set
+GHC.Types.Unique.Supply
+GHC.Types.Var
+GHC.Types.Var.Env
+GHC.Types.Var.Set
+GHC.Unit
+GHC.Unit.External
+GHC.Unit.Finder.Types
+GHC.Unit.Home
+GHC.Unit.Home.ModInfo
+GHC.Unit.Info
+GHC.Unit.Module
+GHC.Unit.Module.Deps
+GHC.Unit.Module.Env
+GHC.Unit.Module.Graph
+GHC.Unit.Module.Imported
+GHC.Unit.Module.Location
+GHC.Unit.Module.ModDetails
+GHC.Unit.Module.ModGuts
+GHC.Unit.Module.ModIface
+GHC.Unit.Module.ModSummary
+GHC.Unit.Module.Name
+GHC.Unit.Module.Status
+GHC.Unit.Module.Warnings
+GHC.Unit.Parser
+GHC.Unit.Ppr
+GHC.Unit.State
+GHC.Unit.Types
+GHC.Utils.Binary
+GHC.Utils.Binary.Typeable
+GHC.Utils.BufHandle
+GHC.Utils.CliOption
+GHC.Utils.Error
+GHC.Utils.Exception
+GHC.Utils.FV
+GHC.Utils.Fingerprint
+GHC.Utils.GlobalVars
+GHC.Utils.IO.Unsafe
+GHC.Utils.Json
+GHC.Utils.Lexeme
+GHC.Utils.Misc
+GHC.Utils.Monad
+GHC.Utils.Outputable
+GHC.Utils.Panic
+GHC.Utils.Panic.Plain
+GHC.Utils.Ppr
+GHC.Utils.Ppr.Colour
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample
=====================================
@@ -0,0 +1,79 @@
+ Wed Nov 11 23:04 2020 Time and Allocation Profiling Report (Final)
+
+ CallerCc1 +RTS -hc -p -RTS 7
+
+ total time = 0.06 secs (58 ticks @ 1000 us, 1 processor)
+ total alloc = 105,486,200 bytes (excludes profiling overheads)
+
+COST CENTRE MODULE SRC %time %alloc
+
+clause.clause' Main Main.hs:(63,12)-(65,57) 29.3 37.5
+insert Main Main.hs:(108,1)-(112,8) 27.6 1.7
+disin Main Main.hs:(74,1)-(83,11) 22.4 49.5
+disin.dp Main Main.hs:80:3-14 5.2 0.0
+conjunct Main Main.hs:(70,1)-(71,18) 5.2 0.0
+unicl Main Main.hs:(176,1)-(180,36) 3.4 1.1
+tautclause Main Main.hs:173:1-49 3.4 3.7
+disin.dq Main Main.hs:81:3-14 3.4 0.0
+unicl.unicl' Main Main.hs:(178,11)-(180,36) 0.0 2.6
+split.split' Main Main.hs:(165,11)-(166,28) 0.0 2.3
+clause Main Main.hs:(61,1)-(65,57) 0.0 1.4
+
+
+ individual inherited
+COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
+
+MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0
+ CAF Main <entire-module> 255 0 0.0 0.0 0.0 0.0
+ clauses Main Main.hs:68:1-74 261 1 0.0 0.0 0.0 0.0
+ Main.clauses(calling Data.Foldable.concat) Main Main.hs:68:1-7 263 1 0.0 0.0 0.0 0.0
+ main Main Main.hs:(42,1)-(44,23) 256 1 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 279 1 0.0 0.0 0.0 0.0
+ spaces Main Main.hs:160:1-19 303 1 0.0 0.0 0.0 0.0
+ CAF GHC.Conc.Signal <entire-module> 246 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Encoding <entire-module> 235 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Encoding.Iconv <entire-module> 233 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Handle.FD <entire-module> 225 0 0.0 0.0 0.0 0.0
+ main Main Main.hs:(42,1)-(44,23) 257 0 0.0 0.0 100.0 100.0
+ res Main Main.hs:(46,1)-(48,26) 258 1 0.0 0.0 100.0 99.9
+ Main.main(calling Data.Foldable.concat) Main Main.hs:42:1-4 259 1 0.0 0.0 0.0 0.0
+ res.xs Main Main.hs:47:8-69 260 1 0.0 0.0 0.0 0.0
+ clauses Main Main.hs:68:1-74 262 0 0.0 0.0 100.0 99.9
+ disin Main Main.hs:(74,1)-(83,11) 267 857598 22.4 49.5 36.2 49.5
+ conjunct Main Main.hs:(70,1)-(71,18) 291 759353 5.2 0.0 5.2 0.0
+ disin.dp Main Main.hs:80:3-14 292 380009 5.2 0.0 5.2 0.0
+ disin.dq Main Main.hs:81:3-14 293 380009 3.4 0.0 3.4 0.0
+ negin Main Main.hs:(119,1)-(124,11) 268 1617 0.0 0.1 0.0 0.1
+ elim Main Main.hs:(89,1)-(94,57) 269 1393 0.0 0.1 0.0 0.1
+ disp Main Main.hs:86:1-71 301 7 0.0 0.0 0.0 0.0
+ interleave Main Main.hs:(115,1)-(116,25) 302 35 0.0 0.0 0.0 0.0
+ parse Main Main.hs:135:1-39 270 7 0.0 0.0 0.0 0.0
+ parse.(...) Main Main.hs:135:19-39 272 7 0.0 0.0 0.0 0.0
+ parse' Main Main.hs:(137,1)-(145,42) 273 280 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 276 56 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 274 56 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 275 49 0.0 0.0 0.0 0.0
+ parse'.(...) Main Main.hs:142:20-49 278 21 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 280 0 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 282 63 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 283 63 0.0 0.0 0.0 0.0
+ while Main Main.hs:182:1-48 281 63 0.0 0.0 0.0 0.0
+ red Main Main.hs:(148,1)-(152,43) 284 42 0.0 0.0 0.0 0.0
+ parse'.s' Main Main.hs:142:20-49 285 21 0.0 0.0 0.0 0.0
+ parse'.x Main Main.hs:142:20-49 277 21 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 286 0 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 288 21 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 289 14 0.0 0.0 0.0 0.0
+ while Main Main.hs:182:1-48 287 21 0.0 0.0 0.0 0.0
+ red Main Main.hs:(148,1)-(152,43) 290 14 0.0 0.0 0.0 0.0
+ parse.f Main Main.hs:135:19-39 271 7 0.0 0.0 0.0 0.0
+ split Main Main.hs:(163,1)-(166,28) 265 7 0.0 0.0 0.0 2.3
+ split.split' Main Main.hs:(165,11)-(166,28) 266 74837 0.0 2.3 0.0 2.3
+ unicl Main Main.hs:(176,1)-(180,36) 264 7 3.4 1.1 63.8 48.0
+ unicl.unicl' Main Main.hs:(178,11)-(180,36) 294 37422 0.0 2.6 60.3 46.9
+ tautclause Main Main.hs:173:1-49 295 37422 3.4 3.7 3.4 3.7
+ unicl.unicl'.cp Main Main.hs:180:24-36 296 37422 0.0 0.0 56.9 40.6
+ clause Main Main.hs:(61,1)-(65,57) 297 37422 0.0 1.4 56.9 40.6
+ clause.clause' Main Main.hs:(63,12)-(65,57) 298 696150 29.3 37.5 56.9 39.2
+ insert Main Main.hs:(108,1)-(112,8) 299 366786 27.6 1.7 27.6 1.7
+ insert Main Main.hs:(108,1)-(112,8) 300 7 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout
=====================================
@@ -0,0 +1,7 @@
+a <=
+a <=
+a <=
+a <=
+a <=
+a <=
+a <=
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample
=====================================
@@ -0,0 +1,78 @@
+ Wed Nov 11 23:04 2020 Time and Allocation Profiling Report (Final)
+
+ CallerCc2 +RTS -hc -p -RTS 7
+
+ total time = 0.06 secs (59 ticks @ 1000 us, 1 processor)
+ total alloc = 105,486,200 bytes (excludes profiling overheads)
+
+COST CENTRE MODULE SRC %time %alloc
+
+disin Main Main.hs:(74,1)-(83,11) 32.2 49.5
+insert Main Main.hs:(108,1)-(112,8) 27.1 1.7
+clause.clause' Main Main.hs:(63,12)-(65,57) 25.4 37.5
+tautclause Main Main.hs:173:1-49 3.4 3.7
+split.split' Main Main.hs:(165,11)-(166,28) 3.4 2.3
+disin.dq Main Main.hs:81:3-14 3.4 0.0
+conjunct Main Main.hs:(70,1)-(71,18) 3.4 0.0
+clause Main Main.hs:(61,1)-(65,57) 1.7 1.4
+unicl.unicl' Main Main.hs:(178,11)-(180,36) 0.0 2.6
+unicl Main Main.hs:(176,1)-(180,36) 0.0 1.1
+
+
+ individual inherited
+COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
+
+MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0
+ CAF Main <entire-module> 255 0 0.0 0.0 0.0 0.0
+ clauses Main Main.hs:68:1-74 261 1 0.0 0.0 0.0 0.0
+ Main.clauses(calling Data.Foldable.concat) Main Main.hs:68:1-7 263 1 0.0 0.0 0.0 0.0
+ main Main Main.hs:(42,1)-(44,23) 256 1 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 279 1 0.0 0.0 0.0 0.0
+ spaces Main Main.hs:160:1-19 303 1 0.0 0.0 0.0 0.0
+ CAF GHC.Conc.Signal <entire-module> 246 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Encoding <entire-module> 235 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Encoding.Iconv <entire-module> 233 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Handle.FD <entire-module> 225 0 0.0 0.0 0.0 0.0
+ main Main Main.hs:(42,1)-(44,23) 257 0 0.0 0.0 100.0 100.0
+ res Main Main.hs:(46,1)-(48,26) 258 1 0.0 0.0 100.0 99.9
+ Main.main(calling Data.Foldable.concat) Main Main.hs:42:1-4 259 1 0.0 0.0 0.0 0.0
+ res.xs Main Main.hs:47:8-69 260 1 0.0 0.0 0.0 0.0
+ clauses Main Main.hs:68:1-74 262 0 0.0 0.0 100.0 99.9
+ disin Main Main.hs:(74,1)-(83,11) 267 857598 32.2 49.5 39.0 49.5
+ conjunct Main Main.hs:(70,1)-(71,18) 291 759353 3.4 0.0 3.4 0.0
+ disin.dp Main Main.hs:80:3-14 292 380009 0.0 0.0 0.0 0.0
+ disin.dq Main Main.hs:81:3-14 293 380009 3.4 0.0 3.4 0.0
+ negin Main Main.hs:(119,1)-(124,11) 268 1617 0.0 0.1 0.0 0.1
+ elim Main Main.hs:(89,1)-(94,57) 269 1393 0.0 0.1 0.0 0.1
+ disp Main Main.hs:86:1-71 301 7 0.0 0.0 0.0 0.0
+ interleave Main Main.hs:(115,1)-(116,25) 302 35 0.0 0.0 0.0 0.0
+ parse Main Main.hs:135:1-39 270 7 0.0 0.0 0.0 0.0
+ parse.(...) Main Main.hs:135:19-39 272 7 0.0 0.0 0.0 0.0
+ parse' Main Main.hs:(137,1)-(145,42) 273 280 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 276 56 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 274 56 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 275 49 0.0 0.0 0.0 0.0
+ parse'.(...) Main Main.hs:142:20-49 278 21 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 280 0 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 282 63 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 283 63 0.0 0.0 0.0 0.0
+ while Main Main.hs:182:1-48 281 63 0.0 0.0 0.0 0.0
+ red Main Main.hs:(148,1)-(152,43) 284 42 0.0 0.0 0.0 0.0
+ parse'.s' Main Main.hs:142:20-49 285 21 0.0 0.0 0.0 0.0
+ parse'.x Main Main.hs:142:20-49 277 21 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 286 0 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 288 21 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 289 14 0.0 0.0 0.0 0.0
+ while Main Main.hs:182:1-48 287 21 0.0 0.0 0.0 0.0
+ red Main Main.hs:(148,1)-(152,43) 290 14 0.0 0.0 0.0 0.0
+ parse.f Main Main.hs:135:19-39 271 7 0.0 0.0 0.0 0.0
+ split Main Main.hs:(163,1)-(166,28) 265 7 0.0 0.0 3.4 2.3
+ split.split' Main Main.hs:(165,11)-(166,28) 266 74837 3.4 2.3 3.4 2.3
+ unicl Main Main.hs:(176,1)-(180,36) 264 7 0.0 1.1 57.6 48.0
+ unicl.unicl' Main Main.hs:(178,11)-(180,36) 294 37422 0.0 2.6 57.6 46.9
+ tautclause Main Main.hs:173:1-49 295 37422 3.4 3.7 3.4 3.7
+ unicl.unicl'.cp Main Main.hs:180:24-36 296 37422 0.0 0.0 54.2 40.6
+ clause Main Main.hs:(61,1)-(65,57) 297 37422 1.7 1.4 54.2 40.6
+ clause.clause' Main Main.hs:(63,12)-(65,57) 298 696150 25.4 37.5 52.5 39.2
+ insert Main Main.hs:(108,1)-(112,8) 299 366786 27.1 1.7 27.1 1.7
+ insert Main Main.hs:(108,1)-(112,8) 300 7 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout
=====================================
@@ -0,0 +1,7 @@
+a <=
+a <=
+a <=
+a <=
+a <=
+a <=
+a <=
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample
=====================================
@@ -0,0 +1,79 @@
+ Wed Nov 11 23:04 2020 Time and Allocation Profiling Report (Final)
+
+ CallerCc3 +RTS -hc -p -RTS 7
+
+ total time = 0.06 secs (55 ticks @ 1000 us, 1 processor)
+ total alloc = 105,486,200 bytes (excludes profiling overheads)
+
+COST CENTRE MODULE SRC %time %alloc
+
+disin Main Main.hs:(74,1)-(83,11) 27.3 49.5
+insert Main Main.hs:(108,1)-(112,8) 25.5 1.7
+clause.clause' Main Main.hs:(63,12)-(65,57) 18.2 37.5
+conjunct Main Main.hs:(70,1)-(71,18) 10.9 0.0
+tautclause Main Main.hs:173:1-49 9.1 3.7
+unicl.unicl'.cp Main Main.hs:180:24-36 1.8 0.0
+unicl.unicl' Main Main.hs:(178,11)-(180,36) 1.8 2.6
+unicl Main Main.hs:(176,1)-(180,36) 1.8 1.1
+split.split' Main Main.hs:(165,11)-(166,28) 1.8 2.3
+disin.dq Main Main.hs:81:3-14 1.8 0.0
+clause Main Main.hs:(61,1)-(65,57) 0.0 1.4
+
+
+ individual inherited
+COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
+
+MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0
+ CAF Main <entire-module> 255 0 0.0 0.0 0.0 0.0
+ clauses Main Main.hs:68:1-74 261 1 0.0 0.0 0.0 0.0
+ Main.clauses(calling Data.Foldable.concat) Main Main.hs:68:1-7 263 1 0.0 0.0 0.0 0.0
+ main Main Main.hs:(42,1)-(44,23) 256 1 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 279 1 0.0 0.0 0.0 0.0
+ spaces Main Main.hs:160:1-19 303 1 0.0 0.0 0.0 0.0
+ CAF GHC.Conc.Signal <entire-module> 246 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Encoding <entire-module> 235 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Encoding.Iconv <entire-module> 233 0 0.0 0.0 0.0 0.0
+ CAF GHC.IO.Handle.FD <entire-module> 225 0 0.0 0.0 0.0 0.0
+ main Main Main.hs:(42,1)-(44,23) 257 0 0.0 0.0 100.0 100.0
+ res Main Main.hs:(46,1)-(48,26) 258 1 0.0 0.0 100.0 99.9
+ Main.main(calling Data.Foldable.concat) Main Main.hs:42:1-4 259 1 0.0 0.0 0.0 0.0
+ res.xs Main Main.hs:47:8-69 260 1 0.0 0.0 0.0 0.0
+ clauses Main Main.hs:68:1-74 262 0 0.0 0.0 100.0 99.9
+ disin Main Main.hs:(74,1)-(83,11) 267 857598 27.3 49.5 40.0 49.5
+ conjunct Main Main.hs:(70,1)-(71,18) 291 759353 10.9 0.0 10.9 0.0
+ disin.dp Main Main.hs:80:3-14 292 380009 0.0 0.0 0.0 0.0
+ disin.dq Main Main.hs:81:3-14 293 380009 1.8 0.0 1.8 0.0
+ negin Main Main.hs:(119,1)-(124,11) 268 1617 0.0 0.1 0.0 0.1
+ elim Main Main.hs:(89,1)-(94,57) 269 1393 0.0 0.1 0.0 0.1
+ disp Main Main.hs:86:1-71 301 7 0.0 0.0 0.0 0.0
+ interleave Main Main.hs:(115,1)-(116,25) 302 35 0.0 0.0 0.0 0.0
+ parse Main Main.hs:135:1-39 270 7 0.0 0.0 0.0 0.0
+ parse.(...) Main Main.hs:135:19-39 272 7 0.0 0.0 0.0 0.0
+ parse' Main Main.hs:(137,1)-(145,42) 273 280 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 276 56 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 274 56 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 275 49 0.0 0.0 0.0 0.0
+ parse'.(...) Main Main.hs:142:20-49 278 21 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 280 0 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 282 63 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 283 63 0.0 0.0 0.0 0.0
+ while Main Main.hs:182:1-48 281 63 0.0 0.0 0.0 0.0
+ red Main Main.hs:(148,1)-(152,43) 284 42 0.0 0.0 0.0 0.0
+ parse'.s' Main Main.hs:142:20-49 285 21 0.0 0.0 0.0 0.0
+ parse'.x Main Main.hs:142:20-49 277 21 0.0 0.0 0.0 0.0
+ redstar Main Main.hs:155:1-35 286 0 0.0 0.0 0.0 0.0
+ spri Main Main.hs:(169,1)-(170,10) 288 21 0.0 0.0 0.0 0.0
+ opri Main Main.hs:(127,1)-(132,12) 289 14 0.0 0.0 0.0 0.0
+ while Main Main.hs:182:1-48 287 21 0.0 0.0 0.0 0.0
+ red Main Main.hs:(148,1)-(152,43) 290 14 0.0 0.0 0.0 0.0
+ parse.f Main Main.hs:135:19-39 271 7 0.0 0.0 0.0 0.0
+ split Main Main.hs:(163,1)-(166,28) 265 7 0.0 0.0 1.8 2.3
+ split.split' Main Main.hs:(165,11)-(166,28) 266 74837 1.8 2.3 1.8 2.3
+ unicl Main Main.hs:(176,1)-(180,36) 264 7 1.8 1.1 58.2 48.0
+ unicl.unicl' Main Main.hs:(178,11)-(180,36) 294 37422 1.8 2.6 56.4 46.9
+ tautclause Main Main.hs:173:1-49 295 37422 9.1 3.7 9.1 3.7
+ unicl.unicl'.cp Main Main.hs:180:24-36 296 37422 1.8 0.0 45.5 40.6
+ clause Main Main.hs:(61,1)-(65,57) 297 37422 0.0 1.4 43.6 40.6
+ clause.clause' Main Main.hs:(63,12)-(65,57) 298 696150 18.2 37.5 43.6 39.2
+ insert Main Main.hs:(108,1)-(112,8) 299 366786 25.5 1.7 25.5 1.7
+ insert Main Main.hs:(108,1)-(112,8) 300 7 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout
=====================================
@@ -0,0 +1,7 @@
+a <=
+a <=
+a <=
+a <=
+a <=
+a <=
+a <=
=====================================
testsuite/tests/profiling/should_run/caller-cc/Main.hs
=====================================
@@ -0,0 +1,182 @@
+{-
+From: dw at minster.york.ac.uk
+To: partain
+Subject: a compiler test
+Date: 3 Mar 1992 12:31:00 GMT
+
+Will,
+ One of the decisions taken at the FLARE meeting yesterday was that we
+(FLARE people) should send you (GRASP people) interesting Haskell programs
+to test your new compiler. So allow me to present the following program,
+written by Colin Runciman in various functional languages over the years,
+which puts propositions into clausal form. The original program was
+interactive, but I've made it batch so that you can run it over night.
+Here is an example run with the prototype compiler. Note the result is
+"a <=".
+
+ hc clausify.hs
+ Haskell-0.41 (EXPERIMENTAL)
+ Glasgow University Haskell Compiler, version 0.41
+ G-Code version
+ -71$ a.out
+ a <=
+ -71$
+
+Cheers,
+
+David
+-}
+
+------------------------------------------------------------------------------
+-- reducing propositions to clausal form
+-- Colin Runciman, University of York, 18/10/90
+
+-- an excellent benchmark is: (a = a = a) = (a = a = a) = (a = a = a)
+-- batch mode version David Wakeling, February 1992
+
+module Main(main) where
+
+import Data.Ix
+import System.Environment
+
+main = do
+ (n:_) <- getArgs
+ putStr (res (read n))
+
+res n = concat (map clauses xs)
+ where xs = take n (repeat "(a = a = a) = (a = a = a) = (a = a = a)")
+ {-# NOINLINE xs #-}
+
+data StackFrame = Ast Formula | Lex Char
+
+data Formula =
+ Sym Char |
+ Not Formula |
+ Dis Formula Formula |
+ Con Formula Formula |
+ Imp Formula Formula |
+ Eqv Formula Formula
+
+-- separate positive and negative literals, eliminating duplicates
+clause p = clause' p ([] , [])
+ where
+ clause' (Dis p q) x = clause' p (clause' q x)
+ clause' (Sym s) (c,a) = (insert s c , a)
+ clause' (Not (Sym s)) (c,a) = (c , insert s a)
+
+-- the main pipeline from propositional formulae to printed clauses
+clauses = concat . map disp . unicl . split . disin . negin . elim . parse
+
+conjunct (Con p q) = True
+conjunct p = False
+
+-- shift disjunction within conjunction
+disin (Dis p (Con q r)) = Con (disin (Dis p q)) (disin (Dis p r))
+disin (Dis (Con p q) r) = Con (disin (Dis p r)) (disin (Dis q r))
+disin (Dis p q) =
+ if conjunct dp || conjunct dq then disin (Dis dp dq)
+ else (Dis dp dq)
+ where
+ dp = disin p
+ dq = disin q
+disin (Con p q) = Con (disin p) (disin q)
+disin p = p
+
+-- format pair of lists of propositional symbols as clausal axiom
+disp (l,r) = interleave l spaces ++ "<=" ++ interleave spaces r ++ "\n"
+
+-- eliminate connectives other than not, disjunction and conjunction
+elim (Sym s) = Sym s
+elim (Not p) = Not (elim p)
+elim (Dis p q) = Dis (elim p) (elim q)
+elim (Con p q) = Con (elim p) (elim q)
+elim (Imp p q) = Dis (Not (elim p)) (elim q)
+elim (Eqv f f') = Con (elim (Imp f f')) (elim (Imp f' f))
+
+-- the priorities of propositional expressions
+{- UNUSED:
+fpri (Sym c) = 6
+fpri (Not p) = 5
+fpri (Con p q) = 4
+fpri (Dis p q) = 3
+fpri (Imp p q) = 2
+fpri (Eqv p q) = 1
+-}
+
+-- insertion of an item into an ordered list
+-- Note: this is a corrected version from Colin (94/05/03 WDP)
+insert x [] = [x]
+insert x p@(y:ys) =
+ if x < y then x : p
+ else if x > y then y : insert x ys
+ else p
+
+
+interleave (x:xs) ys = x : interleave ys xs
+interleave [] _ = []
+
+-- shift negation to innermost positions
+negin (Not (Not p)) = negin p
+negin (Not (Con p q)) = Dis (negin (Not p)) (negin (Not q))
+negin (Not (Dis p q)) = Con (negin (Not p)) (negin (Not q))
+negin (Dis p q) = Dis (negin p) (negin q)
+negin (Con p q) = Con (negin p) (negin q)
+negin p = p
+
+-- the priorities of symbols during parsing
+opri '(' = 0
+opri '=' = 1
+opri '>' = 2
+opri '|' = 3
+opri '&' = 4
+opri '~' = 5
+
+-- parsing a propositional formula
+parse t = f where [Ast f] = parse' t []
+
+parse' [] s = redstar s
+parse' (' ':t) s = parse' t s
+parse' ('(':t) s = parse' t (Lex '(' : s)
+parse' (')':t) s = parse' t (x:s')
+ where
+ (x : Lex '(' : s') = redstar s
+parse' (c:t) s = if inRange ('a','z') c then parse' t (Ast (Sym c) : s)
+ else if spri s > opri c then parse' (c:t) (red s)
+ else parse' t (Lex c : s)
+
+-- reduction of the parse stack
+red (Ast p : Lex '=' : Ast q : s) = Ast (Eqv q p) : s
+red (Ast p : Lex '>' : Ast q : s) = Ast (Imp q p) : s
+red (Ast p : Lex '|' : Ast q : s) = Ast (Dis q p) : s
+red (Ast p : Lex '&' : Ast q : s) = Ast (Con q p) : s
+red (Ast p : Lex '~' : s) = Ast (Not p) : s
+
+-- iterative reduction of the parse stack
+redstar = while ((/=) 0 . spri) red
+
+-- old: partain:
+--redstar = while ((/=) (0::Int) . spri) red
+
+spaces = repeat ' '
+
+-- split conjunctive proposition into a list of conjuncts
+split p = split' p []
+ where
+ split' (Con p q) a = split' p (split' q a)
+ split' p a = p : a
+
+-- priority of the parse stack
+spri (Ast x : Lex c : s) = opri c
+spri s = 0
+
+-- does any symbol appear in both consequent and antecedent of clause
+tautclause (c,a) = [x | x <- c, x `elem` a] /= []
+
+-- form unique clausal axioms excluding tautologies
+unicl a = foldr unicl' [] a
+ where
+ unicl' p x = if tautclause cp then x else insert cp x
+ where
+ cp = clause p
+
+while p f x = if p x then while p f (f x) else x
=====================================
testsuite/tests/profiling/should_run/caller-cc/all.T
=====================================
@@ -0,0 +1,19 @@
+setTestOpts(req_profiling)
+setTestOpts(extra_ways(['prof', 'ghci-ext-prof']))
+setTestOpts(only_ways(prof_ways))
+setTestOpts(extra_files(['Main.hs']))
+setTestOpts(extra_run_opts('7'))
+
+# N.B. Main.hs is stolen from heapprof001.
+
+test('CallerCc1', normal,
+ multimod_compile_and_run,
+ ['Main', '-fprof-callers=*.concat -O0'])
+
+test('CallerCc2', normal,
+ multimod_compile_and_run,
+ ['Main', '-fprof-callers=Data.Foldable.concat -O0'])
+
+test('CallerCc3', normal,
+ multimod_compile_and_run,
+ ['Main', '-fprof-callers=Data.Foldable.con*at -O0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54160a2ebf84de74aac4d09cbbb5afd711aab44c...744911991324d708bb154f5918c09906e71e1a49
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54160a2ebf84de74aac4d09cbbb5afd711aab44c...744911991324d708bb154f5918c09906e71e1a49
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/20201112/da650f6a/attachment-0001.html>
More information about the ghc-commits
mailing list