never executed always true always false

    1 module GHC.Core.UsageEnv
    2   ( Usage(..)
    3   , UsageEnv
    4   , addUE
    5   , addUsage
    6   , bottomUE
    7   , deleteUE
    8   , lookupUE
    9   , scaleUE
   10   , scaleUsage
   11   , supUE
   12   , supUEs
   13   , unitUE
   14   , zeroUE
   15   ) where
   16 
   17 import Data.Foldable
   18 import GHC.Prelude
   19 import GHC.Core.Multiplicity
   20 import GHC.Types.Name
   21 import GHC.Types.Name.Env
   22 import GHC.Utils.Outputable
   23 import GHC.Utils.Panic
   24 
   25 --
   26 -- * Usage environments
   27 --
   28 
   29 -- The typechecker and the linter output usage environments. See Note [Usages]
   30 -- in Multiplicity. Every absent name being considered to map to 'Zero' of
   31 -- 'Bottom' depending on a flag. See Note [Zero as a usage] in Multiplicity, see
   32 -- Note [Bottom as a usage] in Multiplicity.
   33 
   34 data Usage = Zero | Bottom | MUsage Mult
   35 
   36 instance Outputable Usage where
   37   ppr Zero = text "0"
   38   ppr Bottom = text "Bottom"
   39   ppr (MUsage x) = ppr x
   40 
   41 addUsage :: Usage -> Usage -> Usage
   42 addUsage Zero x = x
   43 addUsage x Zero = x
   44 addUsage Bottom x = x
   45 addUsage x Bottom = x
   46 addUsage (MUsage x) (MUsage y) = MUsage $ mkMultAdd x y
   47 
   48 scaleUsage :: Mult -> Usage -> Usage
   49 scaleUsage One Bottom     = Bottom
   50 scaleUsage _   Zero       = Zero
   51 scaleUsage x   Bottom     = MUsage x
   52 scaleUsage x   (MUsage y) = MUsage $ mkMultMul x y
   53 
   54 -- For now, we use extra multiplicity Bottom for empty case.
   55 data UsageEnv = UsageEnv !(NameEnv Mult) Bool
   56 
   57 unitUE :: NamedThing n => n -> Mult -> UsageEnv
   58 unitUE x w = UsageEnv (unitNameEnv (getName x) w) False
   59 
   60 zeroUE, bottomUE :: UsageEnv
   61 zeroUE = UsageEnv emptyNameEnv False
   62 
   63 bottomUE = UsageEnv emptyNameEnv True
   64 
   65 addUE :: UsageEnv -> UsageEnv -> UsageEnv
   66 addUE (UsageEnv e1 b1) (UsageEnv e2 b2) =
   67   UsageEnv (plusNameEnv_C mkMultAdd e1 e2) (b1 || b2)
   68 
   69 scaleUE :: Mult -> UsageEnv -> UsageEnv
   70 scaleUE One ue = ue
   71 scaleUE w (UsageEnv e _) =
   72   UsageEnv (mapNameEnv (mkMultMul w) e) False
   73 
   74 supUE :: UsageEnv -> UsageEnv -> UsageEnv
   75 supUE (UsageEnv e1 False) (UsageEnv e2 False) =
   76   UsageEnv (plusNameEnv_CD mkMultSup e1 Many e2 Many) False
   77 supUE (UsageEnv e1 b1) (UsageEnv e2 b2) = UsageEnv (plusNameEnv_CD2 combineUsage e1 e2) (b1 && b2)
   78    where combineUsage (Just x) (Just y) = mkMultSup x y
   79          combineUsage Nothing  (Just x) | b1        = x
   80                                         | otherwise = Many
   81          combineUsage (Just x) Nothing  | b2        = x
   82                                         | otherwise = Many
   83          combineUsage Nothing  Nothing  = pprPanic "supUE" (ppr e1 <+> ppr e2)
   84 -- Note: If you are changing this logic, check 'mkMultSup' in Multiplicity as well.
   85 
   86 supUEs :: [UsageEnv] -> UsageEnv
   87 supUEs = foldr supUE bottomUE
   88 
   89 
   90 deleteUE :: NamedThing n => UsageEnv -> n -> UsageEnv
   91 deleteUE (UsageEnv e b) x = UsageEnv (delFromNameEnv e (getName x)) b
   92 
   93 -- | |lookupUE x env| returns the multiplicity assigned to |x| in |env|, if |x| is not
   94 -- bound in |env|, then returns |Zero| or |Bottom|.
   95 lookupUE :: NamedThing n => UsageEnv -> n -> Usage
   96 lookupUE (UsageEnv e has_bottom) x =
   97   case lookupNameEnv e (getName x) of
   98     Just w  -> MUsage w
   99     Nothing -> if has_bottom then Bottom else Zero
  100 
  101 instance Outputable UsageEnv where
  102   ppr (UsageEnv ne b) = text "UsageEnv:" <+> ppr ne <+> ppr b