X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=8c9579e621eb2ea4cd01e8672bbf3060f8473a05;hb=37b0cb1147cadef4d68f3fc61faa3ec11ad47440;hp=8e048333eb23971ad9afeabccfb31c6302252e0f;hpb=a51fe79ebcdcb8285573a18f12cade2101533419;p=ghc-hetmet.git

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 8e04833..8c9579e 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -18,13 +18,14 @@ import CoreSyn
 import CoreUnfold           ( mkInlineUnfolding )
 import CoreFVs
 import CoreMonad            ( CoreM, getHscEnv )
-import FamInstEnv           ( extendFamInstEnvList )
 import Var
 import Id
 import OccName
 import BasicTypes           ( isLoopBreaker )
 import Outputable
 import Util                 ( zipLazy )
+import MonadUtils
+
 import Control.Monad
 
 debug		= False
@@ -60,9 +61,7 @@ vectModule guts
       -- TODO: What new binds do we get back here?
       (types', fam_insts, tc_binds) <- vectTypeEnv (mg_types guts)
 
-      -- TODO: What is this?
-      let fam_inst_env' = extendFamInstEnvList (mg_fam_inst_env guts) fam_insts
-      updGEnv (setFamInstEnv fam_inst_env')
+      (_, fam_inst_env) <- readGEnv global_fam_inst_env
 
       -- dicts   <- mapM buildPADict pa_insts
       -- workers <- mapM vectDataConWorkers pa_insts
@@ -72,7 +71,7 @@ vectModule guts
 
       return $ guts { mg_types        = types'
                     , mg_binds        = Rec tc_binds : binds'
-                    , mg_fam_inst_env = fam_inst_env'
+                    , mg_fam_inst_env = fam_inst_env
                     , mg_fam_insts    = mg_fam_insts guts ++ fam_insts
                     }
 
@@ -168,7 +167,7 @@ vectTopBinder var inline expr
       vty  <- vectType (idType var)
 
       -- Make the vectorised version of binding's name, and set the unfolding used for inlining.
-      var' <- liftM (`setIdUnfolding` unfolding) 
+      var' <- liftM (`setIdUnfoldingLazily` unfolding) 
            $  cloneId mkVectOcc var vty
 
       -- Add the mapping between the plain and vectorised name to the state.
@@ -190,9 +189,13 @@ vectTopRhs
 vectTopRhs var expr
  = dtrace (vcat [text "vectTopRhs", ppr expr])
  $ closedV
- $ do (inline, vexpr) <- inBind var
+ $ do (inline, isScalar, vexpr) <- inBind var
+                      $ pprTrace "vectTopRhs" (ppr var)
                       $ vectPolyExpr (isLoopBreaker $ idOccInfo var)
                                       (freeVars expr)
+      if isScalar 
+         then addGlobalScalar var
+         else return ()
       return (inline, vectorised vexpr)