[project @ 1999-11-01 17:09:54 by simonpj]
[ghc-hetmet.git] / ghc / compiler / simplCore / BinderInfo.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 %************************************************************************
5 %*                                                                      *
6 \section[BinderInfo]{Information attached to binders by SubstAnal}
7 %*                                                                      *
8 %************************************************************************
9
10 \begin{code}
11 module BinderInfo (
12         BinderInfo,
13
14         addBinderInfo, orBinderInfo,
15
16         deadOccurrence, funOccurrence, noBinderInfo,
17
18         markMany, markInsideLam, markInsideSCC,
19         getBinderInfoArity,
20         setBinderInfoArityToZero,
21
22         binderInfoToOccInfo
23     ) where
24
25 #include "HsVersions.h"
26
27 import IdInfo           ( OccInfo(..), InsideLam, OneBranch, insideLam, notInsideLam, oneBranch )
28 import GlaExts          ( Int(..), (+#) )
29 import Outputable
30 \end{code}
31
32 The @BinderInfo@ describes how a variable is used in a given scope.
33
34 NOTE: With SCCs we have to be careful what we unfold! We don't want to
35 change the attribution of execution costs. If we decide to unfold
36 within an SCC we can tag the definition as @DontKeepBinder@.
37 Definitions tagged as @KeepBinder@ are discarded when we enter the
38 scope of an SCC.
39
40 \begin{code}
41 data BinderInfo
42   = DeadCode    -- Dead code; discard the binding.
43
44   | ManyOcc     -- Everything else besides DeadCode and OneOccs
45
46         !Int    -- number of arguments on stack when called; this is a minimum guarantee
47
48
49   | SingleOcc   -- Just one occurrence (or one each in
50                 -- mutually-exclusive case alts).
51
52       !InsideLam
53
54       !InsideSCC
55
56       !Int      -- Number of mutually-exclusive case alternatives
57                 -- in which it occurs
58
59                 -- Note that we only worry about the case-alt counts
60                 -- if the SingleOcc is substitutable -- that's the only
61                 -- time we *use* the info; we could be more clever for
62                 -- other cases if we really had to. (WDP/PS)
63
64       !Int      -- number of arguments on stack when called; minimum guarantee
65
66 -- In general, we are feel free to substitute unless
67 -- (a) is in an argument position (ArgOcc)
68 -- (b) is inside a lambda [or type lambda?] (DupDanger)
69 -- (c) is inside an SCC expression (InsideSCC)
70 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
71 --      (because the RHS will be inlined regardless of its size)
72 --      [again, DupDanger]
73
74 data InsideSCC
75   = InsideSCC       -- Inside an SCC; so be careful when substituting.
76   | NotInsideSCC    -- It's ok.
77
78 noBinderInfo = ManyOcc 0        -- A non-committal value
79 \end{code} 
80
81 \begin{code}
82 binderInfoToOccInfo :: BinderInfo -> OccInfo
83 binderInfoToOccInfo DeadCode                                 = IAmDead
84 binderInfoToOccInfo (SingleOcc in_lam NotInsideSCC n_alts _) = OneOcc in_lam (n_alts==1)
85 binderInfoToOccInfo other                                    = NoOccInfo
86 \end{code}
87
88
89
90 Construction
91 ~~~~~~~~~~~~~
92 \begin{code}
93 deadOccurrence :: BinderInfo
94 deadOccurrence = DeadCode
95
96 funOccurrence :: Int -> BinderInfo
97 funOccurrence = SingleOcc notInsideLam NotInsideSCC 1
98
99 markMany, markInsideLam, markInsideSCC :: BinderInfo -> BinderInfo
100
101 markMany (SingleOcc _ _ _ ar) = ManyOcc ar
102 markMany (ManyOcc ar)      = ManyOcc ar
103 markMany DeadCode          = panic "markMany"
104
105 markInsideLam (SingleOcc _ in_scc n_alts ar) = SingleOcc insideLam in_scc n_alts ar
106 markInsideLam other                       = other
107
108 markInsideSCC (SingleOcc dup_danger _ n_alts ar) = SingleOcc dup_danger InsideSCC n_alts ar
109 markInsideSCC other                           = other
110
111 addBinderInfo, orBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
112
113 addBinderInfo DeadCode info2 = info2
114 addBinderInfo info1 DeadCode = info1
115 addBinderInfo info1 info2
116  = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
117
118 -- (orBinderInfo orig new) is used
119 -- when combining occurrence info from branches of a case
120
121 orBinderInfo DeadCode info2 = info2
122 orBinderInfo info1 DeadCode = info1
123 orBinderInfo (SingleOcc dup1 scc1 n_alts1 ar_1)
124              (SingleOcc dup2 scc2 n_alts2 ar_2)
125   = let
126      scc  = or_sccs  scc1  scc2
127      dup  = or_dups  dup1  dup2
128      alts = n_alts1 + n_alts2
129      ar   = min ar_1 ar_2
130    in
131    SingleOcc dup scc alts ar
132
133 orBinderInfo info1 info2
134  = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
135
136 or_dups in_lam1 in_lam2 = in_lam1 || in_lam2
137
138 or_sccs InsideSCC _ = InsideSCC
139 or_sccs _ InsideSCC = InsideSCC
140 or_sccs _ _         = NotInsideSCC
141
142 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
143 setBinderInfoArityToZero DeadCode    = DeadCode
144 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
145 setBinderInfoArityToZero (SingleOcc dd sc i _) = SingleOcc dd sc i 0
146 \end{code}
147
148 \begin{code}
149 getBinderInfoArity (DeadCode) = 0
150 getBinderInfoArity (ManyOcc i) = i
151 getBinderInfoArity (SingleOcc _ _ _ i) = i
152 \end{code}
153
154 \begin{code}
155 instance Outputable BinderInfo where
156   ppr DeadCode     = ptext SLIT("Dead")
157   ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
158   ppr (SingleOcc dup_danger in_scc n_alts ar)
159     = hcat [ ptext SLIT("One-"), ppr dup_danger,
160                   char '-', pp_scc in_scc,  char '-', int n_alts,
161                   char '-', int ar ]
162     where
163       pp_scc InsideSCC    = ptext SLIT("*SCC*")
164       pp_scc NotInsideSCC = ptext SLIT("noscc")
165 \end{code}