[commit: ghc] master: Merge ghc-new-co into master branch (cbebca1)
Simon Peyton Jones
simonpj at microsoft.com
Thu May 12 12:10:29 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cbebca1c9164a5e5ae9b117d0dcf5ad217defc6d
>---------------------------------------------------------------
commit cbebca1c9164a5e5ae9b117d0dcf5ad217defc6d
Merge: 37a6a52... 3d56d5a...
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon May 9 11:53:47 2011 +0100
Merge ghc-new-co into master branch
compiler/basicTypes/DataCon.lhs | 88 +-
compiler/basicTypes/Id.lhs | 39 +-
compiler/basicTypes/IdInfo.lhs | 5 +-
compiler/basicTypes/IdInfo.lhs-boot | 2 +
compiler/basicTypes/MkId.lhs | 108 +-
compiler/basicTypes/Var.lhs | 87 +-
compiler/basicTypes/VarEnv.lhs | 3 +-
compiler/basicTypes/VarSet.lhs | 6 +-
compiler/cmm/CmmCPS.hs | 1 +
compiler/coreSyn/CoreArity.lhs | 42 +-
compiler/coreSyn/CoreFVs.lhs | 21 +-
compiler/coreSyn/CoreLint.lhs | 446 +++---
compiler/coreSyn/CorePrep.lhs | 37 +-
compiler/coreSyn/CoreSubst.lhs | 255 ++--
compiler/coreSyn/CoreSyn.lhs | 59 +-
compiler/coreSyn/CoreTidy.lhs | 9 +-
compiler/coreSyn/CoreUnfold.lhs | 44 +-
compiler/coreSyn/CoreUtils.lhs | 239 ++--
compiler/coreSyn/ExternalCore.lhs | 13 +-
compiler/coreSyn/MkCore.lhs | 10 +-
compiler/coreSyn/MkExternalCore.lhs | 57 +-
compiler/coreSyn/PprCore.lhs | 16 +-
compiler/coreSyn/PprExternalCore.lhs | 6 +-
compiler/deSugar/Check.lhs | 1 -
compiler/deSugar/Desugar.lhs | 2 +
compiler/deSugar/DsBinds.lhs | 26 +-
compiler/deSugar/DsCCall.lhs | 4 +-
compiler/deSugar/DsExpr.lhs | 28 +-
compiler/deSugar/DsForeign.lhs | 13 +-
compiler/deSugar/DsUtils.lhs | 11 +-
compiler/deSugar/Match.lhs | 14 +-
compiler/deSugar/MatchCon.lhs | 1 -
compiler/ghc.cabal.in | 2 +
compiler/ghci/ByteCodeGen.lhs | 31 +-
compiler/ghci/RtClosureInspect.hs | 281 ++--
compiler/hsSyn/HsBinds.lhs | 10 +-
compiler/hsSyn/HsPat.lhs | 4 +-
compiler/hsSyn/HsUtils.lhs | 32 +-
compiler/iface/BinIface.hs | 99 +-
compiler/iface/BuildTyCl.lhs | 20 +-
compiler/iface/IfaceSyn.lhs | 44 +-
compiler/iface/IfaceType.lhs | 112 +-
compiler/iface/MkIface.lhs | 37 +-
compiler/iface/TcIface.lhs | 76 +-
compiler/main/DynFlags.hs | 4 +-
compiler/main/GHC.hs | 7 +-
compiler/main/HscTypes.lhs | 27 +-
compiler/main/PprTyThing.hs | 9 +-
compiler/main/TidyPgm.lhs | 1 +
compiler/parser/ParserCore.y | 2 +-
compiler/prelude/PrelNames.lhs | 13 +-
compiler/prelude/PrelRules.lhs | 4 +-
compiler/prelude/TysPrim.lhs | 312 +++--
compiler/prelude/TysWiredIn.lhs | 29 +-
compiler/rename/RnNames.lhs | 2 +-
compiler/rename/RnTypes.lhs | 2 +-
compiler/simplCore/CSE.lhs | 2 +
compiler/simplCore/FloatIn.lhs | 6 +-
compiler/simplCore/FloatOut.lhs | 1 +
compiler/simplCore/LiberateCase.lhs | 1 +
compiler/simplCore/OccurAnal.lhs | 96 +-
compiler/simplCore/SAT.lhs | 23 +-
compiler/simplCore/SetLevels.lhs | 15 +-
compiler/simplCore/SimplEnv.lhs | 69 +-
compiler/simplCore/SimplUtils.lhs | 34 +-
compiler/simplCore/Simplify.lhs | 148 ++-
compiler/specialise/Rules.lhs | 30 +-
compiler/specialise/SpecConstr.lhs | 34 +-
compiler/specialise/Specialise.lhs | 7 +-
compiler/stgSyn/CoreToStg.lhs | 10 +-
compiler/stgSyn/StgSyn.lhs | 24 +-
compiler/stranal/DmdAnal.lhs | 33 +-
compiler/stranal/WorkWrap.lhs | 1 +
compiler/stranal/WwLib.lhs | 27 +-
compiler/typecheck/FamInst.lhs | 8 +-
compiler/typecheck/Inst.lhs | 10 +-
compiler/typecheck/TcArrows.lhs | 16 +-
compiler/typecheck/TcBinds.lhs | 2 +-
compiler/typecheck/TcCanonical.lhs | 190 +--
compiler/typecheck/TcDeriv.lhs | 10 +-
compiler/typecheck/TcEnv.lhs | 5 +-
compiler/typecheck/TcErrors.lhs | 14 +-
compiler/typecheck/TcExpr.lhs | 70 +-
compiler/typecheck/TcGenDeriv.lhs | 3 +-
compiler/typecheck/TcHsSyn.lhs | 35 +-
compiler/typecheck/TcHsType.lhs | 17 +-
compiler/typecheck/TcInstDcls.lhs | 233 +++-
compiler/typecheck/TcInteract.lhs | 106 +-
compiler/typecheck/TcMType.lhs | 47 +-
compiler/typecheck/TcMatches.lhs | 10 +-
compiler/typecheck/TcPat.lhs | 42 +-
compiler/typecheck/TcRnDriver.lhs | 57 +-
compiler/typecheck/TcRnMonad.lhs | 4 +-
compiler/typecheck/TcRnTypes.lhs | 7 +-
compiler/typecheck/TcRules.lhs | 1 -
compiler/typecheck/TcSMonad.lhs | 8 +-
compiler/typecheck/TcSimplify.lhs | 7 +-
compiler/typecheck/TcSplice.lhs | 21 +-
compiler/typecheck/TcTyClsDecls.lhs | 264 +---
compiler/typecheck/TcTyDecls.lhs | 2 +-
compiler/typecheck/TcType.lhs | 326 ++---
compiler/typecheck/TcUnify.lhs | 101 +-
compiler/typecheck/TcUnify.lhs-boot | 4 +-
compiler/types/Coercion.lhs | 1562 ++++++++++++--------
compiler/types/FamInstEnv.lhs | 81 +-
compiler/types/FunDeps.lhs | 4 +-
compiler/types/InstEnv.lhs | 4 +-
compiler/types/Kind.lhs | 232 +++
compiler/types/OptCoercion.lhs | 547 ++++----
compiler/types/TyCon.lhs | 234 ++--
compiler/types/Type.lhs | 647 ++++-----
compiler/types/TypeRep.lhs | 556 ++++---
compiler/types/TypeRep.lhs-boot | 3 +-
compiler/types/Unify.lhs | 70 +-
compiler/utils/Pair.lhs | 47 +
compiler/vectorise/Vectorise.hs | 3 +-
compiler/vectorise/Vectorise/Builtins/Base.hs | 1 -
.../vectorise/Vectorise/Builtins/Initialise.hs | 1 -
compiler/vectorise/Vectorise/Exp.hs | 3 +-
compiler/vectorise/Vectorise/Type/Env.hs | 1 -
compiler/vectorise/Vectorise/Type/PRepr.hs | 11 +-
compiler/vectorise/Vectorise/Type/Type.hs | 1 -
compiler/vectorise/Vectorise/Utils.hs | 3 +-
compiler/vectorise/Vectorise/Utils/Base.hs | 2 +-
compiler/vectorise/Vectorise/Utils/Closure.hs | 1 -
compiler/vectorise/Vectorise/Utils/Hoisting.hs | 1 -
compiler/vectorise/Vectorise/Utils/PADict.hs | 7 +-
compiler/vectorise/Vectorise/Utils/Poly.hs | 1 -
compiler/vectorise/Vectorise/Var.hs | 1 -
ghc/GhciTags.hs | 7 +-
130 files changed, 4914 insertions(+), 4151 deletions(-)
diff --cc compiler/ghci/ByteCodeGen.lhs
index b888747,c07073a..426f4f2
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@@ -807,37 -808,37 +806,37 @@@ doCase d s p (_,scrut) bndr alts is_unb
isAlgCase = not (isUnLiftedType bndr_ty) && not is_unboxed_tuple
-- given an alt, return a discr and code for it.
- codeAlt (DEFAULT, _, (_,rhs))
- = do rhs_code <- schemeE d_alts s p_alts rhs
- return (NoDiscr, rhs_code)
+ codeAlt (DEFAULT, _, (_,rhs))
+ = do rhs_code <- schemeE d_alts s p_alts rhs
+ return (NoDiscr, rhs_code)
codeAlt alt@(_, bndrs, (_,rhs))
- -- primitive or nullary constructor alt: no need to UNPACK
- | null real_bndrs = do
- rhs_code <- schemeE d_alts s p_alts rhs
+ -- primitive or nullary constructor alt: no need to UNPACK
+ | null real_bndrs = do
+ rhs_code <- schemeE d_alts s p_alts rhs
return (my_discr alt, rhs_code)
- -- algebraic alt with some binders
+ -- algebraic alt with some binders
| otherwise =
let
- (ptrs,nptrs) = partition (isFollowableArg.idCgRep) real_bndrs
- ptr_sizes = map (fromIntegral . idSizeW) ptrs
- nptrs_sizes = map (fromIntegral . idSizeW) nptrs
- bind_sizes = ptr_sizes ++ nptrs_sizes
- size = sum ptr_sizes + sum nptrs_sizes
- -- the UNPACK instruction unpacks in reverse order...
- p' = Map.insertList
- (zip (reverse (ptrs ++ nptrs))
- (mkStackOffsets d_alts (reverse bind_sizes)))
- p_alts
- in do
+ (ptrs,nptrs) = partition (isFollowableArg.idCgRep) real_bndrs
+ ptr_sizes = map (fromIntegral . idSizeW) ptrs
+ nptrs_sizes = map (fromIntegral . idSizeW) nptrs
+ bind_sizes = ptr_sizes ++ nptrs_sizes
+ size = sum ptr_sizes + sum nptrs_sizes
+ -- the UNPACK instruction unpacks in reverse order...
+ p' = Map.insertList
+ (zip (reverse (ptrs ++ nptrs))
+ (mkStackOffsets d_alts (reverse bind_sizes)))
+ p_alts
+ in do
MASSERT(isAlgCase)
- rhs_code <- schemeE (d_alts+size) s p' rhs
+ rhs_code <- schemeE (d_alts+size) s p' rhs
return (my_discr alt, unitOL (UNPACK size) `appOL` rhs_code)
- where
- real_bndrs = filter (not.isTyCoVar) bndrs
+ where
+ real_bndrs = filterOut isTyVar bndrs
my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-}
- my_discr (DataAlt dc, _, _)
+ my_discr (DataAlt dc, _, _)
| isUnboxedTupleCon dc
= unboxedTupleException
| otherwise
@@@ -1193,10 -1194,13 +1192,13 @@@ implement_tagToId name
pushAtom :: Word16 -> BCEnv -> AnnExpr' Id VarSet -> BcM (BCInstrList, Word16)
-pushAtom d p e
- | Just e' <- bcView e
+pushAtom d p e
+ | Just e' <- bcView e
= pushAtom d p e'
+ pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things,
+ = return (nilOL, 0) -- treated just like a variable VoidArg
+
pushAtom d p (AnnVar v)
| idCgRep v == VoidArg
= return (nilOL, 0)
@@@ -1270,11 -1274,8 +1272,8 @@@ pushAtom _ _ (AnnLit lit
-- Get the addr on the stack, untaggedly
return (unitOL (PUSH_UBX (Right addr) 1), 1)
- pushAtom d p (AnnCast e _)
- = pushAtom d p (snd e)
-
pushAtom _ _ expr
- = pprPanic "ByteCodeGen.pushAtom"
+ = pprPanic "ByteCodeGen.pushAtom"
(pprCoreExpr (deAnnotate (undefined, expr)))
foreign import ccall unsafe "memcpy"
@@@ -1452,13 -1453,13 +1451,13 @@@ bcView :: AnnExpr' Var ann -> Maybe (An
-- b) type applications
-- c) casts
-- d) notes
--- Type lambdas *can* occur in random expressions,
+-- Type lambdas *can* occur in random expressions,
-- whereas value lambdas cannot; that is why they are nuked here
- bcView (AnnNote _ (_,e)) = Just e
- bcView (AnnCast (_,e) _) = Just e
- bcView (AnnLam v (_,e)) | isTyCoVar v = Just e
- bcView (AnnApp (_,e) (_, AnnType _)) = Just e
- bcView _ = Nothing
+ bcView (AnnNote _ (_,e)) = Just e
+ bcView (AnnCast (_,e) _) = Just e
+ bcView (AnnLam v (_,e)) | isTyVar v = Just e
+ bcView (AnnApp (_,e) (_, AnnType _)) = Just e
+ bcView _ = Nothing
isVoidArgAtom :: AnnExpr' Var ann -> Bool
isVoidArgAtom e | Just e' <- bcView e = isVoidArgAtom e'
More information about the Cvs-ghc
mailing list