X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsTypes.lhs;h=09cb0736cce1798e5862089b16e15a103c949a29;hp=7c173180744043e16fbb9da2d921b74aac37b301;hb=9da4639011348fb6c318e3cba4b08622f811d9c4;hpb=108361d05dfb0aa37871c2c6a4ddec45a1b68010

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 7c17318..09cb073 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -14,7 +14,7 @@ module HsTypes (
 	LBangType, BangType, HsBang(..), 
         getBangType, getBangStrictness, 
 	
-	mkExplicitHsForAllTy, mkImplicitHsForAllTy, 
+	mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
 	hsTyVarName, hsTyVarNames, replaceTyVarName,
 	hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
 	splitHsInstDeclTy, splitHsFunType,
@@ -32,7 +32,7 @@ import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
 
 import Type		( Type )
 import {- Kind parts of -} 
-       Type	        ( {- instance Outputable Kind -}, Kind,
+       Type	        ( {- instance Outputable Kind -} Kind,
 			  pprParendKind, pprKind, isLiftedTypeKind )
 import BasicTypes	( IPName, Boxity, tupleParens )
 import SrcLoc		( Located(..), unLoc, noSrcSpan )
@@ -190,6 +190,12 @@ mk_forall_ty exp  tvs  ty			            = HsForAllTy exp tvs (L noSrcSpan []) ty
 Implicit `plus` Implicit = Implicit
 exp1     `plus` exp2     = Explicit
 
+hsExplicitTvs :: LHsType name -> [name]
+-- The explicitly-given forall'd type variables of a HsType
+hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
+hsExplicitTvs other   			          = []
+
+---------------------
 type LHsTyVarBndr name = Located (HsTyVarBndr name)
 
 data HsTyVarBndr name