{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-2015
-}

-- | Functions to computing the statistics reflective of the "size"
-- of a Core expression
module GHC.Core.Stats (
        -- * Expression and bindings size
        coreBindsSize, exprSize,
        CoreStats(..), coreBindsStats, exprStats,
    ) where

import GHC.Prelude

import GHC.Types.Basic
import GHC.Core
import GHC.Utils.Outputable
import GHC.Core.Coercion
import GHC.Types.Tickish
import GHC.Types.Var
import GHC.Core.Type(Type, typeSize)
import GHC.Types.Id (isJoinId)

data CoreStats = CS { CoreStats -> Int
cs_tm :: !Int    -- Terms
                    , CoreStats -> Int
cs_ty :: !Int    -- Types
                    , CoreStats -> Int
cs_co :: !Int    -- Coercions
                    , CoreStats -> Int
cs_vb :: !Int    -- Local value bindings
                    , CoreStats -> Int
cs_jb :: !Int }  -- Local join bindings


instance Outputable CoreStats where
 ppr :: CoreStats -> SDoc
ppr (CS { cs_tm :: CoreStats -> Int
cs_tm = Int
i1, cs_ty :: CoreStats -> Int
cs_ty = Int
i2, cs_co :: CoreStats -> Int
cs_co = Int
i3, cs_vb :: CoreStats -> Int
cs_vb = Int
i4, cs_jb :: CoreStats -> Int
cs_jb = Int
i5 })
   = SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [String -> SDoc
text String
"terms:"     SDoc -> SDoc -> SDoc
<+> forall a. Integral a => a -> SDoc
intWithCommas Int
i1 SDoc -> SDoc -> SDoc
<> SDoc
comma,
                  String -> SDoc
text String
"types:"     SDoc -> SDoc -> SDoc
<+> forall a. Integral a => a -> SDoc
intWithCommas Int
i2 SDoc -> SDoc -> SDoc
<> SDoc
comma,
                  String -> SDoc
text String
"coercions:" SDoc -> SDoc -> SDoc
<+> forall a. Integral a => a -> SDoc
intWithCommas Int
i3 SDoc -> SDoc -> SDoc
<> SDoc
comma,
                  String -> SDoc
text String
"joins:"     SDoc -> SDoc -> SDoc
<+> forall a. Integral a => a -> SDoc
intWithCommas Int
i5 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'/' SDoc -> SDoc -> SDoc
<>
                                        forall a. Integral a => a -> SDoc
intWithCommas (Int
i4 forall a. Num a => a -> a -> a
+ Int
i5) ])

plusCS :: CoreStats -> CoreStats -> CoreStats
plusCS :: CoreStats -> CoreStats -> CoreStats
plusCS (CS { cs_tm :: CoreStats -> Int
cs_tm = Int
p1, cs_ty :: CoreStats -> Int
cs_ty = Int
q1, cs_co :: CoreStats -> Int
cs_co = Int
r1, cs_vb :: CoreStats -> Int
cs_vb = Int
v1, cs_jb :: CoreStats -> Int
cs_jb = Int
j1 })
       (CS { cs_tm :: CoreStats -> Int
cs_tm = Int
p2, cs_ty :: CoreStats -> Int
cs_ty = Int
q2, cs_co :: CoreStats -> Int
cs_co = Int
r2, cs_vb :: CoreStats -> Int
cs_vb = Int
v2, cs_jb :: CoreStats -> Int
cs_jb = Int
j2 })
  = CS { cs_tm :: Int
cs_tm = Int
p1forall a. Num a => a -> a -> a
+Int
p2, cs_ty :: Int
cs_ty = Int
q1forall a. Num a => a -> a -> a
+Int
q2, cs_co :: Int
cs_co = Int
r1forall a. Num a => a -> a -> a
+Int
r2, cs_vb :: Int
cs_vb = Int
v1forall a. Num a => a -> a -> a
+Int
v2
       , cs_jb :: Int
cs_jb = Int
j1forall a. Num a => a -> a -> a
+Int
j2 }

zeroCS, oneTM :: CoreStats
zeroCS :: CoreStats
zeroCS = CS { cs_tm :: Int
cs_tm = Int
0, cs_ty :: Int
cs_ty = Int
0, cs_co :: Int
cs_co = Int
0, cs_vb :: Int
cs_vb = Int
0, cs_jb :: Int
cs_jb = Int
0 }
oneTM :: CoreStats
oneTM  = CoreStats
zeroCS { cs_tm :: Int
cs_tm = Int
1 }

sumCS :: (a -> CoreStats) -> [a] -> CoreStats
sumCS :: forall a. (a -> CoreStats) -> [a] -> CoreStats
sumCS a -> CoreStats
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\CoreStats
s a
a -> CoreStats -> CoreStats -> CoreStats
plusCS CoreStats
s (a -> CoreStats
f a
a)) CoreStats
zeroCS

