never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-2015
    4 -}
    5 
    6 -- | Functions to computing the statistics reflective of the "size"
    7 -- of a Core expression
    8 module GHC.Core.Stats (
    9         -- * Expression and bindings size
   10         coreBindsSize, exprSize,
   11         CoreStats(..), coreBindsStats, exprStats,
   12     ) where
   13 
   14 import GHC.Prelude
   15 
   16 import GHC.Types.Basic
   17 import GHC.Core
   18 import GHC.Utils.Outputable
   19 import GHC.Core.Coercion
   20 import GHC.Types.Tickish
   21 import GHC.Types.Var
   22 import GHC.Core.Type(Type, typeSize)
   23 import GHC.Types.Id (isJoinId)
   24 
   25 data CoreStats = CS { cs_tm :: !Int    -- Terms
   26                     , cs_ty :: !Int    -- Types
   27                     , cs_co :: !Int    -- Coercions
   28                     , cs_vb :: !Int    -- Local value bindings
   29                     , cs_jb :: !Int }  -- Local join bindings
   30 
   31 
   32 instance Outputable CoreStats where
   33  ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5 })
   34    = braces (sep [text "terms:"     <+> intWithCommas i1 <> comma,
   35                   text "types:"     <+> intWithCommas i2 <> comma,
   36                   text "coercions:" <+> intWithCommas i3 <> comma,
   37                   text "joins:"     <+> intWithCommas i5 <> char '/' <>
   38                                         intWithCommas (i4 + i5) ])
   39 
   40 plusCS :: CoreStats -> CoreStats -> CoreStats
   41 plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1 })
   42        (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2 })
   43   = CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2, cs_vb = v1+v2
   44        , cs_jb = j1+j2 }
   45 
   46 zeroCS, oneTM :: CoreStats
   47 zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 }
   48 oneTM  = zeroCS { cs_tm = 1 }
   49 
   50 sumCS :: (a -> CoreStats) -> [a] -> CoreStats
   51 sumCS f = foldl' (\s a -> plusCS s (f a)) zeroCS
   52 
   53 coreBindsStats :: [CoreBind] -> CoreStats
   54 coreBindsStats = sumCS (bindStats TopLevel)
   55 
   56 bindStats :: TopLevelFlag -> CoreBind -> CoreStats
   57 bindStats top_lvl (NonRec v r) = bindingStats top_lvl v r
   58 bindStats top_lvl (Rec prs)    = sumCS (\(v,r) -> bindingStats top_lvl v r) prs
   59 
   60 bindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats
   61 bindingStats top_lvl v r = letBndrStats top_lvl v `plusCS` exprStats r
   62 
   63 bndrStats :: Var -> CoreStats
   64 bndrStats v = oneTM `plusCS` tyStats (varType v)
   65 
   66 letBndrStats :: TopLevelFlag -> Var -> CoreStats
   67 letBndrStats top_lvl v
   68   | isTyVar v || isTopLevel top_lvl = bndrStats v
   69   | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats
   70   | otherwise  = oneTM { cs_vb = 1 } `plusCS` ty_stats
   71   where
   72     ty_stats = tyStats (varType v)
   73 
   74 exprStats :: CoreExpr -> CoreStats
   75 exprStats (Var {})        = oneTM
   76 exprStats (Lit {})        = oneTM
   77 exprStats (Type t)        = tyStats t
   78 exprStats (Coercion c)    = coStats c
   79 exprStats (App f a)       = exprStats f `plusCS` exprStats a
   80 exprStats (Lam b e)       = bndrStats b `plusCS` exprStats e
   81 exprStats (Let b e)       = bindStats NotTopLevel b `plusCS` exprStats e
   82 exprStats (Case e b _ as) = exprStats e `plusCS` bndrStats b
   83                                         `plusCS` sumCS altStats as
   84 exprStats (Cast e co)     = coStats co `plusCS` exprStats e
   85 exprStats (Tick _ e)      = exprStats e
   86 
   87 altStats :: CoreAlt -> CoreStats
   88 altStats (Alt _ bs r) = altBndrStats bs `plusCS` exprStats r
   89 
   90 altBndrStats :: [Var] -> CoreStats
   91 -- Charge one for the alternative, not for each binder
   92 altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs
   93 
   94 tyStats :: Type -> CoreStats
   95 tyStats ty = zeroCS { cs_ty = typeSize ty }
   96 
   97 coStats :: Coercion -> CoreStats
   98 coStats co = zeroCS { cs_co = coercionSize co }
   99 
  100 coreBindsSize :: [CoreBind] -> Int
  101 -- We use coreBindStats for user printout
  102 -- but this one is a quick and dirty basis for
  103 -- the simplifier's tick limit
  104 coreBindsSize bs = sum (map bindSize bs)
  105 
  106 exprSize :: CoreExpr -> Int
  107 -- ^ A measure of the size of the expressions, strictly greater than 0
  108 -- Counts *leaves*, not internal nodes. Types and coercions are not counted.
  109 exprSize (Var _)         = 1
  110 exprSize (Lit _)         = 1
  111 exprSize (App f a)       = exprSize f + exprSize a
  112 exprSize (Lam b e)       = bndrSize b + exprSize e
  113 exprSize (Let b e)       = bindSize b + exprSize e
  114 exprSize (Case e b _ as) = exprSize e + bndrSize b + 1 + sum (map altSize as)
  115 exprSize (Cast e _)      = 1 + exprSize e
  116 exprSize (Tick n e)      = tickSize n + exprSize e
  117 exprSize (Type _)        = 1
  118 exprSize (Coercion _)    = 1
  119 
  120 tickSize :: CoreTickish -> Int
  121 tickSize (ProfNote _ _ _) = 1
  122 tickSize _ = 1
  123 
  124 bndrSize :: Var -> Int
  125 bndrSize _ = 1
  126 
  127 bndrsSize :: [Var] -> Int
  128 bndrsSize = sum . map bndrSize
  129 
  130 bindSize :: CoreBind -> Int
  131 bindSize (NonRec b e) = bndrSize b + exprSize e
  132 bindSize (Rec prs)    = sum (map pairSize prs)
  133 
  134 pairSize :: (Var, CoreExpr) -> Int
  135 pairSize (b,e) = bndrSize b + exprSize e
  136 
  137 altSize :: CoreAlt -> Int
  138 altSize (Alt _ bs e) = bndrsSize bs + exprSize e