1{-
2(c) Bartosz Nitka, Facebook 2015
3
4-}
5
6{-# LANGUAGE BangPatterns #-}
7
8-- | Utilities for efficiently and deterministically computing free variables.
9module GHC.Utils.FV (
10        -- * Deterministic free vars computations
11        FV, InterestingVarFun,
12
13        -- * Running the computations
14        fvVarList, fvVarSet, fvDVarSet,
15
16        -- ** Manipulating those computations
17        unitFV,
18        emptyFV,
19        mkFVs,
20        unionFV,
21        unionsFV,
22        delFV,
23        delFVs,
24        filterFV,
25        mapUnionFV,
26    ) where
27
28import GHC.Prelude
29
30import GHC.Types.Var
31import GHC.Types.Var.Set
32
33-- | Predicate on possible free variables: returns @True@ iff the variable is
34-- interesting
35type InterestingVarFun = Var -> Bool
36
37-- Note [Deterministic FV]
38-- ~~~~~~~~~~~~~~~~~~~~~~~
39-- When computing free variables, the order in which you get them affects
40-- the results of floating and specialization. If you use UniqFM to collect
41-- them and then turn that into a list, you get them in nondeterministic
42-- order as described in Note [Deterministic UniqFM] in GHC.Types.Unique.DFM.
43
44-- A naive algorithm for free variables relies on merging sets of variables.
45-- Merging costs O(n+m) for UniqFM and for UniqDFM there's an additional log
46-- factor. It's cheaper to incrementally add to a list and use a set to check
47-- for duplicates.
48type FV = InterestingVarFun -- Used for filtering sets as we build them
49        -> VarSet           -- Locally bound variables
50        -> VarAcc           -- Accumulator
51        -> VarAcc
52
53type VarAcc = ([Var], VarSet)  -- List to preserve ordering and set to check for membership,
54                               -- so that the list doesn't have duplicates
55                               -- For explanation of why using `VarSet` is not deterministic see
56                               -- Note [Deterministic UniqFM] in GHC.Types.Unique.DFM.
57
58-- Note [FV naming conventions]
59-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
60-- To get the performance and determinism that FV provides, FV computations
61-- need to built up from smaller FV computations and then evaluated with
62-- one of `fvVarList`, `fvDVarSet` That means the functions
63-- returning FV need to be exported.
64--
65-- The conventions are:
66--
67-- a) non-deterministic functions:
68--   * a function that returns VarSet
69--       e.g. `tyVarsOfType`
70-- b) deterministic functions:
71--   * a worker that returns FV
72--       e.g. `tyFVsOfType`
73--   * a function that returns [Var]
74--       e.g. `tyVarsOfTypeList`
75--   * a function that returns DVarSet
76--       e.g. `tyVarsOfTypeDSet`
77--
78-- Where tyVarsOfType, tyVarsOfTypeList, tyVarsOfTypeDSet are implemented
79-- in terms of the worker evaluated with fvVarSet, fvVarList, fvDVarSet
80-- respectively.
81
82-- | Run a free variable computation, returning a list of distinct free
83-- variables in deterministic order and a non-deterministic set containing
84-- those variables.
85fvVarAcc :: FV ->  ([Var], VarSet)
86fvVarAcc fv = fv (const True) emptyVarSet ([], emptyVarSet)
87
88-- | Run a free variable computation, returning a list of distinct free
89-- variables in deterministic order.
90fvVarList :: FV -> [Var]
91fvVarList = fst . fvVarAcc
92
93-- | Run a free variable computation, returning a deterministic set of free
94-- variables. Note that this is just a wrapper around the version that
95-- returns a deterministic list. If you need a list you should use
96-- `fvVarList`.
97fvDVarSet :: FV -> DVarSet
98fvDVarSet = mkDVarSet . fvVarList
99
100-- | Run a free variable computation, returning a non-deterministic set of
101-- free variables. Don't use if the set will be later converted to a list
102-- and the order of that list will impact the generated code.
103fvVarSet :: FV -> VarSet
104fvVarSet = snd . fvVarAcc
105
106-- Note [FV eta expansion]
107-- ~~~~~~~~~~~~~~~~~~~~~~~
108-- Let's consider an eta-reduced implementation of freeVarsOf using FV:
109--
110-- freeVarsOf (App a b) = freeVarsOf a `unionFV` freeVarsOf b
111--
112-- If GHC doesn't eta-expand it, after inlining unionFV we end up with
113--
114-- freeVarsOf = \x ->
115--   case x of
116--     App a b -> \fv_cand in_scope acc ->
117--       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc
118--
119-- which has to create a thunk, resulting in more allocations.
120--
121-- On the other hand if it is eta-expanded:
122--
123-- freeVarsOf (App a b) fv_cand in_scope acc =
124--   (freeVarsOf a `unionFV` freeVarsOf b) fv_cand in_scope acc
125--
126-- after inlining unionFV we have:
127--
128-- freeVarsOf = \x fv_cand in_scope acc ->
129--   case x of
130--     App a b ->
131--       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc
132--
133-- which saves allocations.
134--
135-- GHC when presented with knowledge about all the call sites, correctly
136-- eta-expands in this case. Unfortunately due to the fact that freeVarsOf gets
137-- exported to be composed with other functions, GHC doesn't have that
138-- information and has to be more conservative here.
139--
140-- Hence functions that get exported and return FV need to be manually
141-- eta-expanded. See also #11146.
142
143-- | Add a variable - when free, to the returned free variables.
144-- Ignores duplicates and respects the filtering function.
145unitFV :: Id -> FV
146unitFV var fv_cand in_scope acc@(have, haveSet)
147  | var `elemVarSet` in_scope = acc
148  | var `elemVarSet` haveSet = acc
149  | fv_cand var = (var:have, extendVarSet haveSet var)
150  | otherwise = acc
151{-# INLINE unitFV #-}
152
153-- | Return no free variables.
154emptyFV :: FV
155emptyFV _ _ acc = acc
156{-# INLINE emptyFV #-}
157
158-- | Union two free variable computations.
159unionFV :: FV -> FV -> FV
160unionFV fv1 fv2 fv_cand in_scope acc =
161  fv1 fv_cand in_scope $! fv2 fv_cand in_scope $! acc
162{-# INLINE unionFV #-}
163
164-- | Mark the variable as not free by putting it in scope.
165delFV :: Var -> FV -> FV
166delFV var fv fv_cand !in_scope acc =
167  fv fv_cand (extendVarSet in_scope var) acc
168{-# INLINE delFV #-}
169
170-- | Mark many free variables as not free.
171delFVs :: VarSet -> FV -> FV
172delFVs vars fv fv_cand !in_scope acc =
173  fv fv_cand (in_scope `unionVarSet` vars) acc
174{-# INLINE delFVs #-}
175
176-- | Filter a free variable computation.
177filterFV :: InterestingVarFun -> FV -> FV
178filterFV fv_cand2 fv fv_cand1 in_scope acc =
179  fv (\v -> fv_cand1 v && fv_cand2 v) in_scope acc
180{-# INLINE filterFV #-}
181
182-- | Map a free variable computation over a list and union the results.
183mapUnionFV :: (a -> FV) -> [a] -> FV
184mapUnionFV _f [] _fv_cand _in_scope acc = acc
185mapUnionFV f (a:as) fv_cand in_scope acc =
186  mapUnionFV f as fv_cand in_scope $! f a fv_cand in_scope $! acc
187{-# INLINABLE mapUnionFV #-}
188
189-- | Union many free variable computations.
190unionsFV :: [FV] -> FV
191unionsFV fvs fv_cand in_scope acc = mapUnionFV id fvs fv_cand in_scope acc
192{-# INLINE unionsFV #-}
193
194-- | Add multiple variables - when free, to the returned free variables.
195-- Ignores duplicates and respects the filtering function.
196mkFVs :: [Var] -> FV
197mkFVs vars fv_cand in_scope acc =
198  mapUnionFV unitFV vars fv_cand in_scope acc
199{-# INLINE mkFVs #-}
200