coreBindsStats :: [CoreBind] -> CoreStats
coreBindsStats :: [CoreBind] -> CoreStats
coreBindsStats = forall a. (a -> CoreStats) -> [a] -> CoreStats
sumCS (TopLevelFlag -> CoreBind -> CoreStats
bindStats TopLevelFlag
TopLevel)

bindStats :: TopLevelFlag -> CoreBind -> CoreStats
bindStats :: TopLevelFlag -> CoreBind -> CoreStats
bindStats TopLevelFlag
top_lvl (NonRec CoreBndr
v Expr CoreBndr
r) = TopLevelFlag -> CoreBndr -> Expr CoreBndr -> CoreStats
bindingStats TopLevelFlag
top_lvl CoreBndr
v Expr CoreBndr
r
bindStats TopLevelFlag
top_lvl (Rec [(CoreBndr, Expr CoreBndr)]
prs)    = forall a. (a -> CoreStats) -> [a] -> CoreStats
sumCS (\(CoreBndr
v,Expr CoreBndr
r) -> TopLevelFlag -> CoreBndr -> Expr CoreBndr -> CoreStats
bindingStats TopLevelFlag
top_lvl CoreBndr
v Expr CoreBndr
r) [(CoreBndr, Expr CoreBndr)]
prs

bindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats
bindingStats :: TopLevelFlag -> CoreBndr -> Expr CoreBndr -> CoreStats
bindingStats TopLevelFlag
top_lvl CoreBndr
v Expr CoreBndr
r = TopLevelFlag -> CoreBndr -> CoreStats
letBndrStats TopLevelFlag
top_lvl CoreBndr
v CoreStats -> CoreStats -> CoreStats
`plusCS` Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
r

bndrStats :: Var -> CoreStats
bndrStats :: CoreBndr -> CoreStats
bndrStats CoreBndr
v = CoreStats
oneTM CoreStats -> CoreStats -> CoreStats
`plusCS` Type -> CoreStats
tyStats (CoreBndr -> Type
varType CoreBndr
v)

letBndrStats :: TopLevelFlag -> Var -> CoreStats
letBndrStats :: TopLevelFlag -> CoreBndr -> CoreStats
letBndrStats TopLevelFlag
top_lvl CoreBndr
v
  | CoreBndr -> Bool
isTyVar CoreBndr
v Bool -> Bool -> Bool
|| TopLevelFlag -> Bool
isTopLevel TopLevelFlag
top_lvl = CoreBndr -> CoreStats
bndrStats CoreBndr
v
  | CoreBndr -> Bool
isJoinId CoreBndr
v = CoreStats
oneTM { cs_jb :: Int
cs_jb = Int
1 } CoreStats -> CoreStats -> CoreStats
`plusCS` CoreStats
ty_stats
  | Bool
otherwise  = CoreStats
oneTM { cs_vb :: Int
cs_vb = Int
1 } CoreStats -> CoreStats -> CoreStats
`plusCS` CoreStats
ty_stats
  where
    ty_stats :: CoreStats
ty_stats = Type -> CoreStats
tyStats (CoreBndr -> Type
varType CoreBndr
v)

exprStats :: CoreExpr -> CoreStats
exprStats :: Expr CoreBndr -> CoreStats
exprStats (Var {})        = CoreStats
oneTM
exprStats (Lit {})        = CoreStats
oneTM
exprStats (Type Type
t)        = Type -> CoreStats
tyStats Type
t
exprStats (Coercion Coercion
c)    = Coercion -> CoreStats
coStats Coercion
c
exprStats (App Expr CoreBndr
f Expr CoreBndr
a)       = Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
f CoreStats -> CoreStats -> CoreStats
`plusCS` Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
a
exprStats (Lam CoreBndr
b Expr CoreBndr
e)       = CoreBndr -> CoreStats
bndrStats CoreBndr
b CoreStats -> CoreStats -> CoreStats
`plusCS` Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
e
exprStats (Let CoreBind
b Expr CoreBndr
e)       = TopLevelFlag -> CoreBind -> CoreStats
bindStats TopLevelFlag
NotTopLevel CoreBind
b CoreStats -> CoreStats -> CoreStats
`plusCS` Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
e
exprStats (Case Expr CoreBndr
e CoreBndr
b Type
_ [Alt CoreBndr]
as) = Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
e CoreStats -> CoreStats -> CoreStats
`plusCS` CoreBndr -> CoreStats
bndrStats CoreBndr
b
                                        CoreStats -> CoreStats -> CoreStats
`plusCS` forall a. (a -> CoreStats) -> [a] -> CoreStats
sumCS Alt CoreBndr -> CoreStats
altStats [Alt CoreBndr]
as
exprStats (Cast Expr CoreBndr
e Coercion
co)     = Coercion -> CoreStats
coStats Coercion
co CoreStats -> CoreStats -> CoreStats
`plusCS` Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
e
exprStats (Tick CoreTickish
_ Expr CoreBndr
e)      = Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
e

