X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise%2FExp.hs;h=28ff4d88de907f65e576d89cbac9d49a319dd864;hb=56602d12c1a46fca405a9a53a91497a9597e2397;hp=1c2ee4c3d35d7f0290ee53811ce14ff45c231c1b;hpb=d5744ef51a8b8b1e063daa98026a9f803bfc88b4;p=ghc-hetmet.git

diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index 1c2ee4c..28ff4d8 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -3,10 +3,8 @@
 module Vectorise.Exp
 	(vectPolyExpr)
 where
-import VectUtils
-import VectType
-import Vectorise.Utils.Closure
-import Vectorise.Utils.Hoisting
+import Vectorise.Utils
+import Vectorise.Type.Type
 import Vectorise.Var
 import Vectorise.Vect
 import Vectorise.Env
@@ -24,7 +22,7 @@ import Var
 import VarEnv
 import VarSet
 import Id
-import BasicTypes
+import BasicTypes( isLoopBreaker )
 import Literal
 import TysWiredIn
 import TysPrim
@@ -199,22 +197,47 @@ vectScalarLam args body
         =    tycon == intTyCon
           || tycon == floatTyCon
           || tycon == doubleTyCon
+          || tycon == boolTyCon
 
         | otherwise = False
 
     is_scalar vs (Var v)     = v `elemVarSet` vs
     is_scalar _ e@(Lit _)    = is_scalar_ty $ exprType e
-    is_scalar vs (App e1 e2) = is_scalar vs e1 && is_scalar vs e2
+    
+    is_scalar _ (App (Var v) (Lit _)) 
+       | Just con <- isDataConId_maybe v = con `elem` [intDataCon, floatDataCon, doubleDataCon]
+
+    is_scalar vs (App e1 e2) = is_scalar vs e1 && is_scalar vs e2    
+    is_scalar vs (Let (NonRec b letExpr) body) 
+                             = is_scalar vs letExpr && is_scalar (extendVarSet vs b) body
+    is_scalar vs (Let (Rec bnds) body) 
+                             =  let vs' = extendVarSetList vs (map fst bnds)
+                                in all (is_scalar vs') (map snd bnds) && is_scalar vs' body
+    is_scalar vs (Case e eId ty alts)  
+                             = let vs' = extendVarSet vs eId
+	                           in is_scalar_ty ty &&
+                                  is_scalar vs' e   &&
+                                  (all (is_scalar_alt vs') alts)
+                                    
     is_scalar _ _            = False
 
+    is_scalar_alt vs (_, bs, e) 
+                             = is_scalar (extendVarSetList vs bs) e
+
     -- A scalar function has to actually compute something. Without the check,
     -- we would treat (\(x :: Int) -> x) as a scalar function and lift it to
     -- (map (\x -> x)) which is very bad. Normal lifting transforms it to
     -- (\n# x -> x) which is what we want.
     uses funs (Var v)     = v `elemVarSet` funs 
     uses funs (App e1 e2) = uses funs e1 || uses funs e2
+    uses funs (Let (NonRec _b letExpr) body) 
+                          = uses funs letExpr || uses funs  body
+    uses funs (Case e _eId _ty alts) 
+                          = uses funs e || any (uses_alt funs) alts
     uses _ _              = False
 
+    uses_alt funs (_, _bs, e)   
+                          = uses funs e 
 
 -- | Vectorise a lambda abstraction.
 vectLam