projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge commit
[ghc-hetmet.git]
/
compiler
/
types
/
OptCoercion.lhs
diff --git
a/compiler/types/OptCoercion.lhs
b/compiler/types/OptCoercion.lhs
index
c955712
..
a93df03
100644
(file)
--- a/
compiler/types/OptCoercion.lhs
+++ b/
compiler/types/OptCoercion.lhs
@@
-3,26
+3,18
@@
%
\r
\r
\begin{code}
\r
%
\r
\r
\begin{code}
\r
-{-# OPTIONS_GHC -w #-}
\r
-module OptCoercion (
\r
- optCoercion
\r
- ) where
\r
+module OptCoercion ( optCoercion ) where
\r
\r
#include "HsVersions.h"
\r
\r
\r
#include "HsVersions.h"
\r
\r
-import Unify ( tcMatchTy )
\r
import Coercion
\r
import Type hiding( substTyVarBndr, substTy, extendTvSubst )
\r
import Coercion
\r
import Type hiding( substTyVarBndr, substTy, extendTvSubst )
\r
-import TypeRep
\r
import TyCon
\r
import Var
\r
import VarSet
\r
import VarEnv
\r
import TyCon
\r
import Var
\r
import VarSet
\r
import VarEnv
\r
-import PrelNames
\r
import StaticFlags ( opt_NoOptCoercion )
\r
import StaticFlags ( opt_NoOptCoercion )
\r
-import Util
\r
import Outputable
\r
import Outputable
\r
-import Unify
\r
import Pair
\r
import Maybes( allMaybes )
\r
import FastString
\r
import Pair
\r
import Maybes( allMaybes )
\r
import FastString
\r
@@
-100,10
+92,13
@@
opt_co env sym co
\r
opt_co' env _ (Refl ty) = Refl (substTy env ty)
\r
opt_co' env sym (SymCo co) = opt_co env (not sym) co
\r
\r
opt_co' env _ (Refl ty) = Refl (substTy env ty)
\r
opt_co' env sym (SymCo co) = opt_co env (not sym) co
\r
-opt_co' env sym (TyConAppCo tc cos) = TyConAppCo tc (map (opt_co env sym) cos)
\r
+opt_co' env sym (TyConAppCo tc cos) = mkTyConAppCo tc (map (opt_co env sym) cos)
\r
+opt_co' env sym (PredCo cos) = mkPredCo (fmap (opt_co env sym) cos)
\r
opt_co' env sym (AppCo co1 co2) = mkAppCo (opt_co env sym co1) (opt_co env sym co2)
\r
opt_co' env sym (ForAllCo tv co) = case substTyVarBndr env tv of
\r
opt_co' env sym (AppCo co1 co2) = mkAppCo (opt_co env sym co1) (opt_co env sym co2)
\r
opt_co' env sym (ForAllCo tv co) = case substTyVarBndr env tv of
\r
- (env', tv') -> ForAllCo tv' (opt_co env' sym co)
\r
+ (env', tv') -> mkForAllCo tv' (opt_co env' sym co)
\r
+ -- Use the "mk" functions to check for nested Refls
\r
+
\r
opt_co' env sym (CoVarCo cv)
\r
| Just co <- lookupCoVar env cv
\r
= opt_co (zapCvSubstEnv env) sym co
\r
opt_co' env sym (CoVarCo cv)
\r
| Just co <- lookupCoVar env cv
\r
= opt_co (zapCvSubstEnv env) sym co
\r
@@
-338,8
+333,8
@@
opt_trans_pred (IParam n1 co1) (IParam n2 co2)
opt_trans_pred _ _ = Nothing
\r
\r
fireTransRule :: String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
\r
opt_trans_pred _ _ = Nothing
\r
\r
fireTransRule :: String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
\r
-fireTransRule rule co1 co2 res
\r
- = -- pprTrace ("Trans rule fired: " ++ rule) (vcat [ppr co1, ppr co2, ppr res]) $
\r
+fireTransRule _rule _co1 _co2 res
\r
+ = -- pprTrace ("Trans rule fired: " ++ _rule) (vcat [ppr _co1, ppr _co2, ppr res]) $
\r
Just res
\r
\r
-----------
\r
Just res
\r
\r
-----------
\r