Fix bug in vectorisation

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

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 96fe9d2..166eae6 100644 (file)
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -83,14 +83,12 @@ vectTopBind b@(Rec bs)
 vectTopBinder :: Var -> VM Var
 vectTopBinder var
   = do
-      vty <- liftM (mkForAllTys tyvars) $ vectType mono_ty
+      vty <- vectType (idType var)
       name <- cloneName mkVectOcc (getName var)
       let var' | isExportedId var = Id.mkExportedLocalId name vty
                | otherwise        = Id.mkLocalId         name vty
       defGlobalVar var var'
       return var'
-  where
-    (tyvars, mono_ty) = splitForAllTys (idType var)
     
 vectTopRhs :: CoreExpr -> VM CoreExpr
 vectTopRhs = liftM fst . closedV . vectPolyExpr (panic "Empty lifting context") . freeVars
@@ -438,7 +436,7 @@ vectTyCon tc
                     Nothing  -> pprTrace "ccTyCon:" (ppr tc) $ return tc
 
 vectType :: Type -> VM Type
-vectType ty | Just ty' <- coreView ty = vectType ty
+vectType ty | Just ty' <- coreView ty = vectType ty'
 vectType (TyVarTy tv) = return $ TyVarTy tv
 vectType (AppTy ty1 ty2) = liftM2 AppTy (vectType ty1) (vectType ty2)
 vectType (TyConApp tc tys) = liftM2 TyConApp (vectTyCon tc) (mapM vectType tys)