2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1999
5 Analysis functions over data types. Specficially, detecting recursive types.
7 This stuff is only used for source-code decls; it's recorded in interface
8 files for imported data types.
14 calcClassCycles, calcSynCycles
17 #include "HsVersions.h"
19 import TypeRep ( Type(..), TyNote(..), PredType(..) ) -- friend
20 import HsSyn ( TyClDecl(..), HsPred(..), LTyClDecl, isClassDecl )
21 import RnHsSyn ( extractHsTyNames )
22 import Type ( predTypeRep, tcView )
23 import HscTypes ( TyThing(..), ModDetails(..) )
24 import TyCon ( TyCon, tyConArity, tyConDataCons, tyConTyVars,
25 synTyConDefn, isSynTyCon, isAlgTyCon,
26 tyConName, isNewTyCon, isProductTyCon, newTyConRhs )
27 import Class ( classTyCon )
28 import DataCon ( dataConOrigArgTys )
31 import Name ( Name, isTyVarName )
34 import Digraph ( SCC(..), stronglyConnComp, stronglyConnCompR )
35 import BasicTypes ( RecFlag(..) )
36 import SrcLoc ( Located(..), unLoc )
41 %************************************************************************
43 Cycles in class and type synonym declarations
45 %************************************************************************
47 Checking for class-decl loops is easy, because we don't allow class decls
50 We allow type synonyms in hi-boot files, but we *trust* hi-boot files,
51 so we don't check for loops that involve them. So we only look for synonym
52 loops in the module being compiled.
54 We check for type synonym and class cycles on the *source* code.
57 a) Otherwise we'd need a special function to extract type-synonym tycons
58 from a type, whereas we have extractHsTyNames already
60 b) If we checked for type synonym loops after building the TyCon, we
61 can't do a hoistForAllTys on the type synonym rhs, (else we fall into
62 a black hole) which seems unclean. Apart from anything else, it'd mean
63 that a type-synonym rhs could have for-alls to the right of an arrow,
64 which means adding new cases to the validity checker
66 Indeed, in general, checking for cycles beforehand means we need to
67 be less careful about black holes through synonym cycles.
69 The main disadvantage is that a cycle that goes via a type synonym in an
70 .hi-boot file can lead the compiler into a loop, because it assumes that cycles
71 only occur entirely within the source code of the module being compiled.
72 But hi-boot files are trusted anyway, so this isn't much worse than (say)
75 [ NOTE ----------------------------------------------
76 If we reverse this decision, this comment came from tcTyDecl1, and should
78 -- dsHsType, not tcHsKindedType, to avoid a loop. tcHsKindedType does hoisting,
79 -- which requires looking through synonyms... and therefore goes into a loop
80 -- on (erroneously) recursive synonyms.
81 -- Solution: do not hoist synonyms, because they'll be hoisted soon enough
82 -- when they are substituted
84 We'd also need to add back in this definition
86 synTyConsOfType :: Type -> [TyCon]
87 -- Does not look through type synonyms at all
88 -- Return a list of synonym tycons
92 go :: Type -> NameEnv TyCon -- The NameEnv does duplicate elim
93 go (TyVarTy v) = emptyNameEnv
94 go (TyConApp tc tys) = go_tc tc tys
95 go (AppTy a b) = go a `plusNameEnv` go b
96 go (FunTy a b) = go a `plusNameEnv` go b
97 go (PredTy (IParam _ ty)) = go ty
98 go (PredTy (ClassP cls tys)) = go_s tys -- Ignore class
99 go (NoteTy _ ty) = go ty
100 go (ForAllTy _ ty) = go ty
102 go_tc tc tys | isSynTyCon tc = extendNameEnv (go_s tys) (tyConName tc) tc
103 | otherwise = go_s tys
104 go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys
105 ---------------------------------------- END NOTE ]
108 calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)]
110 = stronglyConnComp syn_edges
112 syn_edges = [ (ldecl, unLoc (tcdLName decl),
113 mk_syn_edges (tcdSynRhs decl))
114 | ldecl@(L _ decl) <- decls ]
116 mk_syn_edges rhs = [ tc | tc <- nameSetToList (extractHsTyNames rhs),
117 not (isTyVarName tc) ]
120 calcClassCycles :: [LTyClDecl Name] -> [[LTyClDecl Name]]
121 calcClassCycles decls
122 = [decls | CyclicSCC decls <- stronglyConnComp cls_edges]
124 cls_edges = [ (ldecl, unLoc (tcdLName decl),
125 mk_cls_edges (unLoc (tcdCtxt decl)))
126 | ldecl@(L _ decl) <- decls, isClassDecl decl ]
128 mk_cls_edges ctxt = [ cls | L _ (HsClassP cls _) <- ctxt ]
132 %************************************************************************
134 Deciding which type constructors are recursive
136 %************************************************************************
138 For newtypes, we label some as "recursive" such that
140 INVARIANT: there is no cycle of non-recursive newtypes
142 In any loop, only one newtype need be marked as recursive; it is
143 a "loop breaker". Labelling more than necessary as recursive is OK,
144 provided the invariant is maintained.
146 A newtype M.T is defined to be "recursive" iff
147 (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
148 (b) it is declared in a source file, but that source file has a
149 companion hi-boot file which declares the type
150 or (c) one can get from T's rhs to T via type
151 synonyms, or non-recursive newtypes *in M*
152 e.g. newtype T = MkT (T -> Int)
154 (a) is conservative; declarations in hi-boot files are always
155 made loop breakers. That's why in (b) we can restrict attention
156 to tycons in M, because any loops through newtypes outside M
157 will be broken by those newtypes
158 (b) ensures that a newtype is not treated as a loop breaker in one place
159 and later as a non-loop-breaker. This matters in GHCi particularly, when
160 a newtype T might be embedded in many types in the environment, and then
161 T's source module is compiled. We don't want T's recursiveness to change.
163 The "recursive" flag for algebraic data types is irrelevant (never consulted)
164 for types with more than one constructor.
166 An algebraic data type M.T is "recursive" iff
167 it has just one constructor, and
168 (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
169 (b) it is declared in a source file, but that source file has a
170 companion hi-boot file which declares the type
171 or (c) one can get from its arg types to T via type synonyms,
172 or by non-recursive newtypes or non-recursive product types in M
173 e.g. data T = MkT (T -> Int) Bool
174 Just like newtype in fact
176 A type synonym is recursive if one can get from its
177 right hand side back to it via type synonyms. (This is
178 reported as an error.)
180 A class is recursive if one can get from its superclasses
181 back to it. (This is an error too.)
185 A data type read from an hi-boot file will have an AbstractTyCon as its AlgTyConRhs
186 and will respond True to isHiBootTyCon. The idea is that we treat these as if one
187 could get from these types to anywhere. So when we see
190 import {-# SOURCE #-} Foo( T )
193 then we mark S as recursive, just in case. What that means is that if we see
198 then we don't need to look inside S to compute R's recursiveness. Since S is imported
199 (not from an hi-boot file), one cannot get from R back to S except via an hi-boot file,
200 and that means that some data type will be marked recursive along the way. So R is
201 unconditionly non-recursive (i.e. there'll be a loop breaker elsewhere if necessary)
203 This in turn means that we grovel through fewer interface files when computing
204 recursiveness, because we need only look at the type decls in the module being
205 compiled, plus the outer structure of directly-mentioned types.
208 calcRecFlags :: ModDetails -> [TyThing] -> (Name -> RecFlag)
209 -- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
210 -- Any type constructors in boot_names are automatically considered loop breakers
211 calcRecFlags boot_details tyclss
214 is_rec n | n `elemNameSet` rec_names = Recursive
215 | otherwise = NonRecursive
217 boot_name_set = md_exports boot_details
218 rec_names = boot_name_set `unionNameSets`
219 nt_loop_breakers `unionNameSets`
222 all_tycons = [ tc | tycls <- tyclss,
223 -- Recursion of newtypes/data types can happen via
224 -- the class TyCon, so tyclss includes the class tycons
225 let tc = getTyCon tycls,
226 not (tyConName tc `elemNameSet` boot_name_set) ]
227 -- Remove the boot_name_set because they are going
228 -- to be loop breakers regardless.
230 -------------------------------------------------
232 -- These edge-construction loops rely on
233 -- every loop going via tyclss, the types and classes
234 -- in the module being compiled. Stuff in interface
235 -- files should be correctly marked. If not (e.g. a
236 -- type synonym in a hi-boot file) we can get an infinite
237 -- loop. We could program round this, but it'd make the code
238 -- rather less nice, so I'm not going to do that yet.
240 --------------- Newtypes ----------------------
241 new_tycons = filter isNewTyCon all_tycons
242 nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges)
243 is_rec_nt tc = tyConName tc `elemNameSet` nt_loop_breakers
244 -- is_rec_nt is a locally-used helper function
246 nt_edges = [(t, mk_nt_edges t) | t <- new_tycons]
248 mk_nt_edges nt -- Invariant: nt is a newtype
249 = concatMap (mk_nt_edges1 nt) (tcTyConsOfType (new_tc_rhs nt))
250 -- tyConsOfType looks through synonyms
253 | tc `elem` new_tycons = [tc] -- Loop
254 -- At this point we know that either it's a local *data* type,
255 -- or it's imported. Either way, it can't form part of a newtype cycle
258 --------------- Product types ----------------------
259 -- The "prod_tycons" are the non-newtype products
260 prod_tycons = [tc | tc <- all_tycons,
261 not (isNewTyCon tc), isProductTyCon tc]
262 prod_loop_breakers = mkNameSet (findLoopBreakers prod_edges)
264 prod_edges = [(tc, mk_prod_edges tc) | tc <- prod_tycons]
266 mk_prod_edges tc -- Invariant: tc is a product tycon
267 = concatMap (mk_prod_edges1 tc) (dataConOrigArgTys (head (tyConDataCons tc)))
269 mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (tcTyConsOfType ty)
271 mk_prod_edges2 ptc tc
272 | tc `elem` prod_tycons = [tc] -- Local product
273 | tc `elem` new_tycons = if is_rec_nt tc -- Local newtype
275 else mk_prod_edges1 ptc (new_tc_rhs tc)
276 -- At this point we know that either it's a local non-product data type,
277 -- or it's imported. Either way, it can't form part of a cycle
280 new_tc_rhs tc = snd (newTyConRhs tc) -- Ignore the type variables
282 getTyCon (ATyCon tc) = tc
283 getTyCon (AClass cl) = classTyCon cl
285 findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
286 -- Finds a set of tycons that cut all loops
287 findLoopBreakers deps
288 = go [(tc,tc,ds) | (tc,ds) <- deps]
291 | CyclicSCC ((tc,_,_) : edges') <- stronglyConnCompR edges,
292 name <- tyConName tc : go edges']
295 These two functions know about type representations, so they could be
296 in Type or TcType -- but they are very specialised to this module, so
297 I've chosen to put them here.
300 tcTyConsOfType :: Type -> [TyCon]
301 -- tcTyConsOfType looks through all synonyms, but not through any newtypes.
302 -- When it finds a Class, it returns the class TyCon. The reaons it's here
303 -- (not in Type.lhs) is because it is newtype-aware.
305 = nameEnvElts (go ty)
307 go :: Type -> NameEnv TyCon -- The NameEnv does duplicate elim
308 go ty | Just ty' <- tcView ty = go ty'
309 go (TyVarTy v) = emptyNameEnv
310 go (TyConApp tc tys) = go_tc tc tys
311 go (AppTy a b) = go a `plusNameEnv` go b
312 go (FunTy a b) = go a `plusNameEnv` go b
313 go (PredTy (IParam _ ty)) = go ty
314 go (PredTy (ClassP cls tys)) = go_tc (classTyCon cls) tys
315 go (ForAllTy _ ty) = go ty
317 go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
318 go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys