%\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
- import Unify ( tcMatchTy )\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 PrelNames\r
import StaticFlags ( opt_NoOptCoercion )\r
- import Util\r
import Outputable\r
- import Unify\r
import Pair\r
import Maybes( allMaybes )\r
import FastString\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
- \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
- (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_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
-- can appear as the right hand side of a type synonym.
| FunTy
- Type
+ Type
Type -- ^ Special case of 'TyConApp': @TyConApp FunTyCon [t1, t2]@
+ -- See Note [Equality-constrained types]
| ForAllTy
- TyCoVar -- ^ Type *or* coercion variable; see Note [Equality-constrained types]
+ TyCoVar -- Type variable
Type -- ^ A polymorphic type
| PredTy
is encoded like this:
ForAllTy (a:*) $ ForAllTy (b:*) $
- ForAllTy (wild_co : a ~ [b]) $
+ FunTy (PredTy (EqPred a [b]) $
blah
-That is, the "(a ~ [b]) =>" part is encode as a for-all
-type with a coercion variable that is never mentioned.
-
-We could instead have used a FunTy with an EqPred on the
-left. But we want
-
- * FunTy to mean RUN-TIME abstraction,
- passing a real value at runtime,
-
- * ForAllTy to mean COMPILE-TIME abstraction,
- erased at runtime
-
-------------------------------------
Note [PredTy]
| isSymOcc (getOccName tv) = parens (ppr tv)
| otherwise = ppr tv
+ -------------------
pprForAll :: [TyVar] -> SDoc
pprForAll [] = empty
pprForAll tvs = ptext (sLit "forall") <+> sep (map pprTvBndr tvs) <> dot
pprTvBndr :: TyVar -> SDoc
- pprTvBndr tv
+ pprTvBndr tv
| isLiftedTypeKind kind = ppr_tvar tv
- | otherwise = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
- where
- kind = tyVarKind tv
+ | otherwise = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
+ where
+ kind = tyVarKind tv
\end{code}
Note [Infix type variables]