[project @ 2005-02-28 16:04:54 by simonpj]

Add forall-hoisting to TcIface; see comments with mkIfTcAPp
	Fixes Sourceforge bug 1146068
	tc191 tests

This fix is temporary, until we get rid of forall-hoisting
altogether

diff --git a/ghc/compiler/iface/IfaceType.lhs b/ghc/compiler/iface/IfaceType.lhs
index b713908..f893a58 100644 (file)
--- a/ghc/compiler/iface/IfaceType.lhs
+++ b/ghc/compiler/iface/IfaceType.lhs
@@ -338,7 +338,7 @@ toIfaceType ext (FunTy t1 t2)            = IfaceFunTy (toIfaceType ext t1) (toIfac
 toIfaceType ext (TyConApp tc tys)           = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
 toIfaceType ext (ForAllTy tv t)             = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
 toIfaceType ext (PredTy st)                 = IfacePredTy (toIfacePred ext st)
-toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app
+toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app  -- Retain synonyms
 toIfaceType ext (NoteTy other_note ty)      = toIfaceType ext ty
 
 ----------------

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 0167fdb..a75582a 100644 (file)
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -14,23 +14,23 @@ module TcIface (
 
 import IfaceSyn
 import LoadIface       ( loadHomeInterface, loadInterface, predInstGates,
-                         discardDeclPrags, loadDecls )
-import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, lookupOrig,
+                         loadDecls )
+import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, 
                          extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
                          tcIfaceTyVar, tcIfaceLclId,
                          newIfaceName, newIfaceNames )
 import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
                          mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
 import TcRnMonad
-import Type            ( liftedTypeKind, splitTyConApp, 
+import TcType          ( hoistForAllTys )      -- TEMPORARY HACK
+import Type            ( liftedTypeKind, splitTyConApp, mkSynTy, mkTyConApp,
                          mkTyVarTys, mkGenTyConApp, ThetaType, pprClassPred )
 import TypeRep         ( Type(..), PredType(..) )
-import TyCon           ( TyCon, tyConName )
+import TyCon           ( TyCon, tyConName, isSynTyCon )
 import HscTypes                ( ExternalPackageState(..), EpsStats(..), PackageInstEnv, 
-                         HscEnv, TyThing(..), implicitTyThings, tyThingClass, tyThingTyCon, 
+                         HscEnv, TyThing(..), tyThingClass, tyThingTyCon, 
                          ModIface(..), ModDetails(..), ModGuts,
-                         mkTypeEnv, extendTypeEnv, 
-                         lookupTypeEnv, lookupType, typeEnvIds )
+                         extendTypeEnv, lookupTypeEnv, lookupType, typeEnvIds )
 import InstEnv         ( extendInstEnvList )
 import CoreSyn
 import PprCore         ( pprIdRules )
@@ -61,7 +61,7 @@ import Outputable
 import ErrUtils                ( Message )
 import Maybes          ( MaybeErr(..) )
 import SrcLoc          ( noSrcLoc )
-import Util            ( zipWithEqual, dropList, equalLength, zipLazy )
+import Util            ( zipWithEqual, dropList, equalLength )
 import CmdLineOpts     ( DynFlag(..) )
 \end{code}
 
@@ -583,12 +583,21 @@ 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 (mkGenTyConApp tc' ts') }
+tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkIfTcApp 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.
+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') }