%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
%************************************************************************
%* *
\begin{code}
module BinderInfo (
BinderInfo(..),
- FunOrArg, DuplicationDanger, InsideSCC, -- NB: all abstract (yay!)
- addBinderInfo, orBinderInfo, andBinderInfo,
+ addBinderInfo, orBinderInfo,
- deadOccurrence, argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
+ deadOccurrence, funOccurrence, noBinderInfo,
- markMany, markDangerousToDup, markInsideSCC,
+ markLazy, markMany, markInsideLam, markInsideSCC,
getBinderInfoArity,
setBinderInfoArityToZero,
- isOneOcc, isOneFunOcc, isOneSafeFunOcc, isOneSameSCCFunOcc,
- isDeadOcc, isInlinableOcc,
-
- isFun, isDupDanger -- for Simon Marlow deforestation
+ occInfoToInlinePrag
) where
#include "HsVersions.h"
+import IdInfo ( InlinePragInfo(..), OccInfo(..) )
import Util ( panic )
import GlaExts ( Int(..), (+#) )
import Outputable
-
\end{code}
The @BinderInfo@ describes how a variable is used in a given scope.
| OneOcc -- Just one occurrence (or one each in
-- mutually-exclusive case alts).
- !FunOrArg -- How it occurs
-
- !DuplicationDanger
+ !OccInfo
!InsideSCC
-- (because the RHS will be inlined regardless of its size)
-- [again, DupDanger]
-data FunOrArg
- = FunOcc -- An occurrence in a function position
- | ArgOcc -- Other arg occurrence
-
- -- When combining branches of a case, only report FunOcc if
- -- both branches are FunOccs
-
-data DuplicationDanger
- = DupDanger -- Inside a non-linear lambda (that is, a lambda which
- -- is sure to be instantiated only once), or inside
- -- the rhs of an INLINE-pragma'd thing. Either way,
- -- substituting a redex for this occurrence is
- -- dangerous because it might duplicate work.
-
- | NoDupDanger -- It's ok; substitution won't duplicate work.
-
data InsideSCC
= InsideSCC -- Inside an SCC; so be careful when substituting.
| NotInsideSCC -- It's ok.
noBinderInfo = ManyOcc 0 -- A non-committal value
-\end{code}
-
-
+\end{code}
\begin{code}
-isOneOcc :: BinderInfo -> Bool
-isOneOcc (OneOcc _ _ _ _ _) = True
-isOneOcc other_bind = False
-
-isOneFunOcc :: BinderInfo -> Bool
-isOneFunOcc (OneOcc FunOcc _ _ _ _) = True
-isOneFunOcc other_bind = False
-
-isOneSameSCCFunOcc :: BinderInfo -> Bool
-isOneSameSCCFunOcc (OneOcc FunOcc _ NotInsideSCC _ _) = True
-isOneSameSCCFunOcc other_bind = False
-
-isOneSafeFunOcc :: BinderInfo -> Bool -- Completely safe
-isOneSafeFunOcc (OneOcc FunOcc NoDupDanger NotInsideSCC n_alts _) = n_alts <= 1
-isOneSafeFunOcc other = False
-
--- A non-WHNF can be inlined if it doesn't occur inside a lambda,
--- and occurs exactly once or
--- occurs once in each branch of a case and is small
---
--- If the thing is in WHNF, there's no danger of duplicating work,
--- so we can inline if it occurs once, or is small
-isInlinableOcc :: Bool -- True <=> don't worry about dup-danger
- -> Bool -- True <=> don't worry about code size
- -> BinderInfo
- -> Bool -- Inlinable
-isInlinableOcc whnf small (ManyOcc _)
- = whnf && small
-isInlinableOcc whnf small (OneOcc _ dup_danger _ n_alts _)
- = (whnf || (case dup_danger of {NoDupDanger -> True; other -> False}))
- && (small || n_alts <= 1)
-isInlinableOcc _ _ DeadCode = False
-
-isDeadOcc :: BinderInfo -> Bool
-isDeadOcc DeadCode = True
-isDeadOcc other = False
-
-isFun :: FunOrArg -> Bool
-isFun FunOcc = True
-isFun _ = False
-
-isDupDanger :: DuplicationDanger -> Bool
-isDupDanger DupDanger = True
-isDupDanger _ = False
+occInfoToInlinePrag :: BinderInfo -> InlinePragInfo
+occInfoToInlinePrag DeadCode = IAmDead
+occInfoToInlinePrag (OneOcc occ_info NotInsideSCC n_alts _) = ICanSafelyBeINLINEd occ_info (n_alts==1)
+occInfoToInlinePrag other = NoInlinePragInfo
\end{code}
deadOccurrence :: BinderInfo
deadOccurrence = DeadCode
-argOccurrence, funOccurrence :: Int -> BinderInfo
-
-funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
-argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
+funOccurrence :: Int -> BinderInfo
+funOccurrence = OneOcc StrictOcc NotInsideSCC 1
-markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
+markLazy, markMany, markInsideLam, markInsideSCC :: BinderInfo -> BinderInfo
-markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
-markMany (ManyOcc ar) = ManyOcc ar
-markMany DeadCode = panic "markMany"
+markMany (OneOcc _ _ _ ar) = ManyOcc ar
+markMany (ManyOcc ar) = ManyOcc ar
+markMany DeadCode = panic "markMany"
-markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
- = OneOcc posn DupDanger in_scc n_alts ar
-markDangerousToDup other = other
+markInsideLam (OneOcc _ in_scc n_alts ar) = OneOcc InsideLam in_scc n_alts ar
+markInsideLam other = other
-dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
+markInsideSCC (OneOcc dup_danger _ n_alts ar) = OneOcc dup_danger InsideSCC n_alts ar
+markInsideSCC other = other
-markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
- = OneOcc posn dup_danger InsideSCC n_alts ar
-markInsideSCC other = other
+markLazy (OneOcc StrictOcc scc n_alts ar) = OneOcc LazyOcc scc n_alts ar
+markLazy other = other
-addBinderInfo, orBinderInfo
- :: BinderInfo -> BinderInfo -> BinderInfo
+addBinderInfo, orBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
addBinderInfo DeadCode info2 = info2
addBinderInfo info1 DeadCode = info1
addBinderInfo info1 info2
= ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
--- (orBinderInfo orig new) is used in two situations:
--- First, when a variable whose occurrence info
--- is currently "orig" is bound to a variable whose occurrence info is "new"
--- eg (\new -> e) orig
--- What we want to do is to *worsen* orig's info to take account of new's
---
--- Second, when combining occurrence info from branches of a case
+-- (orBinderInfo orig new) is used
+-- when combining occurrence info from branches of a case
orBinderInfo DeadCode info2 = info2
orBinderInfo info1 DeadCode = info1
-orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
- (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
+orBinderInfo (OneOcc dup1 scc1 n_alts1 ar_1)
+ (OneOcc dup2 scc2 n_alts2 ar_2)
= let
- posn = combine_posns posn1 posn2
- scc = combine_sccs scc1 scc2
- dup = combine_dups dup1 dup2
+ scc = or_sccs scc1 scc2
+ dup = or_dups dup1 dup2
alts = n_alts1 + n_alts2
ar = min ar_1 ar_2
in
- OneOcc posn dup scc alts ar
+ OneOcc dup scc alts ar
orBinderInfo info1 info2
= ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
--- (andBinderInfo orig new) is used
--- when completing a let-binding
--- let new = ...orig...
--- we compute the way orig occurs in (...orig...), and then use andBinderInfo
--- to worsen this info by the way new occurs in the let body; then we use
--- that to worsen orig's currently recorded occurrence info.
-
-andBinderInfo DeadCode info2 = DeadCode
-andBinderInfo info1 DeadCode = DeadCode
-andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
- (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
- = let
- posn = combine_posns posn1 posn2
- scc = combine_sccs scc1 scc2
- dup = combine_dups dup1 dup2
- alts = n_alts1 + n_alts2
- in
- OneOcc posn dup scc alts ar_1
-
-andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
-
+or_dups InsideLam _ = InsideLam
+or_dups _ InsideLam = InsideLam
+or_dups StrictOcc StrictOcc = StrictOcc
+or_dups _ _ = LazyOcc
-combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
-combine_posns _ _ = ArgOcc
-
-combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
-combine_dups _ DupDanger = DupDanger
-combine_dups _ _ = NoDupDanger
-
-combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
-combine_sccs _ InsideSCC = InsideSCC
-combine_sccs _ _ = NotInsideSCC
+or_sccs InsideSCC _ = InsideSCC
+or_sccs _ InsideSCC = InsideSCC
+or_sccs _ _ = NotInsideSCC
setBinderInfoArityToZero :: BinderInfo -> BinderInfo
setBinderInfoArityToZero DeadCode = DeadCode
setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
-setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
+setBinderInfoArityToZero (OneOcc dd sc i _) = OneOcc dd sc i 0
\end{code}
\begin{code}
getBinderInfoArity (DeadCode) = 0
getBinderInfoArity (ManyOcc i) = i
-getBinderInfoArity (OneOcc _ _ _ _ i) = i
+getBinderInfoArity (OneOcc _ _ _ i) = i
\end{code}
\begin{code}
instance Outputable BinderInfo where
ppr DeadCode = ptext SLIT("Dead")
ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
- ppr (OneOcc posn dup_danger in_scc n_alts ar)
- = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
+ ppr (OneOcc dup_danger in_scc n_alts ar)
+ = hcat [ ptext SLIT("One-"), ppr dup_danger,
char '-', pp_scc in_scc, char '-', int n_alts,
char '-', int ar ]
where
- pp_posn FunOcc = ptext SLIT("fun")
- pp_posn ArgOcc = ptext SLIT("arg")
-
- pp_danger DupDanger = ptext SLIT("*dup*")
- pp_danger NoDupDanger = ptext SLIT("nodup")
-
pp_scc InsideSCC = ptext SLIT("*SCC*")
pp_scc NotInsideSCC = ptext SLIT("noscc")
\end{code}
projects / ghc-hetmet.git / blobdiff