Fix scoped type variables for expression type signatures

[ghc-hetmet.git] / compiler / hsSyn / HsTypes.lhs

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index f1343a3..09cb073 100644 (file)
--- 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,
@@ -31,7 +31,8 @@ module HsTypes (
 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
 
 import Type            ( Type )
-import Kind            ( {- instance Outputable Kind -}, Kind,
+import {- Kind parts of -} 
+       Type            ( {- instance Outputable Kind -} Kind,
                          pprParendKind, pprKind, isLiftedTypeKind )
 import BasicTypes      ( IPName, Boxity, tupleParens )
 import SrcLoc          ( Located(..), unLoc, noSrcSpan )
@@ -189,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