Simon's big boxy-type commit

[ghc-hetmet.git] / ghc / compiler / typecheck / TcTyDecls.lhs

diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index 105bef9..4ce5fed 100644 (file)
--- 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)