Why name a function 'getGhciMode' when it returns GhcMode?

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

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 9feeda6..b902c8c 100644 (file)
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -17,22 +17,21 @@ import LoadIface    ( loadInterface, loadWiredInHomeIface,
                          loadDecls, findAndReadIface )
 import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, 
                          extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
-                         tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc, 
+                         tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc, refineIfaceIdEnv,
                          newIfaceName, newIfaceNames, ifaceExportNames )
 import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
                          mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
 import TcRnMonad
-import TcType          ( hoistForAllTys )      -- TEMPORARY HACK
-import Type            ( liftedTypeKind, splitTyConApp, mkSynTy, mkTyConApp,
-                         mkTyVarTys, ThetaType, 
-                         mkGenTyConApp )       -- Don't remove this... see mkIfTcApp
+import Type            ( liftedTypeKind, splitTyConApp, mkTyConApp,
+                         mkTyVarTys, ThetaType )
 import TypeRep         ( Type(..), PredType(..) )
-import TyCon           ( TyCon, tyConName, isSynTyCon )
+import TyCon           ( TyCon, tyConName )
 import HscTypes                ( ExternalPackageState(..), 
                          TyThing(..), tyThingClass, tyThingTyCon, 
                          ModIface(..), ModDetails(..), HomeModInfo(..),
                          emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
 import InstEnv         ( Instance(..), mkImportedInstance )
+import Unify           ( coreRefineTys )
 import CoreSyn
 import CoreUtils       ( exprType )
 import CoreUnfold
@@ -114,7 +113,7 @@ tcImportDecl name
   = do { initIfaceTcRn (loadWiredInHomeIface name) 
        ; return thing }
   | otherwise
-  = do         { traceIf (text "tcLookupGlobal" <+> ppr name)
+  = do         { traceIf (text "tcImportDecl" <+> ppr name)
        ; mb_thing <- initIfaceTcRn (importDecl name)
        ; case mb_thing of
            Succeeded thing -> return thing
@@ -233,7 +232,7 @@ tcHiBootIface :: Module -> TcRn ModDetails
 tcHiBootIface mod
   = do         { traceIf (text "loadHiBootInterface" <+> ppr mod)
 
-       ; mode <- getGhciMode
+       ; mode <- getGhcMode
        ; if not (isOneShot mode)
                -- In --make and interactive mode, if this module has an hs-boot file
                -- we'll have compiled it already, and it'll be in the HPT
@@ -535,22 +534,12 @@ tcIfaceType :: IfaceType -> IfL Type
 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
-tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkIfTcApp tc' ts') }
+tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 
 tcIfaceTypes tys = mapM tcIfaceType tys
 
-mkIfTcApp :: TyCon -> [Type] -> Type
--- In interface files we retain type synonyms (for brevity and better error
--- messages), but type synonyms can expand into non-hoisted types (ones with
--- foralls to the right of an arrow), so we must be careful to hoist them here.
--- This hack should go away when we get rid of hoisting.
--- Then we should go back to mkGenTyConApp or something like it
-mkIfTcApp tc tys
-  | isSynTyCon tc = hoistForAllTys (mkSynTy tc tys)
-  | otherwise    = mkTyConApp tc tys
-
 -----------------------------------------
 tcIfacePredType :: IfacePredType -> IfL PredType
 tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
@@ -688,8 +677,16 @@ tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_occs, rhs)
                                    ppr (con, arg_names, rhs) $$ ppr tyvars $$ ppr arg_tys )
                           zipWith mkLocalId id_names arg_tys
 
+               Just refine = coreRefineTys con tyvars (mkTyConApp tycon inst_tys)
+               
        ; rhs' <- extendIfaceTyVarEnv tyvars    $
                  extendIfaceIdEnv arg_ids      $
+                 refineIfaceIdEnv refine       $
+                       -- You might think that we don't need to refine the envt here,
+                       -- but we do: \(x::a) -> case y of 
+                       --                           MkT -> case x of { True -> ... }
+                       -- In the "case x" we need to know x's type, because we use that
+                       -- to find which module to look for "True" in. Sigh.
                  tcIfaceExpr rhs
        ; return (DataAlt con, tyvars ++ arg_ids, rhs') }}