Fix bug in vectorisation

[ghc-hetmet.git] / compiler / vectorise / VectMonad.hs

diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index 041928d..68966a1 100644 (file)
--- a/compiler/vectorise/VectMonad.hs
+++ b/compiler/vectorise/VectMonad.hs
@@ -121,6 +121,9 @@ data GlobalEnv = GlobalEnv {
                 -- instances
                 --
                 , global_fam_inst_env :: FamInstEnvs
+
+                -- Hoisted bindings
+                , global_bindings :: [(Var, CoreExpr)]
                 }
 
 data LocalEnv = LocalEnv {
@@ -131,9 +134,6 @@ data LocalEnv = LocalEnv {
 
                  -- Mapping from tyvars to their PA dictionaries
                , local_tyvar_pa :: VarEnv CoreExpr
-
-                 -- Hoisted bindings
-               , local_bindings :: [(Var, CoreExpr)]
                }
               
 
@@ -146,12 +146,12 @@ initGlobalEnv info instEnvs famInstEnvs
     , global_tycon_pa      = emptyNameEnv
     , global_inst_env      = instEnvs
     , global_fam_inst_env  = famInstEnvs
+    , global_bindings      = []
     }
 
 emptyLocalEnv = LocalEnv {
                    local_vars     = emptyVarEnv
                  , local_tyvar_pa = emptyVarEnv
-                 , local_bindings = []
                  }
 
 -- FIXME
@@ -263,8 +263,14 @@ newTyVar fs k
       u <- liftDs newUnique
       return $ mkTyVar (mkSysTvName u fs) k
 
-defGlobalVar :: Var -> CoreExpr -> VM ()
-defGlobalVar v e = updGEnv $ \env -> env { global_vars = extendVarEnv (global_vars env) v e }
+defGlobalVar :: Var -> Var -> VM ()
+defGlobalVar v v' = updGEnv $ \env ->
+  env { global_vars = extendVarEnv (global_vars env) v (Var v')
+      , global_exported_vars = upd (global_exported_vars env)
+      }
+  where
+    upd env | isExportedId v = extendVarEnv env v (v, v')
+            | otherwise      = env
 
 lookupVar :: Var -> VM (Scope CoreExpr (CoreExpr, CoreExpr))
 lookupVar v