X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectUtils.hs;h=5cd04715391abce4a43bd77e24e4f338851877f2;hp=2a3b3facae153a9b6be64cc1a8000b80fad7b75d;hb=a3be6a8eea9fe9c93fcedd393fcb0ac45dc48f5e;hpb=5e979164079ae89ca01483131149b8727dd82686

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index 2a3b3fa..5cd0471 100644
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -1,4 +1,5 @@
 module VectUtils (
+  collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg,
   splitClosureTy,
   mkPADictType, mkPArrayType,
   paDictArgType, paDictOfType
@@ -19,6 +20,22 @@ import Outputable
 
 import Control.Monad         ( liftM )
 
+collectAnnTypeArgs :: AnnExpr b ann -> (AnnExpr b ann, [Type])
+collectAnnTypeArgs expr = go expr []
+  where
+    go (_, AnnApp f (_, AnnType ty)) tys = go f (ty : tys)
+    go e                             tys = (e, tys)
+
+collectAnnTypeBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
+collectAnnTypeBinders expr = go [] expr
+  where
+    go bs (_, AnnLam b e) | isTyVar b = go (b:bs) e
+    go bs e                           = (reverse bs, e)
+
+isAnnTypeArg :: AnnExpr b ann -> Bool
+isAnnTypeArg (_, AnnType t) = True
+isAnnTypeArg _              = False
+
 isClosureTyCon :: TyCon -> Bool
 isClosureTyCon tc = tyConUnique tc == closureTyConKey