From: simonmar <unknown>
Date: Thu, 23 Jan 2003 16:01:33 +0000 (+0000)
Subject: [project @ 2003-01-23 16:01:33 by simonmar]
X-Git-Tag: Approx_11550_changesets_converted~1242
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=6873f3d4d387ab6179ebd6983bc5460e3c93fbe4

[project @ 2003-01-23 16:01:33 by simonmar]
Allow FFI declarations to have polymorphic types. eg:

foreign import ccall unsafe "stdlib.h &free" pFree :: FunPtr (Ptr a -> IO ())

(the change actually removed a line, the extra lines are because I
reformatted an import declaration).
---

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 29997cd..f41c7a4 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -111,18 +111,25 @@ import {-# SOURCE #-} PprType( pprType )
 import TypeRep		( Type(..), TyNote(..), funTyCon )  -- friend
 
 import Type		(	-- Re-exports
-			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-			  Kind, Type, SourceType(..), PredType, ThetaType, 
-			  unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
-			  mkForAllTy, mkForAllTys, defaultKind, isTypeKind, isAnyTypeKind,
+			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
+			  tyVarsOfTheta, Kind, Type, SourceType(..),
+			  PredType, ThetaType, unliftedTypeKind,
+			  liftedTypeKind, openTypeKind, mkArrowKind,
+			  mkArrowKinds, mkForAllTy, mkForAllTys,
+			  defaultKind, isTypeKind, isAnyTypeKind,
 			  mkFunTy, mkFunTys, zipFunTys, isTyVarTy,
-			  mkTyConApp, mkGenTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
-			  mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
-			  isUnLiftedType, isUnboxedTupleType, isPrimitiveType,
+			  mkTyConApp, mkGenTyConApp, mkAppTy,
+			  mkAppTys, mkSynTy, applyTy, applyTys,
+			  mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
+			  mkPredTys, isUnLiftedType,
+			  isUnboxedTupleType, isPrimitiveType,
 			  splitNewType_maybe, splitTyConApp_maybe,
-			  tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
-			  tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, eqKind, eqUsage,
-			  hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind
+			  tidyTopType, tidyType, tidyPred, tidyTypes,
+			  tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
+			  tidyTyVarBndr, tidyOpenTyVar,
+			  tidyOpenTyVars, eqKind, eqUsage,
+			  hasMoreBoxityInfo, liftedBoxity,
+			  superBoxity, typeKind, superKind, repType
 			)
 import TyCon		( TyCon, isUnLiftedTyCon )
 import Class		( classHasFDs, Class )
@@ -824,9 +831,8 @@ checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
 	-- Non-recursive ones are transparent to splitTyConApp,
 	-- but recursive ones aren't; hence the splitNewType_maybe
 checkRepTyCon check_tc ty 
-  | Just ty'    <- splitNewType_maybe ty  = checkRepTyCon check_tc ty'
-  | Just (tc,_) <- splitTyConApp_maybe ty = check_tc tc
-  | otherwise				  = False
+  | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
+  | otherwise				  	    = False
 \end{code}
 
 ----------------------------------------------