%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
%************************************************************************
%* *
%************************************************************************
\begin{code}
-
#include "HsVersions.h"
module BinderInfo (
BinderInfo(..),
FunOrArg, DuplicationDanger, InsideSCC, -- NB: all abstract (yay!)
- inlineUnconditionally, oneTextualOcc, oneSafeOcc,
-
- combineBinderInfo, combineAltsBinderInfo,
+ addBinderInfo, orBinderInfo, andBinderInfo,
- argOccurrence, funOccurrence,
+ argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
markMany, markDangerousToDup, markInsideSCC,
getBinderInfoArity,
setBinderInfoArityToZero,
-
+
isFun, isDupDanger -- for Simon Marlow deforestation
) where
-IMPORT_Trace -- ToDo: rm (debugging)
+IMP_Ubiq(){-uitous-}
-import PlainCore
-import Outputable
import Pretty
-import Util -- for pragmas only
+import Util ( panic )
+#if __GLASGOW_HASKELL__ >= 202
+import Outputable
+#endif
+
\end{code}
The @BinderInfo@ describes how a variable is used in a given scope.
| ManyOcc -- Everything else besides DeadCode and OneOccs
- Int -- number of arguments on stack when called
+ Int -- number of arguments on stack when called; this is a minimum guarantee
| OneOcc -- Just one occurrence (or one each in
-- time we *use* the info; we could be more clever for
-- other cases if we really had to. (WDP/PS)
- Int -- number of arguments on stack when called
+ Int -- number of arguments on stack when called; minimum guarantee
-- In general, we are feel free to substitute unless
-- (a) is in an argument position (ArgOcc)
-- When combining branches of a case, only report FunOcc if
-- both branches are FunOccs
-data DuplicationDanger
+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,
data InsideSCC
= InsideSCC -- Inside an SCC; so be careful when substituting.
| NotInsideSCC -- It's ok.
-\end{code}
+noBinderInfo = ManyOcc 0 -- A non-committal value
+\end{code}
-Predicates
-~~~~~~~~~~
-@oneTextualOcc@ checks for one occurrence, in any position.
-The occurrence may be inside a lambda, that's all right.
\begin{code}
-oneTextualOcc :: Bool -> BinderInfo -> Bool
-
-oneTextualOcc ok_to_dup (OneOcc _ _ _ n_alts _) = n_alts <= 1 || ok_to_dup
-oneTextualOcc _ other = False
-\end{code}
-
-@safeSingleOcc@ detects single occurences of values that are safe to
-inline, {\em including} ones in an argument position.
+isFun :: FunOrArg -> Bool
+isFun FunOcc = True
+isFun _ = False
-\begin{code}
-oneSafeOcc :: Bool -> BinderInfo -> Bool
-oneSafeOcc ok_to_dup (OneOcc _ NoDupDanger NotInsideSCC n_alts _)
- = n_alts <= 1 || ok_to_dup
-oneSafeOcc _ other = False
+isDupDanger :: DuplicationDanger -> Bool
+isDupDanger DupDanger = True
+isDupDanger _ = False
\end{code}
@inlineUnconditionally@ decides whether a let-bound thing can
definitely be inlined.
\begin{code}
+{- NOT USED
+
inlineUnconditionally :: Bool -> BinderInfo -> Bool
--inlineUnconditionally ok_to_dup DeadCode = True
-- damage, e.g., limit to M alternatives.
inlineUnconditionally _ _ = False
-\end{code}
-
-\begin{code}
-isFun :: FunOrArg -> Bool
-isFun FunOcc = True
-isFun _ = False
-
-isDupDanger :: DuplicationDanger -> Bool
-isDupDanger DupDanger = True
-isDupDanger _ = False
+-}
\end{code}
= OneOcc posn DupDanger in_scc n_alts ar
markDangerousToDup other = other
+dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
+
markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
= OneOcc posn dup_danger InsideSCC n_alts ar
markInsideSCC other = other
-combineBinderInfo, combineAltsBinderInfo
+addBinderInfo, orBinderInfo
:: BinderInfo -> BinderInfo -> BinderInfo
-combineBinderInfo DeadCode info2 = info2
-combineBinderInfo info1 DeadCode = info1
-combineBinderInfo info1 info2
- = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
-
-combineAltsBinderInfo DeadCode info2 = info2
-combineAltsBinderInfo info1 DeadCode = info1
-combineAltsBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
- (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
- = OneOcc (combine_posns posn1 posn2)
- (combine_dups dup1 dup2)
- (combine_sccs scc1 scc2)
- (n_alts1 + n_alts2)
- (min ar_1 ar_2)
- where
- 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
-
-combineAltsBinderInfo info1 info2
- = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
+addBinderInfo DeadCode info2 = info2
+addBinderInfo info1 DeadCode = info1
+addBinderInfo info1 info2
+ = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
+ (I# i#) -> ManyOcc (I# i#)
+ -- ManyOcc min (getBinderInfoArity info1) (getBinderInfoArity info2))
+
+-- (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)
+ = let
+ -- Seriously maligned in order to make it stricter,
+ -- let's hope it is worth it..
+ posn = combine_posns posn1 posn2
+ scc = combine_sccs scc1 scc2
+ dup = combine_dups dup1 dup2
+ alts = n_alts1 + n_alts2
+ ar = min ar_1 ar_2
+
+ -- No CSE, please!
+ cont1 = case scc of { InsideSCC -> cont2; _ -> cont2 }
+ cont2 = case dup of { DupDanger -> cont3; _ -> cont3 }
+ cont3 = case alts of { (I# 0#) -> cont4; _ -> cont4 }
+ cont4 = case ar of { (I# 0#) -> cont5; _ -> cont5 }
+ cont5 = OneOcc posn dup scc alts ar
+ in
+ case posn of { FunOcc -> cont1; _ -> cont1 }
+orBinderInfo info1 info2
+ = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
+ (I# i#) -> ManyOcc (I# i#)
+
+-- (andBinderInfo 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 completing a let-binding
+-- let new = ...orig...
+-- we compute the way orig occurs in (...orig...), and then use orBinderInfo
+-- 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 (I# n_alts1#) (I# ar_1#))
+ (OneOcc posn2 dup2 scc2 (I# n_alts2#) ar_2)
+ = let
+ -- Perversly maligned in order to make it stricter.
+ posn = combine_posns posn1 posn2
+ scc = combine_sccs scc1 scc2
+ dup = combine_dups dup1 dup2
+ alts = I# (n_alts1# +# n_alts2#)
+
+ -- No CSE, please!
+ cont1 = case scc of { InsideSCC -> cont2; _ -> cont2 }
+ cont2 = case dup of { DupDanger -> cont3; _ -> cont3 }
+ cont3 = case alts of { (I# 0#) -> cont4; _ -> cont4 }
+ cont4 = OneOcc posn dup scc alts (I# ar_1#)
+ in
+ case posn of {FunOcc -> cont1; _ -> cont1}
+
+andBinderInfo info1 info2 =
+ case getBinderInfoArity info1 of
+ (I# i#) -> ManyOcc (I# i#)
+ --ManyOcc (getBinderInfoArity info1)
+
+
+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
setBinderInfoArityToZero :: BinderInfo -> BinderInfo
setBinderInfoArityToZero DeadCode = DeadCode
\begin{code}
instance Outputable BinderInfo where
- ppr sty DeadCode = ppStr "Dead"
- ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
+ ppr sty DeadCode = ptext SLIT("Dead")
+ ppr sty (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
- = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
- ppChar '-', pp_scc in_scc, ppChar '-', ppInt n_alts,
- ppChar '-', ppInt ar ]
+ = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
+ char '-', pp_scc in_scc, char '-', int n_alts,
+ char '-', int ar ]
where
- pp_posn FunOcc = ppStr "fun"
- pp_posn ArgOcc = ppStr "arg"
+ pp_posn FunOcc = ptext SLIT("fun")
+ pp_posn ArgOcc = ptext SLIT("arg")
- pp_danger DupDanger = ppStr "*dup*"
- pp_danger NoDupDanger = ppStr "nodup"
+ pp_danger DupDanger = ptext SLIT("*dup*")
+ pp_danger NoDupDanger = ptext SLIT("nodup")
- pp_scc InsideSCC = ppStr "*SCC*"
- pp_scc NotInsideSCC = ppStr "noscc"
+ pp_scc InsideSCC = ptext SLIT("*SCC*")
+ pp_scc NotInsideSCC = ptext SLIT("noscc")
\end{code}
projects / ghc-hetmet.git / blobdiff