X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise.hs;h=2bce391a8f72788ee8d8ccc36116232cad754943;hb=cfccfa67393fcf8cb43aaa465d421b67c7117580;hp=27cdde35a089d1f9724c741bddb3ce2f3abb6018;hpb=3736e30f683990ee94055b60905cce208a467e8b;p=ghc-hetmet.git

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 27cdde3..2bce391 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -27,6 +27,7 @@ import OccName
 
 import Literal              ( Literal, mkMachInt )
 import TysWiredIn
+import TysPrim              ( intPrimTy )
 
 import Outputable
 import FastString
@@ -371,9 +372,8 @@ vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt _, [], body)]
       (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
       return $ vCaseDEFAULT vscrut vbndr vty lty vbody
 
-vectAlgCase tycon _ty_args scrut bndr ty [(DataAlt dc, bndrs, body)]
+vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt dc, bndrs, body)]
   = do
-      vect_tc    <- maybeV (lookupTyCon tycon)
       (vty, lty) <- vectAndLiftType ty
       vexpr      <- vectExpr scrut
       (vbndr, (vbndrs, (vect_body, lift_body)))
@@ -448,9 +448,7 @@ vectAlgCase tycon _ty_args scrut bndr ty alts
               tag  = mkDataConTag vect_dc
               fvs  = freeVarsOf body `delVarSetList` bndrs
 
-          pick <- builtin (selPick arity)
-          let flags_expr = mkApps pick [sel, tag]
-          flags_var <- newLocalVar (fsLit "flags") (exprType flags_expr)
+          sel_tags  <- liftM (`App` sel) (builtin (selTags arity))
           lc        <- builtin liftingContext
           elems     <- builtin (selElements arity ntag)
 
@@ -458,15 +456,17 @@ vectAlgCase tycon _ty_args scrut bndr ty alts
             <- vectBndrsIn bndrs
              . localV
              $ do
-                 binds    <- mapM (pack_var (Var lc) (Var flags_var))
+                 binds    <- mapM (pack_var (Var lc) sel_tags tag)
                            . filter isLocalId
                            $ varSetElems fvs
                  (ve, le) <- vectExpr body
-                 empty    <- emptyPD vty
                  return (ve, Case (elems `App` sel) lc lty
-                               [(DEFAULT, [], Let (NonRec flags_var flags_expr)
-                                              $ mkLets (concat binds) le),
-                                (LitAlt (mkMachInt 0), [], empty)])
+                             [(DEFAULT, [], (mkLets (concat binds) le))])
+                 -- empty    <- emptyPD vty
+                 -- return (ve, Case (elems `App` sel) lc lty
+                 --             [(DEFAULT, [], Let (NonRec flags_var flags_expr)
+                 --                             $ mkLets (concat binds) le),
+                 --               (LitAlt (mkMachInt 0), [], empty)])
           let (vect_bndrs, lift_bndrs) = unzip vbndrs
           return (vect_dc, vect_bndrs, lift_bndrs, vbody)
 
@@ -474,14 +474,14 @@ vectAlgCase tycon _ty_args scrut bndr ty alts
 
     mk_vect_alt vect_dc bndrs body = (DataAlt vect_dc, bndrs, body)
 
-    pack_var len flags v
+    pack_var len tags t v
       = do
           r <- lookupVar v
           case r of
             Local (vv, lv) ->
               do
                 lv'  <- cloneVar lv
-                expr <- packPD (idType vv) (Var lv) len flags
+                expr <- packByTagPD (idType vv) (Var lv) len tags t
                 updLEnv (\env -> env { local_vars = extendVarEnv
                                                 (local_vars env) v (vv, lv') })
                 return [(NonRec lv' expr)]