From 39a924f10cb4fed95d8fc0caf209876a693ab1f9 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Mon, 13 Jul 2009 09:20:32 +0000 Subject: [PATCH] Fix warnings --- compiler/vectorise/VectBuiltIn.hs | 2 +- compiler/vectorise/VectCore.hs | 3 --- compiler/vectorise/VectType.hs | 29 +++++++++-------------------- compiler/vectorise/VectUtils.hs | 8 +++----- compiler/vectorise/Vectorise.hs | 3 +-- 5 files changed, 14 insertions(+), 31 deletions(-) diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 16b23ab..e822837 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -161,6 +161,7 @@ prodTyCon n bi prodDataCon :: Int -> Builtins -> DataCon prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of [con] -> con + _ -> pprPanic "prodDataCon" (ppr n) combinePDVar :: Int -> Builtins -> Var combinePDVar = indexBuiltin "combinePDVar" combinePDVars @@ -275,7 +276,6 @@ initBuiltins pkg , dph_Repr = dph_Repr , dph_Closure = dph_Closure , dph_Selector = dph_Selector - , dph_Unboxed = dph_Unboxed , dph_Scalar = dph_Scalar }) = dph_Modules pkg diff --git a/compiler/vectorise/VectCore.hs b/compiler/vectorise/VectCore.hs index 50e7847..c98c03c 100644 --- a/compiler/vectorise/VectCore.hs +++ b/compiler/vectorise/VectCore.hs @@ -17,9 +17,6 @@ module VectCore ( import CoreSyn import CoreUtils ( mkInlineMe ) -import MkCore ( mkWildCase ) -import CoreUtils ( exprType ) -import DataCon ( DataCon ) import Type ( Type ) import Var diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs index 0a104e3..b6cea0c 100644 --- a/compiler/vectorise/VectType.hs +++ b/compiler/vectorise/VectType.hs @@ -25,8 +25,6 @@ import BasicTypes ( StrictnessMark(..), boolToRecFlag ) import Var ( Var, TyVar ) import Name ( Name, getOccName ) import NameEnv -import TysWiredIn -import TysPrim ( intPrimTy ) import Unique import UniqFM @@ -36,7 +34,6 @@ import Digraph ( SCC(..), stronglyConnCompFromEdgedVertices ) import Outputable import FastString -import MonadUtils ( mapAndUnzip3M ) import Control.Monad ( liftM, liftM2, zipWithM, zipWithM_, mapAndUnzipM ) import Data.List ( inits, tails, zipWith4, zipWith5 ) @@ -233,11 +230,11 @@ buildPReprTyCon orig_tc vect_tc buildPReprType :: TyCon -> VM Type buildPReprType vect_tc = sum_type . map dataConRepArgTys $ tyConDataCons vect_tc where - sum_type [] = voidType + sum_type [] = voidType sum_type [tys] = prod_type tys - sum_type tys = do - (sum_tc, _, _, args) <- reprSumTyCons vect_tc - return $ mkTyConApp sum_tc args + sum_type _ = do + (sum_tc, _, _, args) <- reprSumTyCons vect_tc + return $ mkTyConApp sum_tc args prod_type [] = voidType prod_type [ty] = return ty @@ -276,7 +273,7 @@ buildToPRepr vect_tc repr_tc _ wrap = wrapFamInstBody repr_tc ty_args - to_sum arg arg_ty res_ty [] + to_sum _ _ _ [] = do void <- builtin voidVar return $ wrap (Var void) @@ -296,8 +293,6 @@ buildToPRepr vect_tc repr_tc _ return . mkWildCase arg arg_ty res_ty $ zipWith4 mk_alt cons vars sum_cons prods where - arity = length cons - mk_alt con vars sum_con expr = (DataAlt con, vars, wrap $ sum_con `App` expr) @@ -314,9 +309,6 @@ buildToPRepr vect_tc repr_tc _ prod_con <- builtin (prodDataCon (length tys)) vars <- newLocalVars (fsLit "x") tys return (mkConApp prod_con (map Type tys ++ map Var vars), vars) - where - arity = length tys - buildFromPRepr :: TyCon -> TyCon -> TyCon -> VM CoreExpr buildFromPRepr vect_tc repr_tc _ @@ -331,7 +323,7 @@ buildFromPRepr vect_tc repr_tc _ ty_args = mkTyVarTys (tyConTyVars vect_tc) res_ty = mkTyConApp vect_tc ty_args - from_sum expr [] = pprPanic "buildFromPRepr" (ppr vect_tc) + from_sum _ [] = pprPanic "buildFromPRepr" (ppr vect_tc) from_sum expr [con] = from_prod expr con from_sum expr cons = do @@ -342,14 +334,12 @@ buildFromPRepr vect_tc repr_tc _ return . mkWildCase expr (exprType expr) res_ty $ zipWith3 mk_alt sum_cons vars prods where - arity = length cons - mk_alt con var expr = (DataAlt con, [var], expr) from_prod expr con = case dataConRepArgTys con of [] -> return $ apply_con [] - [ty] -> return $ apply_con [expr] + [_] -> return $ apply_con [expr] tys -> do prod_con <- builtin (prodDataCon (length tys)) vars <- newLocalVars (fsLit "y") tys @@ -452,7 +442,6 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc from_sum res_ty expr cons = do (_, pdata_tc, sel_ty, arg_tys) <- reprSumTyCons vect_tc - prod_tys <- mapM mkPDataType arg_tys sel <- newLocalVar (fsLit "sel") sel_ty vars <- newLocalVars (fsLit "xs") arg_tys rs <- zipWithM (from_prod res_ty) (map Var vars) cons @@ -466,8 +455,8 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc from_prod res_ty expr con - | [] <- tys = return ([], id) - | [ty] <- tys = return ([expr], id) + | [] <- tys = return ([], id) + | [_] <- tys = return ([expr], id) | otherwise = do prod_tc <- builtin (prodTyCon (length tys)) diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index 30ce9ac..8121c06 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -215,8 +215,6 @@ paDFunApply dfun tys dicts <- mapM paDictOfType tys return $ mkApps (mkTyApps dfun tys) dicts -type PAMethod = (Builtins -> Var, String) - paMethod :: (Builtins -> Var) -> String -> Type -> VM CoreExpr paMethod _ name ty | Just tycon <- splitPrimTyCon ty @@ -445,11 +443,11 @@ buildEnv vs `mkTyApps` lenv_tyargs `mkApps` map Var lvs - vbind env body = mkWildCase venv ty (exprType body) - [(DataAlt venv_con, vvs, body)] + vbind env body = mkWildCase env ty (exprType body) + [(DataAlt venv_con, vvs, body)] lbind env body = - let scrut = unwrapFamInstScrut lenv_tc lenv_tyargs lenv + let scrut = unwrapFamInstScrut lenv_tc lenv_tyargs env in mkWildCase scrut (exprType scrut) (exprType body) [(DataAlt lenv_con, lvs, body)] diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 27cdde3..36ee7b7 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -371,9 +371,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))) -- 1.7.10.4