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:
c99e670
)
fix and enable coercion optimization
author
tom.schrijvers@cs.kuleuven.be
<unknown>
Wed, 28 Oct 2009 19:53:59 +0000
(19:53 +0000)
committer
tom.schrijvers@cs.kuleuven.be
<unknown>
Wed, 28 Oct 2009 19:53:59 +0000
(19:53 +0000)
compiler/types/Coercion.lhs
patch
|
blob
|
history
diff --git
a/compiler/types/Coercion.lhs
b/compiler/types/Coercion.lhs
index
d78bc22
..
e5dfe26
100644
(file)
--- a/
compiler/types/Coercion.lhs
+++ b/
compiler/types/Coercion.lhs
@@
-679,10
+679,9
@@
mkEqPredCoI _ (ACo co1) ty2 coi2 = ACo $ PredTy $ EqPred co1 (fromCoI coi
\begin{code}
optCoercion :: Coercion -> Coercion
\begin{code}
optCoercion :: Coercion -> Coercion
-optCoercion co = co
-{-
- = pprTrace "optCoercion" (ppr co $$ ppr (coercionKind co)) $
- ASSERT2( coercionKind co `eq` coercionKind result, ppr co $$ ppr result )
+optCoercion co
+ = pprTrace "optCoercion" (ppr co $$ ppr (coercionKind co) $$ text ">-->" $$ ppr result) $
+ ASSERT2( coercionKind co `eq` coercionKind result, ppr co $$ ppr result $$ ppr (coercionKind co) $$ ppr (coercionKind result) )
result
where
(s1,t1) `eq` (s2,t2) = s1 `coreEqType` s2 && t1 `coreEqType` t2
result
where
(s1,t1) `eq` (s2,t2) = s1 `coreEqType` s2 && t1 `coreEqType` t2
@@
-730,11
+729,23
@@
optCoercion co = co
else if chan1 || chan2
then (TyConApp tc [ty1',ty2'], True , False)
else (ty , False, False)
else if chan1 || chan2
then (TyConApp tc [ty1',ty2'], True , False)
else (ty , False, False)
- | otherwise
+ | tc == leftCoercionTyCon, [ty1] <- args
+ = let (ty1', chan1, id1) = go ty1
+ in if chan1
+ then (TyConApp tc [ty1'], True , id1)
+ else (ty , False, id1)
+ | tc == rightCoercionTyCon, [ty1] <- args
+ = let (ty1', chan1, id1) = go ty1
+ in if chan1
+ then (TyConApp tc [ty1'], True , id1)
+ else (ty , False, id1)
+ | not (isCoercionTyCon tc)
= let (args', chans, ids) = mapAndUnzip3 go args
in if or chans
then (TyConApp tc args', True , and ids)
= let (args', chans, ids) = mapAndUnzip3 go args
in if or chans
then (TyConApp tc args', True , and ids)
- else (ty , False, and ids)
+ else (ty , False, and ids)
+ | otherwise
+ = (ty, False, False)
go ty@(FunTy ty1 ty2)
= let (ty1',chan1,id1) = go ty1
(ty2',chan2,id2) = go ty2
go ty@(FunTy ty1 ty2)
= let (ty1',chan1,id1) = go ty1
(ty2',chan2,id2) = go ty2
@@
-762,5
+773,4
@@
optCoercion co = co
in if chan1
then (PredTy (IParam name ty1'), True , id1)
else (ty , False, id1)
in if chan1
then (PredTy (IParam name ty1'), True , id1)
else (ty , False, id1)
--}
\end{code}
\end{code}