X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=64d46fc0932bee32f199d09fedaca7adcf6036c7;hb=48fb2b521898998a17873ad6cf30610aa5ab6db3;hp=5f24741af04069ce7ea68cae9277a105c93f76d2;hpb=f8bfbc444dc77d9d8c5f19ff33e198da43c7a8f0;p=ghc-hetmet.git

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 5f24741..64d46fc 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -19,6 +19,8 @@ import Rules                ( RuleBase )
 import DataCon
 import TyCon
 import Type
+import FamInstEnv           ( extendFamInstEnvList )
+import InstEnv              ( extendInstEnvList )
 import Var
 import VarEnv
 import VarSet
@@ -56,8 +58,20 @@ vectorise hsc_env _ _ guts
 vectModule :: ModGuts -> VM ModGuts
 vectModule guts
   = do
+      (types', fam_insts, insts) <- vectTypeEnv (mg_types guts)
+
+      let fam_inst_env' = extendFamInstEnvList (mg_fam_inst_env guts) fam_insts
+          inst_env'     = extendInstEnvList (mg_inst_env guts) insts
+      updGEnv (setInstEnvs inst_env' fam_inst_env')
+      
       binds' <- mapM vectTopBind (mg_binds guts)
-      return $ guts { mg_binds = binds' }
+      return $ guts { mg_types        = types'
+                    , mg_binds        = binds'
+                    , mg_inst_env     = inst_env'
+                    , mg_fam_inst_env = fam_inst_env'
+                    , mg_insts        = mg_insts guts ++ insts
+                    , mg_fam_insts    = mg_fam_insts guts ++ fam_insts
+                    }
 
 vectTopBind :: CoreBind -> VM CoreBind
 vectTopBind b@(NonRec var expr)