- if tag1 _LT_ tag2 then LT else GT
- where
- tag_CC (NormalCC _ _ _ _ _) = (ILIT(1) :: FAST_INT)
- tag_CC (AllCafsCC _ _) = ILIT(2)
- tag_CC (AllDictsCC _ _ _) = ILIT(3)
- tag_CC PreludeCafsCC = ILIT(4)
- tag_CC (PreludeDictsCC _) = ILIT(5)
- tag_CC OverheadCC = ILIT(6)
- tag_CC DontCareCC = ILIT(7)
-
- -- some BUG avoidance here...
- tag_CC NoCostCentre = panic# "tag_CC:NoCostCentre"
- tag_CC SubsumedCosts = panic# "tag_CC:SubsumedCosts"
- tag_CC CurrentCC = panic# "tag_CC:SubsumedCosts"
-
-
-cmp_kind (UserCC n1) (UserCC n2) = n1 `compare` n2
-cmp_kind (AutoCC i1) (AutoCC i2) = i1 `compare` i2
-cmp_kind (DictCC i1) (DictCC i2) = i1 `compare` i2
-cmp_kind other_1 other_2
- = let
- tag1 = tag_CcKind other_1
- tag2 = tag_CcKind other_2
- in
- if tag1 _LT_ tag2 then LT else GT
- where
- tag_CcKind (UserCC _) = (ILIT(1) :: FAST_INT)
- tag_CcKind (AutoCC _) = ILIT(2)
- tag_CcKind (DictCC _) = ILIT(3)
-
-cmp_caf IsNotCafCC IsCafCC = LT
-cmp_caf IsNotCafCC IsNotCafCC = EQ
-cmp_caf IsCafCC IsCafCC = EQ
-cmp_caf IsCafCC IsNotCafCC = GT
-\end{code}
-
-\begin{code}
-showCostCentre :: Bool -> CostCentre -> String
-uppCostCentre :: Bool -> CostCentre -> SDoc
-uppCostCentreDecl :: Bool -> CostCentre -> SDoc
-
-{- PprUnfolding is gone now
-showCostCentre PprUnfolding print_as_string cc
- = ASSERT(not print_as_string) -- we never "print as string w/ Unfolding"
- ASSERT(not (noCostCentreAttached cc))
- ASSERT(not (currentOrSubsumedCosts cc))
- uppShow 80 (upp_cc_uf cc)
--}
-
-showCostCentre print_as_string cc
- = showSDoc (uppCostCentre print_as_string cc)
-
-uppCostCentre print_as_string NoCostCentre
- | print_as_string = text "\"NO_CC\""
- | otherwise = ptext SLIT("NO_CC")
-
-uppCostCentre print_as_string SubsumedCosts
- | print_as_string = text "\"SUBSUMED\""
- | otherwise = ptext SLIT("CC_SUBSUMED")
-
-uppCostCentre print_as_string CurrentCC
- | print_as_string = text "\"CURRENT_CC\""
- | otherwise = ptext SLIT("CCC")
-
-uppCostCentre print_as_string OverheadCC
- | print_as_string = text "\"OVERHEAD\""
- | otherwise = ptext SLIT("CC_OVERHEAD")
-
-uppCostCentre print_as_string cc
- = getPprStyle $ \ sty ->
- let
- prefix_CC = ptext SLIT("CC_")
- basic_thing = do_cc sty cc
- basic_thing_string = stringToC basic_thing
- in
- if print_as_string then
- hcat [char '"', text basic_thing_string, char '"']
-
- else if (friendly_sty sty) then
- text basic_thing
- else
- hcat [prefix_CC, identToC (_PK_ basic_thing)]