projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
3736e30
)
Fix warnings
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Mon, 13 Jul 2009 09:20:32 +0000
(09:20 +0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Mon, 13 Jul 2009 09:20:32 +0000
(09:20 +0000)
compiler/vectorise/VectBuiltIn.hs
patch
|
blob
|
history
compiler/vectorise/VectCore.hs
patch
|
blob
|
history
compiler/vectorise/VectType.hs
patch
|
blob
|
history
compiler/vectorise/VectUtils.hs
patch
|
blob
|
history
compiler/vectorise/Vectorise.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/VectBuiltIn.hs
b/compiler/vectorise/VectBuiltIn.hs
index
16b23ab
..
e822837
100644
(file)
--- 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
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
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_Repr = dph_Repr
, dph_Closure = dph_Closure
, dph_Selector = dph_Selector
- , dph_Unboxed = dph_Unboxed
, dph_Scalar = dph_Scalar
})
= dph_Modules pkg
, dph_Scalar = dph_Scalar
})
= dph_Modules pkg
diff --git
a/compiler/vectorise/VectCore.hs
b/compiler/vectorise/VectCore.hs
index
50e7847
..
c98c03c
100644
(file)
--- a/
compiler/vectorise/VectCore.hs
+++ b/
compiler/vectorise/VectCore.hs
@@
-17,9
+17,6
@@
module VectCore (
import CoreSyn
import CoreUtils ( mkInlineMe )
import CoreSyn
import CoreUtils ( mkInlineMe )
-import MkCore ( mkWildCase )
-import CoreUtils ( exprType )
-import DataCon ( DataCon )
import Type ( Type )
import Var
import Type ( Type )
import Var
diff --git
a/compiler/vectorise/VectType.hs
b/compiler/vectorise/VectType.hs
index
0a104e3
..
b6cea0c
100644
(file)
--- 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 Var ( Var, TyVar )
import Name ( Name, getOccName )
import NameEnv
-import TysWiredIn
-import TysPrim ( intPrimTy )
import Unique
import UniqFM
import Unique
import UniqFM
@@
-36,7
+34,6
@@
import Digraph ( SCC(..), stronglyConnCompFromEdgedVertices )
import Outputable
import FastString
import Outputable
import FastString
-import MonadUtils ( mapAndUnzip3M )
import Control.Monad ( liftM, liftM2, zipWithM, zipWithM_, mapAndUnzipM )
import Data.List ( inits, tails, zipWith4, zipWith5 )
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
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] = 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
prod_type [] = voidType
prod_type [ty] = return ty
@@
-276,7
+273,7
@@
buildToPRepr vect_tc repr_tc _
wrap = wrapFamInstBody repr_tc ty_args
wrap = wrapFamInstBody repr_tc ty_args
- to_sum arg arg_ty res_ty []
+ to_sum _ _ _ []
= do
void <- builtin voidVar
return $ wrap (Var void)
= 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
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)
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)
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 _
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
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
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
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 []
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
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
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
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
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))
| otherwise
= do
prod_tc <- builtin (prodTyCon (length tys))
diff --git
a/compiler/vectorise/VectUtils.hs
b/compiler/vectorise/VectUtils.hs
index
30ce9ac
..
8121c06
100644
(file)
--- 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
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
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
`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 =
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)]
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
(file)
--- 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
(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
= do
- vect_tc <- maybeV (lookupTyCon tycon)
(vty, lty) <- vectAndLiftType ty
vexpr <- vectExpr scrut
(vbndr, (vbndrs, (vect_body, lift_body)))
(vty, lty) <- vectAndLiftType ty
vexpr <- vectExpr scrut
(vbndr, (vbndrs, (vect_body, lift_body)))