altStats :: CoreAlt -> CoreStats
altStats :: Alt CoreBndr -> CoreStats
altStats (Alt AltCon
_ [CoreBndr]
bs Expr CoreBndr
r) = [CoreBndr] -> CoreStats
altBndrStats [CoreBndr]
bs CoreStats -> CoreStats -> CoreStats
`plusCS` Expr CoreBndr -> CoreStats
exprStats Expr CoreBndr
r

altBndrStats :: [Var] -> CoreStats
-- Charge one for the alternative, not for each binder
altBndrStats :: [CoreBndr] -> CoreStats
altBndrStats [CoreBndr]
vs = CoreStats
oneTM CoreStats -> CoreStats -> CoreStats
`plusCS` forall a. (a -> CoreStats) -> [a] -> CoreStats
sumCS (Type -> CoreStats
tyStats forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreBndr -> Type
varType) [CoreBndr]
vs

tyStats :: Type -> CoreStats
tyStats :: Type -> CoreStats
tyStats Type
ty = CoreStats
zeroCS { cs_ty :: Int
cs_ty = Type -> Int
typeSize Type
ty }

coStats :: Coercion -> CoreStats
coStats :: Coercion -> CoreStats
coStats Coercion
co = CoreStats
zeroCS { cs_co :: Int
cs_co = Coercion -> Int
coercionSize Coercion
co }

coreBindsSize :: [CoreBind] -> Int
-- We use coreBindStats for user printout
-- but this one is a quick and dirty basis for
-- the simplifier's tick limit
coreBindsSize :: [CoreBind] -> Int
coreBindsSize [CoreBind]
bs = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map CoreBind -> Int
bindSize [CoreBind]
bs)

exprSize :: CoreExpr -> Int
-- ^ A measure of the size of the expressions, strictly greater than 0
-- Counts *leaves*, not internal nodes. Types and coercions are not counted.
exprSize :: Expr CoreBndr -> Int
exprSize (Var CoreBndr
_)         = Int
1
exprSize (Lit Literal
_)         = Int
1
exprSize (App Expr CoreBndr
f Expr CoreBndr
a)       = Expr CoreBndr -> Int
exprSize Expr CoreBndr
f forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
a
exprSize (Lam CoreBndr
b Expr CoreBndr
e)       = CoreBndr -> Int
bndrSize CoreBndr
b forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e
exprSize (Let CoreBind
b Expr CoreBndr
e)       = CoreBind -> Int
bindSize CoreBind
b forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e
exprSize (Case Expr CoreBndr
e CoreBndr
b Type
_ [Alt CoreBndr]
as) = Expr CoreBndr -> Int
exprSize Expr CoreBndr
e forall a. Num a => a -> a -> a
+ CoreBndr -> Int
bndrSize CoreBndr
b forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map Alt CoreBndr -> Int
altSize [Alt CoreBndr]
as)
exprSize (Cast Expr CoreBndr
e Coercion
_)      = Int
1 forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e
exprSize (Tick CoreTickish
n Expr CoreBndr
e)      = CoreTickish -> Int
tickSize CoreTickish
n forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e
exprSize (Type Type
_)        = Int
1
exprSize (Coercion Coercion
_)    = Int
1

tickSize :: CoreTickish -> Int
tickSize :: CoreTickish -> Int
tickSize (ProfNote CostCentre
_ Bool
_ Bool
_) = Int
1
tickSize CoreTickish
_ = Int
1

bndrSize :: Var -> Int
bndrSize :: CoreBndr -> Int
bndrSize CoreBndr
_ = Int
1

bndrsSize :: [Var] -> Int
bndrsSize :: [CoreBndr] -> Int
bndrsSize = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CoreBndr -> Int
bndrSize

bindSize :: CoreBind -> Int
bindSize :: CoreBind -> Int
bindSize (NonRec CoreBndr
b Expr CoreBndr
e) = CoreBndr -> Int
bndrSize CoreBndr
b forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e
bindSize (Rec [(CoreBndr, Expr CoreBndr)]
prs)    = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map (CoreBndr, Expr CoreBndr) -> Int
pairSize [(CoreBndr, Expr CoreBndr)]
prs)

pairSize :: (Var, CoreExpr) -> Int
pairSize :: (CoreBndr, Expr CoreBndr) -> Int
pairSize (CoreBndr
b,Expr CoreBndr
e) = CoreBndr -> Int
bndrSize CoreBndr
b forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e

altSize :: CoreAlt -> Int
altSize :: Alt CoreBndr -> Int
altSize (Alt AltCon
_ [CoreBndr]
bs Expr CoreBndr
e) = [CoreBndr] -> Int
bndrsSize [CoreBndr]
bs forall a. Num a => a -> a -> a
+ Expr CoreBndr -> Int
exprSize Expr CoreBndr
e