Fix bug in vectorised DataCon worker generation

diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index b6f11b2..96745c5 100644 (file)
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -352,7 +352,7 @@ vectDataConWorker shape vect_tc arr_tc arr_dc orig_dc vect_dc pre (dc_tys : post
                 args    <- mapM (newLocalVar FSLIT("xs")) arr_tys
                 shapes  <- shapeReplicate shape
                                           (Var len)
                 args    <- mapM (newLocalVar FSLIT("xs")) arr_tys
                 shapes  <- shapeReplicate shape
                                           (Var len)

-                                          (mkIntLitInt $ dataConTag vect_dc)
+                                          (mkDataConTag vect_dc)

                 
                 empty_pre  <- mapM emptyPA (concat pre)
                 empty_post <- mapM emptyPA (concat post)
                 
                 empty_pre  <- mapM emptyPA (concat pre)
                 empty_post <- mapM emptyPA (concat post)

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index df8c23f..f7df277 100644 (file)
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -1,6 +1,7 @@
 module VectUtils (
   collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg,
   collectAnnValBinders,
 module VectUtils (
   collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg,
   collectAnnValBinders,

+  mkDataConTag,

   splitClosureTy,
   mkPADictType, mkPArrayType,
   paDictArgType, paDictOfType, paDFunType,
   splitClosureTy,
   mkPADictType, mkPArrayType,
   paDictArgType, paDictOfType, paDFunType,

@@ -23,7 +24,7 @@ import CoreUtils
 import Type
 import TypeRep
 import TyCon
 import Type
 import TypeRep
 import TyCon

-import DataCon            ( dataConWrapId )
+import DataCon            ( DataCon, dataConWrapId, dataConTag )

 import Var
 import Id                 ( mkWildId )
 import MkId               ( unwrapFamInstScrut )
 import Var
 import Id                 ( mkWildId )
 import MkId               ( unwrapFamInstScrut )

@@ -58,6 +59,9 @@ isAnnTypeArg :: AnnExpr b ann -> Bool
 isAnnTypeArg (_, AnnType t) = True
 isAnnTypeArg _              = False
 
 isAnnTypeArg (_, AnnType t) = True
 isAnnTypeArg _              = False
 

+mkDataConTag :: DataCon -> CoreExpr
+mkDataConTag dc = mkConApp intDataCon [mkIntLitInt $ dataConTag dc]
+

 isClosureTyCon :: TyCon -> Bool
 isClosureTyCon tc = tyConName tc == closureTyConName
 
 isClosureTyCon :: TyCon -> Bool
 isClosureTyCon tc = tyConName tc == closureTyConName