Commit 72c2f581 authored by simonpj's avatar simonpj
Browse files

[project @ 2002-03-12 15:55:26 by simonpj]

------------------------
	Fix a type-invariant bug
	------------------------

We need to call Type.mkGenTyConApp from Type.mkAppTy, in
case there's a partially applied type synonym.  Explanation
with Type.mkAppTy.  All part of GHC's rather liberal treatment
of type synonyms.

Shown up by a program from Ralf Laemmel:

	type Generic i o = forall x. i x -> o x
	type Id x = x
	comb :: Generic Id Id

Test is typecheck/should_compile/tc149.hs
parent a03714e2
......@@ -697,7 +697,8 @@ check_tau_type rank ubx_tup (NoteTy note ty)
-- Synonym notes are built only when the synonym is
-- saturated (see Type.mkSynTy)
-- Not checking the 'note' part allows us to instantiate a synonym
-- defn with a for-all type, but that seems OK too
-- defn with a for-all type, or with a partially-applied type synonym,
-- but that seems OK too
check_tau_type rank ubx_tup ty@(TyConApp tc tys)
| isSynTyCon tc
......
......@@ -34,9 +34,9 @@ import TcMType ( newKindVar, zonkKindEnv, tcInstType,
import TcUnify ( unifyKind, unifyOpenTypeKind )
import TcType ( Type, Kind, SourceType(..), ThetaType, TyVarDetails(..),
TcTyVar, TcKind, TcThetaType, TcTauType,
mkTyVarTy, mkTyVarTys, mkFunTy, mkSynTy,
mkTyVarTy, mkTyVarTys, mkFunTy,
hoistForAllTys, zipFunTys,
mkSigmaTy, mkPredTy, mkTyConApp, mkAppTys,
mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys,
liftedTypeKind, unliftedTypeKind, mkArrowKind,
mkArrowKinds, tcSplitFunTy_maybe
)
......@@ -45,7 +45,7 @@ import Inst ( Inst, InstOrigin(..), newMethodWithGivenTy, instToId )
import Id ( mkLocalId, idName, idType )
import Var ( TyVar, mkTyVar, tyVarKind )
import ErrUtils ( Message )
import TyCon ( TyCon, isSynTyCon, tyConKind )
import TyCon ( TyCon, tyConKind )
import Class ( classTyCon )
import Name ( Name )
import NameSet
......@@ -480,9 +480,7 @@ tc_fun_type name arg_tys
case thing of
ATyVar tv -> returnTc (mkAppTys (mkTyVarTy tv) arg_tys)
AGlobal (ATyCon tc)
| isSynTyCon tc -> returnTc (mkSynTy tc arg_tys)
| otherwise -> returnTc (mkTyConApp tc arg_tys)
AGlobal (ATyCon tc) -> returnTc (mkGenTyConApp tc arg_tys)
other -> failWithTc (wrongThingErr "type constructor" thing name)
\end{code}
......
......@@ -87,7 +87,7 @@ module TcType (
Type, SourceType(..), PredType, ThetaType,
mkForAllTy, mkForAllTys,
mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
isUnLiftedType, -- Source types are always lifted
......@@ -115,7 +115,7 @@ import Type ( -- Re-exports
unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,
mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
splitNewType_maybe, splitTyConApp_maybe,
......
......@@ -33,7 +33,7 @@ module Type (
mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys,
funResultTy, funArgTy, zipFunTys, isFunTy,
mkTyConApp, mkTyConTy,
mkGenTyConApp, mkTyConApp, mkTyConTy,
tyConAppTyCon, tyConAppArgs,
splitTyConApp_maybe, splitTyConApp,
......@@ -194,8 +194,16 @@ mkAppTy orig_ty1 orig_ty2
mk_app orig_ty1
where
mk_app (NoteTy _ ty1) = mk_app ty1
mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
mk_app ty1 = AppTy orig_ty1 orig_ty2
-- We call mkGenTyConApp because the TyConApp could be an
-- under-saturated type synonym. GHC allows that; e.g.
-- type Foo k = k a -> k a
-- type Id x = x
-- foo :: Foo Id -> Foo Id
--
-- Here Id is partially applied in the type sig for Foo,
-- but once the type synonyms are expanded all is well
mkAppTys :: Type -> [Type] -> Type
mkAppTys orig_ty1 [] = orig_ty1
......@@ -306,6 +314,11 @@ funArgTy ty = pprPanic "funArgTy" (pprType ty)
as apppropriate.
\begin{code}
mkGenTyConApp :: TyCon -> [Type] -> Type
mkGenTyConApp tc tys
| isSynTyCon tc = mkSynTy tc tys
| otherwise = mkTyConApp tc tys
mkTyConApp :: TyCon -> [Type] -> Type
-- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
mkTyConApp tycon tys
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment