[commit: ghc] type-nats: Merge branch 'master' into type-nats (896d20f)
Iavor Diatchki
diatchki at galois.com
Fri Dec 30 04:27:47 CET 2011
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 <iavor.diatchki at gmail.com>
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
More information about the Cvs-ghc
mailing list