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