Added a VECTORISE pragma

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

diff --git a/compiler/vectorise/Vectorise/Type/Type.hs b/compiler/vectorise/Vectorise/Type/Type.hs
index e62f45a..8cc2bec 100644 (file)
--- a/compiler/vectorise/Vectorise/Type/Type.hs
+++ b/compiler/vectorise/Vectorise/Type/Type.hs
@@ -33,7 +33,7 @@ vectAndLiftType :: Type -> VM (Type, Type)
 vectAndLiftType ty | Just ty' <- coreView ty = vectAndLiftType ty'
 vectAndLiftType ty
   = do
 vectAndLiftType ty | Just ty' <- coreView ty = vectAndLiftType ty'
 vectAndLiftType ty
   = do

-      mdicts   <- mapM paDictArgType tyvars
+      mdicts   <- mapM paDictArgType (reverse tyvars)

       let dicts = [dict | Just dict <- mdicts]
       vmono_ty <- vectType mono_ty
       lmono_ty <- mkPDataType vmono_ty
       let dicts = [dict | Just dict <- mdicts]
       vmono_ty <- vectType mono_ty
       lmono_ty <- mkPDataType vmono_ty

@@ -78,7 +78,8 @@ vectType ty@(ForAllTy _ _)
       dictsPA     <- liftM catMaybes $ mapM paDictArgType tyvars
 
       -- pack it all back together.
       dictsPA     <- liftM catMaybes $ mapM paDictArgType tyvars
 
       -- pack it all back together.

-      return $ abstractType tyvars (dictsVect ++ dictsPA) tyBody''
+      traceVt "vect ForAllTy: " $ ppr (abstractType tyvars (dictsPA ++ dictsVect) tyBody'')
+      return $ abstractType tyvars (dictsPA ++ dictsVect) tyBody''

 
 vectType ty = cantVectorise "Can't vectorise type" (ppr ty)
 
 
 vectType ty = cantVectorise "Can't vectorise type" (ppr ty)