diff options
| author | Alp Mestanogullari <alpmestan@gmail.com> | 2019-07-24 21:46:49 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-08-02 22:20:14 -0400 |
| commit | 0c5cd771a8792ca4a4a553d3d4636e32191ef936 (patch) | |
| tree | cf6c57187c5b399c98bcdcffa8a69c8e36017d0f /compiler/main | |
| parent | 5e960287b74ce2e11be98dbf7c1dc4ce2d7e0d9a (diff) | |
| download | haskell-0c5cd771a8792ca4a4a553d3d4636e32191ef936.tar.gz | |
compiler: emit finer grained codegen events to eventlog
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/CodeOutput.hs | 45 |
1 files changed, 23 insertions, 22 deletions
diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index 6f80df9676..4133526532 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -120,28 +120,29 @@ outputC dflags filenm cmm_stream packages -- ToDo: make the C backend consume the C-- incrementally, by -- pushing the cmm_stream inside (c.f. nativeCodeGen) rawcmms <- Stream.collect cmm_stream - - -- figure out which header files to #include in the generated .hc file: - -- - -- * extra_includes from packages - -- * -#include options from the cmdline and OPTIONS pragmas - -- * the _stub.h file, if there is one. - -- - let rts = getPackageDetails dflags rtsUnitId - - let cc_injects = unlines (map mk_include (includes rts)) - mk_include h_file = - case h_file of - '"':_{-"-} -> "#include "++h_file - '<':_ -> "#include "++h_file - _ -> "#include \""++h_file++"\"" - - let pkg_names = map installedUnitIdString packages - - doOutput filenm $ \ h -> do - hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") - hPutStr h cc_injects - writeCs dflags h rawcmms + withTiming (return dflags) (text "C codegen") id $ do + + -- figure out which header files to #include in the generated .hc file: + -- + -- * extra_includes from packages + -- * -#include options from the cmdline and OPTIONS pragmas + -- * the _stub.h file, if there is one. + -- + let rts = getPackageDetails dflags rtsUnitId + + let cc_injects = unlines (map mk_include (includes rts)) + mk_include h_file = + case h_file of + '"':_{-"-} -> "#include "++h_file + '<':_ -> "#include "++h_file + _ -> "#include \""++h_file++"\"" + + let pkg_names = map installedUnitIdString packages + + doOutput filenm $ \ h -> do + hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") + hPutStr h cc_injects + writeCs dflags h rawcmms {- ************************************************************************ |