Introduce -fprof-callers flagwip/T18566

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.

19 files changed, 759 insertions, 5 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 4dc3ec0abe..a1eae78a60 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/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
diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs
new file mode 100644
index 0000000000..1bbf96ca73
--- /dev/null
+++ b/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)
+
diff --git a/compiler/GHC/Core/Opt/CallerCC.hs-boot b/compiler/GHC/Core/Opt/CallerCC.hs-boot
new file mode 100644
index 0000000000..9d367916e1
--- /dev/null
+++ b/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
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index bdacfba90b..21b4403e94 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/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"
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index f393255b54..5d8be8c838 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/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
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 687c6e1598..2f26276eb7 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/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)
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index e73c061018..1c52f4e326 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/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@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
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 0a333ba1dc..faeb4f6520 100644
--- a/compiler/ghc.cabal.in
+++ b/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
diff --git a/docs/users_guide/9.2.1-notes.rst b/docs/users_guide/9.2.1-notes.rst
index 4ba4fc911f..da0461f982 100644
--- a/docs/users_guide/9.2.1-notes.rst
+++ b/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
diff --git a/docs/users_guide/profiling.rst b/docs/users_guide/profiling.rst
index 77e00bbbe4..0b075429b5 100644
--- a/docs/users_guide/profiling.rst
+++ b/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
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout
index 9e810ce68c..5fbdf896ee 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout
@@ -114,8 +114,8 @@ GHC.Parser.PostProcess
 GHC.Parser.PostProcess.Haddock
 GHC.Parser.Types
 GHC.Platform
+GHC.Platform.AArch64
 GHC.Platform.ARM
-GHC.Platform.ARM64
 GHC.Platform.Constants
 GHC.Platform.NoRegs
 GHC.Platform.PPC
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample
new file mode 100644
index 0000000000..bd653712ea
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample
@@ -0,0 +1,79 @@
+	Fri Nov 13 01:06 2020 Time and Allocation Profiling Report  (Final)
+
+	   CallerCc1 +RTS -hc -p -RTS 7
+
+	total time  =        0.09 secs   (87 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)      35.6   49.5
+insert         Main      Main.hs:(108,1)-(112,8)     21.8    1.7
+clause.clause' Main      Main.hs:(63,12)-(65,57)     17.2   37.5
+unicl.unicl'   Main      Main.hs:(178,11)-(180,36)    6.9    2.6
+conjunct       Main      Main.hs:(70,1)-(71,18)       5.7    0.0
+split.split'   Main      Main.hs:(165,11)-(166,28)    3.4    2.3
+disin.dp       Main      Main.hs:80:3-14              3.4    0.0
+unicl          Main      Main.hs:(176,1)-(180,36)     2.3    1.1
+tautclause     Main      Main.hs:173:1-49             2.3    3.7
+disin.dq       Main      Main.hs:81:3-14              1.1    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   35.6   49.5    46.0   49.5
+     conjunct                                 Main                  Main.hs:(70,1)-(71,18)    291      759353    5.7    0.0     5.7    0.0
+     disin.dp                                 Main                  Main.hs:80:3-14           292      380009    3.4    0.0     3.4    0.0
+     disin.dq                                 Main                  Main.hs:81:3-14           293      380009    1.1    0.0     1.1    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    2.3    1.1    50.6   48.0
+     unicl.unicl'                             Main                  Main.hs:(178,11)-(180,36) 294       37422    6.9    2.6    48.3   46.9
+      tautclause                              Main                  Main.hs:173:1-49          295       37422    2.3    3.7     2.3    3.7
+      unicl.unicl'.cp                         Main                  Main.hs:180:24-36         296       37422    0.0    0.0    39.1   40.6
+       clause                                 Main                  Main.hs:(61,1)-(65,57)    297       37422    0.0    1.4    39.1   40.6
+        clause.clause'                        Main                  Main.hs:(63,12)-(65,57)   298      696150   17.2   37.5    39.1   39.2
+         insert                               Main                  Main.hs:(108,1)-(112,8)   299      366786   21.8    1.7    21.8    1.7
+      insert                                  Main                  Main.hs:(108,1)-(112,8)   300           7    0.0    0.0     0.0    0.0
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout
new file mode 100644
index 0000000000..e62352412e
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout
@@ -0,0 +1,7 @@
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample
new file mode 100644
index 0000000000..d35a0d8350
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample
@@ -0,0 +1,78 @@
+	Fri Nov 13 01:06 2020 Time and Allocation Profiling Report  (Final)
+
+	   CallerCc2 +RTS -hc -p -RTS 7
+
+	total time  =        0.09 secs   (91 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)      26.4   49.5
+clause.clause' Main      Main.hs:(63,12)-(65,57)     23.1   37.5
+insert         Main      Main.hs:(108,1)-(112,8)     18.7    1.7
+conjunct       Main      Main.hs:(70,1)-(71,18)       8.8    0.0
+unicl.unicl'   Main      Main.hs:(178,11)-(180,36)    5.5    2.6
+tautclause     Main      Main.hs:173:1-49             5.5    3.7
+unicl          Main      Main.hs:(176,1)-(180,36)     3.3    1.1
+split.split'   Main      Main.hs:(165,11)-(166,28)    3.3    2.3
+disin.dp       Main      Main.hs:80:3-14              3.3    0.0
+clause         Main      Main.hs:(61,1)-(65,57)       2.2    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   26.4   49.5    38.5   49.5
+     conjunct                                 Main                  Main.hs:(70,1)-(71,18)    291      759353    8.8    0.0     8.8    0.0
+     disin.dp                                 Main                  Main.hs:80:3-14           292      380009    3.3    0.0     3.3    0.0
+     disin.dq                                 Main                  Main.hs:81:3-14           293      380009    0.0    0.0     0.0    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.3    2.3
+     split.split'                             Main                  Main.hs:(165,11)-(166,28) 266       74837    3.3    2.3     3.3    2.3
+    unicl                                     Main                  Main.hs:(176,1)-(180,36)  264           7    3.3    1.1    58.2   48.0
+     unicl.unicl'                             Main                  Main.hs:(178,11)-(180,36) 294       37422    5.5    2.6    54.9   46.9
+      tautclause                              Main                  Main.hs:173:1-49          295       37422    5.5    3.7     5.5    3.7
+      unicl.unicl'.cp                         Main                  Main.hs:180:24-36         296       37422    0.0    0.0    44.0   40.6
+       clause                                 Main                  Main.hs:(61,1)-(65,57)    297       37422    2.2    1.4    44.0   40.6
+        clause.clause'                        Main                  Main.hs:(63,12)-(65,57)   298      696150   23.1   37.5    41.8   39.2
+         insert                               Main                  Main.hs:(108,1)-(112,8)   299      366786   18.7    1.7    18.7    1.7
+      insert                                  Main                  Main.hs:(108,1)-(112,8)   300           7    0.0    0.0     0.0    0.0
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout
new file mode 100644
index 0000000000..e62352412e
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout
@@ -0,0 +1,7 @@
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample
new file mode 100644
index 0000000000..68fd783a35
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample
@@ -0,0 +1,78 @@
+	Fri Nov 13 01:06 2020 Time and Allocation Profiling Report  (Final)
+
+	   CallerCc3 +RTS -hc -p -RTS 7
+
+	total time  =        0.09 secs   (85 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)      29.4   49.5
+insert         Main      Main.hs:(108,1)-(112,8)     24.7    1.7
+clause.clause' Main      Main.hs:(63,12)-(65,57)     23.5   37.5
+conjunct       Main      Main.hs:(70,1)-(71,18)      10.6    0.0
+tautclause     Main      Main.hs:173:1-49             4.7    3.7
+unicl.unicl'   Main      Main.hs:(178,11)-(180,36)    3.5    2.6
+split.split'   Main      Main.hs:(165,11)-(166,28)    2.4    2.3
+disin.dp       Main      Main.hs:80:3-14              1.2    0.0
+unicl          Main      Main.hs:(176,1)-(180,36)     0.0    1.1
+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   29.4   49.5    41.2   49.5
+     conjunct                                 Main                  Main.hs:(70,1)-(71,18)    291      759353   10.6    0.0    10.6    0.0
+     disin.dp                                 Main                  Main.hs:80:3-14           292      380009    1.2    0.0     1.2    0.0
+     disin.dq                                 Main                  Main.hs:81:3-14           293      380009    0.0    0.0     0.0    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     2.4    2.3
+     split.split'                             Main                  Main.hs:(165,11)-(166,28) 266       74837    2.4    2.3     2.4    2.3
+    unicl                                     Main                  Main.hs:(176,1)-(180,36)  264           7    0.0    1.1    56.5   48.0
+     unicl.unicl'                             Main                  Main.hs:(178,11)-(180,36) 294       37422    3.5    2.6    56.5   46.9
+      tautclause                              Main                  Main.hs:173:1-49          295       37422    4.7    3.7     4.7    3.7
+      unicl.unicl'.cp                         Main                  Main.hs:180:24-36         296       37422    0.0    0.0    48.2   40.6
+       clause                                 Main                  Main.hs:(61,1)-(65,57)    297       37422    0.0    1.4    48.2   40.6
+        clause.clause'                        Main                  Main.hs:(63,12)-(65,57)   298      696150   23.5   37.5    48.2   39.2
+         insert                               Main                  Main.hs:(108,1)-(112,8)   299      366786   24.7    1.7    24.7    1.7
+      insert                                  Main                  Main.hs:(108,1)-(112,8)   300           7    0.0    0.0     0.0    0.0
diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout
new file mode 100644
index 0000000000..e62352412e
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout
@@ -0,0 +1,7 @@
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
+a <= 
diff --git a/testsuite/tests/profiling/should_run/caller-cc/Main.hs b/testsuite/tests/profiling/should_run/caller-cc/Main.hs
new file mode 100644
index 0000000000..c945631d33
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/caller-cc/Main.hs
@@ -0,0 +1,182 @@
+{-
+From: dw@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
diff --git a/testsuite/tests/profiling/should_run/caller-cc/all.T b/testsuite/tests/profiling/should_run/caller-cc/all.T
new file mode 100644
index 0000000000..2b8837aa07
--- /dev/null
+++ b/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'])