Remove unused imports

[ghc-hetmet.git] / compiler / iface / TcIface.lhs

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index af43f97..7db9551 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -19,7 +19,6 @@ import LoadIface
 import IfaceEnv
 import BuildTyCl
 import TcRnMonad
-import TcType          ( tcSplitSigmaTy )
 import Type
 import TypeRep
 import HscTypes
@@ -43,7 +42,6 @@ import qualified Var
 import VarEnv
 import Name
 import NameEnv
-import OccName
 import Module
 import LazyUniqFM
 import UniqSupply
@@ -58,7 +56,6 @@ import BasicTypes (Arity)
 
 import Control.Monad
 import Data.List
-import Data.Maybe
 \end{code}
 
 This module takes
@@ -418,7 +415,7 @@ tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
                                   ifIdDetails = details, ifIdInfo = info})
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
-       ; details <- tcIdDetails ty details
+       ; details <- tcIdDetails details
        ; info <- tcIdInfo ignore_prags name ty info
        ; return (AnId (mkGlobalId details name ty info)) }
 
@@ -429,36 +426,27 @@ tcIfaceDecl _ (IfaceData {ifName = occ_name,
                          ifRec = is_rec, 
                          ifGeneric = want_generic,
                          ifFamInst = mb_family })
-  = do { tc_name <- lookupIfaceTop occ_name
-       ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-
-       { tycon <- fixM ( \ tycon -> do
+  = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+    { tc_name <- lookupIfaceTop occ_name
+    ; tycon <- fixM ( \ tycon -> do
            { stupid_theta <- tcIfaceCtxt ctxt
-           ; famInst <- 
-               case mb_family of
-                 Nothing         -> return Nothing
-                 Just (fam, tys) -> 
-                   do { famTyCon <- tcIfaceTyCon fam
-                      ; insttys <- mapM tcIfaceType tys
-                      ; return $ Just (famTyCon, insttys)
-                      }
+           ; mb_fam_inst  <- tcFamInst mb_family
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
            ; buildAlgTyCon tc_name tyvars stupid_theta
-                           cons is_rec want_generic gadt_syn famInst
+                           cons is_rec want_generic gadt_syn mb_fam_inst
            })
-        ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
-       ; return (ATyCon tycon)
-    }}
+    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
+    ; return (ATyCon tycon) }
 
 tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
                         ifSynRhs = mb_rhs_ty,
                         ifSynKind = kind, ifFamInst = mb_family})
-   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
+   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
      { tc_name <- lookupIfaceTop occ_name
      ; rhs_kind <- tcIfaceType kind    -- Note [Synonym kind loop]
      ; ~(rhs, fam) <- forkM (mk_doc tc_name) $ 
                              do { rhs <- tc_syn_rhs rhs_kind mb_rhs_ty
-                        ; fam <- tc_syn_fam mb_family
+                        ; fam <- tcFamInst mb_family
                         ; return (rhs, fam) }
      ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam
      ; return $ ATyCon tycon
@@ -468,12 +456,6 @@ tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
      tc_syn_rhs kind Nothing   = return (OpenSynTyCon kind Nothing)
      tc_syn_rhs _    (Just ty) = do { rhs_ty <- tcIfaceType ty
                                    ; return (SynonymTyCon rhs_ty) }
-     tc_syn_fam Nothing 
-       = return Nothing
-     tc_syn_fam (Just (fam, tys)) 
-       = do { famTyCon <- tcIfaceTyCon fam
-           ; insttys <- mapM tcIfaceType tys
-                   ; return $ Just (famTyCon, insttys) }
 
 tcIfaceDecl ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
@@ -511,6 +493,12 @@ tcIfaceDecl _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0)) }
 
+tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
+tcFamInst Nothing           = return Nothing
+tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
+                                ; insttys <- mapM tcIfaceType tys
+                                        ; return $ Just (famTyCon, insttys) }
+
 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
 tcIfaceDataCons tycon_name tycon _ if_cons
   = case if_cons of
@@ -975,16 +963,12 @@ do_one (IfaceRec pairs) thing_inside
 %************************************************************************
 
 \begin{code}
-tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
-tcIdDetails _  IfVanillaId = return VanillaId
-tcIdDetails _  IfDFunId    = return DFunId
-tcIdDetails ty (IfRecSelId naughty)
-  = return (RecSelId { sel_tycon = tc, sel_naughty = naughty })
-  where
-    (_, _, tau) = tcSplitSigmaTy ty
-    tc = tyConAppTyCon (funArgTy tau)
-    -- A bit fragile. Relies on the selector type looking like
-    --    forall abc. (stupid-context) => T a b c -> blah
+tcIdDetails :: IfaceIdDetails -> IfL IdDetails
+tcIdDetails IfVanillaId = return VanillaId
+tcIdDetails IfDFunId    = return DFunId
+tcIdDetails (IfRecSelId tc naughty)
+  = do { tc' <- tcIfaceTyCon tc
+       ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
 
 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
 tcIdInfo ignore_prags name ty info 
@@ -1200,6 +1184,7 @@ bindIfaceBndrs (b:bs) thing_inside
     bindIfaceBndrs bs  $ \ bs' ->
     thing_inside (b':bs')
 
+
 -----------------------
 tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
 tcIfaceLetBndr (IfLetBndr fs ty info)
@@ -1247,5 +1232,20 @@ mk_iface_tyvar name ifKind
                return (Var.mkCoVar name kind)
          else
                return (Var.mkTyVar name kind) }
-\end{code}
+
+bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
+-- Used for type variable in nested associated data/type declarations
+-- where some of the type variables are already in scope
+--    class C a where { data T a b }
+-- Here 'a' is in scope when we look at the 'data T'
+bindIfaceTyVars_AT [] thing_inside
+  = thing_inside []
+bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside 
+  = bindIfaceTyVars_AT bs $ \ bs' ->
+    do { mb_tv <- lookupIfaceTyVar tv_occ
+       ; case mb_tv of
+          Just b' -> thing_inside (b':bs')
+          Nothing -> bindIfaceTyVar b $ \ b' -> 
+                     thing_inside (b':bs') }
+\end{code}