<commit_before>{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}

module Gen2.Profiling
  ( module CostCentre
  , initCostCentres
  , costCentreLbl
  , costCentreStackLbl
  , ccsVarJ
  , ifProfiling
  , ifProfiling'
  , ifProfilingM
  , profiling
  , profStat
  , setSCC
  , enterCostCentreFun
  , enterCostCentreThunk
  ) where

import           CLabel
import           CostCentre
import           DynFlags
import           Encoding
import           FastString
import           Id
import           Module
import           Outputable           hiding ((<>))
import           SrcLoc

import           Control.Applicative
import           Control.Lens
import           Data.Monoid
import qualified Data.Text            as T

import           Compiler.JMacro
import           Compiler.JMacro.Base

import           Gen2.ClosureInfo
import           Gen2.RtsTypes
import           Gen2.Utils

--------------------------------------------------------------------------------
-- Initialization

initCostCentres :: CollectedCCs -> G ()
initCostCentres (local_CCs, _extern_CCs, singleton_CCSs) = do
    mapM_ emitCostCentreDecl local_CCs
    mapM_ emitCostCentreStackDecl singleton_CCSs

emitCostCentreDecl :: CostCentre -> G ()
emitCostCentreDecl cc = do
    dflags <- use gsDynFlags
    ccsLbl <- costCentreLbl cc
    let is_caf = isCafCC cc
        label  = costCentreUserName cc
        modl   = Module.moduleNameString $ moduleName $ cc_mod cc
        loc    = showPpr dflags (costCentreSrcSpan cc)
        js     =
          decl ccsLbl <>
          [j| `ccsLbl` = h$registerCC(`label`, `modl`, `loc`, `is_caf`); |]
    emitGlobal js

emitCostCentreStackDecl :: CostCentreStack -> G ()
emitCostCentreStackDecl ccs = do
    case maybeSingletonCCS ccs of
      Just cc -> do
        ccsLbl <- singletonCCSLbl cc
        ccLbl  <- costCentreLbl cc
        let js =
              decl ccsLbl <>
              [j| `ccsLbl` = h$registerCCS(`ccLbl`); |]
        emitGlobal js
      Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
<commit_msg>declare extern ccs (not sure if this is right approach but fixes some bugs)<commit_after>{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}

module Gen2.Profiling
  ( module CostCentre
  , initCostCentres
  , costCentreLbl
  , costCentreStackLbl
  , ccsVarJ
  , ifProfiling
  , ifProfiling'
  , ifProfilingM
  , profiling
  , profStat
  , setSCC
  , enterCostCentreFun
  , enterCostCentreThunk
  ) where

import           CLabel
import           CostCentre
import           DynFlags
import           Encoding
import           FastString
import           Id
import           Module
import           Outputable           hiding ((<>))
import           SrcLoc

import           Control.Applicative
import           Control.Lens
import           Data.Monoid
import qualified Data.Text            as T

import           Compiler.JMacro
import           Compiler.JMacro.Base

import           Gen2.ClosureInfo
import           Gen2.RtsTypes
import           Gen2.Utils

--------------------------------------------------------------------------------
-- Initialization

initCostCentres :: CollectedCCs -> G ()
initCostCentres (local_CCs, extern_CCs, singleton_CCSs) = do
    mapM_ emitCostCentreDecl local_CCs
    mapM_ emitCostCentreDecl extern_CCs
    mapM_ emitCostCentreStackDecl singleton_CCSs

emitCostCentreDecl :: CostCentre -> G ()
emitCostCentreDecl cc = do
    dflags <- use gsDynFlags
    ccsLbl <- costCentreLbl cc
    let is_caf = isCafCC cc
        label  = costCentreUserName cc
        modl   = Module.moduleNameString $ moduleName $ cc_mod cc
        loc    = showPpr dflags (costCentreSrcSpan cc)
        js     =
          decl ccsLbl <>
          [j| `ccsLbl` = h$registerCC(`label`, `modl`, `loc`, `is_caf`); |]
    emitGlobal js

emitCostCentreStackDecl :: CostCentreStack -> G ()
emitCostCentreStackDecl ccs = do
    case maybeSingletonCCS ccs of
      Just cc -> do
        ccsLbl <- singletonCCSLbl cc
        ccLbl  <- costCentreLbl cc
        let js =
              decl ccsLbl <>
              [j| `ccsLbl` = h$registerCCS(`ccLbl`); |]
        emitGlobal js
      Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)

{'fraction_non_alphanumeric': 0.10337401292175162, 'fraction_numerical': 0.00191433357262503, 'mean_word_length': 1.96243798724309, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4188389', 'n_tokens_mistral': 1319, 'n_tokens_neox': 1282, 'n_words': 314}