content: {-
  (c) The University of Glasgow 2006
  (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
  
  \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
  
  (And a pretty good illustration of quite a few things wrong with
  Haskell. [WDP 94/11])
  -}
  
  module Eta.BasicTypes.IdInfo (
          -- * The IdDetails type
          IdDetails(..), pprIdDetails, coVarDetails,
  
          -- * The IdInfo type
          IdInfo,         -- Abstract
          vanillaIdInfo, noCafIdInfo,
          seqIdInfo,
  
          -- ** The OneShotInfo type
          OneShotInfo(..),
          oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
          setOneShotInfo,
  
          -- ** Zapping various forms of Info
          zapLamInfo, zapFragileInfo,
          zapDemandInfo, zapUsageInfo,
  
          -- ** The ArityInfo type
          ArityInfo,
          unknownArity,
          arityInfo, setArityInfo, ppArityInfo,
  
          callArityInfo, setCallArityInfo,
  
          -- ** Demand and strictness Info
          strictnessInfo, setStrictnessInfo,
          demandInfo, setDemandInfo, pprStrictness,
  
          -- ** Unfolding Info
          unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
  
          -- ** The InlinePragInfo type
          InlinePragInfo,
          inlinePragInfo, setInlinePragInfo,
  
          -- ** The OccInfo type
          OccInfo(..),
          isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
          occInfo, setOccInfo,
  
          InsideLam, OneBranch,
          insideLam, notInsideLam, oneBranch, notOneBranch,
  
          -- ** The RuleInfo type
          RuleInfo(..),
          emptyRuleInfo,
          isEmptyRuleInfo, ruleInfoFreeVars,
          ruleInfoRules, setRuleInfoHead,
          ruleInfo, setRuleInfo,
  
          -- ** The CAFInfo type
          CafInfo(..),
          ppCafInfo, mayHaveCafRefs,
          cafInfo, setCafInfo,
  
          -- ** Tick-box Info
          TickBoxOp(..), TickBoxId,
      ) where
  
  import Eta.Core.CoreSyn
  
  import Eta.Types.Class
  import {-# SOURCE #-} Eta.Prelude.PrimOp (PrimOp)
  import Eta.BasicTypes.Name
  import Eta.BasicTypes.VarSet
  import Eta.BasicTypes.BasicTypes
  import Eta.BasicTypes.DataCon
  import Eta.Types.TyCon
  import Eta.Prelude.ForeignCall
  import Eta.Utils.Outputable
  import Eta.BasicTypes.Module
  import Eta.Utils.FastString
  import Eta.BasicTypes.Demand
  
  -- infixl so you can say (id `set` a `set` b)
  infixl  1 `setRuleInfo`,
            `setArityInfo`,
            `setInlinePragInfo`,
            `setUnfoldingInfo`,
            `setOneShotInfo`,
            `setOccInfo`,
            `setCafInfo`,
            `setStrictnessInfo`,
            `setDemandInfo`
  
  {-
  ************************************************************************
  *                                                                      *
                       IdDetails
  *                                                                      *
  ************************************************************************
  -}
  
  -- | The 'IdDetails' of an 'Id' give stable, and necessary,
  -- information about the Id.
  data IdDetails
    = VanillaId
  
    -- | The 'Id' for a record selector
    | RecSelId
      { sel_tycon   :: TyCon      -- ^ For a data type family, this is the /instance/ 'TyCon'
                                  --   not the family 'TyCon'
      , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
                                  --    data T = forall a. MkT { x :: a }
      }                           -- See Note [Naughty record selectors] in TcTyClsDecls
  
    | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/
    | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/
  
                                  -- [the only reasons we need to know is so that
                                  --  a) to support isImplicitId
                                  --  b) when desugaring a RecordCon we can get
                                  --     from the Id back to the data con]
  
    | ClassOpId Class             -- ^ The 'Id' is a superclass selector or class operation of a class
  
    | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator
    | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call
  
    | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
  
    | DFunId Int Bool             -- ^ A dictionary function.
         -- Int = the number of "silent" arguments to the dfun
         --       e.g.  class D a => C a where ...
         --             instance C a => C [a]
         --       has is_silent = 1, because the dfun
         --       has type  dfun :: (D a, C a) => C [a]
         --       See Note [Silent superclass arguments] in TcInstDcls
         --
         -- Bool = True <=> the class has only one method, so may be
         --                  implemented with a newtype, so it might be bad
         --                  to be strict on this dictionary
  
  coVarDetails :: IdDetails
  coVarDetails = VanillaId
  
  instance Outputable IdDetails where
      ppr = pprIdDetails
  
  pprIdDetails :: IdDetails -> SDoc
  pprIdDetails VanillaId = empty
  pprIdDetails other     = brackets (pp other)
   where
     pp VanillaId         = panic "pprIdDetails"
     pp (DataConWorkId _) = ptext (sLit "DataCon")
     pp (DataConWrapId _) = ptext (sLit "DataConWrapper")
     pp (ClassOpId {})    = ptext (sLit "ClassOp")
     pp (PrimOpId _)      = ptext (sLit "PrimOp")
     pp (FCallId _)       = ptext (sLit "ForeignCall")
     pp (TickBoxOpId _)   = ptext (sLit "TickBoxOp")
     pp (DFunId ns nt)    = ptext (sLit "DFunId")
                               <> ppWhen (ns /= 0) (brackets (int ns))
                               <> ppWhen nt (ptext (sLit "(nt)"))
     pp (RecSelId { sel_naughty = is_naughty })
                           = brackets $ ptext (sLit "RecSel")
                              <> ppWhen is_naughty (ptext (sLit "(naughty)"))
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection{The main IdInfo type}
  *                                                                      *
  ************************************************************************
  -}
  
  -- | An 'IdInfo' gives /optional/ information about an 'Id'.  If
  -- present it never lies, but it may not be present, in which case there
  -- is always a conservative assumption which can be made.
  --
  -- Two 'Id's may have different info even though they have the same
  -- 'Unique' (and are hence the same 'Id'); for example, one might lack
  -- the properties attached to the other.
  --
  -- The 'IdInfo' gives information about the value, or definition, of the
  -- 'Id'.  It does not contain information about the 'Id''s usage,
  -- except for 'demandInfo' and 'oneShotInfo'.
  data IdInfo
    = IdInfo {
          arityInfo       :: !ArityInfo,          -- ^ 'Id' arity
          ruleInfo        :: RuleInfo,            -- ^ Specialisations of the 'Id's function which exist
                                                  -- See Note [Specialisations and RULES in IdInfo]
          unfoldingInfo   :: Unfolding,           -- ^ The 'Id's unfolding
          cafInfo         :: CafInfo,             -- ^ 'Id' CAF info
          oneShotInfo     :: OneShotInfo,         -- ^ Info about a lambda-bound variable, if the 'Id' is one
          inlinePragInfo  :: InlinePragma,        -- ^ Any inline pragma atached to the 'Id'
          occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program
  
          strictnessInfo  :: StrictSig,      --  ^ A strictness signature
  
          demandInfo      :: Demand,       -- ^ ID demand information
          callArityInfo :: !ArityInfo    -- ^ How this is called.
                                           -- n <=> all calls have at least n arguments
      }
  
  -- | Just evaluate the 'IdInfo' to WHNF
  seqIdInfo :: IdInfo -> ()
  seqIdInfo (IdInfo {}) = ()
  
  -- Setters
  
  setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
  setRuleInfo       info sp = sp `seq` info { ruleInfo = sp }
  setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
  setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
  setOccInfo :: IdInfo -> OccInfo -> IdInfo
  setOccInfo        info oc = oc `seq` info { occInfo = oc }
          -- Try to avoid spack leaks by seq'ing
  
  setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo
  setUnfoldingInfoLazily info uf  -- Lazy variant to avoid looking at the
    =                             -- unfolding of an imported Id unless necessary
      info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.)
  
  setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
  setUnfoldingInfo info uf
    = -- We don't seq the unfolding, as we generate intermediate
      -- unfoldings which are just thrown away, so evaluating them is a
      -- waste of time.
      -- seqUnfolding uf `seq`
      info { unfoldingInfo = uf }
  
  setArityInfo :: IdInfo -> ArityInfo -> IdInfo
  setArityInfo      info ar  = info { arityInfo = ar  }
  setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
  setCallArityInfo info ar  = info { callArityInfo = ar  }
  setCafInfo :: IdInfo -> CafInfo -> IdInfo
  setCafInfo        info caf = info { cafInfo = caf }
  
  setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
  setOneShotInfo      info lb = {-lb `seq`-} info { oneShotInfo = lb }
  
  setDemandInfo :: IdInfo -> Demand -> IdInfo
  setDemandInfo info dd = dd `seq` info { demandInfo = dd }
  
  setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
  setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
  
  -- | Basic 'IdInfo' that carries no useful information whatsoever
  vanillaIdInfo :: IdInfo
  vanillaIdInfo
    = IdInfo {
              cafInfo             = vanillaCafInfo,
              arityInfo           = unknownArity,
              ruleInfo            = emptyRuleInfo,
              unfoldingInfo       = noUnfolding,
              oneShotInfo         = NoOneShotInfo,
              inlinePragInfo      = defaultInlinePragma,
              occInfo             = NoOccInfo,
              demandInfo          = topDmd,
              strictnessInfo      = nopSig,
              callArityInfo     = unknownArity
             }
  
  -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
  noCafIdInfo :: IdInfo
  noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
          -- Used for built-in type Ids in MkId.
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection[arity-IdInfo]{Arity info about an @Id@}
  *                                                                      *
  ************************************************************************
  
  For locally-defined Ids, the code generator maintains its own notion
  of their arities; so it should not be asking...  (but other things
  besides the code-generator need arity info!)
  -}
  
  -- | An 'ArityInfo' of @n@ tells us that partial application of this
  -- 'Id' to up to @n-1@ value arguments does essentially no work.
  --
  -- That is not necessarily the same as saying that it has @n@ leading
  -- lambdas, because coerces may get in the way.
  --
  -- The arity might increase later in the compilation process, if
  -- an extra lambda floats up to the binding site.
  type ArityInfo = Arity
  
  -- | It is always safe to assume that an 'Id' has an arity of 0
  unknownArity :: Arity
  unknownArity = 0 :: Arity
  
  ppArityInfo :: Int -> SDoc
  ppArityInfo 0 = empty
  ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection{Inline-pragma information}
  *                                                                      *
  ************************************************************************
  -}
  
  -- | Tells when the inlining is active.
  -- When it is active the thing may be inlined, depending on how
  -- big it is.
  --
  -- If there was an @INLINE@ pragma, then as a separate matter, the
  -- RHS will have been made to look small with a Core inline 'Note'
  --
  -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
  -- entirely as a way to inhibit inlining until we want it
  type InlinePragInfo = InlinePragma
  
  {-
  ************************************************************************
  *                                                                      *
                 Strictness
  *                                                                      *
  ************************************************************************
  -}
  
  pprStrictness :: StrictSig -> SDoc
  pprStrictness sig = ppr sig
  
  {-
  ************************************************************************
  *                                                                      *
          RuleInfo
  *                                                                      *
  ************************************************************************
  
  Note [Specialisations and RULES in IdInfo]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Generally speaking, a GlobalId has an *empty* RuleInfo.  All their
  RULES are contained in the globally-built rule-base.  In principle,
  one could attach the to M.f the RULES for M.f that are defined in M.
  But we don't do that for instance declarations and so we just treat
  them all uniformly.
  
  The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
  jsut for convenience really.
  
  However, LocalIds may have non-empty RuleInfo.  We treat them
  differently because:
    a) they might be nested, in which case a global table won't work
    b) the RULE might mention free variables, which we use to keep things alive
  
  In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off
  and put in the global list.
  -}
  
  -- | Records the specializations of this 'Id' that we know about
  -- in the form of rewrite 'CoreRule's that target them
  data RuleInfo
    = RuleInfo
          [CoreRule]
          DVarSet          -- Locally-defined free vars of *both* LHS and RHS
                          -- of rules.  I don't think it needs to include the
                          -- ru_fn though.
                          -- Note [Rule dependency info] in OccurAnal
  
  -- | Assume that no specilizations exist: always safe
  emptyRuleInfo :: RuleInfo
  emptyRuleInfo = RuleInfo [] emptyDVarSet
  
  isEmptyRuleInfo :: RuleInfo -> Bool
  isEmptyRuleInfo (RuleInfo rs _) = null rs
  
  -- | Retrieve the locally-defined free variables of both the left and
  -- right hand sides of the specialization rules
  ruleInfoFreeVars :: RuleInfo -> DVarSet
  ruleInfoFreeVars (RuleInfo _ fvs) = fvs
  
  ruleInfoRules :: RuleInfo -> [CoreRule]
  ruleInfoRules (RuleInfo rules _) = rules
  
  -- | Change the name of the function the rule is keyed on on all of the 'CoreRule's
  setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
  setRuleInfoHead fn (RuleInfo rules fvs)
    = RuleInfo (map (setRuleIdName fn) rules) fvs
  
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection[CG-IdInfo]{Code generator-related information}
  *                                                                      *
  ************************************************************************
  -}
  
  -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
  
  -- | Records whether an 'Id' makes Constant Applicative Form references
  data CafInfo
          = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:
                                          --
                                          -- 1. A function or static constructor
                                          --    that refers to one or more CAFs, or
                                          --
                                          -- 2. A real live CAF
  
          | NoCafRefs                     -- ^ A function or static constructor
                                          -- that refers to no CAFs.
          deriving (Eq, Ord)
  
  -- | Assumes that the 'Id' has CAF references: definitely safe
  vanillaCafInfo :: CafInfo
  vanillaCafInfo = MayHaveCafRefs
  
  mayHaveCafRefs :: CafInfo -> Bool
  mayHaveCafRefs  MayHaveCafRefs = True
  mayHaveCafRefs _               = False
  
  instance Outputable CafInfo where
     ppr = ppCafInfo
  
  ppCafInfo :: CafInfo -> SDoc
  ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
  ppCafInfo MayHaveCafRefs = empty
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection{Bulk operations on IdInfo}
  *                                                                      *
  ************************************************************************
  -}
  
  -- | This is used to remove information on lambda binders that we have
  -- setup as part of a lambda group, assuming they will be applied all at once,
  -- but turn out to be part of an unsaturated lambda as in e.g:
  --
  -- > (\x1. \x2. e) arg1
  zapLamInfo :: IdInfo -> Maybe IdInfo
  zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
    | is_safe_occ occ && is_safe_dmd demand
    = Nothing
    | otherwise
    = Just (info {occInfo = safe_occ, demandInfo = topDmd})
    where
          -- The "unsafe" occ info is the ones that say I'm not in a lambda
          -- because that might not be true for an unsaturated lambda
      is_safe_occ (OneOcc in_lam _ _) = in_lam
      is_safe_occ _other              = True
  
      safe_occ = case occ of
                   OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
                   _other                -> occ
  
      is_safe_dmd dmd = not (isStrictDmd dmd)
  
  -- | Remove all demand info on the 'IdInfo'
  zapDemandInfo :: IdInfo -> Maybe IdInfo
  zapDemandInfo info = Just (info {demandInfo = topDmd})
  
  -- | Remove usage (but not strictness) info on the 'IdInfo'
  zapUsageInfo :: IdInfo -> Maybe IdInfo
  zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})
  
  zapFragileInfo :: IdInfo -> Maybe IdInfo
  -- ^ Zap info that depends on free variables
  zapFragileInfo info
    = Just (info `setRuleInfo` emptyRuleInfo
                 `setUnfoldingInfo` noUnfolding
                 `setOccInfo` zapFragileOcc occ)
    where
      occ = occInfo info
  
  {-
  ************************************************************************
  *                                                                      *
  \subsection{TickBoxOp}
  *                                                                      *
  ************************************************************************
  -}
  
  type TickBoxId = Int
  
  -- | Tick box for Hpc-style coverage
  data TickBoxOp
     = TickBox Module {-# UNPACK #-} !TickBoxId
  
  instance Outputable TickBoxOp where
      ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)
  