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

module Gen2.Profiling (initCostCentres) where

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

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

import           Debug.Trace

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
    curModl <- use gsModule
    let is_caf = isCafCC cc
        label  = costCentreUserName cc
        modl   = Module.moduleNameString $ moduleName $ cc_mod cc
        loc    = showPpr dflags (costCentreSrcSpan cc)
        var    = TxtI $ T.pack (moduleNameColons (moduleName curModl) ++ "_" ++ zEncodeString label)

    let js =
          decl var <>
          [j| `var` = h$registerCC(`label`, `modl`, `loc`, `is_caf`); |]
    emitGlobal js
    trace ("emitting: " ++ show (renderJs js)) (return ())

emitCostCentreStackDecl :: CostCentreStack -> G ()
emitCostCentreStackDecl ccs = do
    case maybeSingletonCCS ccs of
      Just cc -> do
        dflags  <- use gsDynFlags
        curModl <- use gsModule
        let cc_label  = costCentreUserName cc
            ccs_label = cc_label ++ "_ccs"
            var       = TxtI $ T.pack (moduleNameColons (moduleName curModl) ++ "_" ++ zEncodeString ccs_label)

        let js =
              decl var <>
              [j| `var` = h$registerCCS(`JVar $ TxtI $ T.pack cc_label`); |]
        emitGlobal js
        trace ("emitting: " ++ show (renderJs js)) (return ())

      Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
<commit_msg>fix some cc var nameing<commit_after>{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}

module Gen2.Profiling (initCostCentres) where

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

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

import           Debug.Trace

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
    let is_caf = isCafCC cc
        label  = costCentreUserName cc
        modl   = Module.moduleNameString $ moduleName $ cc_mod cc
        loc    = showPpr dflags (costCentreSrcSpan cc)

    var <- ccVar cc
    let js =
          decl var <>
          [j| `var` = h$registerCC(`label`, `modl`, `loc`, `is_caf`); |]
    emitGlobal js
    trace ("emitting: " ++ show (renderJs js)) (return ())

emitCostCentreStackDecl :: CostCentreStack -> G ()
emitCostCentreStackDecl ccs = do
    case maybeSingletonCCS ccs of
      Just cc -> do
        ccs_var <- singletonCCSVar cc
        cc_var  <- ccVar cc
        let js =
              decl ccs_var <>
              [j| `ccs_var` = h$registerCCS(`cc_var`); |]
        emitGlobal js
        trace ("emitting: " ++ show (renderJs js)) (return ())

      Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)

singletonCCSVar :: CostCentre -> G Ident
singletonCCSVar cc = do
    curModl <- use gsModule
    let cc_label  = costCentreUserName cc
        ccs_label = cc_label ++ "_ccs"
    return $ TxtI $ T.pack (moduleNameColons (moduleName curModl) ++ "_" ++ zEncodeString ccs_label)

ccVar :: CostCentre -> G Ident
ccVar cc = do
    curModl <- use gsModule
    let is_caf = isCafCC cc
        label  = costCentreUserName cc
    return $ TxtI $ T.pack (moduleNameColons (moduleName curModl) ++ "_" ++ zEncodeString label)
{'fraction_non_alphanumeric': 0.08444044134204008, 'fraction_numerical': 0.0018013960819635217, 'mean_word_length': 2.2661764705882352, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 21, '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': '7019707', 'n_tokens_mistral': 1426, 'n_tokens_neox': 1389, 'n_words': 372}