X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectType.hs;h=7b9ec50e8366b4bab4610cb960492dea5a4f7e12;hb=cfccfa67393fcf8cb43aaa465d421b67c7117580;hp=e75c977ce868bb67a9837d2d5412e8b81e7b6f12;hpb=a139addf4890fc2167949680ead07ab809a9d98b;p=ghc-hetmet.git

diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index e75c977..7b9ec50 100644
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -37,7 +37,7 @@ import FastString
 
 import MonadUtils     ( zipWith3M, foldrM, concatMapM )
 import Control.Monad  ( liftM, liftM2, zipWithM, zipWithM_, mapAndUnzipM )
-import Data.List      ( inits, tails, zipWith4, zipWith5, zipWith6 )
+import Data.List      ( inits, tails, zipWith4, zipWith6 )
 
 -- ----------------------------------------------------------------------------
 -- Types
@@ -332,7 +332,7 @@ buildToPRepr vect_tc repr_tc _ repr
 
     wrap_repr_inst = wrapFamInstBody repr_tc ty_args
 
-    to_sum arg arg_ty res_ty EmptySum
+    to_sum _ _ _ EmptySum
       = do
           void <- builtin voidVar
           return $ wrap_repr_inst $ Var void
@@ -348,8 +348,7 @@ buildToPRepr vect_tc repr_tc _ repr
                                   , repr_cons    =  cons })
       = do
           alts <- mapM con_alt cons
-          let ty_args = map Type tys
-              alts' = [(pat, vars, wrap_repr_inst
+          let alts' = [(pat, vars, wrap_repr_inst
                                    $ mkConApp sum_con (map Type tys ++ [body]))
                         | ((pat, vars, body), sum_con)
                             <- zip alts (tyConDataCons sum_tc)]
@@ -400,7 +399,7 @@ buildFromPRepr vect_tc repr_tc _ repr
     ty_args = mkTyVarTys (tyConTyVars vect_tc)
     res_ty  = mkTyConApp vect_tc ty_args
 
-    from_sum expr EmptySum
+    from_sum _ EmptySum
       = do
           dummy <- builtin fromVoidVar
           return $ Var dummy `App` Type res_ty
@@ -419,7 +418,7 @@ buildFromPRepr vect_tc repr_tc _ repr
     from_con expr (ConRepr con r)
       = from_prod expr (mkConApp con $ map Type ty_args) r
 
-    from_prod expr con EmptyProd = return con
+    from_prod _ con EmptyProd = return con
     from_prod expr con (UnaryProd r)
       = do
           e <- from_comp expr r
@@ -562,7 +561,7 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc r
 
     [pdata_con] = tyConDataCons pdata_tc
 
-    from_sum res_ty res expr EmptySum = return (res, [])
+    from_sum _ res _ EmptySum = return (res, [])
     from_sum res_ty res expr (UnarySum r) = from_con res_ty res expr r
     from_sum res_ty res expr (Sum { repr_psum_tc = psum_tc
                                   , repr_sel_ty  = sel_ty
@@ -583,7 +582,7 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc r
 
     from_con res_ty res expr (ConRepr _ r) = from_prod res_ty res expr r
 
-    from_prod res_ty res expr EmptyProd = return (res, [])
+    from_prod _ res _ EmptyProd = return (res, [])
     from_prod res_ty res expr (UnaryProd r)
       = from_comp res_ty res expr r
     from_prod res_ty res expr (Prod { repr_ptup_tc  = ptup_tc
@@ -600,8 +599,8 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc r
       where
         [ptup_con] = tyConDataCons ptup_tc
 
-    from_comp res_ty res expr (Keep _ _) = return (res, [expr])
-    from_comp res_ty res expr (Wrap ty)
+    from_comp _ res expr (Keep _ _) = return (res, [expr])
+    from_comp _ res expr (Wrap ty)
       = do
           wrap_tc  <- builtin wrapTyCon
           (pwrap_tc, _) <- pdataReprTyCon (mkTyConApp wrap_tc [ty])
@@ -816,6 +815,13 @@ buildPADict vect_tc prepr_tc arr_tc repr
           var  <- newLocalVar name (exprType body)
           return (var, mkInlineMe body)
 
+-- The InlineMe note has gone away.  Instead, you need to use
+-- CoreUnfold.mkInlineRule to make an InlineRule for the thing, and
+-- attach *that* as the unfolding for the dictionary binder
+mkInlineMe :: CoreExpr -> CoreExpr
+mkInlineMe expr = pprTrace "VectType: Roman, you need to use the new InlineRule story" 
+	   	           (ppr expr) expr
+
 paMethods :: [(FastString, TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr)]
 paMethods = [(fsLit "dictPRepr",    buildPRDict),
              (fsLit "toPRepr",      buildToPRepr),