Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/896d20fabdf0087e8dd33cc419a377b7a9adee88 >--------------------------------------------------------------- commit 896d20fabdf0087e8dd33cc419a377b7a9adee88 Merge: 42186dd... b0c0205... Author: Iavor S. Diatchki <[email protected]> Date: Thu Dec 29 16:45:30 2011 -0800 Merge branch 'master' into type-nats Conflicts: compiler/typecheck/TcCanonical.lhs compiler/typecheck/TcSMonad.lhs compiler/basicTypes/Name.lhs | 3 + compiler/basicTypes/RdrName.lhs | 7 +- compiler/cmm/CmmParse.y | 2 +- compiler/codeGen/CgMonad.lhs | 4 +- compiler/codeGen/CgProf.hs | 2 +- compiler/codeGen/StgCmmMonad.hs | 4 +- compiler/codeGen/StgCmmProf.hs | 16 +- compiler/coreSyn/CoreSyn.lhs | 2 + compiler/coreSyn/CoreUtils.lhs | 8 +- compiler/coreSyn/MkCore.lhs | 2 +- compiler/coreSyn/PprCore.lhs | 3 + compiler/deSugar/DsArrows.lhs | 238 +++++---- compiler/deSugar/DsBinds.lhs | 4 +- compiler/deSugar/DsUtils.lhs | 2 +- compiler/hsSyn/HsDecls.lhs | 4 +- compiler/hsSyn/HsExpr.lhs | 19 +- compiler/hsSyn/HsImpExp.lhs | 8 +- compiler/hsSyn/HsTypes.lhs | 13 + compiler/hsSyn/HsUtils.lhs | 2 +- compiler/iface/TcIface.lhs | 2 +- compiler/main/DriverPipeline.hs | 15 +- compiler/main/DynFlags.hs | 39 ++- compiler/main/GHC.hs | 444 ++++++++-------- compiler/main/GhcMonad.hs | 9 +- compiler/main/HscMain.hs | 191 ++++--- compiler/main/InteractiveEval.hs | 95 ++-- compiler/nativeGen/AsmCodeGen.lhs | 10 +- compiler/nativeGen/NCGMonad.hs | 14 +- compiler/nativeGen/PPC/CodeGen.hs | 18 +- compiler/nativeGen/SPARC/CodeGen.hs | 2 +- compiler/nativeGen/SPARC/CodeGen/CCall.hs | 4 +- compiler/nativeGen/SPARC/CodeGen/CondCode.hs | 4 +- compiler/nativeGen/SPARC/CodeGen/Gen64.hs | 4 +- compiler/nativeGen/X86/CodeGen.hs | 26 +- compiler/parser/Lexer.x | 4 +- compiler/parser/Parser.y.pp | 53 ++- compiler/parser/RdrHsSyn.lhs | 22 +- compiler/prelude/TysWiredIn.lhs | 8 +- compiler/rename/RnEnv.lhs | 20 +- compiler/rename/RnNames.lhs | 16 +- compiler/rename/RnPat.lhs | 2 +- compiler/rename/RnSource.lhs | 50 ++- compiler/simplCore/CoreMonad.lhs | 6 +- compiler/typecheck/TcArrows.lhs | 27 +- compiler/typecheck/TcCanonical.lhs | 231 +++------ compiler/typecheck/TcErrors.lhs | 9 +- compiler/typecheck/TcEvidence.lhs | 45 ++- compiler/typecheck/TcHsSyn.lhs | 50 ++- compiler/typecheck/TcHsType.lhs | 12 +- compiler/typecheck/TcInstDcls.lhs | 74 ++-- compiler/typecheck/TcInteract.lhs | 138 +++++- compiler/typecheck/TcMatches.lhs | 3 +- compiler/typecheck/TcRnMonad.lhs | 11 +- compiler/typecheck/TcRnTypes.lhs | 5 + compiler/typecheck/TcSMonad.lhs | 99 +---- compiler/typecheck/TcSplice.lhs | 5 +- compiler/typecheck/TcType.lhs | 1 + compiler/types/Class.lhs | 2 +- compiler/types/TypeRep.lhs | 6 +- compiler/utils/Outputable.lhs | 39 +- compiler/utils/Util.lhs | 31 +- docs/users_guide/glasgow_exts.xml | 17 +- ghc/GhciMonad.hs | 68 ++-- ghc/InteractiveUI.hs | 715 +++++++++++++------------- ghc/Main.hs | 123 ++--- includes/rts/prof/CCS.h | 2 +- rts/StgCRun.c | 12 + sync-all | 106 +++-- 68 files changed, 1729 insertions(+), 1503 deletions(-) diff --cc compiler/typecheck/TcCanonical.lhs index c1b40c7,dce91b1..480c1b1 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@@ -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 _ _ xi@(LiteralTy _) = return (xi, mkTcReflCo xi) + - flatten d ctxt v@(TyVarTy _) + 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} diff --cc compiler/types/TypeRep.lhs index 9f5b6b1,26526ab..c830a12 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@@ -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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
