From b77da25ef0d95e776a43779bbb4843eb01d33552 Mon Sep 17 00:00:00 2001
From: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Date: Wed, 5 Dec 2012 15:28:19 +1100
Subject: Rewrote vectorisation avoidance (based on the HS paper)

* Vectorisation avoidance is now the default
* Types and values from unvectorised modules are permitted in scalar code
* Simplified the VECTORISE pragmas (see http://hackage.haskell.org/trac/ghc/wiki/DataParallel/VectPragma for the spec)
* Vectorisation information is now included in the annotated Core AST
---
 compiler/vectorise/Vectorise/Utils.hs | 27 ++++++++++++++++++---------
 1 file changed, 18 insertions(+), 9 deletions(-)

(limited to 'compiler/vectorise/Vectorise/Utils.hs')

diff --git a/compiler/vectorise/Vectorise/Utils.hs b/compiler/vectorise/Vectorise/Utils.hs
index c5f1cb7cb1..fafce7a67d 100644
--- a/compiler/vectorise/Vectorise/Utils.hs
+++ b/compiler/vectorise/Vectorise/Utils.hs
@@ -17,7 +17,7 @@ module Vectorise.Utils (
   combinePD, liftPD,
 
   -- * Scalars
-  zipScalars, scalarClosure,
+  isScalar, zipScalars, scalarClosure,
 
   -- * Naming
   newLocalVar
@@ -137,20 +137,29 @@ liftPD x
 
 -- Scalars --------------------------------------------------------------------
 
+isScalar :: Type -> VM Bool
+isScalar ty
+  = do
+    { scalar <- builtin scalarClass
+    ; existsInst scalar [ty]
+    }
+
 zipScalars :: [Type] -> Type -> VM CoreExpr
 zipScalars arg_tys res_ty
-  = do
-      scalar <- builtin scalarClass
-      (dfuns, _) <- mapAndUnzipM (\ty -> lookupInst scalar [ty]) ty_args
-      zipf <- builtin (scalarZip $ length arg_tys)
-      return $ Var zipf `mkTyApps` ty_args `mkApps` map Var dfuns
+  = do 
+    { scalar <- builtin scalarClass
+    ; (dfuns, _) <- mapAndUnzipM (\ty -> lookupInst scalar [ty]) ty_args
+    ; zipf <- builtin (scalarZip $ length arg_tys)
+    ; return $ Var zipf `mkTyApps` ty_args `mkApps` map Var dfuns
+    }
     where
       ty_args = arg_tys ++ [res_ty]
 
 scalarClosure :: [Type] -> Type -> CoreExpr -> CoreExpr -> VM CoreExpr
 scalarClosure arg_tys res_ty scalar_fun array_fun
   = do
-      ctr <- builtin (closureCtrFun $ length arg_tys)
-      pas <- mapM paDictOfType (init arg_tys)
-      return $ Var ctr `mkTyApps` (arg_tys ++ [res_ty])
+    { ctr <- builtin (closureCtrFun $ length arg_tys)
+    ; pas <- mapM paDictOfType (init arg_tys)
+    ; return $ Var ctr `mkTyApps` (arg_tys ++ [res_ty])
                        `mkApps`   (pas ++ [scalar_fun, array_fun])
+    }
-- 
cgit v1.2.1