X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcTyDecls.lhs;h=4ce5fed3f3987e2f0d5869e08fb31cdba2e8cf43;hb=ac10f8408520a30e8437496d320b8b86afda2e8f;hp=105bef97275bada9f4f4e5c1943c0acc835b0b3e;hpb=d551dbfef0b710f5ede21ee0c54ee7e80dd53b64;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index 105bef9..4ce5fed 100644
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -22,10 +22,10 @@ module TcTyDecls(
 import TypeRep          ( Type(..), TyNote(..), PredType(..) )  -- friend
 import HsSyn		( TyClDecl(..), HsPred(..), LTyClDecl, isClassDecl )
 import RnHsSyn		( extractHsTyNames )
-import Type		( predTypeRep )
-import HscTypes		( TyThing(..) )
+import Type		( predTypeRep, tcView )
+import HscTypes		( TyThing(..), ModDetails(..) )
 import TyCon            ( TyCon, ArgVrcs, tyConArity, tyConDataCons, tyConTyVars,
-                          getSynTyConDefn, isSynTyCon, isAlgTyCon, 
+                          synTyConDefn, isSynTyCon, isAlgTyCon, 
 			  tyConName, isNewTyCon, isProductTyCon, tyConArgVrcs, newTyConRhs )
 import Class		( classTyCon )
 import DataCon          ( dataConOrigArgTys )
@@ -94,19 +94,14 @@ synTyConsOfType ty
   where
      go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim
      go (TyVarTy v)	  	  = emptyNameEnv
-     go (TyConApp tc tys) 	  = go_tc tc tys	-- See note (a)
+     go (TyConApp tc tys) 	  = go_tc tc tys
      go (AppTy a b)	  	  = go a `plusNameEnv` go b
      go (FunTy a b)	  	  = go a `plusNameEnv` go b
      go (PredTy (IParam _ ty))    = go ty	
      go (PredTy (ClassP cls tys)) = go_s tys	-- Ignore class
-     go (NoteTy (SynNote ty) _)	  = go ty	-- Don't look through it!
-     go (NoteTy other ty)	  = go ty	
+     go (NoteTy _ ty)		  = go ty	
      go (ForAllTy _ ty)	  	  = go ty
 
-	-- Note (a): the unexpanded branch of a SynNote has a
-	--	     TyConApp for the synonym, so the tc of
-	--	     a TyConApp must be tested for possible synonyms
-
      go_tc tc tys | isSynTyCon tc = extendNameEnv (go_s tys) (tyConName tc) tc
 		  | otherwise	  = go_s tys
      go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys
@@ -213,16 +208,16 @@ recursiveness, because we need only look at the type decls in the module being
 compiled, plus the outer structure of directly-mentioned types.
 
 \begin{code}
-calcRecFlags :: [Name] -> [TyThing] -> (Name -> RecFlag)
+calcRecFlags :: ModDetails -> [TyThing] -> (Name -> RecFlag)
 -- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
 -- Any type constructors in boot_names are automatically considered loop breakers
-calcRecFlags boot_names tyclss
+calcRecFlags boot_details tyclss
   = is_rec
   where
     is_rec n | n `elemNameSet` rec_names = Recursive
 	     | otherwise		 = NonRecursive
 
-    boot_name_set = mkNameSet boot_names
+    boot_name_set = md_exports boot_details
     rec_names = boot_name_set	  `unionNameSets` 
 		nt_loop_breakers  `unionNameSets`
 	        prod_loop_breakers
@@ -313,14 +308,14 @@ tcTyConsOfType ty
   = nameEnvElts (go ty)
   where
      go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim
-     go (TyVarTy v)	  	  = emptyNameEnv
-     go (TyConApp tc tys) 	  = go_tc tc tys
-     go (AppTy a b)	  	  = go a `plusNameEnv` go b
-     go (FunTy a b)	  	  = go a `plusNameEnv` go b
-     go (PredTy (IParam _ ty))    = go ty
-     go (PredTy (ClassP cls tys)) = go_tc (classTyCon cls) tys
-     go (NoteTy _ ty)		  = go ty
-     go (ForAllTy _ ty)	  	  = go ty
+     go ty | Just ty' <- tcView ty = go ty'
+     go (TyVarTy v)	  	   = emptyNameEnv
+     go (TyConApp tc tys) 	   = go_tc tc tys
+     go (AppTy a b)	  	   = go a `plusNameEnv` go b
+     go (FunTy a b)	  	   = go a `plusNameEnv` go b
+     go (PredTy (IParam _ ty))     = go ty
+     go (PredTy (ClassP cls tys))  = go_tc (classTyCon cls) tys
+     go (ForAllTy _ ty)	  	   = go ty
 
      go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
      go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys
@@ -397,7 +392,7 @@ calcTyConArgVrcs tyclss
        	argtys    = concatMap dataConOrigArgTys data_cons	-- Rep? or Orig?
 
     tcaoIter oi tc | isSynTyCon tc
-      = let (tyvs,ty) = getSynTyConDefn tc
+      = let (tyvs,ty) = synTyConDefn tc
                         -- we use the already-computed result for tycons not in this SCC
         in  map (\v -> vrcInTy (lookup oi) v ty) tyvs
 
@@ -422,10 +417,6 @@ vrcInTy :: (TyCon -> ArgVrcs)  -- function to get argVrcs of a tycon (break out
         -> Type                -- type to check for occ in
         -> (Bool,Bool)         -- (occurs positively, occurs negatively)
 
-vrcInTy fao v (NoteTy (SynNote _)   ty) = vrcInTy fao v ty
-    			-- SynTyCon doesn't neccessarily have vrcInfo at this point,
-    			-- so don't try and use it
-
 vrcInTy fao v (NoteTy (FTVNote ftv) ty) = if elemVarSet v ftv
     					  then vrcInTy fao v ty
     					  else (False,False)