2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1999
6 Analysis functions over data types. Specficially, detecting recursive types.
8 This stuff is only used for source-code decls; it's recorded in interface
9 files for imported data types.
14 calcClassCycles, calcSynCycles
17 #include "HsVersions.h"
33 import Maybes( mapCatMaybes )
34 import Util ( isSingleton )
39 %************************************************************************
41 Cycles in class and type synonym declarations
43 %************************************************************************
45 Checking for class-decl loops is easy, because we don't allow class decls
48 We allow type synonyms in hi-boot files, but we *trust* hi-boot files,
49 so we don't check for loops that involve them. So we only look for synonym
50 loops in the module being compiled.
52 We check for type synonym and class cycles on the *source* code.
55 a) Otherwise we'd need a special function to extract type-synonym tycons
56 from a type, whereas we have extractHsTyNames already
58 b) If we checked for type synonym loops after building the TyCon, we
59 can't do a hoistForAllTys on the type synonym rhs, (else we fall into
60 a black hole) which seems unclean. Apart from anything else, it'd mean
61 that a type-synonym rhs could have for-alls to the right of an arrow,
62 which means adding new cases to the validity checker
64 Indeed, in general, checking for cycles beforehand means we need to
65 be less careful about black holes through synonym cycles.
67 The main disadvantage is that a cycle that goes via a type synonym in an
68 .hi-boot file can lead the compiler into a loop, because it assumes that cycles
69 only occur entirely within the source code of the module being compiled.
70 But hi-boot files are trusted anyway, so this isn't much worse than (say)
73 [ NOTE ----------------------------------------------
74 If we reverse this decision, this comment came from tcTyDecl1, and should
76 -- dsHsType, not tcHsKindedType, to avoid a loop. tcHsKindedType does hoisting,
77 -- which requires looking through synonyms... and therefore goes into a loop
78 -- on (erroneously) recursive synonyms.
79 -- Solution: do not hoist synonyms, because they'll be hoisted soon enough
80 -- when they are substituted
82 We'd also need to add back in this definition
84 synTyConsOfType :: Type -> [TyCon]
85 -- Does not look through type synonyms at all
86 -- Return a list of synonym tycons
90 go :: Type -> NameEnv TyCon -- The NameEnv does duplicate elim
91 go (TyVarTy v) = emptyNameEnv
92 go (TyConApp tc tys) = go_tc tc tys
93 go (AppTy a b) = go a `plusNameEnv` go b
94 go (FunTy a b) = go a `plusNameEnv` go b
95 go (PredTy (IParam _ ty)) = go ty
96 go (PredTy (ClassP cls tys)) = go_s tys -- Ignore class
97 go (ForAllTy _ ty) = go ty
99 go_tc tc tys | isSynTyCon tc = extendNameEnv (go_s tys) (tyConName tc) tc
100 | otherwise = go_s tys
101 go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys
102 ---------------------------------------- END NOTE ]
105 calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)]
107 = stronglyConnCompFromEdgedVertices syn_edges
109 syn_edges = [ (ldecl, unLoc (tcdLName decl),
110 mk_syn_edges (tcdSynRhs decl))
111 | ldecl@(L _ decl) <- decls ]
113 mk_syn_edges rhs = [ tc | tc <- nameSetToList (extractHsTyNames rhs),
114 not (isTyVarName tc) ]
117 calcClassCycles :: [LTyClDecl Name] -> [[LTyClDecl Name]]
118 calcClassCycles decls
119 = [decls | CyclicSCC decls <- stronglyConnCompFromEdgedVertices cls_edges]
121 cls_edges = [ (ldecl, unLoc (tcdLName decl),
122 mk_cls_edges (unLoc (tcdCtxt decl)))
123 | ldecl@(L _ decl) <- decls, isClassDecl decl ]
125 mk_cls_edges ctxt = [ cls | L _ (HsClassP cls _) <- ctxt ]
129 %************************************************************************
131 Deciding which type constructors are recursive
133 %************************************************************************
135 Identification of recursive TyCons
136 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
137 The knot-tying parameters: @rec_details_list@ is an alist mapping @Name@s to
140 Identifying a TyCon as recursive serves two purposes
142 1. Avoid infinite types. Non-recursive newtypes are treated as
143 "transparent", like type synonyms, after the type checker. If we did
144 this for all newtypes, we'd get infinite types. So we figure out for
145 each newtype whether it is "recursive", and add a coercion if so. In
146 effect, we are trying to "cut the loops" by identifying a loop-breaker.
148 2. Avoid infinite unboxing. This is nothing to do with newtypes.
152 Well, this function diverges, but we don't want the strictness analyser
153 to diverge. But the strictness analyser will diverge because it looks
154 deeper and deeper into the structure of T. (I believe there are
155 examples where the function does something sane, and the strictness
156 analyser still diverges, but I can't see one now.)
158 Now, concerning (1), the FC2 branch currently adds a coercion for ALL
159 newtypes. I did this as an experiment, to try to expose cases in which
160 the coercions got in the way of optimisations. If it turns out that we
161 can indeed always use a coercion, then we don't risk recursive types,
162 and don't need to figure out what the loop breakers are.
164 For newtype *families* though, we will always have a coercion, so they
165 are always loop breakers! So you can easily adjust the current
166 algorithm by simply treating all newtype families as loop breakers (and
167 indeed type families). I think.
171 For newtypes, we label some as "recursive" such that
173 INVARIANT: there is no cycle of non-recursive newtypes
175 In any loop, only one newtype need be marked as recursive; it is
176 a "loop breaker". Labelling more than necessary as recursive is OK,
177 provided the invariant is maintained.
179 A newtype M.T is defined to be "recursive" iff
180 (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
181 (b) it is declared in a source file, but that source file has a
182 companion hi-boot file which declares the type
183 or (c) one can get from T's rhs to T via type
184 synonyms, or non-recursive newtypes *in M*
185 e.g. newtype T = MkT (T -> Int)
187 (a) is conservative; declarations in hi-boot files are always
188 made loop breakers. That's why in (b) we can restrict attention
189 to tycons in M, because any loops through newtypes outside M
190 will be broken by those newtypes
191 (b) ensures that a newtype is not treated as a loop breaker in one place
192 and later as a non-loop-breaker. This matters in GHCi particularly, when
193 a newtype T might be embedded in many types in the environment, and then
194 T's source module is compiled. We don't want T's recursiveness to change.
196 The "recursive" flag for algebraic data types is irrelevant (never consulted)
197 for types with more than one constructor.
200 An algebraic data type M.T is "recursive" iff
201 it has just one constructor, and
202 (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
203 (b) it is declared in a source file, but that source file has a
204 companion hi-boot file which declares the type
205 or (c) one can get from its arg types to T via type synonyms,
206 or by non-recursive newtypes or non-recursive product types in M
207 e.g. data T = MkT (T -> Int) Bool
208 Just like newtype in fact
210 A type synonym is recursive if one can get from its
211 right hand side back to it via type synonyms. (This is
212 reported as an error.)
214 A class is recursive if one can get from its superclasses
215 back to it. (This is an error too.)
219 A data type read from an hi-boot file will have an AbstractTyCon as its AlgTyConRhs
220 and will respond True to isHiBootTyCon. The idea is that we treat these as if one
221 could get from these types to anywhere. So when we see
224 import {-# SOURCE #-} Foo( T )
227 then we mark S as recursive, just in case. What that means is that if we see
232 then we don't need to look inside S to compute R's recursiveness. Since S is imported
233 (not from an hi-boot file), one cannot get from R back to S except via an hi-boot file,
234 and that means that some data type will be marked recursive along the way. So R is
235 unconditionly non-recursive (i.e. there'll be a loop breaker elsewhere if necessary)
237 This in turn means that we grovel through fewer interface files when computing
238 recursiveness, because we need only look at the type decls in the module being
239 compiled, plus the outer structure of directly-mentioned types.
242 calcRecFlags :: ModDetails -> [TyThing] -> (Name -> RecFlag)
243 -- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
244 -- Any type constructors in boot_names are automatically considered loop breakers
245 calcRecFlags boot_details tyclss
248 is_rec n | n `elemNameSet` rec_names = Recursive
249 | otherwise = NonRecursive
251 boot_name_set = availsToNameSet (md_exports boot_details)
252 rec_names = boot_name_set `unionNameSets`
253 nt_loop_breakers `unionNameSets`
256 all_tycons = [ tc | tc <- mapCatMaybes getTyCon tyclss
257 -- Recursion of newtypes/data types can happen via
258 -- the class TyCon, so tyclss includes the class tycons
259 , not (tyConName tc `elemNameSet` boot_name_set) ]
260 -- Remove the boot_name_set because they are going
261 -- to be loop breakers regardless.
263 -------------------------------------------------
265 -- These edge-construction loops rely on
266 -- every loop going via tyclss, the types and classes
267 -- in the module being compiled. Stuff in interface
268 -- files should be correctly marked. If not (e.g. a
269 -- type synonym in a hi-boot file) we can get an infinite
270 -- loop. We could program round this, but it'd make the code
271 -- rather less nice, so I'm not going to do that yet.
273 single_con_tycons = filter (isSingleton . tyConDataCons) all_tycons
274 -- Both newtypes and data types, with exactly one data constructor
275 (new_tycons, prod_tycons) = partition isNewTyCon single_con_tycons
276 -- NB: we do *not* call isProductTyCon because that checks
277 -- for vanilla-ness of data constructors; and that depends
278 -- on empty existential type variables; and that is figured
279 -- out by tcResultType; which uses tcMatchTy; which uses
280 -- coreView; which calls coreExpandTyCon_maybe; which uses
281 -- the recursiveness of the TyCon. Result... a black hole.
284 --------------- Newtypes ----------------------
285 nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges)
286 is_rec_nt tc = tyConName tc `elemNameSet` nt_loop_breakers
287 -- is_rec_nt is a locally-used helper function
289 nt_edges = [(t, mk_nt_edges t) | t <- new_tycons]
291 mk_nt_edges nt -- Invariant: nt is a newtype
292 = concatMap (mk_nt_edges1 nt) (tcTyConsOfType (new_tc_rhs nt))
293 -- tyConsOfType looks through synonyms
296 | tc `elem` new_tycons = [tc] -- Loop
297 -- At this point we know that either it's a local *data* type,
298 -- or it's imported. Either way, it can't form part of a newtype cycle
301 --------------- Product types ----------------------
302 prod_loop_breakers = mkNameSet (findLoopBreakers prod_edges)
304 prod_edges = [(tc, mk_prod_edges tc) | tc <- prod_tycons]
306 mk_prod_edges tc -- Invariant: tc is a product tycon
307 = concatMap (mk_prod_edges1 tc) (dataConOrigArgTys (head (tyConDataCons tc)))
309 mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (tcTyConsOfType ty)
311 mk_prod_edges2 ptc tc
312 | tc `elem` prod_tycons = [tc] -- Local product
313 | tc `elem` new_tycons = if is_rec_nt tc -- Local newtype
315 else mk_prod_edges1 ptc (new_tc_rhs tc)
316 -- At this point we know that either it's a local non-product data type,
317 -- or it's imported. Either way, it can't form part of a cycle
320 new_tc_rhs :: TyCon -> Type
321 new_tc_rhs tc = snd (newTyConRhs tc) -- Ignore the type variables
323 getTyCon :: TyThing -> Maybe TyCon
324 getTyCon (ATyCon tc) = Just tc
325 getTyCon (AClass cl) = Just (classTyCon cl)
328 findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
329 -- Finds a set of tycons that cut all loops
330 findLoopBreakers deps
331 = go [(tc,tc,ds) | (tc,ds) <- deps]
334 | CyclicSCC ((tc,_,_) : edges') <- stronglyConnCompFromEdgedVerticesR edges,
335 name <- tyConName tc : go edges']
338 These two functions know about type representations, so they could be
339 in Type or TcType -- but they are very specialised to this module, so
340 I've chosen to put them here.
343 tcTyConsOfType :: Type -> [TyCon]
344 -- tcTyConsOfType looks through all synonyms, but not through any newtypes.
345 -- When it finds a Class, it returns the class TyCon. The reaons it's here
346 -- (not in Type.lhs) is because it is newtype-aware.
348 = nameEnvElts (go ty)
350 go :: Type -> NameEnv TyCon -- The NameEnv does duplicate elim
351 go ty | Just ty' <- tcView ty = go ty'
352 go (TyVarTy _) = emptyNameEnv
353 go (TyConApp tc tys) = go_tc tc tys
354 go (AppTy a b) = go a `plusNameEnv` go b
355 go (FunTy a b) = go a `plusNameEnv` go b
356 go (PredTy (IParam _ ty)) = go ty
357 go (PredTy (ClassP cls tys)) = go_tc (classTyCon cls) tys
358 go (PredTy (EqPred ty1 ty2)) = go ty1 `plusNameEnv` go ty2
359 go (ForAllTy _ ty) = go ty
361 go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
362 go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys