Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/18570719202a94958195eeb6e40c76d7cc4da360 >--------------------------------------------------------------- commit 18570719202a94958195eeb6e40c76d7cc4da360 Merge: b0f1171... bcef1e28... Author: Iavor S. Diatchki <[email protected]> Date: Wed Aug 29 19:49:02 2012 -0700 Merge remote-tracking branch 'origin/master' into type-nats The only interesting change is adding the mapC instance in coreSyn/TrieMap. Conflicts: compiler/typecheck/TcEvidence.lhs compiler/basicTypes/RdrName.lhs | 21 +- compiler/cmm/CmmParse.y | 1058 ++++++++++---------- compiler/codeGen/CodeGen/Platform.hs | 46 +- compiler/codeGen/CodeGen/Platform/ARM.hs | 2 - compiler/codeGen/CodeGen/Platform/NoRegs.hs | 2 - compiler/codeGen/CodeGen/Platform/PPC.hs | 2 - compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs | 2 - compiler/codeGen/CodeGen/Platform/SPARC.hs | 2 - compiler/codeGen/CodeGen/Platform/X86.hs | 2 - compiler/codeGen/CodeGen/Platform/X86_64.hs | 2 - compiler/coreSyn/CorePrep.lhs | 46 +- compiler/coreSyn/CoreSyn.lhs | 8 + compiler/coreSyn/CoreUtils.lhs | 10 +- compiler/coreSyn/TrieMap.lhs | 112 ++- compiler/deSugar/DsBinds.lhs | 11 +- compiler/ghc.cabal.in | 1 - compiler/ghci/Linker.lhs | 67 +- compiler/hsSyn/HsDecls.lhs | 5 +- compiler/iface/MkIface.lhs | 7 +- compiler/llvmGen/LlvmCodeGen/Ppr.hs | 59 +- compiler/main/DriverPhases.hs | 41 +- compiler/main/DriverPipeline.hs | 20 +- compiler/main/GHC.hs | 6 + compiler/main/HscMain.hs | 38 +- compiler/main/HscTypes.lhs | 3 +- compiler/main/TidyPgm.lhs | 23 +- compiler/nativeGen/AsmCodeGen.lhs | 8 +- compiler/nativeGen/PPC/CodeGen.hs | 46 +- compiler/nativeGen/PPC/Instr.hs | 23 +- compiler/nativeGen/PPC/Regs.hs | 328 +------ compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs | 16 +- .../nativeGen/RegAlloc/Linear/JoinToTargets.hs | 2 +- compiler/nativeGen/RegAlloc/Linear/Main.hs | 33 +- compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs | 5 +- .../nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs | 25 +- compiler/nativeGen/SPARC/CodeGen.hs | 10 +- compiler/nativeGen/SPARC/CodeGen/Base.hs | 11 +- compiler/nativeGen/SPARC/CodeGen/Gen32.hs | 7 +- compiler/nativeGen/SPARC/Imm.hs | 4 +- compiler/nativeGen/SPARC/Instr.hs | 15 +- compiler/nativeGen/SPARC/RegPlate.hs | 318 ------ compiler/nativeGen/SPARC/Regs.hs | 130 +--- compiler/nativeGen/X86/CodeGen.hs | 157 ++-- compiler/nativeGen/X86/Instr.hs | 24 +- compiler/nativeGen/X86/Regs.hs | 216 +---- compiler/prelude/primops.txt.pp | 2 +- compiler/rename/RnEnv.lhs | 23 +- compiler/rename/RnNames.lhs | 196 +++-- compiler/specialise/Rules.lhs | 7 +- compiler/specialise/SpecConstr.lhs | 6 +- compiler/specialise/Specialise.lhs | 12 +- compiler/typecheck/TcBinds.lhs | 57 +- compiler/typecheck/TcCanonical.lhs | 12 +- compiler/typecheck/TcEvidence.lhs | 42 +- compiler/typecheck/TcMType.lhs | 34 +- compiler/typecheck/TcSimplify.lhs | 46 +- compiler/typecheck/TcTyClsDecls.lhs | 7 +- compiler/utils/Util.lhs | 17 +- docs/users_guide/using.xml | 17 +- ghc/InteractiveUI.hs | 54 +- includes/CodeGen.Platform.hs | 585 +++++++++++- includes/rts/storage/ClosureMacros.h | 60 +- mk/config.mk.in | 10 - rts/Interpreter.c | 2 +- rts/Printer.c | 2 +- rts/RaiseAsync.c | 2 +- rts/posix/OSThreads.c | 6 +- rts/sm/Compact.c | 6 +- rts/sm/Evac.c | 6 +- rts/sm/MarkWeak.c | 4 +- rts/sm/Sanity.c | 8 +- utils/ghc-cabal/Main.hs | 3 +- utils/ghc-cabal/ghc-cabal.cabal | 1 + 73 files changed, 2064 insertions(+), 2137 deletions(-) diff --cc compiler/coreSyn/TrieMap.lhs index 93112e0,7170f1c..479b6fd --- a/compiler/coreSyn/TrieMap.lhs +++ b/compiler/coreSyn/TrieMap.lhs @@@ -447,8 -483,28 +485,29 @@@ instance TrieMap CoercionMap wher type Key CoercionMap = Coercion emptyTM = EmptyKM lookupTM = lkC emptyCME - alterTM = xtC emptyCME - foldTM = fdC + alterTM = xtC emptyCME + foldTM = fdC + mapTM = mapC + + mapC :: (a->b) -> CoercionMap a -> CoercionMap b + mapC _ EmptyKM = EmptyKM + mapC f (KM { km_refl = krefl, km_tc_app = ktc + , km_app = kapp, km_forall = kforall + , km_var = kvar, km_axiom = kax + , km_unsafe = kunsafe, km_sym = ksym, km_trans = ktrans - , km_nth = knth, km_inst = kinst }) ++ , km_nth = knth, km_inst = kinst, km_type_nats = knats }) + = KM { km_refl = mapTM f krefl + , km_tc_app = mapNameEnv (mapTM f) ktc + , km_app = mapTM (mapTM f) kapp + , km_forall = mapTM (mapTM f) kforall + , km_var = mapTM f kvar + , km_axiom = mapNameEnv (mapTM f) kax + , km_unsafe = mapTM (mapTM f) kunsafe + , km_sym = mapTM f ksym + , km_trans = mapTM (mapTM f) ktrans + , km_nth = IntMap.map (mapTM f) knth - , km_inst = mapTM (mapTM f) kinst } ++ , km_inst = mapTM (mapTM f) kinst ++ , km_type_nats = mapNameEnv (mapTM (mapTM f)) knats } lkC :: CmEnv -> Coercion -> CoercionMap a -> Maybe a lkC env co m diff --cc compiler/typecheck/TcEvidence.lhs index 51f94ed,1214905..7e4071e --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@@ -36,8 -36,7 +36,8 @@@ import Va import PprCore () -- Instance OutputableBndr TyVar import TypeRep -- Knows type representation import TcType - import Type( tyConAppArgN, getEqPredTys_maybe, tyConAppTyCon_maybe, getEqPredTys -import Type( tyConAppArgN, tyConAppTyCon_maybe, getEqPredTys ) ++import Type( tyConAppArgN, tyConAppTyCon_maybe, getEqPredTys + , co_axr_inst ) import TysPrim( funTyCon ) import TyCon import PrelNames @@@ -249,13 -243,10 +248,11 @@@ coVarsOfTcCo tc_c `minusVarSet` get_bndrs bs go (TcLetCo {}) = emptyVarSet -- Harumph. This does legitimately happen in the call -- to evVarsOfTerm in the DEBUG check of setEvBind + go (TcTypeNatCo _ _ cos) = foldr (unionVarSet . go) emptyVarSet cos - -- We expect only coercion bindings + -- We expect only coercion bindings, so use evTermCoercion go_bind :: EvBind -> VarSet - go_bind (EvBind _ (EvCoercion co)) = go co - go_bind (EvBind _ (EvId v)) = unitVarSet v - go_bind other = pprPanic "coVarsOfTcCo:Bind" (ppr other) + go_bind (EvBind _ tm) = go (evTermCoercion tm) get_bndrs :: Bag EvBind -> VarSet get_bndrs = foldrBag (\ (EvBind b _) bs -> extendVarSet bs b) emptyVarSet _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
