X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsTypes.lhs;fp=ghc%2Fcompiler%2FhsSyn%2FHsTypes.lhs;h=8ad5940069329caf64e0ca6880c6c53ad3fdaa90;hb=9008f5e5149514f61edf0bc9498985e58595cf40;hp=30890504bc24c0002a2f59c9385dd7f1639fc3fc;hpb=25311512b0b601ac76eac078508fa14d2d9e91dd;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 3089050..8ad5940 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -17,7 +17,7 @@ module HsTypes (
 	mkExplicitHsForAllTy, mkImplicitHsForAllTy, 
 	hsTyVarName, hsTyVarNames, replaceTyVarName,
 	hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
-	splitHsInstDeclTy,
+	splitHsInstDeclTy, splitHsFunType,
 	
 	-- Type place holder
 	PostTcType, placeHolderType,
@@ -235,6 +235,13 @@ splitHsInstDeclTy inst_ty
   where
     split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
     split_tau tvs cxt (HsParTy (L _ ty))	    = split_tau tvs cxt ty
+
+-- Splits HsType into the (init, last) parts
+splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
+splitHsFunType (L l (HsFunTy x y)) = (x:args, res)
+  where
+  (args, res) = splitHsFunType y
+splitHsFunType other = ([], other)
 \end{code}