X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyDecls.lhs;h=de22c637080b2f7945703ad908429045e9de1a26;hb=3f1b316d7035c55cd712cd39a9981339bcef2e8c;hp=86d4a2b830d698d2a45577981ca2f2463d5d6b82;hpb=e8a591c1a3dbdeccec2dd2aacccd7435004b0d51;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index 86d4a2b..de22c63 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,8 +8,14 @@ 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} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module TcTyDecls( calcRecFlags, calcClassCycles, calcSynCycles @@ -16,24 +23,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 ) -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} @@ -214,7 +217,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 @@ -238,7 +241,8 @@ calcRecFlags boot_details tyclss -- rather less nice, so I'm not going to do that yet. --------------- Newtypes ---------------------- - new_tycons = filter isNewTyCon all_tycons + new_tycons = filter isNewTyConAndNotOpen all_tycons + isNewTyConAndNotOpen tycon = isNewTyCon tycon && not (isOpenTyCon tycon) nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges) is_rec_nt tc = tyConName tc `elemNameSet` nt_loop_breakers -- is_rec_nt is a locally-used helper function @@ -281,6 +285,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 @@ -313,6 +318,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