Merge commit
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 4 May 2011 12:26:30 +0000 (13:26 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 4 May 2011 12:26:30 +0000 (13:26 +0100)
1  2 
compiler/types/OptCoercion.lhs
compiler/types/TypeRep.lhs

@@@ -3,26 -3,18 +3,18 @@@
  %\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
@@@ -100,13 -92,11 +92,13 @@@ opt_co env sym c
  \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
@@@ -341,8 -331,8 +333,8 @@@ opt_trans_pred (IParam n1 co1) (IParam 
  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
@@@ -145,12 -145,11 +145,12 @@@ data Typ
                        --    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
@@@ -184,9 -183,21 +184,9 @@@ The type   forall ab. (a ~ [b]) => bla
  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]
  
@@@ -597,16 -608,17 +597,17 @@@ ppr_tvar tv  -- Note [Infix type variab
    | 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]