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"
34 import Util ( isSingleton )
35 import List ( partition )
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 For newtypes, we label some as "recursive" such that
137 INVARIANT: there is no cycle of non-recursive newtypes
139 In any loop, only one newtype need be marked as recursive; it is
140 a "loop breaker". Labelling more than necessary as recursive is OK,
141 provided the invariant is maintained.
143 A newtype M.T is defined to be "recursive" iff
144 (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
145 (b) it is declared in a source file, but that source file has a
146 companion hi-boot file which declares the type
147 or (c) one can get from T's rhs to T via type
148 synonyms, or non-recursive newtypes *in M*
149 e.g. newtype T = MkT (T -> Int)
151 (a) is conservative; declarations in hi-boot files are always
152 made loop breakers. That's why in (b) we can restrict attention
153 to tycons in M, because any loops through newtypes outside M
154 will be broken by those newtypes
155 (b) ensures that a newtype is not treated as a loop breaker in one place
156 and later as a non-loop-breaker. This matters in GHCi particularly, when
157 a newtype T might be embedded in many types in the environment, and then
158 T's source module is compiled. We don't want T's recursiveness to change.
160 The "recursive" flag for algebraic data types is irrelevant (never consulted)
161 for types with more than one constructor.
163 An algebraic data type M.T is "recursive" iff
164 it has just one constructor, and
165 (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
166 (b) it is declared in a source file, but that source file has a
167 companion hi-boot file which declares the type
168 or (c) one can get from its arg types to T via type synonyms,
169 or by non-recursive newtypes or non-recursive product types in M
170 e.g. data T = MkT (T -> Int) Bool
171 Just like newtype in fact
173 A type synonym is recursive if one can get from its
174 right hand side back to it via type synonyms. (This is
175 reported as an error.)
177 A class is recursive if one can get from its superclasses
178 back to it. (This is an error too.)
182 A data type read from an hi-boot file will have an AbstractTyCon as its AlgTyConRhs
183 and will respond True to isHiBootTyCon. The idea is that we treat these as if one
184 could get from these types to anywhere. So when we see
187 import {-# SOURCE #-} Foo( T )
190 then we mark S as recursive, just in case. What that means is that if we see
195 then we don't need to look inside S to compute R's recursiveness. Since S is imported
196 (not from an hi-boot file), one cannot get from R back to S except via an hi-boot file,
197 and that means that some data type will be marked recursive along the way. So R is
198 unconditionly non-recursive (i.e. there'll be a loop breaker elsewhere if necessary)
200 This in turn means that we grovel through fewer interface files when computing
201 recursiveness, because we need only look at the type decls in the module being
202 compiled, plus the outer structure of directly-mentioned types.
205 calcRecFlags :: ModDetails -> [TyThing] -> (Name -> RecFlag)
206 -- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
207 -- Any type constructors in boot_names are automatically considered loop breakers
208 calcRecFlags boot_details tyclss
211 is_rec n | n `elemNameSet` rec_names = Recursive
212 | otherwise = NonRecursive
214 boot_name_set = availsToNameSet (md_exports boot_details)
215 rec_names = boot_name_set `unionNameSets`
216 nt_loop_breakers `unionNameSets`
219 all_tycons = [ tc | tycls <- tyclss,
220 -- Recursion of newtypes/data types can happen via
221 -- the class TyCon, so tyclss includes the class tycons
222 let tc = getTyCon tycls,
223 not (tyConName tc `elemNameSet` boot_name_set) ]
224 -- Remove the boot_name_set because they are going
225 -- to be loop breakers regardless.
227 -------------------------------------------------
229 -- These edge-construction loops rely on
230 -- every loop going via tyclss, the types and classes
231 -- in the module being compiled. Stuff in interface
232 -- files should be correctly marked. If not (e.g. a
233 -- type synonym in a hi-boot file) we can get an infinite
234 -- loop. We could program round this, but it'd make the code
235 -- rather less nice, so I'm not going to do that yet.
237 single_con_tycons = filter (isSingleton . tyConDataCons) all_tycons
238 -- Both newtypes and data types, with exactly one data constructor
239 (new_tycons, prod_tycons) = partition isNewTyCon single_con_tycons
240 -- NB: we do *not* call isProductTyCon because that checks
241 -- for vanilla-ness of data constructors; and that depends
242 -- on empty existential type variables; and that is figured
243 -- out by tcResultType; which uses tcMatchTy; which uses
244 -- coreView; which calls coreExpandTyCon_maybe; which uses
245 -- the recursiveness of the TyCon. Result... a black hole.
248 --------------- Newtypes ----------------------
249 nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges)
250 is_rec_nt tc = tyConName tc `elemNameSet` nt_loop_breakers
251 -- is_rec_nt is a locally-used helper function
253 nt_edges = [(t, mk_nt_edges t) | t <- new_tycons]
255 mk_nt_edges nt -- Invariant: nt is a newtype
256 = concatMap (mk_nt_edges1 nt) (tcTyConsOfType (new_tc_rhs nt))
257 -- tyConsOfType looks through synonyms
260 | tc `elem` new_tycons = [tc] -- Loop
261 -- At this point we know that either it's a local *data* type,
262 -- or it's imported. Either way, it can't form part of a newtype cycle
265 --------------- Product types ----------------------
266 prod_loop_breakers = mkNameSet (findLoopBreakers prod_edges)
268 prod_edges = [(tc, mk_prod_edges tc) | tc <- prod_tycons]
270 mk_prod_edges tc -- Invariant: tc is a product tycon
271 = concatMap (mk_prod_edges1 tc) (dataConOrigArgTys (head (tyConDataCons tc)))
273 mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (tcTyConsOfType ty)
275 mk_prod_edges2 ptc tc
276 | tc `elem` prod_tycons = [tc] -- Local product
277 | tc `elem` new_tycons = if is_rec_nt tc -- Local newtype
279 else mk_prod_edges1 ptc (new_tc_rhs tc)
280 -- At this point we know that either it's a local non-product data type,
281 -- or it's imported. Either way, it can't form part of a cycle
284 new_tc_rhs :: TyCon -> Type
285 new_tc_rhs tc = snd (newTyConRhs tc) -- Ignore the type variables
287 getTyCon :: TyThing -> TyCon
288 getTyCon (ATyCon tc) = tc
289 getTyCon (AClass cl) = classTyCon cl
290 getTyCon _ = panic "getTyCon"
292 findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
293 -- Finds a set of tycons that cut all loops
294 findLoopBreakers deps
295 = go [(tc,tc,ds) | (tc,ds) <- deps]
298 | CyclicSCC ((tc,_,_) : edges') <- stronglyConnCompFromEdgedVerticesR edges,
299 name <- tyConName tc : go edges']
302 These two functions know about type representations, so they could be
303 in Type or TcType -- but they are very specialised to this module, so
304 I've chosen to put them here.
307 tcTyConsOfType :: Type -> [TyCon]
308 -- tcTyConsOfType looks through all synonyms, but not through any newtypes.
309 -- When it finds a Class, it returns the class TyCon. The reaons it's here
310 -- (not in Type.lhs) is because it is newtype-aware.
312 = nameEnvElts (go ty)
314 go :: Type -> NameEnv TyCon -- The NameEnv does duplicate elim
315 go ty | Just ty' <- tcView ty = go ty'
316 go (TyVarTy _) = emptyNameEnv
317 go (TyConApp tc tys) = go_tc tc tys
318 go (AppTy a b) = go a `plusNameEnv` go b
319 go (FunTy a b) = go a `plusNameEnv` go b
320 go (PredTy (IParam _ ty)) = go ty
321 go (PredTy (ClassP cls tys)) = go_tc (classTyCon cls) tys
322 go (ForAllTy _ ty) = go ty
323 go _ = panic "tcTyConsOfType"
325 go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
326 go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys