[commit: ghc] cpr-sum-types: Merge branch 'master' of http://darcs.haskell.org/ghc (22e061e)
Simon Peyton Jones
simonpj at microsoft.com
Fri Oct 28 23:04:16 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : cpr-sum-types
http://hackage.haskell.org/trac/ghc/changeset/22e061e2c7de881ce25220a0d49a2a361b8e240a
>---------------------------------------------------------------
commit 22e061e2c7de881ce25220a0d49a2a361b8e240a
Merge: 0c8e547... 401a499...
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Jul 27 08:32:18 2011 +0100
Merge branch 'master' of http://darcs.haskell.org/ghc
Conflicts:
compiler/coreSyn/PprCore.lhs
compiler/main/TidyPgm.lhs
compiler/stranal/WwLib.lhs
.gitignore | 5 +-
Makefile | 4 +-
aclocal.m4 | 60 +-
boot | 3 +-
compiler/basicTypes/BasicTypes.lhs | 112 +-
compiler/basicTypes/DataCon.lhs | 5 +-
compiler/basicTypes/Id.lhs | 11 +-
compiler/basicTypes/IdInfo.lhs | 14 +-
compiler/basicTypes/MkId.lhs | 26 +-
compiler/basicTypes/Module.lhs | 4 +-
compiler/basicTypes/Name.lhs | 19 +-
compiler/basicTypes/NameSet.lhs | 18 +-
compiler/basicTypes/RdrName.lhs | 12 +-
compiler/basicTypes/SrcLoc.lhs | 235 ++-
compiler/basicTypes/UniqSupply.lhs | 3 +-
compiler/basicTypes/Var.lhs | 3 +-
compiler/basicTypes/VarEnv.lhs | 19 +-
compiler/basicTypes/VarSet.lhs | 5 +-
compiler/cmm/CLabel.hs | 49 +-
compiler/cmm/Cmm.hs | 4 +-
compiler/cmm/CmmBuildInfoTables.hs | 10 +-
compiler/cmm/CmmCallConv.hs | 31 +-
compiler/cmm/CmmCvt.hs | 19 +-
compiler/cmm/CmmDecl.hs | 26 +-
compiler/cmm/CmmExpr.hs | 5 +-
compiler/cmm/CmmInfo.hs | 12 +-
compiler/cmm/CmmLex.x | 20 +-
compiler/cmm/CmmLint.hs | 24 +-
compiler/cmm/CmmLive.hs | 49 +-
compiler/cmm/CmmMachOp.hs | 26 +-
compiler/cmm/CmmNode.hs | 69 +-
compiler/cmm/CmmOpt.hs | 378 ++--
compiler/cmm/CmmParse.y | 43 +-
compiler/cmm/{CmmCPS.hs => CmmPipeline.hs} | 66 +-
compiler/cmm/CmmProcPoint.hs | 15 +-
...{CmmSpillReload.hs => CmmRewriteAssignments.hs} | 407 ++---
compiler/cmm/CmmSpillReload.hs | 631 +------
compiler/cmm/CmmType.hs | 14 +-
compiler/cmm/MkGraph.hs | 77 +-
compiler/cmm/OldCmm.hs | 27 +-
compiler/cmm/OldCmmUtils.hs | 4 +-
compiler/cmm/OldPprCmm.hs | 19 +-
compiler/cmm/PprC.hs | 134 +-
compiler/cmm/PprCmm.hs | 49 +-
compiler/cmm/PprCmmDecl.hs | 54 +-
compiler/cmm/cmm-notes | 54 +-
compiler/codeGen/CgCase.lhs | 19 +
compiler/codeGen/CgExpr.lhs | 7 +
compiler/codeGen/CgForeignCall.hs | 9 +-
compiler/codeGen/CgHpc.hs | 6 +-
compiler/codeGen/CgInfoTbls.hs | 10 +-
compiler/codeGen/CgMonad.lhs | 6 +-
compiler/codeGen/CgPrimOp.hs | 130 ++-
compiler/codeGen/CgUtils.hs | 14 +-
compiler/codeGen/ClosureInfo.lhs | 24 +-
compiler/codeGen/CodeGen.lhs | 4 +-
compiler/codeGen/StgCmm.hs | 4 +-
compiler/codeGen/StgCmmClosure.hs | 30 +-
compiler/codeGen/StgCmmExpr.hs | 21 +
compiler/codeGen/StgCmmForeign.hs | 16 +-
compiler/codeGen/StgCmmHpc.hs | 11 +-
compiler/codeGen/StgCmmLayout.hs | 2 +-
compiler/codeGen/StgCmmMonad.hs | 6 +-
compiler/codeGen/StgCmmPrim.hs | 256 +++
compiler/codeGen/StgCmmUtils.hs | 31 +-
compiler/coreSyn/CoreFVs.lhs | 93 +-
compiler/coreSyn/CoreLint.lhs | 4 +-
compiler/coreSyn/CorePrep.lhs | 18 +-
compiler/coreSyn/CoreSubst.lhs | 79 +-
compiler/coreSyn/CoreSyn.lhs | 240 ++--
compiler/coreSyn/CoreTidy.lhs | 2 +-
compiler/coreSyn/CoreUnfold.lhs | 178 +-
compiler/coreSyn/CoreUtils.lhs | 30 +-
compiler/coreSyn/PprCore.lhs | 62 +-
compiler/deSugar/Coverage.lhs | 49 +-
compiler/deSugar/Desugar.lhs | 61 +-
compiler/deSugar/DsBinds.lhs | 16 +-
compiler/deSugar/DsExpr.lhs | 24 +-
compiler/deSugar/DsForeign.lhs | 53 +-
compiler/deSugar/DsMeta.hs | 155 ++-
compiler/deSugar/DsMonad.lhs | 7 +-
compiler/deSugar/Match.lhs | 14 +-
compiler/deSugar/MatchLit.lhs | 4 +
compiler/ghc.cabal.in | 8 +-
compiler/ghc.mk | 6 -
compiler/ghci/ByteCodeGen.lhs | 45 +-
compiler/ghci/ByteCodeItbls.lhs | 2 +-
compiler/ghci/ByteCodeLink.lhs | 9 +-
compiler/ghci/Debugger.hs | 1 -
compiler/ghci/Linker.lhs | 80 +-
compiler/ghci/RtClosureInspect.hs | 2 +-
compiler/hsSyn/Convert.lhs | 273 +++-
compiler/hsSyn/HsBinds.lhs | 42 +-
compiler/hsSyn/HsDecls.lhs | 28 +-
compiler/hsSyn/HsExpr.lhs | 88 +-
compiler/hsSyn/HsImpExp.lhs | 13 +-
compiler/hsSyn/HsLit.lhs | 10 +-
compiler/hsSyn/HsPat.lhs | 39 +-
compiler/hsSyn/HsSyn.lhs | 2 +-
compiler/hsSyn/HsTypes.lhs | 20 +-
compiler/hsSyn/HsUtils.lhs | 62 +-
compiler/iface/BinIface.hs | 63 +-
compiler/iface/BuildTyCl.lhs | 50 +-
compiler/iface/IfaceEnv.lhs | 2 +-
compiler/iface/IfaceSyn.lhs | 50 +-
compiler/iface/IfaceType.lhs | 11 +-
compiler/iface/LoadIface.lhs | 28 +-
compiler/iface/MkIface.lhs | 331 ++--
compiler/iface/TcIface.lhs | 27 +-
compiler/iface/TcIface.lhs-boot | 27 +-
compiler/llvmGen/Llvm/PpLlvm.hs | 29 +-
compiler/llvmGen/Llvm/Types.hs | 59 +-
compiler/llvmGen/LlvmCodeGen.hs | 44 +-
compiler/llvmGen/LlvmCodeGen/Base.hs | 6 +-
compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 25 +-
compiler/llvmGen/LlvmCodeGen/Data.hs | 13 +-
compiler/llvmGen/LlvmCodeGen/Ppr.hs | 22 +-
compiler/llvmGen/LlvmMangler.hs | 120 +-
compiler/main/CmdLineParser.hs | 110 +-
compiler/main/CodeOutput.lhs | 2 +-
compiler/main/DriverPipeline.hs | 196 ++-
compiler/main/DynFlags.hs | 1199 +++++++------
compiler/main/DynamicLoading.hs | 150 ++
compiler/main/ErrUtils.lhs | 10 +-
compiler/main/GHC.hs | 139 +-
compiler/main/GhcMake.hs | 79 +-
compiler/main/GhcPlugins.hs | 83 +
compiler/main/HeaderInfo.hs | 25 +-
compiler/main/HscMain.lhs | 367 +++-
compiler/main/HscStats.lhs | 32 +-
compiler/main/HscTypes.lhs | 207 ++-
compiler/main/InteractiveEval.hs | 7 +-
compiler/main/Packages.lhs | 71 +-
compiler/main/StaticFlagParser.hs | 75 +-
compiler/main/StaticFlags.hs | 13 +-
compiler/main/SysTools.lhs | 44 +-
compiler/main/TidyPgm.lhs | 185 ++-
compiler/nativeGen/AsmCodeGen.lhs | 175 ++-
compiler/nativeGen/Instruction.hs | 244 ++--
compiler/nativeGen/NCGMonad.hs | 16 +-
compiler/nativeGen/PIC.hs | 11 +-
compiler/nativeGen/PPC/CodeGen.hs | 622 ++++---
compiler/nativeGen/PPC/Instr.hs | 49 +-
compiler/nativeGen/PPC/Ppr.hs | 194 +-
compiler/nativeGen/PPC/RegInfo.hs | 22 +-
compiler/nativeGen/PprInstruction.hs | 2 +
compiler/nativeGen/RegAlloc/Graph/Coalesce.hs | 6 +-
compiler/nativeGen/RegAlloc/Graph/Main.hs | 43 +-
compiler/nativeGen/RegAlloc/Graph/Spill.hs | 12 +-
compiler/nativeGen/RegAlloc/Graph/SpillClean.hs | 101 +-
compiler/nativeGen/RegAlloc/Graph/SpillCost.hs | 13 +-
compiler/nativeGen/RegAlloc/Graph/Stats.hs | 70 +-
compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 27 +-
compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs | 10 +-
.../nativeGen/RegAlloc/Linear/JoinToTargets.hs | 96 +-
compiler/nativeGen/RegAlloc/Linear/Main.hs | 189 +-
compiler/nativeGen/RegAlloc/Linear/StackMap.hs | 5 +-
compiler/nativeGen/RegAlloc/Linear/State.hs | 17 +-
compiler/nativeGen/RegAlloc/Linear/Stats.hs | 4 +-
compiler/nativeGen/RegAlloc/Liveness.hs | 1163 ++++++------
compiler/nativeGen/SPARC/CodeGen.hs | 40 +-
compiler/nativeGen/SPARC/CodeGen/CCall.hs | 25 +-
compiler/nativeGen/SPARC/CodeGen/Expand.hs | 2 +-
compiler/nativeGen/SPARC/CodeGen/Gen32.hs | 10 +-
compiler/nativeGen/SPARC/CodeGen/Gen64.hs | 9 +-
compiler/nativeGen/SPARC/CodeGen/Sanity.hs | 14 +-
compiler/nativeGen/SPARC/Instr.hs | 44 +-
compiler/nativeGen/SPARC/Ppr.hs | 52 +-
compiler/nativeGen/SPARC/ShortcutJump.hs | 23 +-
compiler/nativeGen/Size.hs | 16 +-
compiler/nativeGen/TargetReg.hs | 51 +-
compiler/nativeGen/X86/CodeGen.hs | 1934 ++++++++++----------
compiler/nativeGen/X86/Instr.hs | 60 +-
compiler/nativeGen/X86/Ppr.hs | 648 ++++----
compiler/nativeGen/X86/RegInfo.hs | 22 +-
compiler/parser/Lexer.x | 1099 ++++++------
compiler/parser/Parser.y.pp | 106 +-
compiler/parser/ParserCore.y | 2 +-
compiler/parser/RdrHsSyn.lhs | 2 +-
compiler/prelude/ForeignCall.lhs | 17 +-
compiler/prelude/PrelNames.lhs | 1284 +++++++------
compiler/prelude/PrelRules.lhs | 167 ++-
compiler/prelude/TysWiredIn.lhs | 53 +-
compiler/prelude/primops.txt.pp | 32 +
compiler/rename/RnBinds.lhs | 34 +-
compiler/rename/RnEnv.lhs | 121 +-
compiler/rename/RnHsDoc.hs | 2 +-
compiler/rename/RnHsSyn.lhs | 2 +-
compiler/rename/RnNames.lhs | 262 ++-
compiler/rename/RnPat.lhs | 72 +-
compiler/rename/RnSource.lhs | 24 +-
compiler/rename/RnTypes.lhs | 45 +-
compiler/simplCore/CSE.lhs | 130 +-
compiler/simplCore/CoreMonad.lhs | 335 +---
compiler/simplCore/FloatOut.lhs | 340 +++--
compiler/simplCore/OccurAnal.lhs | 823 +++++----
compiler/simplCore/SetLevels.lhs | 354 +++--
compiler/simplCore/SimplCore.lhs | 375 ++++-
compiler/simplCore/SimplEnv.lhs | 8 +-
compiler/simplCore/SimplUtils.lhs | 39 +-
compiler/simplCore/Simplify.lhs | 29 +-
compiler/specialise/Specialise.lhs | 3 +
compiler/stranal/WwLib.lhs | 2 +-
compiler/typecheck/Inst.lhs | 21 +-
compiler/typecheck/TcBinds.lhs | 85 +-
compiler/typecheck/TcCanonical.lhs | 139 +-
compiler/typecheck/TcClassDcl.lhs | 19 +-
compiler/typecheck/TcDeriv.lhs | 41 +-
compiler/typecheck/TcEnv.lhs | 2 -
compiler/typecheck/TcErrors.lhs | 210 ++--
compiler/typecheck/TcExpr.lhs | 18 +-
compiler/typecheck/TcForeign.lhs | 46 +-
compiler/typecheck/TcGenDeriv.lhs | 48 +-
compiler/typecheck/TcHsSyn.lhs | 12 +-
compiler/typecheck/TcHsType.lhs | 19 +-
compiler/typecheck/TcInstDcls.lhs | 593 +++----
compiler/typecheck/TcInteract.lhs | 331 ++--
compiler/typecheck/TcMType.lhs | 74 +-
compiler/typecheck/TcRnDriver.lhs | 18 +-
compiler/typecheck/TcRnMonad.lhs | 64 +-
compiler/typecheck/TcRnTypes.lhs | 94 +-
compiler/typecheck/TcRules.lhs | 9 +-
compiler/typecheck/TcSMonad.lhs | 6 +-
compiler/typecheck/TcSimplify.lhs | 5 +-
compiler/typecheck/TcSplice.lhs | 25 +-
compiler/typecheck/TcTyClsDecls.lhs | 47 +-
compiler/typecheck/TcType.lhs | 20 +-
compiler/types/Class.lhs | 26 +-
compiler/types/Coercion.lhs | 135 +-
compiler/types/InstEnv.lhs | 81 +-
compiler/types/OptCoercion.lhs | 98 +-
compiler/types/TyCon.lhs | 9 +-
compiler/types/Type.lhs | 15 +-
compiler/types/TypeRep.lhs | 6 +-
compiler/utils/Binary.hs | 36 +
compiler/utils/Digraph.lhs | 88 +-
compiler/utils/Encoding.hs | 2 +-
compiler/utils/FastFunctions.lhs | 3 +-
compiler/utils/FastString.lhs | 11 +-
compiler/utils/Fingerprint.hsc | 57 +-
compiler/utils/FiniteMap.lhs | 1 +
compiler/utils/Outputable.lhs | 43 +
compiler/utils/Panic.lhs | 10 +-
compiler/utils/Platform.hs | 117 +-
compiler/utils/Pretty.lhs | 4 +-
compiler/utils/StringBuffer.lhs | 10 +-
compiler/utils/UniqFM.lhs | 13 +-
compiler/utils/Util.lhs | 6 +-
compiler/utils/md5.c | 3 +
compiler/vectorise/Vectorise.hs | 173 +-
compiler/vectorise/Vectorise/Builtins.hs | 51 +-
.../vectorise/Vectorise/Builtins/Initialise.hs | 188 +-
compiler/vectorise/Vectorise/Builtins/Modules.hs | 12 +-
compiler/vectorise/Vectorise/Builtins/Prelude.hs | 209 ---
compiler/vectorise/Vectorise/Env.hs | 23 +-
compiler/vectorise/Vectorise/Exp.hs | 18 +-
compiler/vectorise/Vectorise/Monad.hs | 8 +-
compiler/vectorise/Vectorise/Monad/Global.hs | 62 +-
compiler/vectorise/Vectorise/Monad/InstEnv.hs | 2 +-
compiler/vectorise/Vectorise/Type/PADict.hs | 73 +-
compiler/vectorise/Vectorise/Type/PRepr.hs | 28 +-
compiler/vectorise/Vectorise/Utils/PADict.hs | 16 +-
configure.ac | 70 +-
distrib/MacOS/mkinstaller | 2 +-
distrib/configure.ac.in | 2 +
docs/users_guide/6.10.1-notes.xml | 1255 -------------
docs/users_guide/6.12.1-notes.xml | 1304 -------------
docs/users_guide/6.6-notes.xml | 1718 -----------------
docs/users_guide/7.0.1-notes.xml | 1226 -------------
docs/users_guide/extending_ghc.xml | 284 +++
docs/users_guide/ffi-chap.xml | 4 +-
docs/users_guide/flags.xml | 97 +-
docs/users_guide/ghci.xml | 4 +
docs/users_guide/glasgow_exts.xml | 236 ++--
docs/users_guide/intro.xml | 2 +-
docs/users_guide/lang.xml | 1 +
docs/users_guide/packages.xml | 93 +-
docs/users_guide/runtime_control.xml | 61 +-
docs/users_guide/safe_haskell.xml | 537 ++++++
docs/users_guide/ug-book.xml.in | 1 +
docs/users_guide/ug-ent.xml.in | 4 +-
ghc.mk | 53 +-
ghc/GhciTags.hs | 6 +-
ghc/InteractiveUI.hs | 251 ++-
ghc/Main.hs | 51 +-
ghc/ghc-bin.cabal.in | 2 +-
ghc/ghc.mk | 1 +
includes/rts/EventLogFormat.h | 21 +-
includes/rts/Flags.h | 4 +-
includes/rts/Globals.h | 1 -
includes/rts/storage/ClosureMacros.h | 4 +-
includes/stg/SMP.h | 2 +-
.../Distribution/InstalledPackageInfo/Binary.hs | 2 +
libraries/bin-package-db/bin-package-db.cabal | 2 +-
libraries/tarballs/time-1.2.0.4.tar.gz | Bin 85693 -> 0 bytes
libraries/tarballs/time-1.2.0.5.tar.gz | Bin 0 -> 86557 bytes
mk/build.mk.sample | 23 +
mk/config.mk.in | 10 +-
mk/validate-settings.mk | 18 +
packages | 96 +-
quickcheck/HeaderInfoTests.hs | 129 --
quickcheck/README | 9 -
quickcheck/RunTests.hs | 62 -
quickcheck/run.sh | 23 -
rts/Adjustor.c | 89 +-
rts/AdjustorAsm.S | 7 +-
rts/Capability.c | 76 +-
rts/Capability.h | 10 +-
rts/Globals.c | 8 -
rts/Interpreter.c | 20 +-
rts/Linker.c | 18 +-
rts/Printer.c | 4 -
rts/ProfHeap.c | 171 +-
rts/ProfHeap.h | 4 +-
rts/Profiling.h | 7 +
rts/RetainerProfile.c | 10 +
rts/RtsFlags.c | 60 +-
rts/RtsProbes.d | 14 +-
rts/STM.c | 4 +-
rts/Schedule.c | 43 +-
rts/Sparks.c | 75 +-
rts/Sparks.h | 42 +-
rts/Stats.c | 43 +-
rts/Stats.h | 2 +-
rts/StgCRun.c | 64 +-
rts/StgRun.h | 4 +
rts/Task.c | 4 +-
rts/Trace.c | 174 ++-
rts/Trace.h | 205 ++-
rts/WSDeque.c | 2 +-
rts/eventlog/EventLog.c | 111 +-
rts/eventlog/EventLog.h | 12 +
rts/ghc.mk | 6 +-
rts/sm/GC.c | 25 +-
rts/sm/GC.h | 4 +-
rts/sm/GCUtils.c | 7 +-
rts/sm/Sanity.c | 4 -
rules/build-package.mk | 2 +
rules/extra-packages.mk | 8 +-
settings.in | 9 +-
sync-all | 420 +++--
utils/fingerprint/fingerprint.py | 2 +-
utils/ghc-cabal/ghc-cabal.cabal | 2 +-
utils/ghc-cabal/ghc.mk | 10 +-
utils/ghc-pkg/Main.hs | 63 +-
utils/ghc-pkg/ghc-pkg.cabal | 2 +-
utils/ghc-pkg/ghc.mk | 2 +-
utils/ghctags/Main.hs | 13 +-
utils/lndir/lndir.c | 2 +
utils/runghc/runghc.cabal.in | 2 +-
validate | 20 +-
351 files changed, 16439 insertions(+), 17704 deletions(-)
diff --cc compiler/iface/BinIface.hs
index b9c2dd9,336030c..fe6ed16
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@@ -16,8 -16,8 +16,7 @@@ import TcRnMona
import IfaceEnv
import HscTypes
import BasicTypes
-import Demand
import Annotations
- import CoreSyn
import IfaceSyn
import Module
import Name
diff --cc compiler/iface/IfaceSyn.lhs
index 6aca9db,8ca6b39..dc8d74e
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@@ -194,16 -191,11 +192,16 @@@ data IfaceIdInf
-- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
-- and so gives a new version.
+type IfaceDmdType = DmdTypeP IfExtName
+type IfaceDemand = DemandP IfExtName
+type IfaceDemands = DemandPs IfExtName
+type IfaceDmdResult = DmdResultP IfExtName
+
data IfaceInfoItem
= HsArity Arity
- | HsStrictness StrictSig
+ | HsStrictness IfaceDmdType
| HsInline InlinePragma
- | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
+ | HsUnfold Bool -- True <=> isStrongLoopBreaker is true
IfaceUnfolding -- See Note [Expose recursive functions]
| HsNoCafRefs
diff --cc compiler/iface/TcIface.lhs
index 40ff650,8cfe301..5885b0e
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@@ -1055,33 -1055,9 +1055,33 @@@ tcIdInfo ignore_prags name ty inf
-- The next two are lazy, so they don't transitively suck stuff in
tcPrag info (HsUnfold lb if_unf)
= do { unf <- tcUnfolding name ty info if_unf
- ; let info1 | lb = info `setOccInfo` nonRuleLoopBreaker
+ ; let info1 | lb = info `setOccInfo` strongLoopBreaker
| otherwise = info
; return (info1 `setUnfoldingInfoLazily` unf) }
+
+tcStrictSig :: IfaceDmdType -> IfL StrictSig
+tcStrictSig (DmdType _ if_arg_dmds if_res_dmd)
+ = liftM2 (\arg_dmds res_dmd -> StrictSig (DmdType emptyDmdEnv arg_dmds res_dmd))
+ (mapM tcDemand if_arg_dmds)
+ (tcDmdResult if_res_dmd)
+
+tcDemand :: IfaceDemand -> IfL Demand
+tcDemand Top = return Top
+tcDemand Abs = return Abs
+tcDemand (Call dmd) = fmap Call (tcDemand dmd)
+tcDemand (Eval dmds) = fmap Eval (tcDemands dmds)
+tcDemand (Defer dmds) = fmap Defer (tcDemands dmds)
+tcDemand (Box dmd) = fmap Box (tcDemand dmd)
+tcDemand Bot = return Bot
+
+tcDemands :: IfaceDemands -> IfL Demands
+tcDemands (Poly dmd) = fmap Poly (tcDemand dmd)
+tcDemands (Prod data_occ dmds) = liftM2 Prod (tcIfaceDataCon data_occ) (mapM tcDemand dmds)
+
+tcDmdResult :: IfaceDmdResult -> IfL DmdResult
+tcDmdResult TopRes = return TopRes
+tcDmdResult (RetCPR data_occ) = fmap RetCPR $ tcIfaceDataCon data_occ
+tcDmdResult BotRes = return BotRes
\end{code}
\begin{code}
diff --cc compiler/main/StaticFlags.hs
index 6564c24,c542d76..4fcfa36
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@@ -219,13 -228,13 +228,13 @@@ opt_SuppressTypeApplication
-- | Suppress info such as arity and unfoldings on identifiers.
opt_SuppressIdInfo :: Bool
opt_SuppressIdInfo
- = lookUp (fsLit "-dsuppress-all")
+ = opt_SuppressAll
|| lookUp (fsLit "-dsuppress-idinfo")
- -- | Suppress seprate type signatures in core, but leave types on lambda bound vars
+ -- | Suppress separate type signatures in core, but leave types on lambda bound vars
opt_SuppressTypeSignatures :: Bool
opt_SuppressTypeSignatures
- = lookUp (fsLit "-dsuppress-all")
+ = opt_SuppressAll
|| lookUp (fsLit "-dsuppress-type-signatures")
-- | Suppress unique ids on variables.
diff --cc compiler/main/TidyPgm.lhs
index 9ce98de,bad78c2..c2a2432
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@@ -701,19 -701,15 +701,15 @@@ chooseExternalIds hsc_env mod omit_prag
let unfold_env' = extendVarEnv unfold_env id (name',False)
tidy_internal ids unfold_env' occ_env'
- addExternal :: Bool -> Id -> ([Id],Bool)
+ addExternal :: Bool -> Id -> ([Id], Bool)
addExternal expose_all id = (new_needed_ids, show_unfold)
where
- new_needed_ids = unfold_ids ++
- filter (\id -> isLocalId id &&
- not (id `elemVarSet` unfold_set))
- (varSetElems spec_ids) -- XXX non-det ordering
-
+ new_needed_ids = bndrFvsInOrder show_unfold id
idinfo = idInfo id
+ show_unfold = show_unfolding (unfoldingInfo idinfo)
never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
- loop_breaker = isNonRuleLoopBreaker (occInfo idinfo)
+ loop_breaker = isStrongLoopBreaker (occInfo idinfo)
- bottoming_fn = isBottomingSig (strictnessInfo idinfo `orElse` topSig)
+ bottoming_fn = isBottomingSig (strictnessInfo idinfo)
- spec_ids = specInfoFreeVars (specInfo idinfo)
-- Stuff to do with the Id's unfolding
-- We leave the unfolding there even if there is a worker
diff --cc compiler/stranal/WwLib.lhs
index c08ea98,1b8b270..4893f43
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@@ -466,21 -448,20 +466,21 @@@ mkWWcpr body_ty (RetCPR data_con
-- Worker: case ( ...body... ) of C a b -> (# a, b #)
uniqs <- getUniquesM
let
- (wrap_wild : work_wild : args) = zipWith mk_ww_local uniqs (ubx_tup_ty : body_ty : con_arg_tys)
+ (wrap_wild : work_wild : args) = zipWith mk_ww_local uniqs
+ (ubx_tup_ty : body_ty : con_arg_tys)
- arg_vars = map Var args
+ arg_vars = varsToCoreExprs args
- ubx_tup_con = tupleCon Unboxed n_con_args
+ ubx_tup_con = tupleCon Unboxed (length con_arg_tys)
ubx_tup_ty = exprType ubx_tup_app
- ubx_tup_app = mkConApp ubx_tup_con (map Type con_arg_tys ++ arg_vars)
- con_app = mkProductBox args body_ty
+ ubx_tup_app = mkConApp ubx_tup_con (map Type con_arg_tys ++ arg_vars)
+ con_app = mkCoerce co $
+ mkConApp data_con
+ (map Type tycon_args ++ map Var args)
- return (\ wkr_call -> Case wkr_call (wrap_wild) (exprType con_app) [(DataAlt ubx_tup_con, args, con_app)],
- \ body -> workerCase (work_wild) body args data_con ubx_tup_app,
- ubx_tup_ty)
- where
- (_arg_tycon, _tycon_arg_tys, data_con, con_arg_tys) = deepSplitProductType "mkWWcpr" body_ty
- n_con_args = length con_arg_tys
- con_arg_ty1 = head con_arg_tys
+ return (\ wkr_call -> Case wkr_call (wrap_wild) (exprType con_app)
+ [(DataAlt ubx_tup_con, args, con_app)],
+ \ body -> workerCase work_wild body raw_data_ty co args
+ data_con ubx_tup_app,
+ ubx_tup_ty)
mkWWcpr body_ty _other -- No CPR info
= return (id, id, body_ty)
More information about the Cvs-ghc
mailing list