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
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
---
--- Nov 05: the type is now hoisted before being put into an interface file
-mkIfTcApp tc tys = mkTyConApp 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') }
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') }}