Merge branch 'master' into type-nats
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Fri, 30 Dec 2011 00:45:30 +0000 (16:45 -0800)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Fri, 30 Dec 2011 00:45:30 +0000 (16:45 -0800)
Conflicts:
compiler/typecheck/TcCanonical.lhs
compiler/typecheck/TcSMonad.lhs

1  2 
compiler/hsSyn/HsTypes.lhs
compiler/iface/TcIface.lhs
compiler/parser/Parser.y.pp
compiler/parser/RdrHsSyn.lhs
compiler/typecheck/TcCanonical.lhs
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcEvidence.lhs
compiler/typecheck/TcHsType.lhs
compiler/typecheck/TcSplice.lhs
compiler/typecheck/TcType.lhs
compiler/types/TypeRep.lhs

Simple merge
Simple merge
Simple merge
Simple merge
@@@ -555,29 -600,28 +600,30 @@@ flatten :: SubGoalDepth -- Dept
  flatten d ctxt ty 
    | Just ty' <- tcView ty
    = do { (xi, co) <- flatten d ctxt ty'
-        ; return (xi,co) }
-       
-        -- DV: The following is tedious to do but maybe we should return to this
-        -- Preserve type synonyms if possible
-        -- ; if no_flattening
-        --   then return (xi, mkTcReflCo xi,no_flattening) -- Importantly, not xi!
-        --   else return (xi,co,no_flattening) 
-        -- }
+        ; return (xi,co) } 
  
- flatten d ctxt v@(TyVarTy _)
 +flatten _ _ xi@(LiteralTy _) = return (xi, mkTcReflCo xi)
 +
+ flatten d ctxt (TyVarTy tv)
    = do { ieqs <- getInertEqs
-        ; let co = liftInertEqsTy ieqs ctxt v           -- co : v ~ ty
-              ty = pSnd (tcCoercionKind co)
-        ; if v `eqType` ty then
-              return (ty,mkTcReflCo ty)
-          else -- NB recursive call. Why? See Note [Non-idempotent inert substitution]
-               -- Actually I believe that applying the substition only *twice* will suffice
-          
-              do { (ty_final,co') <- flatten d ctxt ty  -- co' : ty_final ~ ty
-                 ; return (ty_final,co' `mkTcTransCo` mkTcSymCo co) } }
+        ; let mco = tv_eq_subst (fst ieqs) tv  -- co : v ~ ty
+        ; case mco of -- Done, but make sure the kind is zonked
+            Nothing -> 
+                do { let knd = tyVarKind tv
+                   ; (new_knd,_kind_co) <- flatten d ctxt knd
+                   ; let ty = mkTyVarTy (setVarType tv new_knd)
+                   ; return (ty, mkTcReflCo ty) }
+            -- NB recursive call. 
+            -- Why? See Note [Non-idempotent inert substitution]
+            -- Actually, I think applying the substition just twice will suffice
+            Just (co,ty) -> 
+                do { (ty_final,co') <- flatten d ctxt ty
+                   ; return (ty_final, co' `mkTcTransCo` mkTcSymCo co) } }  
+   where tv_eq_subst subst tv
+           | Just (ct,co) <- lookupVarEnv subst tv
+           , cc_flavor ct `canRewrite` ctxt
+           = Just (co,cc_rhs ct)
+           | otherwise = Nothing
  
  \end{code}
  
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
@@@ -524,11 -510,10 +524,13 @@@ pprThetaArrowTy preds   = parens (fsep 
  instance Outputable Type where
      ppr ty = pprType ty
  
 +instance Outputable TyLit where
 +   ppr = pprTyLit
 +
  instance Outputable name => OutputableBndr (IPName name) where
-     pprBndr _ n = ppr n       -- Simple for now
+     pprBndr _ n   = ppr n     -- Simple for now
+     pprInfixOcc  n = ppr n 
+     pprPrefixOcc n = ppr n 
  
  ------------------
        -- OK, here's the main printer