Commit 39a924f1 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au

Fix warnings

parent 3736e30f
......@@ -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
......
......@@ -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
......
......@@ -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))
......
......@@ -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)]
......
......@@ -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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment