X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyDecls.lhs;h=d05ade3049165b0e0115454b581d3ab8e33c0fc0;hp=f16d89e77aefa42ddb9110abf6977b398d97a068;hb=b99310f05faee2abec850da4349fcd5c0498f7ca;hpb=d5c4754dcb857be7b9f4dbf6482e6050a9cd0991 diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index f16d89e..d05ade3 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1999 % @@ -7,7 +8,6 @@ Analysis functions over data types. Specficially, detecting recursive types. This stuff is only used for source-code decls; it's recorded in interface files for imported data types. - \begin{code} module TcTyDecls( calcRecFlags, @@ -16,25 +16,20 @@ module TcTyDecls( #include "HsVersions.h" -import TypeRep ( Type(..), TyNote(..), PredType(..) ) -- friend -import HsSyn ( TyClDecl(..), HsPred(..), LTyClDecl, isClassDecl ) -import RnHsSyn ( extractHsTyNames ) -import Type ( predTypeRep, tcView ) -import HscTypes ( TyThing(..), ModDetails(..) ) -import TyCon ( TyCon, tyConArity, tyConDataCons, tyConTyVars, - isSynTyCon, isAlgTyCon, - tyConName, isNewTyCon, isProductTyCon, newTyConRhs, - isOpenTyCon ) -import Class ( classTyCon ) -import DataCon ( dataConOrigArgTys ) -import Var ( TyVar ) -import VarSet -import Name ( Name, isTyVarName ) +import TypeRep +import HsSyn +import RnHsSyn +import Type +import HscTypes +import TyCon +import Class +import DataCon +import Name import NameEnv import NameSet -import Digraph ( SCC(..), stronglyConnComp, stronglyConnCompR ) -import BasicTypes ( RecFlag(..) ) -import SrcLoc ( Located(..), unLoc ) +import Digraph +import BasicTypes +import SrcLoc import Outputable \end{code} @@ -215,7 +210,7 @@ calcRecFlags boot_details tyclss is_rec n | n `elemNameSet` rec_names = Recursive | otherwise = NonRecursive - boot_name_set = md_exports boot_details + boot_name_set = availsToNameSet (md_exports boot_details) rec_names = boot_name_set `unionNameSets` nt_loop_breakers `unionNameSets` prod_loop_breakers @@ -283,6 +278,7 @@ new_tc_rhs tc = snd (newTyConRhs tc) -- Ignore the type variables getTyCon (ATyCon tc) = tc getTyCon (AClass cl) = classTyCon cl +getTyCon other = panic "getTyCon" findLoopBreakers :: [(TyCon, [TyCon])] -> [Name] -- Finds a set of tycons that cut all loops @@ -315,6 +311,7 @@ tcTyConsOfType ty go (PredTy (IParam _ ty)) = go ty go (PredTy (ClassP cls tys)) = go_tc (classTyCon cls) tys go (ForAllTy _ ty) = go ty + go other = panic "tcTyConsOfType" go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys