{-
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998

\section{Code output phase}
-}

{-# LANGUAGE CPP #-}

module GHC.Driver.CodeOutput
   ( codeOutput
   , outputForeignStubs
   , profilingInitCode
   )
where

#include "HsVersions.h"

import GHC.Prelude

import GHC.CmmToAsm     ( nativeCodeGen )
import GHC.CmmToLlvm    ( llvmCodeGen )

import GHC.Types.Unique.Supply ( mkSplitUniqSupply )

import GHC.Driver.Finder    ( mkStubPaths )
import GHC.CmmToC           ( writeC )
import GHC.Cmm.Lint         ( cmmLint )
import GHC.Cmm              ( RawCmmGroup )
import GHC.Cmm.CLabel
import GHC.Driver.Types
import GHC.Driver.Session
import GHC.Data.Stream           ( Stream )
import qualified GHC.Data.Stream as Stream
import GHC.SysTools.FileCleanup

import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Unit
import GHC.Types.SrcLoc
import GHC.Types.CostCentre

import Control.Exception
import System.Directory
import System.FilePath
import System.IO

{-
************************************************************************
*                                                                      *
\subsection{Steering}
*                                                                      *
************************************************************************
-}

codeOutput :: DynFlags
           -> Module
           -> FilePath
           -> ModLocation
           -> ForeignStubs
           -> [(ForeignSrcLang, FilePath)]
           -- ^ additional files to be compiled with the C compiler
           -> [UnitId]
           -> Stream IO RawCmmGroup a                       -- Compiled C--
           -> IO (FilePath,
                  (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
                  [(ForeignSrcLang, FilePath)]{-foreign_fps-},
                  a)

codeOutput :: forall a.
DynFlags
-> Module
-> FilePath
-> ModLocation
-> ForeignStubs
-> [(ForeignSrcLang, FilePath)]
-> [UnitId]
-> Stream IO RawCmmGroup a
-> IO
     (FilePath, (Bool, Maybe FilePath), [(ForeignSrcLang, FilePath)], a)
codeOutput DynFlags
dflags Module
this_mod FilePath
filenm ModLocation
location ForeignStubs
foreign_stubs [(ForeignSrcLang, FilePath)]
foreign_fps [UnitId]
pkg_deps
  Stream IO RawCmmGroup a
cmm_stream
  =
    do  {
        -- Lint each CmmGroup as it goes past
        ; let linted_cmm_stream :: Stream IO RawCmmGroup a
linted_cmm_stream =
                 if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoCmmLinting DynFlags
dflags
                    then (RawCmmGroup -> IO RawCmmGroup)
-> Stream IO RawCmmGroup a -> Stream IO RawCmmGroup a
forall (m :: * -> *) a b x.
Monad m =>
(a -> m b) -> Stream m a x -> Stream m b x
Stream.mapM RawCmmGroup -> IO RawCmmGroup
forall {d} {h}.
(Outputable d, Outputable h) =>
GenCmmGroup d h CmmGraph -> IO (GenCmmGroup d h CmmGraph)
do_lint Stream IO RawCmmGroup a
cmm_stream
                    else Stream IO RawCmmGroup a
cmm_stream

              do_lint :: GenCmmGroup d h CmmGraph -> IO (GenCmmGroup d h CmmGraph)
do_lint GenCmmGroup d h CmmGraph
cmm = DynFlags
-> SDoc
-> (GenCmmGroup d h CmmGraph -> ())
-> IO (GenCmmGroup d h CmmGraph)
-> IO (GenCmmGroup d h CmmGraph)
forall (m :: * -> *) a.
MonadIO m =>
DynFlags -> SDoc -> (a -> ()) -> m a -> m a
withTimingSilent
                  DynFlags
dflags
                  (FilePath -> SDoc
text FilePath
"CmmLint"SDoc -> SDoc -> SDoc
<+>SDoc -> SDoc
brackets (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod))
                  (() -> GenCmmGroup d h CmmGraph -> ()
forall a b. a -> b -> a
const ()) (IO (GenCmmGroup d h CmmGraph) -> IO (GenCmmGroup d h CmmGraph))
-> IO (GenCmmGroup d h CmmGraph) -> IO (GenCmmGroup d h CmmGraph)
forall a b. (a -> b) -> a -> b
$ do
                { case DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc
forall d h.
(Outputable d, Outputable h) =>
DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc
cmmLint DynFlags
dflags GenCmmGroup d h CmmGraph
cmm of
                        Just SDoc
err -> do { DynFlags -> LogAction
log_action DynFlags
dflags
                                                   DynFlags
dflags
                                                   WarnReason
NoReason
                                                   Severity
SevDump
                                                   SrcSpan
noSrcSpan
                                                   (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultDumpStyle SDoc
err
                                       ; DynFlags -> Int -> IO ()
ghcExit DynFlags
dflags Int
1
                                       }
                        Maybe SDoc
Nothing  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                ; GenCmmGroup d h CmmGraph -> IO (GenCmmGroup d h CmmGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return GenCmmGroup d h CmmGraph
cmm
                }

        ; (Bool, Maybe FilePath)
stubs_exist <- DynFlags
-> Module
-> ModLocation
-> ForeignStubs
-> IO (Bool, Maybe FilePath)
outputForeignStubs DynFlags
dflags Module
this_mod ModLocation
location ForeignStubs
foreign_stubs
        ; a
a <- case DynFlags -> HscTarget
hscTarget DynFlags
dflags of
                 HscTarget
HscAsm         -> DynFlags
-> Module
-> ModLocation
-> FilePath
-> Stream IO RawCmmGroup a
-> IO a
forall a.
DynFlags
-> Module
-> ModLocation
-> FilePath
-> Stream IO RawCmmGroup a
-> IO a
outputAsm DynFlags
dflags Module
this_mod ModLocation
location FilePath
filenm
                                             Stream IO RawCmmGroup a
linted_cmm_stream
                 HscTarget
HscC           -> DynFlags -> FilePath -> Stream IO RawCmmGroup a -> [UnitId] -> IO a
forall a.
DynFlags -> FilePath -> Stream IO RawCmmGroup a -> [UnitId] -> IO a
outputC DynFlags
dflags FilePath
filenm Stream IO RawCmmGroup a
linted_cmm_stream [UnitId]
pkg_deps
                 HscTarget
HscLlvm        -> DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a
forall a. DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a
outputLlvm DynFlags
dflags FilePath
filenm Stream IO RawCmmGroup a
linted_cmm_stream
                 HscTarget
HscInterpreted -> FilePath -> IO a
forall a. FilePath -> a
panic FilePath
"codeOutput: HscInterpreted"
                 HscTarget
HscNothing     -> FilePath -> IO a
forall a. FilePath -> a
panic FilePath
"codeOutput: HscNothing"
        ; (FilePath, (Bool, Maybe FilePath), [(ForeignSrcLang, FilePath)], a)
-> IO
     (FilePath, (Bool, Maybe FilePath), [(ForeignSrcLang, FilePath)], a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
filenm, (Bool, Maybe FilePath)
stubs_exist, [(ForeignSrcLang, FilePath)]
foreign_fps, a
a)
        }

doOutput :: String -> (Handle -> IO a) -> IO a
doOutput :: forall a. FilePath -> (Handle -> IO a) -> IO a
doOutput FilePath
filenm Handle -> IO a
io_action = IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IOMode -> IO Handle
openFile FilePath
filenm IOMode
WriteMode) Handle -> IO ()
hClose Handle -> IO a
io_action

{-
************************************************************************
*                                                                      *
\subsection{C}
*                                                                      *
************************************************************************
-}

outputC :: DynFlags
        -> FilePath
        -> Stream IO RawCmmGroup a
        -> [UnitId]
        -> IO a

outputC :: forall a.
DynFlags -> FilePath -> Stream IO RawCmmGroup a -> [UnitId] -> IO a
outputC DynFlags
dflags FilePath
filenm Stream IO RawCmmGroup a
cmm_stream [UnitId]
packages
  = do
       DynFlags -> SDoc -> (a -> ()) -> IO a -> IO a
forall (m :: * -> *) a.
MonadIO m =>
DynFlags -> SDoc -> (a -> ()) -> m a -> m a
withTiming DynFlags
dflags (FilePath -> SDoc
text FilePath
"C codegen") (\a
a -> a -> () -> ()
seq a
a () {- FIXME -}) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
         let pkg_names :: [FilePath]
pkg_names = (UnitId -> FilePath) -> [UnitId] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> FilePath
unitIdString [UnitId]
packages
         FilePath -> (Handle -> IO a) -> IO a
forall a. FilePath -> (Handle -> IO a) -> IO a
doOutput FilePath
filenm ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Handle
h -> do
            Handle -> FilePath -> IO ()
hPutStr Handle
h (FilePath
"/* GHC_PACKAGES " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
pkg_names FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n*/\n")
            Handle -> FilePath -> IO ()
hPutStr Handle
h FilePath
"#include \"Stg.h\"\n"
            Stream IO RawCmmGroup a -> (RawCmmGroup -> IO ()) -> IO a
forall (m :: * -> *) a b.
Monad m =>
Stream m a b -> (a -> m ()) -> m b
Stream.consume Stream IO RawCmmGroup a
cmm_stream (DynFlags -> Handle -> RawCmmGroup -> IO ()
writeC DynFlags
dflags Handle
h)

{-
************************************************************************
*                                                                      *
\subsection{Assembler}
*                                                                      *
************************************************************************
-}

outputAsm :: DynFlags -> Module -> ModLocation -> FilePath
          -> Stream IO RawCmmGroup a
          -> IO a
outputAsm :: forall a.
DynFlags
-> Module
-> ModLocation
-> FilePath
-> Stream IO RawCmmGroup a
-> IO a
outputAsm DynFlags
dflags Module
this_mod ModLocation
location FilePath
filenm Stream IO RawCmmGroup a
cmm_stream
  = do UniqSupply
ncg_uniqs <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'n'

       DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
4 (FilePath -> SDoc
text FilePath
"Outputing asm to" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
filenm)

       {-# SCC "OutputAsm" #-} FilePath -> (Handle -> IO a) -> IO a
forall a. FilePath -> (Handle -> IO a) -> IO a
doOutput FilePath
filenm ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
           \Handle
h -> {-# SCC "NativeCodeGen" #-}
                 DynFlags
-> Module
-> ModLocation
-> Handle
-> UniqSupply
-> Stream IO RawCmmGroup a
-> IO a
forall a.
DynFlags
-> Module
-> ModLocation
-> Handle
-> UniqSupply
-> Stream IO RawCmmGroup a
-> IO a
nativeCodeGen DynFlags
dflags Module
this_mod ModLocation
location Handle
h UniqSupply
ncg_uniqs Stream IO RawCmmGroup a
cmm_stream

{-
************************************************************************
*                                                                      *
\subsection{LLVM}
*                                                                      *
************************************************************************
-}

outputLlvm :: DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a
outputLlvm :: forall a. DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a
outputLlvm DynFlags
dflags FilePath
filenm Stream IO RawCmmGroup a
cmm_stream
  = do {-# SCC "llvm_output" #-} FilePath -> (Handle -> IO a) -> IO a
forall a. FilePath -> (Handle -> IO a) -> IO a
doOutput FilePath
filenm ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
           \Handle
f -> {-# SCC "llvm_CodeGen" #-}
                 DynFlags -> Handle -> Stream IO RawCmmGroup a -> IO a
forall a. DynFlags -> Handle -> Stream IO RawCmmGroup a -> IO a
llvmCodeGen DynFlags
dflags Handle
f Stream IO RawCmmGroup a
cmm_stream

{-
************************************************************************
*                                                                      *
\subsection{Foreign import/export}
*                                                                      *
************************************************************************
-}

outputForeignStubs :: DynFlags -> Module -> ModLocation -> ForeignStubs
                   -> IO (Bool,         -- Header file created
                          Maybe FilePath) -- C file created
outputForeignStubs :: DynFlags
-> Module
-> ModLocation
-> ForeignStubs
-> IO (Bool, Maybe FilePath)
outputForeignStubs DynFlags
dflags Module
mod ModLocation
location ForeignStubs
stubs
 = do
   let stub_h :: FilePath
stub_h = DynFlags -> ModuleName -> ModLocation -> FilePath
mkStubPaths DynFlags
dflags (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) ModLocation
location
   FilePath
stub_c <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"c"

   case ForeignStubs
stubs of
     ForeignStubs
NoStubs ->
        (Bool, Maybe FilePath) -> IO (Bool, Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Maybe FilePath
forall a. Maybe a
Nothing)

     ForeignStubs SDoc
h_code SDoc
c_code -> do
        let
            stub_c_output_d :: SDoc
stub_c_output_d = CodeStyle -> SDoc -> SDoc
pprCode CodeStyle
CStyle SDoc
c_code
            stub_c_output_w :: FilePath
stub_c_output_w = DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags SDoc
stub_c_output_d

            -- Header file protos for "foreign export"ed functions.
            stub_h_output_d :: SDoc
stub_h_output_d = CodeStyle -> SDoc -> SDoc
pprCode CodeStyle
CStyle SDoc
h_code
            stub_h_output_w :: FilePath
stub_h_output_w = DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags SDoc
stub_h_output_d

        Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
stub_h)

        DynFlags -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> IO ()
dumpIfSet_dyn DynFlags
dflags DumpFlag
Opt_D_dump_foreign
                      FilePath
"Foreign export header file"
                      DumpFormat
FormatC
                      SDoc
stub_h_output_d

        -- we need the #includes from the rts package for the stub files
        let rts_includes :: FilePath
rts_includes =
               let rts_pkg :: UnitInfo
rts_pkg = HasDebugCallStack => UnitState -> UnitId -> UnitInfo
UnitState -> UnitId -> UnitInfo
unsafeLookupUnitId (DynFlags -> UnitState
unitState DynFlags
dflags) UnitId
rtsUnitId in
               (FilePath -> FilePath) -> [FilePath] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> FilePath
mk_include (UnitInfo -> [FilePath]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [FilePath]
unitIncludes UnitInfo
rts_pkg)
            mk_include :: FilePath -> FilePath
mk_include FilePath
i = FilePath
"#include \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"\n"

            -- wrapper code mentions the ffi_arg type, which comes from ffi.h
            ffi_includes :: FilePath
ffi_includes
              | PlatformMisc -> Bool
platformMisc_libFFI (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dflags = FilePath
"#include <ffi.h>\n"
              | Bool
otherwise = FilePath
""

        Bool
stub_h_file_exists
           <- FilePath -> FilePath -> FilePath -> FilePath -> IO Bool
outputForeignStubs_help FilePath
stub_h FilePath
stub_h_output_w
                (FilePath
"#include <HsFFI.h>\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cplusplus_hdr) FilePath
cplusplus_ftr

        DynFlags -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> IO ()
dumpIfSet_dyn DynFlags
dflags DumpFlag
Opt_D_dump_foreign
                      FilePath
"Foreign export stubs" DumpFormat
FormatC SDoc
stub_c_output_d

        Bool
stub_c_file_exists
           <- FilePath -> FilePath -> FilePath -> FilePath -> IO Bool
outputForeignStubs_help FilePath
stub_c FilePath
stub_c_output_w
                (FilePath
"#define IN_STG_CODE 0\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#include <Rts.h>\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
rts_includes FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
ffi_includes FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
cplusplus_hdr)
                 FilePath
cplusplus_ftr
           -- We're adding the default hc_header to the stub file, but this
           -- isn't really HC code, so we need to define IN_STG_CODE==0 to
           -- avoid the register variables etc. being enabled.

        (Bool, Maybe FilePath) -> IO (Bool, Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
stub_h_file_exists, if Bool
stub_c_file_exists
                                       then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
stub_c
                                       else Maybe FilePath
forall a. Maybe a
Nothing )
 where
   cplusplus_hdr :: FilePath
cplusplus_hdr = FilePath
"#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"
   cplusplus_ftr :: FilePath
cplusplus_ftr = FilePath
"#if defined(__cplusplus)\n}\n#endif\n"


-- Don't use doOutput for dumping the f. export stubs
-- since it is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool
outputForeignStubs_help :: FilePath -> FilePath -> FilePath -> FilePath -> IO Bool
outputForeignStubs_help FilePath
_fname FilePath
""      FilePath
_header FilePath
_footer = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
outputForeignStubs_help FilePath
fname FilePath
doc_str FilePath
header FilePath
footer
   = do FilePath -> FilePath -> IO ()
writeFile FilePath
fname (FilePath
header FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
doc_str FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
footer FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- -----------------------------------------------------------------------------
-- Initialising cost centres

-- We must produce declarations for the cost-centres defined in this
-- module;

-- | Generate code to initialise cost centres
profilingInitCode :: Module -> CollectedCCs -> SDoc
profilingInitCode :: Module -> CollectedCCs -> SDoc
profilingInitCode Module
this_mod ([CostCentre]
local_CCs, [CostCentreStack]
singleton_CCSs)
 = [SDoc] -> SDoc
vcat
    ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$  (CostCentre -> SDoc) -> [CostCentre] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CostCentre -> SDoc
emit_cc_decl [CostCentre]
local_CCs
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ (CostCentreStack -> SDoc) -> [CostCentreStack] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CostCentreStack -> SDoc
emit_ccs_decl [CostCentreStack]
singleton_CCSs
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [[CostCentre] -> SDoc
emit_cc_list [CostCentre]
local_CCs]
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [[CostCentreStack] -> SDoc
emit_ccs_list [CostCentreStack]
singleton_CCSs]
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> SDoc
text FilePath
"static void prof_init_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
            SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"(void) __attribute__((constructor));"
       , FilePath -> SDoc
text FilePath
"static void prof_init_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"(void)"
       , SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat
                 [ FilePath -> SDoc
text FilePath
"registerCcList" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens SDoc
local_cc_list_label SDoc -> SDoc -> SDoc
<> SDoc
semi
                 , FilePath -> SDoc
text FilePath
"registerCcsList" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens SDoc
singleton_cc_list_label SDoc -> SDoc -> SDoc
<> SDoc
semi
                 ])
       ]
 where
   emit_cc_decl :: CostCentre -> SDoc
emit_cc_decl CostCentre
cc =
       FilePath -> SDoc
text FilePath
"extern CostCentre" SDoc -> SDoc -> SDoc
<+> SDoc
cc_lbl SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"[];"
     where cc_lbl :: SDoc
cc_lbl = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentre -> CLabel
mkCCLabel CostCentre
cc)
   local_cc_list_label :: SDoc
local_cc_list_label = FilePath -> SDoc
text FilePath
"local_cc_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
   emit_cc_list :: [CostCentre] -> SDoc
emit_cc_list [CostCentre]
ccs =
      FilePath -> SDoc
text FilePath
"static CostCentre *" SDoc -> SDoc -> SDoc
<> SDoc
local_cc_list_label SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"[] ="
      SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentre -> CLabel
mkCCLabel CostCentre
cc) SDoc -> SDoc -> SDoc
<> SDoc
comma
                         | CostCentre
cc <- [CostCentre]
ccs
                         ] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [FilePath -> SDoc
text FilePath
"NULL"])
      SDoc -> SDoc -> SDoc
<> SDoc
semi

   emit_ccs_decl :: CostCentreStack -> SDoc
emit_ccs_decl CostCentreStack
ccs =
       FilePath -> SDoc
text FilePath
"extern CostCentreStack" SDoc -> SDoc -> SDoc
<+> SDoc
ccs_lbl SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"[];"
     where ccs_lbl :: SDoc
ccs_lbl = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
ccs)
   singleton_cc_list_label :: SDoc
singleton_cc_list_label = FilePath -> SDoc
text FilePath
"singleton_cc_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
   emit_ccs_list :: [CostCentreStack] -> SDoc
emit_ccs_list [CostCentreStack]
ccs =
      FilePath -> SDoc
text FilePath
"static CostCentreStack *" SDoc -> SDoc -> SDoc
<> SDoc
singleton_cc_list_label SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"[] ="
      SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
cc) SDoc -> SDoc -> SDoc
<> SDoc
comma
                         | CostCentreStack
cc <- [CostCentreStack]
ccs
                         ] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [FilePath -> SDoc
text FilePath
"NULL"])
      SDoc -> SDoc -> SDoc
<> SDoc
semi