X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise%2FMonad.hs;fp=compiler%2Fvectorise%2FVectorise%2FMonad.hs;h=73cba88a3bebecbf77531869ab161b65935e4ca8;hp=5fcd2ac0883f6431740ff0e96e63b4b4440612a2;hb=7e95df790b34e11d7308e43dab0a7175b69b70fc;hpb=c0687066474aa4ce4912f31a5c09c1bcd673fb06

diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs
index 5fcd2ac..73cba88 100644
--- a/compiler/vectorise/Vectorise/Monad.hs
+++ b/compiler/vectorise/Vectorise/Monad.hs
@@ -1,27 +1,26 @@
 
 module Vectorise.Monad (
-	module Vectorise.Monad.Base,
-	module Vectorise.Monad.Naming,
-	module Vectorise.Monad.Local,
-	module Vectorise.Monad.Global,
-	module Vectorise.Monad.InstEnv,
-	initV,
-
-	-- * Builtins
-	liftBuiltinDs,
-	builtin,
-	builtins,
-	
-	-- * Variables
-	lookupVar,
-	maybeCantVectoriseVarM,
-	dumpVar,
-	addGlobalScalar, 
-    deleteGlobalScalar,
+  module Vectorise.Monad.Base,
+  module Vectorise.Monad.Naming,
+  module Vectorise.Monad.Local,
+  module Vectorise.Monad.Global,
+  module Vectorise.Monad.InstEnv,
+  initV,
+
+  -- * Builtins
+  liftBuiltinDs,
+  builtin,
+  builtins,
+  
+  -- * Variables
+  lookupVar,
+  maybeCantVectoriseVarM,
+  dumpVar,
+  addGlobalScalar, 
     
-	-- * Primitives
-	lookupPrimPArray,
-	lookupPrimMethod
+  -- * Primitives
+  lookupPrimPArray,
+  lookupPrimMethod
 ) where
 
 import Vectorise.Monad.Base
@@ -82,6 +81,7 @@ initV hsc_env guts info thing_inside
            ; builtin_pas <- initBuiltinPAs builtins instEnvs
 
                -- construct the initial global environment
+           ; let thing_inside' = traceVt "VectDecls" (ppr (mg_vect_decls guts)) >> thing_inside
            ; let genv = extendImportedVarsEnv builtin_vars
                         . extendScalars       builtin_scalars
                         . extendTyConsEnv     builtin_tycons
@@ -92,13 +92,13 @@ initV hsc_env guts info thing_inside
                         $ initGlobalEnv info (mg_vect_decls guts) instEnvs famInstEnvs
  
                -- perform vectorisation
-           ; r <- runVM thing_inside builtins genv emptyLocalEnv
+           ; r <- runVM thing_inside' builtins genv emptyLocalEnv
            ; case r of
                Yes genv _ x -> return $ Just (new_info genv, x)
                No           -> return Nothing
            } }
 
-    new_info genv = updVectInfo genv (mg_types guts) info
+    new_info genv = modVectInfo genv (mg_types guts) info
 
     selectBackendErr = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"
 
@@ -120,7 +120,7 @@ builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi))
 
 -- Var ------------------------------------------------------------------------
 -- | Lookup the vectorised and\/or lifted versions of this variable.
---	If it's in the global environment we get the vectorised version.
+--  If it's in the global environment we get the vectorised version.
 --      If it's in the local environment we get both the vectorised and lifted version.
 lookupVar :: Var -> VM (Scope Var (Var, Var))
 lookupVar v
@@ -140,29 +140,24 @@ maybeCantVectoriseVarM v p
 
 dumpVar :: Var -> a
 dumpVar var
-	| Just _		<- isClassOpId_maybe var
-	= cantVectorise "ClassOpId not vectorised:" (ppr var)
+  | Just _    <- isClassOpId_maybe var
+  = cantVectorise "ClassOpId not vectorised:" (ppr var)
 
-	| otherwise
-	= cantVectorise "Variable not vectorised:" (ppr var)
+  | otherwise
+  = cantVectorise "Variable not vectorised:" (ppr var)
 
 
--- local scalars --------------------------------------------------------------
+-- Global scalars --------------------------------------------------------------
 
 addGlobalScalar :: Var -> VM ()
 addGlobalScalar var 
   = do { traceVt "addGlobalScalar" (ppr var)
-       ; updGEnv $ \env -> env{global_scalars = extendVarSet (global_scalars env) var}
-     }
-     
-deleteGlobalScalar :: Var -> VM ()
-deleteGlobalScalar var 
-  = do { traceVt "deleteGlobalScalar" (ppr var)
-       ; updGEnv $ \env -> env{global_scalars = delVarSet (global_scalars env) var}
-     }
+       ; updGEnv $ \env -> env{global_scalar_vars = extendVarSet (global_scalar_vars env) var}
+       }
      
      
 -- Primitives -----------------------------------------------------------------
+
 lookupPrimPArray :: TyCon -> VM (Maybe TyCon)
 lookupPrimPArray = liftBuiltinDs . primPArray