- else if friendly_sty then
- text basic_thing
- else
- hcat [prefix_CC, identToC (_PK_ basic_thing)]
- where
- friendly_sty = friendly_style sty
-
- ----------------
- do_cc DontCareCC = "DONT_CARE"
- do_cc (AllCafsCC m _) = if print_as_string
- then "CAFs_in_..."
- else "CAFs." ++ _UNPK_ m
- do_cc (AllDictsCC m _ d) = do_dupd d (
- if print_as_string
- then "DICTs_in_..."
- else "DICTs." ++ _UNPK_ m)
- do_cc PreludeCafsCC = if print_as_string
- then "CAFs_in_..."
- else "CAFs"
- do_cc (PreludeDictsCC d) = do_dupd d (
- if print_as_string
- then "DICTs_in_..."
- else "DICTs")
-
- do_cc (NormalCC kind mod_name grp_name is_dupd is_caf)
- = let
- basic_kind = do_kind kind
- module_kind = do_caf is_caf (moduleString mod_name ++ '/':
- basic_kind)
- grp_str = if (_NULL_ grp_name) then mod_name else grp_name
- full_kind = do_caf is_caf
- (moduleString mod_name ++
- ('/' : _UNPK_ grp_str) ++
- ('/' : basic_kind))
- in
- case sty of
- PprForC -> do_caf is_caf basic_kind
- _ ->
- if friendly_sty then
- do_dupd is_dupd full_kind
- else
- module_kind
- where
- do_caf IsCafCC ls = "CAF:" ++ ls
- do_caf _ ls = ls
-
- do_kind (UserCC name) = _UNPK_ name
- do_kind (AutoCC id) = do_id id ++ (if friendly_sty then "/AUTO" else "")
- do_kind (DictCC id) = do_id id ++ (if friendly_sty then "/DICT" else "")
-
- {-
- do_id is only applied in a (not print_as_string) context for local ids,
- hence using the occurrence name is enough.
- -}
- do_id :: Id -> String
- do_id id = getOccString id
-
- ---------------
- do_dupd ADupdCC str = if friendly_sty then str ++ "/DUPD" else str
- do_dupd _ str = str
-
-friendly_style sty -- i.e., probably for human consumption
- = case sty of
- PprForUser _ -> True
- PprDebug -> True
- PprShowAll -> True
- _ -> False
-{-
-friendly_style sty -- i.e., probably for human consumption
- = not (codeStyle sty || ifaceStyle sty)
--}
+\begin{code}
+instance Outputable CostCentreStack where
+ ppr NoCCS = ptext SLIT("NO_CCS")
+ ppr CurrentCCS = ptext SLIT("CCCS")
+ ppr OverheadCCS = ptext SLIT("CCS_OVERHEAD")
+ ppr DontCareCCS = ptext SLIT("CCS_DONT_CARE")
+ ppr SubsumedCCS = ptext SLIT("CCS_SUBSUMED")
+ ppr (PushCC cc NoCCS) = ppr cc <> ptext SLIT("_ccs")
+ ppr (PushCC cc ccs) = ptext SLIT("PushCostCentre") <>
+ parens (ppr ccs <> comma <> ppr cc)
+
+-- print the static declaration for a singleton CCS.
+pprCostCentreStackDecl :: CostCentreStack -> SDoc
+pprCostCentreStackDecl ccs@(PushCC cc NoCCS)
+ = hcat [ ptext SLIT("CCS_DECLARE"), char '(',
+ ppr ccs, comma, -- better be codeStyle
+ ppCostCentreLbl cc, comma,
+ empty, -- Now always externally visible
+ text ");"
+ ]
+
+pprCostCentreStackDecl ccs
+ = pprPanic "pprCostCentreStackDecl: " (ppr ccs)