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
vanillaIdInfo, newStrictnessInfo )
import Class ( Class )
import TyCon ( tyConDataCons, isTupleTyCon, mkForeignTyCon )
-import DataCon ( DataCon, dataConWorkId, dataConTyVars, dataConArgTys, isVanillaDataCon )
+import DataCon ( DataCon, dataConWorkId, dataConTyVars, dataConInstArgTys, isVanillaDataCon )
import TysWiredIn ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )
import Var ( TyVar, mkTyVar, tyVarKind )
import Name ( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
= 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
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
+ --
+ -- We check wheher the interface is a *boot* interface.
+ -- It can happen (when using GHC from Visual Studio) that we
+ -- compile a module in TypecheckOnly mode, with a stable,
+ -- fully-populated HPT. In that case the boot interface isn't there
+ -- (it's been replaced by the mother module) so we can't check it.
+ -- And that's fine, because if M's ModInfo is in the HPT, then
+ -- it's been compiled once, and we don't need to check the boot iface
then do { hpt <- getHpt
; case lookupModuleEnv hpt mod of
- Just info -> return (hm_details info)
- Nothing -> return emptyModDetails }
+ Just info | mi_boot (hm_iface info)
+ -> return (hm_details info)
+ other -> return emptyModDetails }
else do
-- OK, so we're in one-shot mode.
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') }
arg_names <- newIfaceNames arg_occs
; let tyvars = [ mkTyVar name (tyVarKind tv)
| (name,tv) <- arg_names `zip` dataConTyVars con]
- arg_tys = dataConArgTys con (mkTyVarTys tyvars)
+ arg_tys = dataConInstArgTys con (mkTyVarTys tyvars)
id_names = dropList tyvars arg_names
arg_ids = ASSERT2( equalLength id_names arg_tys,
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') }}
tcVanillaAlt data_con inst_tys arg_occs rhs
= do { arg_names <- newIfaceNames arg_occs
- ; let arg_tys = dataConArgTys data_con inst_tys
+ ; let arg_tys = dataConInstArgTys data_con inst_tys
; let arg_ids = ASSERT2( equalLength arg_names arg_tys,
ppr data_con <+> ppr inst_tys <+> ppr arg_occs $$ ppr rhs )
zipWith mkLocalId arg_names arg_tys
tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal name
| Just thing <- wiredInNameTyThing_maybe name
+ -- Wired-in things include TyCons, DataCons, and Ids
= do { loadWiredInHomeIface name; return thing }
-- Even though we are in an interface file, we want to make
-- sure its instances are loaded (imagine f :: Double -> Double)
}}}}}
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
-tcIfaceTyCon IfaceIntTc = return intTyCon
-tcIfaceTyCon IfaceBoolTc = return boolTyCon
-tcIfaceTyCon IfaceCharTc = return charTyCon
-tcIfaceTyCon IfaceListTc = return listTyCon
-tcIfaceTyCon IfacePArrTc = return parrTyCon
-tcIfaceTyCon (IfaceTupTc bx ar) = return (tupleTyCon bx ar)
-tcIfaceTyCon (IfaceTc ext_nm) = do { name <- lookupIfaceExt ext_nm
- ; thing <- tcIfaceGlobal name
- ; return (tyThingTyCon thing) }
+tcIfaceTyCon IfaceIntTc = tcWiredInTyCon intTyCon
+tcIfaceTyCon IfaceBoolTc = tcWiredInTyCon boolTyCon
+tcIfaceTyCon IfaceCharTc = tcWiredInTyCon charTyCon
+tcIfaceTyCon IfaceListTc = tcWiredInTyCon listTyCon
+tcIfaceTyCon IfacePArrTc = tcWiredInTyCon parrTyCon
+tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
+tcIfaceTyCon (IfaceTc ext_nm) = do { name <- lookupIfaceExt ext_nm
+ ; thing <- tcIfaceGlobal name
+ ; return (check_tc (tyThingTyCon thing)) }
+ where
+#ifdef DEBUG
+ check_tc tc = case toIfaceTyCon (error "urk") tc of
+ IfaceTc _ -> tc
+ other -> pprTrace "check_tc" (ppr tc) tc
+#else
+ check_tc tc = tc
+#endif
+
+-- Even though we are in an interface file, we want to make
+-- sure the instances and RULES of this tycon are loaded
+-- Imagine: f :: Double -> Double
+tcWiredInTyCon :: TyCon -> IfL TyCon
+tcWiredInTyCon tc = do { loadWiredInHomeIface (tyConName tc)
+ ; return tc }
tcIfaceClass :: IfaceExtName -> IfL Class
tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
projects / ghc-hetmet.git / blobdiff