Fix an issue with lazyness in the closure viewer

[ghc-hetmet.git] / compiler / types / Type.lhs

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 88a7bc7..480357e 100644 (file)
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -48,7 +48,7 @@ module Type (
        splitTyConApp_maybe, splitTyConApp, 
         splitNewTyConApp_maybe, splitNewTyConApp,
 
-       repType, typePrimRep, coreView, tcView, kindView,
+       repType, repType', typePrimRep, coreView, tcView, kindView,
 
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
        applyTy, applyTys, isForAllTy, dropForAlls,
@@ -94,7 +94,7 @@ module Type (
        substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar,
 
        -- Pretty-printing
-       pprType, pprParendType, pprTyThingCategory,
+       pprType, pprParendType, pprTyThingCategory, pprForAll,
        pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
     ) where
 
@@ -457,6 +457,16 @@ repType (TyConApp tc tys)
                           repType (new_type_rep tc tys)
 repType ty = ty
 
+-- repType' aims to be a more thorough version of repType
+-- For now it simply looks through the TyConApp args too
+repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined
+            | otherwise = go1 ty 
+ where 
+        go1 = go . repType
+        go (TyConApp tc tys) = mkTyConApp tc (map repType' tys)
+        go ty = ty
+
+
 -- new_type_rep doesn't ask any questions: 
 -- it just expands newtype, whether recursive or not
 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
@@ -1015,10 +1025,12 @@ cmpTypesX env ty        []        = GT
 -------------
 cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
 cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
-       -- Compare types as well as names for implicit parameters
-       -- This comparison is used exclusively (I think) for the
-       -- finite map built in TcSimplify
-cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
+       -- Compare names only for implicit parameters
+       -- This comparison is used exclusively (I believe) 
+       -- for the Avails finite map built in TcSimplify
+       -- If the types differ we keep them distinct so that we see 
+       -- a distinct pair to run improvement on 
+cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2)
 cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
 
 -- Constructor order: IParam < ClassP < EqPred