Merge remote-tracking branch 'origin/type-nats' into type-nats-merge
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Mon, 19 Dec 2011 01:25:27 +0000 (17:25 -0800)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Mon, 19 Dec 2011 01:25:27 +0000 (17:25 -0800)
670 files changed:
.gitignore
Makefile
README
aclocal.m4
boot
compiler/DLL-NOTES [deleted file]
compiler/HsVersions.h
compiler/NOTES [deleted file]
compiler/Simon-log [deleted file]
compiler/basicTypes/Avail.hs [new file with mode: 0644]
compiler/basicTypes/BasicTypes.lhs
compiler/basicTypes/DataCon.lhs
compiler/basicTypes/DataCon.lhs-boot
compiler/basicTypes/Demand.lhs
compiler/basicTypes/Id.lhs
compiler/basicTypes/IdInfo.lhs
compiler/basicTypes/Literal.lhs
compiler/basicTypes/MkId.lhs
compiler/basicTypes/Module.lhs
compiler/basicTypes/Name.lhs
compiler/basicTypes/Name.lhs-boot
compiler/basicTypes/NameEnv.lhs
compiler/basicTypes/NameSet.lhs
compiler/basicTypes/OccName.lhs
compiler/basicTypes/RdrName.lhs
compiler/basicTypes/SrcLoc.lhs
compiler/basicTypes/Unique.lhs
compiler/basicTypes/Var.lhs
compiler/basicTypes/VarEnv.lhs
compiler/basicTypes/VarSet.lhs
compiler/cmm/Bitmap.hs [moved from compiler/codeGen/Bitmap.hs with 88% similarity]
compiler/cmm/BlockId.hs
compiler/cmm/CLabel.hs
compiler/cmm/Cmm.hs
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmCallConv.hs
compiler/cmm/CmmCommonBlockElim.hs
compiler/cmm/CmmContFlowOpt.hs
compiler/cmm/CmmCvt.hs
compiler/cmm/CmmDecl.hs [deleted file]
compiler/cmm/CmmExpr.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmLex.x
compiler/cmm/CmmLint.hs
compiler/cmm/CmmLive.hs
compiler/cmm/CmmMachOp.hs
compiler/cmm/CmmNode.hs
compiler/cmm/CmmOpt.hs
compiler/cmm/CmmParse.y
compiler/cmm/CmmPipeline.hs
compiler/cmm/CmmProcPoint.hs
compiler/cmm/CmmRewriteAssignments.hs
compiler/cmm/CmmSpillReload.hs
compiler/cmm/CmmStackLayout.hs
compiler/cmm/CmmType.hs
compiler/cmm/CmmUtils.hs
compiler/cmm/MkGraph.hs
compiler/cmm/OldCmm.hs
compiler/cmm/OldPprCmm.hs
compiler/cmm/PprC.hs
compiler/cmm/PprCmm.hs
compiler/cmm/PprCmmDecl.hs
compiler/cmm/PprCmmExpr.hs
compiler/cmm/SMRep.lhs [new file with mode: 0644]
compiler/cmm/cmm-notes
compiler/codeGen/CgBindery.lhs
compiler/codeGen/CgCallConv.hs
compiler/codeGen/CgCase.lhs
compiler/codeGen/CgClosure.lhs
compiler/codeGen/CgCon.lhs
compiler/codeGen/CgExpr.lhs
compiler/codeGen/CgExtCode.hs
compiler/codeGen/CgForeignCall.hs
compiler/codeGen/CgHeapery.lhs
compiler/codeGen/CgHpc.hs
compiler/codeGen/CgInfoTbls.hs
compiler/codeGen/CgLetNoEscape.lhs
compiler/codeGen/CgMonad.lhs
compiler/codeGen/CgParallel.hs
compiler/codeGen/CgPrimOp.hs
compiler/codeGen/CgProf.hs
compiler/codeGen/CgStackery.lhs
compiler/codeGen/CgTailCall.lhs
compiler/codeGen/CgTicky.hs
compiler/codeGen/CgUtils.hs
compiler/codeGen/ClosureInfo.lhs
compiler/codeGen/CodeGen.lhs
compiler/codeGen/SMRep.lhs [deleted file]
compiler/codeGen/StgCmm.hs
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmClosure.hs
compiler/codeGen/StgCmmCon.hs
compiler/codeGen/StgCmmEnv.hs
compiler/codeGen/StgCmmExpr.hs
compiler/codeGen/StgCmmForeign.hs
compiler/codeGen/StgCmmGran.hs
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmHpc.hs
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmMonad.hs
compiler/codeGen/StgCmmPrim.hs
compiler/codeGen/StgCmmProf.hs
compiler/codeGen/StgCmmTicky.hs
compiler/codeGen/StgCmmUtils.hs
compiler/coreSyn/CoreArity.lhs
compiler/coreSyn/CoreFVs.lhs
compiler/coreSyn/CoreLint.lhs
compiler/coreSyn/CorePrep.lhs
compiler/coreSyn/CoreSubst.lhs
compiler/coreSyn/CoreSyn.lhs
compiler/coreSyn/CoreTidy.lhs
compiler/coreSyn/CoreUnfold.lhs
compiler/coreSyn/CoreUtils.lhs
compiler/coreSyn/ExternalCore.lhs
compiler/coreSyn/MkCore.lhs
compiler/coreSyn/MkExternalCore.lhs
compiler/coreSyn/PprCore.lhs
compiler/coreSyn/PprExternalCore.lhs
compiler/coreSyn/TrieMap.lhs [new file with mode: 0644]
compiler/deSugar/Check.lhs
compiler/deSugar/Coverage.lhs
compiler/deSugar/Desugar.lhs
compiler/deSugar/DsArrows.lhs
compiler/deSugar/DsBinds.lhs
compiler/deSugar/DsCCall.lhs
compiler/deSugar/DsExpr.lhs
compiler/deSugar/DsExpr.lhs-boot
compiler/deSugar/DsForeign.lhs
compiler/deSugar/DsGRHSs.lhs
compiler/deSugar/DsListComp.lhs
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsMonad.lhs
compiler/deSugar/DsUtils.lhs
compiler/deSugar/Match.lhs
compiler/deSugar/Match.lhs-boot
compiler/deSugar/MatchCon.lhs
compiler/deSugar/MatchLit.lhs
compiler/ghc.cabal.in
compiler/ghc.mk
compiler/ghci/ByteCodeAsm.lhs
compiler/ghci/ByteCodeGen.lhs
compiler/ghci/ByteCodeInstr.lhs
compiler/ghci/ByteCodeItbls.lhs
compiler/ghci/ByteCodeLink.lhs
compiler/ghci/Debugger.hs
compiler/ghci/DebuggerUtils.hs [new file with mode: 0644]
compiler/ghci/LibFFI.hsc
compiler/ghci/Linker.lhs
compiler/ghci/ObjLink.lhs
compiler/ghci/RtClosureInspect.hs
compiler/ghci/keepCAFsForGHCi.c
compiler/hsSyn/Convert.lhs
compiler/hsSyn/HsBinds.lhs
compiler/hsSyn/HsDecls.lhs
compiler/hsSyn/HsExpr.lhs
compiler/hsSyn/HsExpr.lhs-boot
compiler/hsSyn/HsImpExp.lhs
compiler/hsSyn/HsLit.lhs
compiler/hsSyn/HsPat.lhs
compiler/hsSyn/HsPat.lhs-boot
compiler/hsSyn/HsSyn.lhs
compiler/hsSyn/HsTypes.lhs
compiler/hsSyn/HsUtils.lhs
compiler/iface/BinIface.hs
compiler/iface/BuildTyCl.lhs
compiler/iface/FlagChecker.hs [new file with mode: 0644]
compiler/iface/IfaceEnv.lhs
compiler/iface/IfaceSyn.lhs
compiler/iface/IfaceType.lhs
compiler/iface/LoadIface.lhs
compiler/iface/MkIface.lhs
compiler/iface/TcIface.lhs
compiler/llvmGen/Llvm/PpLlvm.hs
compiler/llvmGen/Llvm/Types.hs
compiler/llvmGen/LlvmCodeGen.hs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/llvmGen/LlvmCodeGen/Data.hs
compiler/llvmGen/LlvmCodeGen/Ppr.hs
compiler/llvmGen/LlvmMangler.hs
compiler/main/Annotations.lhs
compiler/main/BreakArray.hs
compiler/main/CmdLineParser.hs
compiler/main/CodeOutput.lhs
compiler/main/Constants.lhs
compiler/main/DriverPhases.hs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/DynamicLoading.hs
compiler/main/ErrUtils.lhs
compiler/main/ErrUtils.lhs-boot
compiler/main/GHC.hs
compiler/main/GhcMake.hs
compiler/main/GhcMonad.hs
compiler/main/HeaderInfo.hs
compiler/main/HscMain.hs [new file with mode: 0644]
compiler/main/HscMain.lhs [deleted file]
compiler/main/HscStats.lhs
compiler/main/HscTypes.lhs
compiler/main/InteractiveEval.hs
compiler/main/PackageConfig.hs
compiler/main/Packages.lhs
compiler/main/PprTyThing.hs
compiler/main/StaticFlagParser.hs
compiler/main/StaticFlags.hs
compiler/main/SysTools.lhs
compiler/main/TidyPgm.lhs
compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/CPrim.hs [new file with mode: 0644]
compiler/nativeGen/Instruction.hs
compiler/nativeGen/NCG.h
compiler/nativeGen/NCGMonad.hs
compiler/nativeGen/PIC.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/PPC/Cond.hs
compiler/nativeGen/PPC/Instr.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/PPC/RegInfo.hs
compiler/nativeGen/PPC/Regs.hs
compiler/nativeGen/PprBase.hs
compiler/nativeGen/PprInstruction.hs [new file with mode: 0644]
compiler/nativeGen/Reg.hs
compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
compiler/nativeGen/RegAlloc/Graph/ArchX86.hs
compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
compiler/nativeGen/RegAlloc/Graph/Main.hs
compiler/nativeGen/RegAlloc/Graph/Spill.hs
compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
compiler/nativeGen/RegAlloc/Graph/Stats.hs
compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
compiler/nativeGen/RegAlloc/Linear/Main.hs
compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/StackMap.hs
compiler/nativeGen/RegAlloc/Linear/State.hs
compiler/nativeGen/RegAlloc/Linear/Stats.hs
compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
compiler/nativeGen/RegAlloc/Liveness.hs
compiler/nativeGen/RegClass.hs
compiler/nativeGen/SPARC/AddrMode.hs
compiler/nativeGen/SPARC/Base.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen/Amode.hs
compiler/nativeGen/SPARC/CodeGen/Base.hs
compiler/nativeGen/SPARC/CodeGen/CCall.hs
compiler/nativeGen/SPARC/CodeGen/CondCode.hs
compiler/nativeGen/SPARC/CodeGen/Expand.hs
compiler/nativeGen/SPARC/CodeGen/Gen32.hs
compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
compiler/nativeGen/SPARC/CodeGen/Gen64.hs
compiler/nativeGen/SPARC/CodeGen/Sanity.hs
compiler/nativeGen/SPARC/Cond.hs
compiler/nativeGen/SPARC/Imm.hs
compiler/nativeGen/SPARC/Instr.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/SPARC/RegPlate.hs
compiler/nativeGen/SPARC/Regs.hs
compiler/nativeGen/SPARC/ShortcutJump.hs
compiler/nativeGen/SPARC/Stack.hs
compiler/nativeGen/Size.hs
compiler/nativeGen/TargetReg.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/nativeGen/X86/Cond.hs
compiler/nativeGen/X86/Instr.hs
compiler/nativeGen/X86/Ppr.hs
compiler/nativeGen/X86/RegInfo.hs
compiler/nativeGen/X86/Regs.hs
compiler/parser/Ctype.lhs
compiler/parser/LexCore.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y.pp
compiler/parser/ParserCore.y
compiler/parser/RdrHsSyn.lhs
compiler/prelude/ForeignCall.lhs
compiler/prelude/PrelInfo.lhs
compiler/prelude/PrelNames.lhs
compiler/prelude/PrelRules.lhs
compiler/prelude/PrimOp.lhs
compiler/prelude/TysPrim.lhs
compiler/prelude/TysWiredIn.lhs
compiler/prelude/TysWiredIn.lhs-boot [new file with mode: 0644]
compiler/prelude/primops.txt.pp
compiler/profiling/CostCentre.lhs
compiler/profiling/ProfInit.hs
compiler/profiling/SCCfinal.lhs
compiler/rename/RnBinds.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnExpr.lhs
compiler/rename/RnExpr.lhs-boot
compiler/rename/RnHsSyn.lhs
compiler/rename/RnNames.lhs
compiler/rename/RnPat.lhs
compiler/rename/RnSource.lhs
compiler/rename/RnTypes.lhs
compiler/simplCore/CSE.lhs
compiler/simplCore/CoreMonad.lhs
compiler/simplCore/FloatIn.lhs
compiler/simplCore/FloatOut.lhs
compiler/simplCore/LiberateCase.lhs
compiler/simplCore/OccurAnal.lhs
compiler/simplCore/SAT.lhs
compiler/simplCore/SetLevels.lhs
compiler/simplCore/SimplCore.lhs
compiler/simplCore/SimplEnv.lhs
compiler/simplCore/SimplMonad.lhs
compiler/simplCore/SimplUtils.lhs
compiler/simplCore/Simplify.lhs
compiler/simplStg/SRT.lhs
compiler/simplStg/SimplStg.lhs
compiler/simplStg/StgStats.lhs
compiler/specialise/Rules.lhs
compiler/specialise/SpecConstr.lhs
compiler/specialise/Specialise.lhs
compiler/stgSyn/CoreToStg.lhs
compiler/stgSyn/StgLint.lhs
compiler/stgSyn/StgSyn.lhs
compiler/stranal/DmdAnal.lhs
compiler/stranal/WorkWrap.lhs
compiler/stranal/WwLib.lhs
compiler/typecheck/FamInst.lhs
compiler/typecheck/Inst.lhs
compiler/typecheck/TcArrows.lhs
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcCanonical.lhs
compiler/typecheck/TcClassDcl.lhs
compiler/typecheck/TcDefaults.lhs
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcEnv.lhs
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcEvidence.lhs [new file with mode: 0644]
compiler/typecheck/TcExpr.lhs
compiler/typecheck/TcExpr.lhs-boot
compiler/typecheck/TcForeign.lhs
compiler/typecheck/TcGenDeriv.lhs
compiler/typecheck/TcGenGenerics.lhs [moved from compiler/types/Generics.lhs with 68% similarity]
compiler/typecheck/TcHsSyn.lhs
compiler/typecheck/TcHsType.lhs
compiler/typecheck/TcInstDcls.lhs
compiler/typecheck/TcInteract.lhs
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcMatches.lhs
compiler/typecheck/TcMatches.lhs-boot
compiler/typecheck/TcPat.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcRnTypes.lhs
compiler/typecheck/TcRules.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcSimplify.lhs
compiler/typecheck/TcSplice.lhs
compiler/typecheck/TcSplice.lhs-boot
compiler/typecheck/TcTyClsDecls.lhs
compiler/typecheck/TcTyDecls.lhs
compiler/typecheck/TcType.lhs
compiler/typecheck/TcTypeNats.hs [deleted file]
compiler/typecheck/TcUnify.lhs
compiler/typecheck/TcUnify.lhs-boot
compiler/types/Class.lhs
compiler/types/Coercion.lhs
compiler/types/FamInstEnv.lhs
compiler/types/FunDeps.lhs
compiler/types/IParam.lhs [new file with mode: 0644]
compiler/types/IParam.lhs-boot [new file with mode: 0644]
compiler/types/InstEnv.lhs
compiler/types/Kind.lhs
compiler/types/OptCoercion.lhs
compiler/types/TyCon.lhs
compiler/types/TyCon.lhs-boot
compiler/types/Type.lhs
compiler/types/Type.lhs-boot [new file with mode: 0644]
compiler/types/TypeRep.lhs
compiler/types/TypeRep.lhs-boot
compiler/types/Unify.lhs
compiler/utils/Bag.lhs
compiler/utils/Binary.hs
compiler/utils/BufWrite.hs
compiler/utils/Digraph.lhs
compiler/utils/FastMutInt.lhs
compiler/utils/FastString.lhs
compiler/utils/Fingerprint.hsc
compiler/utils/FiniteMap.lhs
compiler/utils/GraphBase.hs
compiler/utils/GraphColor.hs
compiler/utils/GraphOps.hs
compiler/utils/GraphPpr.hs
compiler/utils/IOEnv.hs
compiler/utils/Interval.hs [deleted file]
compiler/utils/ListSetOps.lhs
compiler/utils/Maybes.lhs
compiler/utils/MonadUtils.hs
compiler/utils/OrdList.lhs
compiler/utils/Outputable.lhs
compiler/utils/Panic.lhs
compiler/utils/Platform.hs
compiler/utils/Pretty.lhs
compiler/utils/UniqFM.lhs
compiler/utils/UniqSet.lhs
compiler/utils/Util.lhs
compiler/utils/md5.c
compiler/vectorise/Vectorise.hs
compiler/vectorise/Vectorise/Builtins.hs
compiler/vectorise/Vectorise/Builtins/Base.hs
compiler/vectorise/Vectorise/Builtins/Initialise.hs
compiler/vectorise/Vectorise/Builtins/Modules.hs [deleted file]
compiler/vectorise/Vectorise/Convert.hs
compiler/vectorise/Vectorise/Env.hs
compiler/vectorise/Vectorise/Exp.hs
compiler/vectorise/Vectorise/Generic/Description.hs [new file with mode: 0644]
compiler/vectorise/Vectorise/Generic/PADict.hs [new file with mode: 0644]
compiler/vectorise/Vectorise/Generic/PAMethods.hs [new file with mode: 0644]
compiler/vectorise/Vectorise/Generic/PData.hs [new file with mode: 0644]
compiler/vectorise/Vectorise/Monad.hs
compiler/vectorise/Vectorise/Monad/Base.hs
compiler/vectorise/Vectorise/Monad/Global.hs
compiler/vectorise/Vectorise/Monad/InstEnv.hs
compiler/vectorise/Vectorise/Monad/Local.hs
compiler/vectorise/Vectorise/Monad/Naming.hs
compiler/vectorise/Vectorise/Type/Classify.hs
compiler/vectorise/Vectorise/Type/Env.hs
compiler/vectorise/Vectorise/Type/PADict.hs [deleted file]
compiler/vectorise/Vectorise/Type/PData.hs [deleted file]
compiler/vectorise/Vectorise/Type/PRepr.hs [deleted file]
compiler/vectorise/Vectorise/Type/Repr.hs [deleted file]
compiler/vectorise/Vectorise/Type/TyConDecl.hs
compiler/vectorise/Vectorise/Type/Type.hs
compiler/vectorise/Vectorise/Utils.hs
compiler/vectorise/Vectorise/Utils/Base.hs
compiler/vectorise/Vectorise/Utils/Closure.hs
compiler/vectorise/Vectorise/Utils/Hoisting.hs
compiler/vectorise/Vectorise/Utils/PADict.hs
compiler/vectorise/Vectorise/Utils/Poly.hs
compiler/vectorise/Vectorise/Var.hs
compiler/vectorise/Vectorise/Vect.hs
configure.ac
distrib/MacOS/mkinstaller [changed mode: 0644->0755]
distrib/configure.ac.in
docs/man/ghc.mk
docs/users_guide/6.10.1-notes.xml [deleted file]
docs/users_guide/6.12.1-notes.xml [deleted file]
docs/users_guide/6.6-notes.xml [deleted file]
docs/users_guide/7.0.1-notes.xml [deleted file]
docs/users_guide/bugs.xml
docs/users_guide/codegens.xml [new file with mode: 0644]
docs/users_guide/debugging.xml
docs/users_guide/extending_ghc.xml [new file with mode: 0644]
docs/users_guide/ffi-chap.xml
docs/users_guide/flags.xml
docs/users_guide/ghci.xml
docs/users_guide/glasgow_exts.xml
docs/users_guide/intro.xml
docs/users_guide/packages.xml
docs/users_guide/phases.xml
docs/users_guide/profiling.xml
docs/users_guide/runghc.xml
docs/users_guide/runtime_control.xml
docs/users_guide/safe_haskell.xml
docs/users_guide/separate_compilation.xml
docs/users_guide/sooner.xml
docs/users_guide/ug-book.xml.in
docs/users_guide/ug-ent.xml.in
docs/users_guide/using.xml
driver/ghci/ghc.mk
driver/ordering-passes [deleted file]
driver/split/ghc-split.lprl
driver/test_mangler [deleted file]
ghc.mk
ghc/GhciMonad.hs
ghc/GhciTags.hs
ghc/InteractiveUI.hs
ghc/Main.hs
ghc/ghc-bin.cabal.in
ghc/ghc.mk
ghc/hschooks.c
includes/Cmm.h
includes/HaskellConstants.hs
includes/Rts.h
includes/RtsAPI.h
includes/RtsOpts.h [deleted file]
includes/Stg.h
includes/ghc.mk
includes/mkDerivedConstants.c
includes/rts/Constants.h
includes/rts/EventLogFormat.h
includes/rts/Flags.h
includes/rts/Globals.h
includes/rts/Main.h [moved from rts/RtsMain.h with 71% similarity]
includes/rts/OSThreads.h
includes/rts/Threads.h
includes/rts/prof/CCS.h
includes/rts/storage/ClosureMacros.h
includes/rts/storage/GC.h
includes/rts/storage/InfoTables.h
includes/rts/storage/TSO.h
includes/stg/MachRegs.h
includes/stg/MiscClosures.h
includes/stg/Regs.h
includes/stg/SMP.h
includes/stg/TailCalls.h
libffi/ghc.mk
libffi/libffi.selinux-detection-3.0.8.patch [deleted file]
libffi/package.conf.in [deleted file]
libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
libraries/bin-package-db/bin-package-db.cabal
libraries/gen_contents_index
libraries/tarballs/time-1.2.0.5.tar.gz [deleted file]
libraries/tarballs/time-1.4.tar.gz [new file with mode: 0644]
mk/build.mk.sample
mk/compiler-ghc.mk
mk/config.mk.in
mk/project.mk.in
mk/tree.mk
mk/validate-settings.mk
new_tc_notes [deleted file]
packages
quickcheck/HeaderInfoTests.hs [deleted file]
quickcheck/README [deleted file]
quickcheck/RunTests.hs [deleted file]
quickcheck/run.sh [deleted file]
rts/Adjustor.c
rts/AdjustorAsm.S
rts/Apply.cmm
rts/AutoApply.h
rts/Capability.c
rts/Capability.h
rts/Disassembler.c
rts/Exception.cmm
rts/GetTime.h
rts/Globals.c
rts/HeapStackCheck.cmm
rts/Interpreter.c
rts/Linker.c
rts/Main.c [deleted file]
rts/Messages.c
rts/OldARMAtomic.c [new file with mode: 0644]
rts/Prelude.h
rts/PrimOps.cmm
rts/Printer.c
rts/ProfHeap.c
rts/ProfHeap.h
rts/Profiling.c
rts/Profiling.h
rts/Proftimer.c
rts/RaiseAsync.c
rts/RetainerProfile.c
rts/RetainerProfile.h
rts/RtsAPI.c
rts/RtsFlags.c
rts/RtsFlags.h
rts/RtsMain.c
rts/RtsProbes.d
rts/RtsStartup.c
rts/RtsUtils.c
rts/STM.c
rts/Schedule.c
rts/Schedule.h
rts/Sparks.c
rts/Sparks.h
rts/Stable.c
rts/Stable.h
rts/Stats.c
rts/Stats.h
rts/StgCRun.c
rts/StgMiscClosures.cmm
rts/StgRun.h
rts/StgStdThunks.cmm
rts/Task.c
rts/Task.h
rts/ThreadLabels.c
rts/ThreadLabels.h
rts/ThreadPaused.c
rts/Threads.c
rts/Ticker.h
rts/Timer.c
rts/Trace.c
rts/Trace.h
rts/Updates.cmm
rts/WSDeque.c
rts/eventlog/EventLog.c
rts/eventlog/EventLog.h
rts/ghc.mk
rts/hooks/OnExit.c
rts/hooks/OutOfHeap.c
rts/hooks/RtsOpts.c [deleted file]
rts/hooks/RtsOptsEnabled.c [deleted file]
rts/package.conf.in
rts/posix/GetTime.c
rts/posix/Itimer.c
rts/posix/Itimer.h
rts/posix/OSThreads.c
rts/posix/Select.c
rts/posix/Select.h
rts/posix/Signals.c
rts/posix/Signals.h
rts/sm/Compact.c
rts/sm/GC.c
rts/sm/GC.h
rts/sm/GCTDecl.h
rts/sm/GCThread.h
rts/sm/GCUtils.c
rts/sm/Sanity.c
rts/sm/Storage.c
rts/sm/Storage.h
rts/win32/GetTime.c
rts/win32/OSThreads.c
rts/win32/ThrIOManager.c
rts/win32/Ticker.c
rts/win32/libHSbase.def
rules/build-dependencies.mk
rules/build-package-data.mk
rules/build-package-way.mk
rules/build-package.mk
rules/build-perl.mk
rules/build-prog.mk
rules/c-suffix-rules.mk
rules/clean-target.mk
rules/cmm-suffix-rules.mk
rules/distdir-way-opts.mk
rules/docbook.mk
rules/extra-packages.mk
rules/haddock.mk
rules/hs-suffix-rules-srcdir.mk
rules/hs-suffix-rules.mk
rules/manual-package-config.mk
rules/package-config.mk
rules/shell-wrapper.mk
settings.in
sync-all
utils/count_lines/count_lines.lprl
utils/fingerprint/fingerprint.py
utils/genapply/GenApply.hs
utils/genprimopcode/Lexer.x
utils/genprimopcode/Main.hs
utils/genprimopcode/ParserM.hs
utils/genprimopcode/Syntax.hs
utils/ghc-cabal/ghc-cabal.cabal
utils/ghc-cabal/ghc.mk
utils/ghc-pkg/ghc-pkg.cabal
utils/ghc-pkg/ghc.mk
utils/ghctags/Main.hs
utils/hp2ps/AreaBelow.c
utils/hp2ps/AuxFile.c
utils/hp2ps/Axes.c
utils/hp2ps/Curves.c
utils/hp2ps/Deviation.c
utils/hp2ps/Dimensions.c
utils/hp2ps/Error.c
utils/hp2ps/HpFile.c
utils/hp2ps/Key.c
utils/hp2ps/Main.c
utils/hp2ps/Marks.c
utils/hp2ps/PsFile.c
utils/hp2ps/Reorder.c
utils/hp2ps/Scale.c
utils/hp2ps/Shade.c
utils/hp2ps/TopTwenty.c
utils/hp2ps/TraceElement.c
utils/hp2ps/Utilities.c
utils/hpc/HpcMarkup.hs
utils/lndir/lndir.c
utils/mkdirhier/ghc.mk
utils/runghc/ghc.mk
utils/runghc/runghc.cabal.in
utils/runghc/runghc.hs
utils/testremove/checkremove.hs
utils/touchy/ghc.mk
utils/unlit/unlit.c
validate

index ac8c70e..2bfec16 100644 (file)
@@ -1,6 +1,9 @@
 # -----------------------------------------------------------------------------
 # generic generated file patterns
 
+Thumbs.db
+.DS_Store
+
 *~
 #*#
 *.bak
@@ -233,4 +236,4 @@ _darcs/
 /utils/unlit/unlit
 
 
-/extra-gcc-opts
\ No newline at end of file
+/extra-gcc-opts
index 0929f28..3325e88 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -110,9 +110,9 @@ endif
 
 .PHONY: test
 test:
-       $(MAKE) -C testsuite/tests/ghc-regress CLEANUP=1 OUTPUT_SUMMARY=../../../testsuite_summary.txt fast
+       $(MAKE) -C testsuite/tests CLEANUP=1 OUTPUT_SUMMARY=../../testsuite_summary.txt fast
 
 .PHONY: fulltest
 fulltest:
-       $(MAKE) -C testsuite/tests/ghc-regress CLEANUP=1 OUTPUT_SUMMARY=../../../testsuite_summary.txt
+       $(MAKE) -C testsuite/tests CLEANUP=1 OUTPUT_SUMMARY=../../testsuite_summary.txt
 
diff --git a/README b/README
index c7d390d..c9bb7f1 100644 (file)
--- a/README
+++ b/README
@@ -76,6 +76,11 @@ These steps give you the default build, which includes everything
 optimised and built in various ways (eg. profiling libs are built).
 It can take a long time.  To customise the build, see the file HACKING.
 
+Once you have a build you need to keep it going.  You need to keep all
+repos in sync with the sync-all script [7].  To get the latest changes:
+
+    $ ./sync-all pull
+    $ ./sync-all get
 
 
 References
@@ -87,6 +92,7 @@ References
  [4] http://www.haskell.org/happy/                      Happy
  [5] http://www.haskell.org/alex/                       Alex
  [6] http://www.haskell.org/haddock/                    Haddock
+ [7] http://hackage.haskell.org/trac/ghc/wiki/Building/SyncAll
 
 
 Contributors
index 3426556..1d5d1f7 100644 (file)
@@ -78,6 +78,312 @@ AC_DEFUN([FPTOOLS_SET_PLATFORM_VARS],
         GHC_CONVERT_VENDOR([$target_vendor], [TargetVendor])
         GHC_CONVERT_OS([$target_os], [TargetOS])
     fi
+
+    windows=NO
+    exeext=''
+    soext='.so'
+    case $host in
+    *-unknown-cygwin32)
+        AC_MSG_WARN([GHC does not support the Cygwin target at the moment])
+        AC_MSG_WARN([I'm assuming you wanted to build for i386-unknown-mingw32])
+        exit 1
+        ;;
+    *-unknown-mingw32)
+        windows=YES
+        exeext='.exe'
+        soext='.dll'
+        ;;
+    i386-apple-darwin|powerpc-apple-darwin)
+        soext='.dylib'
+        ;;
+    x86_64-apple-darwin)
+        soext='.dylib'
+        ;;
+    esac
+
+    BuildPlatform="$BuildArch-$BuildVendor-$BuildOS"
+    BuildPlatform_CPP=`echo "$BuildPlatform" | sed -e 's/\./_/g' -e 's/-/_/g'`
+    BuildArch_CPP=`    echo "$BuildArch"     | sed -e 's/\./_/g' -e 's/-/_/g'`
+    BuildVendor_CPP=`  echo "$BuildVendor"   | sed -e 's/\./_/g' -e 's/-/_/g'`
+    BuildOS_CPP=`      echo "$BuildOS"       | sed -e 's/\./_/g' -e 's/-/_/g'`
+
+    HostPlatform="$HostArch-$HostVendor-$HostOS"
+    HostPlatform_CPP=`echo "$HostPlatform" | sed -e 's/\./_/g' -e 's/-/_/g'`
+    HostArch_CPP=`    echo "$HostArch"     | sed -e 's/\./_/g' -e 's/-/_/g'`
+    HostVendor_CPP=`  echo "$HostVendor"   | sed -e 's/\./_/g' -e 's/-/_/g'`
+    HostOS_CPP=`      echo "$HostOS"       | sed -e 's/\./_/g' -e 's/-/_/g'`
+
+    TargetPlatform="$TargetArch-$TargetVendor-$TargetOS"
+    TargetPlatform_CPP=`echo "$TargetPlatform" | sed -e 's/\./_/g' -e 's/-/_/g'`
+    TargetArch_CPP=`    echo "$TargetArch"     | sed -e 's/\./_/g' -e 's/-/_/g'`
+    TargetVendor_CPP=`  echo "$TargetVendor"   | sed -e 's/\./_/g' -e 's/-/_/g'`
+    TargetOS_CPP=`      echo "$TargetOS"       | sed -e 's/\./_/g' -e 's/-/_/g'`
+
+    echo "GHC build  : $BuildPlatform"
+    echo "GHC host   : $HostPlatform"
+    echo "GHC target : $TargetPlatform"
+
+    AC_SUBST(BuildPlatform)
+    AC_SUBST(HostPlatform)
+    AC_SUBST(TargetPlatform)
+    AC_SUBST(HostPlatform_CPP)
+    AC_SUBST(BuildPlatform_CPP)
+    AC_SUBST(TargetPlatform_CPP)
+
+    AC_SUBST(HostArch_CPP)
+    AC_SUBST(BuildArch_CPP)
+    AC_SUBST(TargetArch_CPP)
+
+    AC_SUBST(HostOS_CPP)
+    AC_SUBST(BuildOS_CPP)
+    AC_SUBST(TargetOS_CPP)
+
+    AC_SUBST(HostVendor_CPP)
+    AC_SUBST(BuildVendor_CPP)
+    AC_SUBST(TargetVendor_CPP)
+
+    AC_SUBST(exeext)
+    AC_SUBST(soext)
+])
+
+
+# FPTOOLS_SET_HASKELL_PLATFORM_VARS
+# ----------------------------------
+# Set the Haskell platform variables
+AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
+[
+    checkArch() {
+        case [$]1 in
+        i386)
+            test -z "[$]2" || eval "[$]2=ArchX86"
+            ;;
+        x86_64)
+            GET_ARM_ISA()
+            test -z "[$]2" || eval "[$]2=ArchX86_64"
+            ;;
+        powerpc)
+            test -z "[$]2" || eval "[$]2=ArchPPC"
+            ;;
+        powerpc64)
+            test -z "[$]2" || eval "[$]2=ArchPPC_64"
+            ;;
+        sparc)
+            test -z "[$]2" || eval "[$]2=ArchSPARC"
+            ;;
+        arm)
+            GET_ARM_ISA()
+            test -z "[$]2" || eval "[$]2=\"ArchARM {armISA = \$ARM_ISA, armISAExt = \$ARM_ISA_EXT}\""
+            ;;
+        alpha)
+            test -z "[$]2" || eval "[$]2=ArchAlpha"
+            ;;
+        mips|mipseb)
+            test -z "[$]2" || eval "[$]2=ArchMipseb"
+            ;;
+        mipsel)
+            test -z "[$]2" || eval "[$]2=ArchMipsel"
+            ;;
+        hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax)
+            test -z "[$]2" || eval "[$]2=ArchUnknown"
+            ;;
+        *)
+            echo "Unknown arch [$]1"
+            exit 1
+            ;;
+        esac
+    }
+
+    checkVendor() {
+        case [$]1 in
+        dec|unknown|hp|apple|next|sun|sgi|ibm)
+            ;;
+        *)
+            echo "Unknown vendor [$]1"
+            exit 1
+            ;;
+        esac
+    }
+
+    checkOS() {
+        case [$]1 in
+        linux)
+            test -z "[$]2" || eval "[$]2=OSLinux"
+            ;;
+        darwin)
+            test -z "[$]2" || eval "[$]2=OSDarwin"
+            ;;
+        solaris2)
+            test -z "[$]2" || eval "[$]2=OSSolaris2"
+            ;;
+        mingw32)
+            test -z "[$]2" || eval "[$]2=OSMinGW32"
+            ;;
+        freebsd)
+            test -z "[$]2" || eval "[$]2=OSFreeBSD"
+            ;;
+        openbsd)
+            test -z "[$]2" || eval "[$]2=OSOpenBSD"
+            ;;
+        netbsd)
+            test -z "[$]2" || eval "[$]2=OSNetBSD"
+            ;;
+        dragonfly|osf1|osf3|hpux|linuxaout|kfreebsdgnu|freebsd2|cygwin32|gnu|nextstep2|nextstep3|sunos4|ultrix|irix|aix|haiku)
+            test -z "[$]2" || eval "[$]2=OSUnknown"
+            ;;
+        *)
+            echo "Unknown OS '[$]1'"
+            exit 1
+            ;;
+        esac
+    }
+
+    dnl ** check for Apple-style dead-stripping support
+    dnl    (.subsections-via-symbols assembler directive)
+
+    AC_MSG_CHECKING(for .subsections_via_symbols)
+    AC_COMPILE_IFELSE(
+        [AC_LANG_PROGRAM([], [__asm__ (".subsections_via_symbols");])],
+        [AC_MSG_RESULT(yes)
+         HaskellHaveSubsectionsViaSymbols=True
+         AC_DEFINE([HAVE_SUBSECTIONS_VIA_SYMBOLS],[1],
+                   [Define to 1 if Apple-style dead-stripping is supported.])
+        ],
+        [HaskellHaveSubsectionsViaSymbols=False
+         AC_MSG_RESULT(no)])
+
+    dnl ** check for .ident assembler directive
+
+    AC_MSG_CHECKING(whether your assembler supports .ident directive)
+    AC_COMPILE_IFELSE(
+        [AC_LANG_SOURCE([__asm__ (".ident \"GHC x.y.z\"");])],
+        [AC_MSG_RESULT(yes)
+         HaskellHaveIdentDirective=True],
+        [AC_MSG_RESULT(no)
+         HaskellHaveIdentDirective=False])
+
+    dnl *** check for GNU non-executable stack note support (ELF only)
+    dnl     (.section .note.GNU-stack,"",@progbits)
+
+    dnl This test doesn't work with "gcc -g" in gcc 4.4 (GHC trac #3889:
+    dnl     Error: can't resolve `.note.GNU-stack' {.note.GNU-stack section} - `.Ltext0' {.text section}
+    dnl so we empty CFLAGS while running this test
+    CFLAGS2="$CFLAGS"
+    CFLAGS=
+    AC_MSG_CHECKING(for GNU non-executable stack support)
+    AC_COMPILE_IFELSE(
+        [AC_LANG_PROGRAM([__asm__ (".section .note.GNU-stack,\"\",@progbits");], [0])],
+        [AC_MSG_RESULT(yes)
+         HaskellHaveGnuNonexecStack=True],
+        [AC_MSG_RESULT(no)
+         HaskellHaveGnuNonexecStack=False])
+    CFLAGS="$CFLAGS2"
+
+    checkArch "$BuildArch" ""
+    checkVendor "$BuildVendor"
+    checkOS "$BuildOS" ""
+
+    checkArch "$HostArch" ""
+    checkVendor "$HostVendor"
+    checkOS "$HostOS" ""
+
+    checkArch "$TargetArch" "HaskellTargetArch"
+    checkVendor "$TargetVendor"
+    checkOS "$TargetOS" "HaskellTargetOs"
+
+    AC_SUBST(HaskellTargetArch)
+    AC_SUBST(HaskellTargetOs)
+    AC_SUBST(HaskellHaveSubsectionsViaSymbols)
+    AC_SUBST(HaskellHaveIdentDirective)
+    AC_SUBST(HaskellHaveGnuNonexecStack)
+])
+
+
+# GET_ARM_ISA
+# ----------------------------------
+# Get info about the ISA on the Arm arch
+AC_DEFUN([GET_ARM_ISA],
+[
+    AC_COMPILE_IFELSE([
+        AC_LANG_PROGRAM(
+            [],
+            [#if defined(__ARM_ARCH_2__)  || \
+                 defined(__ARM_ARCH_3__)  || \
+                 defined(__ARM_ARCH_3M__) || \
+                 defined(__ARM_ARCH_4__)  || \
+                 defined(__ARM_ARCH_4T__) || \
+                 defined(__ARM_ARCH_5__)  || \
+                 defined(__ARM_ARCH_5T__) || \
+                 defined(__ARM_ARCH_5E__) || \
+                 defined(__ARM_ARCH_5TE__)
+                 return 0;
+             #else
+                 not pre arm v6
+             #endif]
+        )],
+        [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv6, 1, [ARM pre v6])
+         AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7])
+         changequote(, )dnl
+         ARM_ISA=ARMv5
+         ARM_ISA_EXT="[]"
+         changequote([, ])dnl
+        ],
+        [
+            AC_COMPILE_IFELSE([
+                AC_LANG_PROGRAM(
+                    [],
+                    [#if defined(__ARM_ARCH_6__)   || \
+                         defined(__ARM_ARCH_6J__)  || \
+                         defined(__ARM_ARCH_6T2__) || \
+                         defined(__ARM_ARCH_6Z__)  || \
+                         defined(__ARM_ARCH_6ZK__) || \
+                         defined(__ARM_ARCH_6M__)
+                         return 0;
+                     #else
+                         not pre arm v7
+                     #endif]
+                )],
+                [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7])
+                 changequote(, )dnl
+                 ARM_ISA=ARMv6
+                 ARM_ISA_EXT="[]"
+                 changequote([, ])dnl
+                ],
+                [changequote(, )dnl
+                 ARM_ISA=ARMv7
+                 ARM_ISA_EXT="[VFPv3,NEON]"
+                 changequote([, ])dnl
+                ])
+        ])
+])
+
+
+# FP_SETTINGS
+# ----------------------------------
+# Set the variables used in the settings file
+AC_DEFUN([FP_SETTINGS],
+[
+    if test "$windows" = YES
+    then
+        SettingsCCompilerCommand='$topdir/../mingw/bin/gcc.exe'
+        SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 $CONF_GCC_LINKER_OPTS_STAGE2"
+        SettingsPerlCommand='$topdir/../perl/perl.exe'
+        SettingsDllWrapCommand='$topdir/../mingw/bin/dllwrap.exe'
+        SettingsWindresCommand='$topdir/../mingw/bin/windres.exe'
+        SettingsTouchCommand='$topdir/touchy.exe'
+    else
+        SettingsCCompilerCommand="$WhatGccIsCalled"
+        SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 $CONF_GCC_LINKER_OPTS_STAGE2"
+        SettingsPerlCommand="$PerlCmd"
+        SettingsDllWrapCommand="/bin/false"
+        SettingsWindresCommand="/bin/false"
+        SettingsTouchCommand='touch'
+    fi
+    AC_SUBST(SettingsCCompilerCommand)
+    AC_SUBST(SettingsCCompilerFlags)
+    AC_SUBST(SettingsPerlCommand)
+    AC_SUBST(SettingsDllWrapCommand)
+    AC_SUBST(SettingsWindresCommand)
+    AC_SUBST(SettingsTouchCommand)
 ])
 
 
@@ -129,6 +435,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
     then
         $2="$$2 -fno-stack-protector"
     fi
+
+    # Reduce memory usage when linking. See trac #5240.
+    if test -n "$LdHashSize31"
+    then
+        $3="$$3 -Wl,$LdHashSize31"
+        $4="$$4     $LdHashSize31"
+    fi
+    if test -n "$LdReduceMemoryOverheads"
+    then
+        $3="$$3 -Wl,$LdReduceMemoryOverheads"
+        $4="$$4     $LdReduceMemoryOverheads"
+    fi
+
     rm -f conftest.c conftest.o
     AC_MSG_RESULT([done])
 ])
@@ -465,36 +784,66 @@ if test ! -f compiler/cmm/CmmLex.hs || test ! -f compiler/parser/Lexer.hs
 then
     FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[2.1.0],
       [AC_MSG_ERROR([Alex version 2.1.0 or later is required to compile GHC.])])[]
+    FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-ge],[3.0],
+      [Alex3=YES],[Alex3=NO])
 fi
 AlexVersion=$fptools_cv_alex_version;
 AC_SUBST(AlexVersion)
+AC_SUBST(Alex3)
 ])
 
 
-# FP_PROG_LD_X
-# ------------
-# Sets the output variable LdXFlag to -x if ld supports this flag, otherwise the
-# variable's value is empty.
-AC_DEFUN([FP_PROG_LD_X],
+# FP_PROG_LD_FLAG
+# ---------------
+# Sets the output variable $2 to $1 if ld supports the $1 flag.
+# Otherwise the variable's value is empty.
+AC_DEFUN([FP_PROG_LD_FLAG],
 [
-AC_CACHE_CHECK([whether ld understands -x], [fp_cv_ld_x],
+AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2],
 [echo 'foo() {}' > conftest.c
 ${CC-cc} -c conftest.c
-if ${LdCmd} -r -x -o conftest2.o conftest.o > /dev/null 2>&1; then
-   fp_cv_ld_x=yes
+if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then
+   fp_cv_$2=$1
 else
-   fp_cv_ld_x=no
+   fp_cv_$2=
 fi
 rm -rf conftest*])
-if test "$fp_cv_ld_x" = yes; then
-  LdXFlag=-x
-else
-  LdXFlag=
-fi
+$2=$fp_cv_$2
+])# FP_PROG_LD_FLAG
+
+
+# FP_PROG_LD_X
+# ------------
+# Sets the output variable LdXFlag to -x if ld supports this flag.
+# Otherwise the variable's value is empty.
+AC_DEFUN([FP_PROG_LD_X],
+[
+FP_PROG_LD_FLAG([-x],[LdXFlag])
 AC_SUBST([LdXFlag])
 ])# FP_PROG_LD_X
 
 
+# FP_PROG_LD_HashSize31
+# ------------
+# Sets the output variable LdHashSize31 to --hash-size=31 if ld supports
+# this flag. Otherwise the variable's value is empty.
+AC_DEFUN([FP_PROG_LD_HashSize31],
+[
+FP_PROG_LD_FLAG([--hash-size=31],[LdHashSize31])
+])# FP_PROG_LD_HashSize31
+
+
+# FP_PROG_LD_ReduceMemoryOverheads
+# ------------
+# Sets the output variable LdReduceMemoryOverheads to
+# --reduce-memory-overheads if ld supports this flag.
+# Otherwise the variable's value is empty.
+AC_DEFUN([FP_PROG_LD_ReduceMemoryOverheads],
+[
+FP_PROG_LD_FLAG([--reduce-memory-overheads],[LdReduceMemoryOverheads])
+])# FP_PROG_LD_ReduceMemoryOverheads
+
+
 # FP_PROG_LD_BUILD_ID
 # ------------
 
@@ -536,6 +885,31 @@ AC_SUBST([LdIsGNULd], [`echo $fp_cv_gnu_ld | sed 'y/yesno/YESNO/'`])
 ])# FP_PROG_LD_IS_GNU
 
 
+# FP_PROG_LD_NO_COMPACT_UNWIND
+# ----------------------------
+
+# Sets the output variable LdHasNoCompactUnwind to YES if ld supports
+# -no_compact_unwind, or NO otherwise.
+AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND],
+[
+AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind],
+[echo 'foo() {}' > conftest.c
+${CC-cc} -c conftest.c
+if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then
+   fp_cv_ld_no_compact_unwind=yes
+else
+   fp_cv_ld_no_compact_unwind=no
+fi
+rm -rf conftest*])
+if test "$fp_cv_ld_no_compact_unwind" = yes; then
+  LdHasNoCompactUnwind=YES
+else
+  LdHasNoCompactUnwind=NO
+fi
+AC_SUBST([LdHasNoCompactUnwind])
+])# FP_PROG_LD_NO_COMPACT_UNWIND
+
+
 # FP_PROG_AR
 # ----------
 # Sets fp_prog_ar_raw to the full path of ar and fp_prog_ar to a non-Cygwin
@@ -690,7 +1064,8 @@ if test -z "$GCC"
 then
   AC_MSG_ERROR([gcc is required])
 fi
-GccLT34=
+GccLT34=NO
+GccLT46=NO
 AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version],
 [
     fp_cv_gcc_version="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/g'`"
@@ -700,11 +1075,29 @@ AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version],
     # isn't a very good reason for that, but for now just make configure
     # fail.
     FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.4], GccLT34=YES)
+    FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [4.6], GccLT46=YES)
 ])
 AC_SUBST([GccVersion], [$fp_cv_gcc_version])
 AC_SUBST(GccLT34)
+AC_SUBST(GccLT46)
 ])# FP_GCC_VERSION
 
+dnl Check to see if the C compiler uses an LLVM back end
+dnl
+AC_DEFUN([FP_CC_LLVM_BACKEND],
+[AC_REQUIRE([AC_PROG_CC])
+AC_MSG_CHECKING([whether C compiler has an LLVM back end])
+$CC -x c /dev/null -dM -E > conftest.txt 2>&1
+if grep "__llvm__" conftest.txt >/dev/null 2>&1; then
+  AC_SUBST([CC_LLVM_BACKEND], [1])
+  AC_MSG_RESULT([yes])
+else
+  AC_SUBST([CC_LLVM_BACKEND], [0])
+  AC_MSG_RESULT([no])
+fi
+rm -f conftest.txt
+])
+
 dnl Small feature test for perl version. Assumes PerlCmd
 dnl contains path to perl binary.
 dnl
@@ -1438,6 +1831,9 @@ case "$1" in
   rs6000)
     $2="rs6000"
     ;;
+  s390x*)
+    $2="s390x"
+    ;;
   s390*)
     $2="s390"
     ;;
@@ -1468,6 +1864,9 @@ AC_DEFUN([GHC_CONVERT_VENDOR],[
   pc|gentoo) # like i686-pc-linux-gnu and i686-gentoo-freebsd8
     $2="unknown"
     ;;
+  softfloat) # like armv5tel-softfloat-linux-gnueabi
+    $2="unknown"
+    ;;
   *)
     #pass thru by default
     $2="$1"
@@ -1512,13 +1911,59 @@ fi
 AC_SUBST($1)
 ])
 
-# LIBRARY_VERSION(lib)
+# LIBRARY_VERSION(lib, [dir])
 # --------------------------------
 # Gets the version number of a library.
 # If $1 is ghc-prim, then we define LIBRARY_ghc_prim_VERSION as 1.2.3
+# $2 points to the directory under libraries/
 AC_DEFUN([LIBRARY_VERSION],[
-LIBRARY_[]translit([$1], [-], [_])[]_VERSION=`grep -i "^version:" libraries/$1/$1.cabal | sed "s/.* //"`
+dir=m4_default([$2],[$1])
+LIBRARY_[]translit([$1], [-], [_])[]_VERSION=`grep -i "^version:" libraries/${dir}/$1.cabal | sed "s/.* //"`
 AC_SUBST(LIBRARY_[]translit([$1], [-], [_])[]_VERSION)
 ])
 
+# XCODE_VERSION()
+# --------------------------------
+# Gets the version number of XCode, if on a Mac
+AC_DEFUN([XCODE_VERSION],[
+    if test "$TargetOS_CPP" = "darwin"
+    then
+        AC_MSG_CHECKING(XCode version)
+        XCodeVersion=`xcodebuild -version | grep Xcode | sed "s/Xcode //"`
+        # Old XCode versions don't actually give the XCode version
+        if test "$XCodeVersion" = ""
+        then
+            AC_MSG_RESULT(not found (too old?))
+            XCodeVersion1=0
+            XCodeVersion2=0
+        else
+            AC_MSG_RESULT($XCodeVersion)
+            XCodeVersion1=`echo "$XCodeVersion" | sed 's/\..*//'`
+            changequote(, )dnl
+            XCodeVersion2=`echo "$XCodeVersion" | sed 's/[^.]*\.\([^.]*\).*/\1/'`
+            changequote([, ])dnl
+            AC_MSG_NOTICE(XCode version component 1: $XCodeVersion1)
+            AC_MSG_NOTICE(XCode version component 2: $XCodeVersion2)
+        fi
+    fi
+])
+
+# FIND_GCC()
+# --------------------------------
+# Finds where gcc is
+AC_DEFUN([FIND_GCC],[
+    if test "$TargetOS_CPP" = "darwin" &&
+        test "$XCodeVersion1" -ge 4
+    then
+        # From Xcode 4, use 'gcc-4.2' to force the use of the gcc legacy
+        # backend (instead of the LLVM backend)
+        FP_ARG_WITH_PATH_GNU_PROG([CC], [gcc-4.2])
+    else
+        FP_ARG_WITH_PATH_GNU_PROG([CC], [gcc])
+    fi
+    export CC
+    WhatGccIsCalled="$CC"
+    AC_SUBST(WhatGccIsCalled)
+])
+
 # LocalWords:  fi
diff --git a/boot b/boot
index 08d4846..5d0973d 100755 (executable)
--- a/boot
+++ b/boot
@@ -174,7 +174,8 @@ sub boot_pkgs {
                     or die "Opening $package/ghc.mk failed: $!";
                 print GHCMK "${package}_PACKAGE = ${pkg}\n";
                 print GHCMK "${package}_dist-install_GROUP = libraries\n";
-                print GHCMK "\$(eval \$(call build-package,${package},dist-install,\$(if \$(filter ${dir},\$(STAGE2_PACKAGES)),2,1)))\n";
+                print GHCMK "\$(if \$(filter ${dir},\$(PKGS_THAT_BUILD_WITH_STAGE0)),\$(eval \$(call build-package,${package},dist-boot,0)))\n";
+                print GHCMK "\$(eval \$(call build-package,${package},dist-install,\$(if \$(filter ${dir},\$(PKGS_THAT_BUILD_WITH_STAGE2)),2,1)))\n";
                 close GHCMK
                     or die "Closing $package/ghc.mk failed: $!";
 
diff --git a/compiler/DLL-NOTES b/compiler/DLL-NOTES
deleted file mode 100644 (file)
index c710b14..0000000
+++ /dev/null
@@ -1,58 +0,0 @@
-                              The DLL story
-                              -------------
-
-***
-
-This file is intended to be a focal point for notes on how DLLs work. Please
-add cross-references to source and other docs, especially when you don't
-find something here that you need.
-
-***
-
-
-Introduction
-------------
-
-On Windows, DLLs are synonymous with packages (since 4.07; this change
-simplified a rather horrible mess). Hence whenever a module is to be
-compiled to go in a DLL, it must be compiled with -package-name dll-name.
-Typically, failing to do this gives Windows error message boxes of the form
-"The instruction at address <x> tried to read memory at address <x>".
-
-
-Dependencies
-------------
-
-Because references in DLLs must be fully resolved when the DLL is compiled
-(except for references to other DLLs), it is not possible for DLLs to call
-the main program. This means that the parts of the RTS and standard package
-which call the main program cannot be compiled into the relevant DLLs, and
-must instead be compiled as standalone object files and linked in to each
-executable. This gives the following picture of dependencies within a program:
-
-            ___________         ___________
-           |           |------>|           |   GHC-land  |  Application-land
-DLL-land   | HSrts.dll |       | HSstd.dll |             |
-           |___________|<------|___________|             |
-                 |                   ^                   |
------------------|-------------------|-------------------|
-            _____v_____         _____|______             |
-.o-land    |           |       |            |            |
-           |  Main.o   |       | PrelMain.o |-----------------------
-          |___________|       |____________|            |          |
-                 |                                       |    ______v______
-                 |                                       |   |             |
-                  ------------------------------------------>|   Main.o    |
-                                                         |   |_____________|
-
-(The application's dependencies are not shown.)
-
-
-Bits of the compiler that deal with DLLs
-----------------------------------------
-
-basicTypes/Module.lhs is the most important place, as it deals with which
-modules identifiers are in.
-
-basicTypes/name.lhs, other bits of basicTypes/, nativeGen/, codeGen/,
-abcCSyn/, and even profiling/ have other references.
index 303d2bd..d852347 100644 (file)
@@ -16,11 +16,6 @@ you will screw up the layout where they are used in case expressions!
 /* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */
 #include "ghc_boot_platform.h"
 
-/* This macro indicates that the target OS supports ELF-like shared libraries */
-#if linux_TARGET_OS || freebsd_TARGET_OS || openbsd_TARGET_OS || solaris2_TARGET_OS
-#define elf_OBJ_FORMAT 1
-#endif
-
 /* Pull in the autoconf defines (HAVE_FOO), but don't include
  * ghcconfig.h, because that will include ghcplatform.h which has the
  * wrong platform settings for the compiler (it has the platform
@@ -36,23 +31,21 @@ you will screw up the layout where they are used in case expressions!
 name :: IORef (ty);                \
 name = Util.global (value);
 
-#define GLOBAL_MVAR(name,value,ty) \
-{-# NOINLINE name #-};             \
-name :: MVar (ty);                 \
-name = Util.globalMVar (value);
+#define GLOBAL_VAR_M(name,value,ty) \
+{-# NOINLINE name #-};              \
+name :: IORef (ty);                 \
+name = Util.globalM (value);
 #endif
 #else /* __HADDOCK__ */
 #define GLOBAL_VAR(name,value,ty)  \
 name :: IORef (ty);                \
 name = Util.global (value);
 
-#define GLOBAL_MVAR(name,value,ty) \
-name :: MVar (ty);                 \
-name = Util.globalMVar (value);
+#define GLOBAL_VAR_M(name,value,ty) \
+name :: IORef (ty);                 \
+name = Util.globalM (value);
 #endif
 
-#define COMMA ,
-
 #ifdef DEBUG
 #define ASSERT(e)      if (not (e)) then (assertPanic __FILE__ __LINE__) else
 #define ASSERT2(e,msg) if (not (e)) then (assertPprPanic __FILE__ __LINE__ (msg)) else
diff --git a/compiler/NOTES b/compiler/NOTES
deleted file mode 100644 (file)
index 645d27e..0000000
+++ /dev/null
@@ -1,156 +0,0 @@
-More type functions
-~~~~~~~~~~~~~~~~~~~
-* Allow {tv = TYPE ty) as a non-rec binding in Core
-* Use this to make equality constraints more uniform
-* Can a Dict can contain an EqPred?  
-  How does that differ from an EqInst?
-* Make DictBinds into Core
-
-* In zonking, do we need to zonk the kinds of coercion variables?
-
-Type functions
-~~~~~~~~~~~~~~
-* A Given inst should be a CoVar, not a coercion
-
-* finaliseEqInst should not need to call zonk
-
-* Why do we need fromGivenEqDict?  How could we construct      
-       a Dict that had an EqPred?
-       newDictBndr should make an EqInst directly
-
-* tc_co should be accessed only inside Inst
-
-* Inst.mkImplicTy needs a commment about filtering out EqInsts
-  How *do* we deal with wanted equalities?
-
-* Inst.instType behaves inconsistently for EqInsts: it should
-  return an EqPred, like the instType' hack in pprDictsTheta
-
-  Consequences: adjust the uses of instType in TcSimplify
-
-* tcDeref* functions are unused, except in tcGenericNormalizeFamInst, when
-  we can equally well use TcMType.lookupTcTyVar
-
-* Coercion.mkEqPredCoI looks very peculiar.
-
-
-
-
--------------------------
-*** unexpected failure for jtod_circint(opt)
-
-
-       New back end thoughts
-
------------------------------------------------------------------------------
-Codegen notes
-
-* jumps to ImpossibleBranch should be removed.
-
-* Profiling:
-       - when updating a closure with an indirection to a function,
-         we should make a permanent indirection.
-
-       - check that we're bumping the scc count appropriately
-
-* check perf & binary sizes against the HEAD
-
------------------------------------------------------------------------------
-C backend notes
-
-* use STGCALL macros for foreign calls (doesn't look like volatile regs
-  are handled properly at the mo).
-
------------------------------------------------------------------------------
-Cmm parser notes
-
-* switches
-
-* need to cater for unexported procedures/info tables?
-
-* We should be able to get rid of entry labels, use info labels only.
-  - we need a %ENTRY_LBL(info_lbl) macro, so that instead of
-     JMP_(foo_entry) we can write jump %ENTRY_LBL(foo_info).
-
------------------------------------------------------------------------------
-
-* Move arg-descr from LFInfo to ClosureInfo? 
-  But: only needed for functions
-
-* Move all of CgClosure.link_caf into NewCaf, and newDynCaf
-
-* If the case binder is dead, and the constr is nullary,
-  do we need to assign to Node?
-
-
--------------------------------
-NB: all floats are let-binds, but some non-rec lets
-    may be unlifted (with RHS ok-for-speculation)
-
-
-simplArg:  [use strictness]
-          [used for non-top-lvl non-rec RHS or function arg]
-  if strict-type || demanded
-       simplStrictExpr
-  else
-       simplExpr ---> (floats,expr)
-       float all the floats if exposes constr app, return expr
-
-simpl (applied lambda)     ==> simplNonRecBind
-simpl (Let (NonRec ...) ..) ==> simplNonRecBind
-
-simpl (Let (Rec ...)    ..) ==> simplRecBind
-
-simplRecBind:
-  simplify binders (but not its IdInfo)
-  simplify the pairs one at a time
-       using simplRecPair
-
-simplNonRecBind:       [was simplBeta]
-       [used for non-top-lvl non-rec bindings]
-  - check for PreInlineUnconditionally
-  - simplify binder, including its IdInfo
-  - simplArg
-  - if strict-type 
-       addCaseBind [which makes a let if ok-for-spec]
-    else
-       completeLazyBind
-
-simplLazyBind: [binder already simplified, but not its IdInfo]
-               [used for both rec and top-lvl non-rec]
-               [must not be strict/unboxed; case not allowed]
-  - check for PreInlineUnconditionally
-  - substituteIdInfo and add result to in-scope 
-       [so that rules are available in rec rhs]
-  - simplExpr --> (floats,expr)
-  - float: lifted floats only
-       if exposes constructor or pap (even if non-triv args)
-       or if top level
-  - completeLazyBind
-  
-
-completeLazyBind:      [given a simplified RHS]
-       [used for both rec and non-rec bindings, top level and not]
-  - try discarding dead
-  - try PostInlineUnconditionally
-  - let-bind coerce arg and repeat
-  - try rhs tylam (float)
-  - try eta expand (float)    [not if any float is unlifted && (non-spec || top_lvl || rec)]
-  - let-bind constructor args [not if any float is ..as above..]
-
-  - add unfolding [this is the only place we add an unfolding]
-    add arity
-
-
-
-
-Eta expansion
-~~~~~~~~~~~~~~
-For eta expansion, we want to catch things like
-
-       case e of (a,b) -> \x -> case a of (p,q) -> \y -> r
-
-If the \x was on the RHS of a let, we'd eta expand to bring the two
-lambdas together.  And in general that's a good thing to do.  Perhaps
-we should eta expand wherever we find a (value) lambda?  Then the eta
-expansion at a let RHS can concentrate solely on the PAP case.
diff --git a/compiler/Simon-log b/compiler/Simon-log
deleted file mode 100644 (file)
index 3d2804d..0000000
+++ /dev/null
@@ -1,1260 +0,0 @@
-       ------------------------------------
-          GHCI hacking
-       ------------------------------------
-
-* Don't forget to put deferred-type-decls back into RnIfaces
-
-* Do we want to record a package name in a .hi file?
-  Does pi_mod have a ModuleName or a Module?
-
-       ------------------------------------
-          Mainly FunDeps (23 Jan 01)
-       ------------------------------------
-
-This commit re-engineers the handling of functional dependencies.
-A functional dependency is no longer an Inst; instead, the necessary
-dependencies are snaffled out of their Class when necessary.
-
-As part of this exercise I found that I had to re-work how to do generalisation
-in a binding group.  There is rather exhaustive documentation on the new Plan
-at the top of TcSimplify.
-
-       ******************
-       WARNING: I have compiled all the libraries with this new compiler
-                and all looks well, but I have not run many programs.
-                Things may break.  Let me know if so.
-       ******************
-
-The main changes are these:
-
-1.  typecheck/TcBinds and TcSimplify have a lot of changes due to the 
-    new generalisation and context reduction story.  There are extensive
-    comments at the start of TcSimplify
-
-2.  typecheck/TcImprove is removed altogether.  Instead, improvement is 
-    interleaved with context reduction (until a fixpoint is reached).
-    All this is done in TcSimplify.
-
-3.  types/FunDeps has new exports
-       * 'improve' does improvement, returning a list of equations
-       * 'grow' and 'oclose' close a list of type variables wrt a set of
-         PredTypes, but in slightly different ways.  Comments in file.
-
-4.  I improved the way in which we check that main::IO t.  It's tidier now.
-
-In addition
-
-*   typecheck/TcMatches: 
-       a) Tidy up, introducing a common function tcCheckExistentialPat
-
-       b) Improve the typechecking of parallel list comprehensions,
-          which wasn't quite right before.  (see comments with tcStmts)
-
-       WARNING: (b) is untested!  Jeff, you might want to check.
-
-*   Numerous other incidental changes in the typechecker
-
-*   Manuel found that rules don't fire well when you have partial applications
-    from overloading.  For example, we may get
-
-       f a (d::Ord a) = let m_g = g a d
-                        in
-                        \y :: a -> ...(m_g (h y))...
-
-    The 'method' m_g doesn't get inlined because (g a d) might be a redex.
-    Yet a rule that looks like 
-               g a d (h y) = ...
-    won't fire because that doesn't show up.  One way out would be to make
-    the rule matcher a bit less paranoid about duplicating work, but instead
-    I've added a flag
-                       -fno-method-sharing
-    which controls whether we generate things like m_g in the first place.
-    It's not clear that they are a win in the first place.
-
-    The flag is actually consulted in Inst.tcInstId
-
-
-
-       ------------------------------------
-          Mainly PredTypes (28 Sept 00)
-       ------------------------------------
-
-Three things in this commit:
-
-       1.  Main thing: tidy up PredTypes
-       2.  Move all Keys into PrelNames
-       3.  Check for unboxed tuples in function args
-
-1. Tidy up PredTypes
-~~~~~~~~~~~~~~~~~~~~
-The main thing in this commit is to modify the representation of Types
-so that they are a (much) better for the qualified-type world.  This
-should simplify Jeff's life as he proceeds with implicit parameters
-and functional dependencies.  In particular, PredType, introduced by
-Jeff, is now blessed and dignified with a place in TypeRep.lhs:
-
-       data PredType  = Class  Class [Type]
-                      | IParam Name  Type
-
-Consider these examples:
-       f :: (Eq a) => a -> Int
-       g :: (?x :: Int -> Int) => a -> Int
-       h :: (r\l) => {r} => {l::Int | r}
-
-Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called
-*predicates*, and are represented by a PredType.  (We don't support
-TREX records yet, but the setup is designed to expand to allow them.)
-
-In addition, Type gains an extra constructor:
-
-       data Type = .... | PredTy PredType
-
-so that PredType is injected directly into Type.  So the type
-       p => t
-is represented by
-       PredType p `FunTy` t
-
-I have deleted the hackish IPNote stuff; predicates are dealt with entirely
-through PredTys, not through NoteTy at all.
-
-
-2.  Move Keys into PrelNames
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-This is just a housekeeping operation. I've moved all the pre-assigned Uniques 
-(aka Keys) from Unique.lhs into PrelNames.lhs.  I've also moved knowKeyRdrNames
-from PrelInfo down into PrelNames.  This localises in PrelNames lots of stuff
-about predefined names.  Previously one had to alter three files to add one,
-now only one.
-
-3.  Unboxed tuples
-~~~~~~~~~~~~~~~~~~
-Add a static check for unboxed tuple arguments.  E.g.
-       data T = T (# Int, Int #)
-is illegal
-
-
-
-       ---------------------------------------
-       Update in place
-       ---------------------------------------
-
--funfolding-update-in-place
-Switching it on doesn't affect many programs, except these
-sphere is because it makes a critical function (vecsub) more inlinable
-
-         sphere               66465k         -20.61%
-          infer               13390k          +1.27%
-        parstof                1461k          +1.18%
-          fluid                3442k          +1.61%
-           atom              177163k         +13.20%
-           bspt                4837k          +4.85%
-       cichelli               33546k          +2.69%
-      typecheck              146023k          +1.47%
-
-
-       ---------------------------------------
-       Simon's tuning changes: early Sept 2000
-       ---------------------------------------
-
-Library changes
-~~~~~~~~~~~~~~~
-* Eta expand PrelShow.showLitChar.  It's impossible to compile this well,
-  and it makes a big difference to some programs (e.g. gen_regexps)
-
-* Make PrelList.concat into a good producer (in the foldr/build sense)
-
-
-Flag changes
-~~~~~~~~~~~~
-* Add -ddump-hi-diffs to print out changes in interface files.  Useful
-  when watching what the compiler is doing
-
-* Add -funfolding-update-in-place to enable the experimental optimisation
-  that makes the inliner a bit keener to inline if it's in the RHS of
-  a thunk that might be updated in place.  Sometimes this is a bad idea
-  (one example is in spectral/sphere; see notes in nofib/Simon-nofib-notes)
-
-
-Tuning things
-~~~~~~~~~~~~~
-* Fix a bug in SetLevels.lvlMFE.  (change ctxt_lvl to dest_level)
-  I don't think this has any performance effect, but it saves making
-  a redundant let-binding that is later eliminated.
-
-* Desugar.dsProgram and DsForeign
-  Glom together all the bindings into a single Rec.  Previously the
-  bindings generated by 'foreign' declarations were not glommed together, but
-  this led to an infelicity (i.e. poorer code than necessary) in the modules
-  that actually declare Float and Double (explained a bit more in Desugar.dsProgram)
-
-* OccurAnal.shortMeOut and IdInfo.shortableIdInfo
-  Don't do the occurrence analyser's shorting out stuff for things which
-  have rules.  Comments near IdInfo.shortableIdInfo.
-  This is deeply boring, and mainly to do with making rules work well.
-  Maybe rules should have phases attached too....
-
-* CprAnalyse.addIdCprInfo
-  Be a bit more willing to add CPR information to thunks; 
-  in particular, if the strictness analyser has just discovered that this
-  is a strict let, then the let-to-case transform will happen, and CPR is fine.
-  This made a big difference to PrelBase.modInt, which had something like
-       modInt = \ x -> let r = ... -> I# v in
-                       ...body strict in r...
-  r's RHS isn't a value yet; but modInt returns r in various branches, so
-  if r doesn't have the CPR property then neither does modInt
-
-* MkId.mkDataConWrapId
-  Arrange that vanilla constructors, like (:) and I#, get unfoldings that are
-  just a simple variable $w:, $wI#.  This ensures they'll be inlined even into
-  rules etc, which makes matching a bit more reliable.  The downside is that in
-  situations like (map (:) xs), we'll end up with (map (\y ys. $w: y ys) xs.
-  Which is tiresome but it doesn't happen much.
-
-* SaAbsInt.findStrictness 
-  Deal with the case where a thing with no arguments is bottom.  This is Good.
-  E.g.   module M where { foo = error "help" }
-  Suppose we have in another module
-       case M.foo of ...
-  Then we'd like to do the case-of-error transform, without inlining foo.
-
-
-Tidying up things
-~~~~~~~~~~~~~~~~~
-* Reorganised Simplify.completeBinding (again).
-
-* Removed the is_bot field in CoreUnfolding (is_cheap is true if is_bot is!)
-  This is just a tidy up
-
-* HsDecls and others
-  Remove the NewCon constructor from ConDecl.  It just added code, and nothing else.
-  And it led to a bug in MkIface, which though that a newtype decl was always changing!
-
-* IdInfo and many others
-  Remove all vestiges of UpdateInfo (hasn't been used for years)
-
-               ------------------------------
-               Join points     Sept 2000
-               ------------------------------
-
-With Andrew Kennedy, I found out why a few of the join points introduced by
-the simplifier end up as *not* let-no-escpaed.  Here's an example:
-
-f x y = case (pwr x b) == 1 of
-        False -> False
-        True -> pwr x c == 1
-
-This compiles to:
-  f = \ @ t w :: Integer ->
-         let {
-           $j :: (State# RealWorld -> Bool)
-           P
-           $j
-             = \ w1 :: (State# RealWorld) ->
-                   case pwr w c of wild {
-                       S# i -> case i of wild1 { 1 -> $wTrue; __DEFAULT -> $wFalse };
-                       J# s d1 ->
-                           case cmpIntegerInt# s d1 1 of wild2 {
-                               0 -> $wTrue; __DEFAULT -> $wFalse
-                           }
-                   }
-         } in 
-           case pwr w b of wild {
-               S# i ->
-                   case i of wild1 { 1 -> $j realWorld#; __DEFAULT -> $wFalse };
-               J# s d1 ->
-                   case cmpIntegerInt# s d1 1 of wild2 {
-                       0 -> $j realWorld#; __DEFAULT -> $wFalse
-                   }
-           }
-
-Now consider
-
-       case (f x) of
-         True  -> False
-         False -> True
-
-Suppose f is inlined into this case.   No new join points are introduced,
-because the alternatives are both small.  But the consumer
-       case [.] of {True -> False; False -> True}
-will move into the body of f, be duplicated 4 ways, and end up consuming
-the result of the four outcomes at the body of f.  This yields:
-           $j :: (State# RealWorld -> Bool)
-           P
-           $j
-             = \ w1 :: (State# RealWorld) ->
-                   case pwr w c of wild {
-                       S# i -> case i of wild1 { 1 -> $wTrue; __DEFAULT -> $wFalse };
-                       J# s d1 ->
-                           case cmpIntegerInt# s d1 1 of wild2 {
-                               0 -> $wTrue; __DEFAULT -> $wFalse
-                           }
-                   }
-         } in 
-           case pwr w b of wild {
-               S# i ->
-                   case i of wild1 { 1 -> case $j realWorld# of {T->F; F->T}
-                                   ; __DEFAULT -> $wTrue };
-               J# s d1 ->
-                   case cmpIntegerInt# s d1 1 of wild2 {
-                       0 -> case $j realWorld# of {T->F; F->T}
-                       ; __DEFAULT -> $wTrue
-                   }
-           }
-
-And, voila, the join point $j isn't let-no-escaped any more.  
-The point is that the consuming context can't "see inside" the join point.
-It's a phase ordering thing.  If f is inlined before the join points 
-are built in the first place, then all is well.
-
-
-
-       -----------------------------
-       Sept 7 2000
-       -----------------------------
-
-* Make the simplifier's Stop continuation record whether the expression being
-  simplified is the RHS of a thunk, or (say) the body of a lambda or case RHS.
-  In the thunk case we want to be a bit keener about inlining if the type of
-  the thunk is amenable to update in place.
-
-* SetLevels was being a bit too eager to float things to the top 
-  level; e.g. _inline_me_ (\a -> e); here e got floated...
-  Easily fixed by a change to ltMajLvl
-
-* Make CoreUnfold.calcUnfoldingGuidance a bit less keen to make case expressions
-  seem small.  The original idea was to make inlined wrappers look small, so that
-  when we inline a wrapper it doesn't make call site (much) bigger
-  Otherwise we get nasty phase ordering stuff: 
-               --      f x = g x x
-               --      h y = ...(f e)...
-  If we inline g's wrapper, f looks big, and doesn't get inlined
-  into h; if we inline f first, while it looks small, then g's 
-  wrapper will get inlined later anyway.  To avoid this nasty
-  ordering difference, we make (case a of (x,y) -> ...), 
-  *where a is one of the arguments* look free.
-
-  BUT  (a) It's too eager.  We don't want to inline a wrapper into a
-           context with no benefit.  
-           E.g.  \ x. f (x+x)          o point in inlining (+) here!
-
-       (b) It's ineffective. Once g's wrapper is inlined, its case-expressions 
-           aren't scrutinising arguments any more
-
-  So I've rescinded this idea for now.  cases still look fairly small.
-
-* Fix interestingArg, which was being too liberal, and hence doing
-  too much inlining.
-
-* Extended CoreUtils.exprIsCheap to make two more things cheap:
-    -  case (coerce x) of ...
-    -   let x = y +# z
-  This makes a bit more eta expansion happen.  It was provoked by
-  a program of Marcin's.
-  
-* The simplifier used to glom together all the top-level bindings into
-  a single Rec every time it was invoked.  The reason for this is explained
-  in SimplCore.lhs, but for at least one simple program it meant that the
-  simplifier never got around to unravelling the recursive group into 
-  non-recursive pieces.  So I've put the glomming under explicit flag
-  control with a -fglom-binds simplifier pass.   A side benefit is
-  that because it happens less often, the (expensive) SCC algorithm
-  runs less often.
-  
-* MkIface.ifaceBinds.   Make sure that we emit rules for things
-  (like class operations) that don't get a top-level binding in the
-  interface file.  Previously such rules were silently forgotten.
-
-* Move transformRhs to *after* simplification, which makes it a
-  little easier to do, and means that the arity it computes is 
-  readily available to completeBinding.  This gets much better
-  arities.
-
-* Do coerce splitting in completeBinding. This gets good code for
-       newtype CInt = CInt Int
-
-       test:: CInt -> Int
-       test x = case x of
-                  1 -> 2
-                  2 -> 4
-                  3 -> 8
-                  4 -> 16
-                  _ -> 0
-
-* Modify the meaning of "arity" so that during compilation it means
-  "if you apply this function to fewer args, it will do virtually 
-  no work".   So, for example 
-       f = coerce t (\x -> e)
-  has arity at least 1.  When a function is exported, it's arity becomes
-  the number of exposed, top-level lambdas, which is subtly different.
-  But that's ok.  
-
-  I removed CoreUtils.exprArity altogether: it looked only at the exposed
-  lambdas.  Instead, we use exprEtaExpandArity exclusively.
-
-  All of this makes I/O programs work much better.
-
-
-       -----------------------------
-       Sept 4 2000
-       -----------------------------
-
-* PrimRep, TysPrim.  Add PrimPtrRep as the representation for
-  MVars and MutVars.  Previously they were given PtrRep, but that
-  crashed dataReturnConvPrim!  Here's the program the killed it:
-     data STRef s a = STRef (MutVar# s a)
-     from (STRef x) = x
-  
-* Make the desugarer use string equality for string literal
-  patterns longer than 1 character.  And put a specialised
-  eqString into PrelBase, with a suitable specialisation rule.
-  This makes a huge difference to the size of the code generated
-  by deriving(Read) notably in Time.lhs
-
-       -----------------------------
-       Marktoberdorf Commits (Aug 2000)
-       -----------------------------
-
-1.  Tidy up the renaming story for "system binders", such as
-dictionary functions, default methods, constructor workers etc.  These
-are now documented in HsDecls.  The main effect of the change, apart
-from tidying up, is to make the *type-checker* (instead of the
-renamer) generate names for dict-funs and default-methods.  This is
-good because Sergei's generic-class stuff generates new classes at
-typecheck time.
-
-
-2.  Fix the CSE pass so it does not require the no-shadowing invariant.
-Keith discovered that the simplifier occasionally returns a result
-with shadowing.  After much fiddling around (which has improved the
-code in the simplifier a bit) I found that it is nearly impossible to
-arrange that it really does do no-shadowing.  So I gave up and fixed
-the CSE pass (which is the only one to rely on it) instead.
-
-
-3. Fix a performance bug in the simplifier.  The change is in
-SimplUtils.interestingArg.  It computes whether an argment should 
-be considered "interesting"; if a function is applied to an interesting
-argument, we are more likely to inline that function.
-Consider this case
-       let x = 3 in f x
-The 'x' argument was considered "uninteresting" for a silly reason.
-Since x only occurs once, it was unconditionally substituted, but
-interestingArg didn't take account of that case.  Now it does.
-
-I also made interestingArg a bit more liberal.  Let's see if we
-get too much inlining now.
-
-
-4.  In the occurrence analyser, we were choosing a bad loop breaker.
-Here's the comment that's now in OccurAnal.reOrderRec
-
-    score ((bndr, rhs), _, _)
-       | exprIsTrivial rhs        = 3  -- Practically certain to be inlined
-               -- Used to have also: && not (isExportedId bndr)
-               -- But I found this sometimes cost an extra iteration when we have
-               --      rec { d = (a,b); a = ...df...; b = ...df...; df = d }
-               -- where df is the exported dictionary. Then df makes a really
-               -- bad choice for loop breaker
-
-I also increased the score for bindings with a non-functional type, so that
-dictionaries have a better chance of getting inlined early
-
-
-5. Add a hash code to the InScopeSet (and make it properly abstract)
-This should make uniqAway a lot more robust.  Simple experiments suggest
-that uniqAway no longer gets into the long iteration chains that it used
-to.
-
-
-6.  Fix a bug in the inliner that made the simplifier tend to get into
-a loop where it would keep iterating ("4 iterations, bailing out" message).
-In SimplUtils.mkRhsTyLam we float bindings out past a big lambda, thus:
-       x = /\ b -> let g = \x -> f x x
-                   in E
-becomes
-       g* = /\a -> \x -> f x x
-       x = /\ b -> let g = g* b in E
-       
-It's essential that we don't simply inling g* back into the RHS of g,
-else we will be back to square 1.  The inliner is meant not to do this
-because there's no benefit to the inlining, but the size calculation
-was a little off in CoreUnfold.
-
-
-7.  In SetLevels we were bogus-ly building a Subst with an empty in-scope
-set, so a WARNING popped up when compiling some modules.  (knights/ChessSetList
-was the example that tickled it.)  Now in fact the warning wasn't an error,
-but the Right Thing to do is to carry down a proper Subst in SetLevels, so
-that is what I have now done.  It is very little more expensive.
-
-
-
-               ~~~~~~~~~~~~
-               Apr/May 2000
-               ~~~~~~~~~~~~
-
-This is a pretty big commit!  It adds stuff I've been working on
-over the last month or so.  DO NOT MERGE IT WITH 4.07!
-
-Recompilation checking
-~~~~~~~~~~~~~~~~~~~~~~
-Substantial improvement in recompilation checking.  The version management
-is now entirely internal to GHC.  ghc-iface.lprl is dead!
-
-The trick is to generate the new interface file in two steps:
-  - first convert Types etc to HsTypes etc, and thereby 
-       build a new ParsedIface
-  - then compare against the parsed (but not renamed) version of the old
-       interface file
-Doing this meant adding code to convert *to* HsSyn things, and to 
-compare HsSyn things for equality.  That is the main tedious bit.
-
-Another improvement is that we now track version info for 
-fixities and rules, which was missing before.
-
-
-Interface file reading
-~~~~~~~~~~~~~~~~~~~~~~
-Make interface files reading more robust.  
-  * If the old interface file is unreadable, don't fail. [bug fix]
-
-  * If the old interface file mentions interfaces 
-    that are unreadable, don't fail. [bug fix]
-
-  * When we can't find the interface file, 
-    print the directories we are looking in.  [feature]
-
-
-Type signatures
-~~~~~~~~~~~~~~~
-  * New flag -ddump-types to print type signatures
-
-
-Type pruning
-~~~~~~~~~~~~
-When importing 
-       data T = T1 A | T2 B | T3 C
-it seems excessive to import the types A, B, C as well, unless
-the constructors T1, T2 etc are used.  A,B,C might be more types,
-and importing them may mean reading more interfaces, and so on.
- So the idea is that the renamer will just import the decl 
-       data T
-unless one of the constructors is used.  This turns out to be quite
-easy to implement.  The downside is that we must make sure the
-constructors are always available if they are really needed, so
-I regard this as an experimental feature.
-
-
-Elimininate ThinAir names
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Eliminate ThinAir.lhs and all its works.  It was always a hack, and now
-the desugarer carries around an environment I think we can nuke ThinAir 
-altogether.
-
-As part of this, I had to move all the Prelude RdrName defns from PrelInfo
-to PrelMods --- so I renamed PrelMods as PrelNames.
-
-I also had to move the builtinRules so that they are injected by the renamer
-(rather than appearing out of the blue in SimplCore).  This is if anything simpler.
-
-Miscellaneous
-~~~~~~~~~~~~~
-* Tidy up the data types involved in Rules
-
-* Eliminate RnEnv.better_provenance; use Name.hasBetterProv instead
-
-* Add Unique.hasKey :: Uniquable a => a -> Unique -> Bool
-  It's useful in a lot of places
-
-* Fix a bug in interface file parsing for __U[!]
-
-
-=======================================
-To-do
-~~~~~
-* Try the effect of enhancing update in place with the CPR 
-  idea in CoreUnfold.calcUnfoldingGuidance
-
-* Check with Simon M re srt on Lit
-
-* Make all primops return a data type so that we can't over-apply a primop
-  This makes code gen simpler. Currently the only primops with a polymorphic
-  return type are:
-       raise# :: a -> b
-       catch# :: a -> (b->a) -> a
-       tagToEnum# :: Int -> a
-
-  Very strange code for PrelException.catchException!  What has STret got
-  to do with it?
-
-* Liberate case
-
-* Missing w/w for coerce in go2 functions of fibToList' in fibheaps
-
-* Watch out for re-boxing in workers; sometimes it happens
-  and then w/w is a Bad Thing
-
-* Only two uses of mkCompulsoryUnfolding -- try to nuke it
-
-* Note that mkDupAlt makes alts that have binders that
-  are guaranteed to appear just once or not at all
-       (a,b) -> j a
-  Same for case binder, but that's harder to take into account.
-
-* max :: Int -> Int -> Int could be CPRd but isn't.
-
-* In mandel2 we do a little less well than 4.04 because we aren't 
-  inlining point_colour, and that means we have to box up an argument
-  before calling it.  [This was due to a bug in 4.04]
-  There's also a great opportunity for liberateCase
-  in check_radius, where it loops around with two lazy F# built each time
-
-* In PrelShow.itos' we find a thunk like:
-         tpl = case chrzh {(zpzh {(remIntzh {x{-aMf-} 10}) 48})}
-               of tpl{-X1j-} __D P { __DEFAULT ->
-                     PrelBase.Czh{-62,s-} {tpl{-X1j-}}
-               }
-  This is a pity.  The remInt# can't fail because the divisor isn't 0,
-  so we could do the sum eagerly and allocate a charcter instead of a thunk.
-
-* It's good to do let-to-case before we wrap up.  Consider
-  f b xs = let ys = partition isUpper xs
-              zs = case ys of (a,b) -> a
-           in case b of
-               True -> case ys of
-                         (a,b) -> (zs,[])
-               False -> case ys of
-                         (a,b) -> (zs ++ xs,[])
-  If we don't do let-to-case at all, we get 3 redundant case ys left.
-  On the other hand we don't want to do it too early, because it
-  prevents inlining into strict arg positions, which is important for 
-  rules to work.
-
-* Strict dictionaries.  
-
-* INLINE functions are not always INLINEd, so it's sad to leave
-  stuff in their bodies like constructors that havn't been inlined.
-
-* If let x = e in b is strict, then CPR can use the CPR info from x
-  This bites in the mod method of Integral Int
-
-* Inline wrappers if they are the RHS of a let, so that update in place
-  can happen?
-
-* Consider doing unboxing on strict constr args in a pattern match,
-  as part of w/w.  
-
-* In spectral/expert/Search.ask there's a statically visible CSE. Catching this 
-  depends almost entirely on chance, which is a pity.
-
-* Think about exprEtaExpandArity in WwLib.  Perhaps eliminate eta expand in simplify?
-  Perhaps use even if no coerces etc, just eta expansion. (e.g. PrelArr.done)
-
-* In knights/KnightHeuristic, we don't find that possibleMoves is strict
-  (with important knock-on effects) unless we apply rules before floating
-  out the literal list [A,B,C...].
-  Similarly, in f_se (F_Cmp ...) in listcompr (but a smaller effect)
-
-* Floating can float the entire body of an INLINE thing out.
-  e.g. PrelArr.done 
-  This is sad, and a bit stupid.
-
-* In spectral/multiplier, we have 
-    xor = lift21 forceBit f
-      where f :: Bit -> Bit -> Bit
-           f 0 0 = 0
-           f 0 1 = 1
-           f 1 0 = 1
-           f 1 1 = 0
-  Trouble is, f is CPR'd, and that means that instead of returning
-  the constants I# 0, I# 1, it returns 0,1 and then boxes them.
-  So allocation goes up.  I don't see a way around this.
-
-* spectral/hartel/parstof ends up saying
-       case (unpackCString "x") of { c:cs -> ... }
-  quite a bit.   We should spot these and behave accordingly.
-
-* Try a different hashing algorithms in hashUFM.  This might reduce long CSE lists
-  as well as making uniqAway faster.
-
-* [I'm not sure this is really important in the end.]
-  Don't float out partial applications in lvlMFE.  E.g. (in hPutStr defn of shoveString)
-       \x -> case .. of 
-               [] -> setBufWPtr a b
-               ...
-  setBufWPtr has arity 3.  Floating it out is plain silly.  And in this particular
-  case it's harmful, because it ends up preventing eta expansion on the \x.
-  That in turn leads to a big extra cost in hPutStr.
-
-  *** Try not doing lvlMFE on the body of a lambda and case alternative ***
-
-* PrelNumExtra.lhs we get three copies of dropTrailing0s.  Too much inlining!
-  drop0 has cost 21, but gets a discount of 6 (3 * #constrs) for its arg.
-  With a keen-neess factor of 2, that makes a discount of 12.  Add two for
-  the arguments and we get 21-12-2, which is just small enough to inline.
-  But that is plainly stupid.
-
-  Add one for cases; and decrease discount for constructors.
-
-* IO.hGetContents still doesn't see that it is strict in the handle.
-  Coerces still getting in the way.
-
-* Try not having really_interesting_cont (subsumed by changes in the 
-       way guidance is calculated for inline things?)
-
-* Enumeration types in worker/wrapper for strictness analysis
-
-* This should be reported as an error:
-       data T k = MkT (k Int#)
-
-* Bogus report of overlapped pattern for
-       f (R {field = [c]}) = 1
-       f (R {})              = 2
-  This shows up for TyCon.tyConSingleDataCon_maybe
-
-*  > module Main( main ) where
-
-   > f :: String -> Int
-   > f "=<" = 0
-   > f "="  = 0
-   
-   > g :: [Char] -> Int
-   > g ['=','<'] = 0
-   > g ['=']     = 0
-   
-   > main = return ()
-   
-   For ``f'' the following is reported.
-   
-   tmp.lhs:4: 
-    Pattern match(es) are overlapped in the definition of function `f'
-            "=" = ...
-
-   There are no complaints for definition for ``g''.
-
-* Without -O I don't think we need change the module version
-  if the usages change; I forget why it changes even with -O
-
-* Record selectors for existential type; no good!  What to do?
-  Record update doesn't make sense either.
-
-  Need to be careful when figuring out strictness, and when generating
-  worker-wrapper split.
-
-  Also when deriving.
-
-
-               Jan 2000
-               ~~~~~~~~ 
-
-A fairly big pile of work originally aimed at
-removing the Con form of Core expression, and replacing it with simple
-Lit form.  However, I wanted to make sure that the resulting thing
-performed better than the original, so I ended up making an absolute
-raft of other changes.
-
-Removing the Con form of Core expressions
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The big thing is that
-
-  For every constructor C there are now *two* Ids:
-
-       C is the constructor's *wrapper*. It evaluates and unboxes arguments
-       before calling $wC.  It has a perfectly ordinary top-level defn 
-       in the module defining the data type.
-
-       $wC is the constructor's *worker*.  It is like a primop that simply
-       allocates and builds the constructor value.  Its arguments are the
-       actual representation arguments of the constructor.
-
-  For every primop P there is *one* Id, its (curried) Id
-
-  Neither contructor worker Id nor the primop Id have a defminition anywhere.
-  Instead they are saturated during the core-to-STG pass, and the code generator
-  generates code for them directly. The STG language still has saturated 
-  primops and constructor applications.
-
-* The Const type disappears, along with Const.lhs.  The literal part
-  of Const.lhs reappears as Literal.lhs.  Much tidying up in here,
-  to bring all the range checking into this one module.
-
-* I got rid of NoRep literals entirely.  They just seem to be too much trouble.
-
-* Because Con's don't exist any more, the funny C { args } syntax
-  disappears from inteface files.
-
-* Every constructor, C, comes with a 
-
-  *wrapper*, called C, whose type is exactly what it looks like
-       in the source program. It is an ordinary function,
-       and it gets a top-level binding like any other function
-
-  *worker*, called $wC, which is the actual data constructor.
-       Its type may be different to C, because:
-               - useless dict args are dropped
-               - strict args may be flattened
-       It does not have a binding.
-
-  The worker is very like a primop, in that it has no binding,
-
-
-Parsing
-~~~~~~~
-* Result type signatures now work
-       f :: Int -> Int = \x -> x
-       -- The Int->Int is the type of f
-
-       g x y :: Int = x+y      
-       -- The Int is the type of the result of (g x y)
-
-
-Recompilation checking and make
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* The .hi file for a modules is not touched if it doesn't change.  (It used to
-  be touched regardless, forcing a chain of recompilations.)  The penalty for this
-  is that we record exported things just as if they were mentioned in the body of
-  the module.  And the penalty for that is that we may recompile a module when
-  the only things that have changed are the things it is passing on without using.
-  But it seems like a good trade.
-
-* -recomp is on by default
-
-Foreign declarations
-~~~~~~~~~~~~~~~~~~~~
-* If you say
-       foreign export zoo :: Int -> IO Int
-  then you get a C produre called 'zoo', not 'zzoo' as before.
-  I've also added a check that complains if you export (or import) a C
-  procedure whose name isn't legal C.
-
-
-Code generation and labels
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-* Now that constructor workers and wrappers have distinct names, there's
-  no need to have a Foo_static_closure and a Foo_closure for constructor Foo.
-  I nuked the entire StaticClosure story.  This has effects in some of
-  the RTS headers (i.e. s/static_closure/closure/g)
-
-
-Rules, constant folding
-~~~~~~~~~~~~~~~~~~~~~~~
-* Constant folding becomes just another rewrite rule, attached to the Id for the
-  PrimOp.   To achieve this, there's a new form of Rule, a BuiltinRule (see CoreSyn.lhs).
-  The prelude rules are in prelude/PrelRules.lhs, while simplCore/ConFold.lhs has gone.
-
-* Appending of constant strings now works, using fold/build fusion, plus
-  the rewrite rule
-       unpack "foo" c (unpack "baz" c n)  =  unpack "foobaz" c n
-  Implemented in PrelRules.lhs
-
-* The CCall primop is tidied up quite a bit.  There is now a data type CCall,
-  defined in PrimOp, that packages up the info needed for a particular CCall.
-  There is a new Id for each new ccall, with an big "occurrence name"
-       {__ccall "foo" gc Int# -> Int#}
-  In interface files, this is parsed as a single Id, which is what it is, really.
-
-Miscellaneous
-~~~~~~~~~~~~~
-* There were numerous places where the host compiler's 
-  minInt/maxInt was being used as the target machine's minInt/maxInt.
-  I nuked all of these; everything is localised to inIntRange and inWordRange,
-  in Literal.lhs
-
-* Desugaring record updates was broken: it didn't generate correct matches when
-  used withe records with fancy unboxing etc.  It now uses matchWrapper.
-
-* Significant tidying up in codeGen/SMRep.lhs
-
-* Add __word, __word64, __int64 terminals to signal the obvious types 
-  in interface files.  Add the ability to print word values in hex into 
-  C code.
-
-* PrimOp.lhs is no longer part of a loop.  Remove PrimOp.hi-boot*
-
-
-Types
-~~~~~
-* isProductTyCon no longer returns False for recursive products, nor
-  for unboxed products; you have to test for these separately.  
-  There's no reason not to do CPR for recursive product types, for example.
-  Ditto splitProductType_maybe.
-
-Simplification
-~~~~~~~~~~~~~~~
-* New -fno-case-of-case flag for the simplifier.  We use this in the first run
-  of the simplifier, where it helps to stop messing up expressions that 
-  the (subsequent) full laziness pass would otherwise find float out.
-  It's much more effective than previous half-baked hacks in inlining.
-
-  Actually, it turned out that there were three places in Simplify.lhs that
-  needed to know use this flag.
-
-* Make the float-in pass push duplicatable bindings into the branches of
-  a case expression, in the hope that we never have to allocate them.
-  (see FloatIn.sepBindsByDropPoint)
-
-* Arrange that top-level bottoming Ids get a NOINLINE pragma
-  This reduced gratuitous inlining of error messages.
-  But arrange that such things still get w/w'd.
-
-* Arrange that a strict argument position is regarded as an 'interesting'
-  context, so that if we see 
-       foldr k z (g x)
-  then we'll be inclined to inline g; this can expose a build.
-
-* There was a missing case in CoreUtils.exprEtaExpandArity that meant
-  we were missing some obvious cases for eta expansion
-  Also improve the code when handling applications.
-
-* Make record selectors (identifiable by their IdFlavour) into "cheap" operations.
-         [The change is a 2-liner in CoreUtils.exprIsCheap]
-  This means that record selection may be inlined into function bodies, which
-  greatly improves the arities of overloaded functions.
-
-* Make a cleaner job of inlining "lone variables".  There was some distributed
-  cunning, but I've centralised it all now in SimplUtils.analyseCont, which
-  analyses the context of a call to decide whether it is "interesting".
-
-* Don't specialise very small functions in Specialise.specDefn
-  It's better to inline it.  Rather like the worker/wrapper case.
-
-* Be just a little more aggressive when floating out of let rhss.
-  See comments with Simplify.wantToExpose
-  A small change with an occasional big effect.
-
-* Make the inline-size computation think that 
-       case x of I# x -> ...
-  is *free*.  
-
-
-CPR analysis
-~~~~~~~~~~~~
-* Fix what was essentially a bug in CPR analysis.  Consider
-
-       letrec f x = let g y = let ... in f e1
-                    in
-                    if ... then (a,b) else g x
-
-  g has the CPR property if f does; so when generating the final annotated
-  RHS for f, we must use an envt in which f is bound to its final abstract
-  value.  This wasn't happening.  Instead, f was given the CPR tag but g
-  wasn't; but of course the w/w pass gives rotten results in that case!!
-  (Because f's CPR-ness relied on g's.)
-
-  On they way I tidied up the code in CprAnalyse.  It's quite a bit shorter.
-
-  The fact that some data constructors return a constructed product shows
-  up in their CPR info (MkId.mkDataConId) not in CprAnalyse.lhs
-
-
-
-Strictness analysis and worker/wrapper
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* BIG THING: pass in the demand to StrictAnal.saExpr.  This affects situations
-  like
-       f (let x = e1 in (x,x))
-  where f turns out to have strictness u(SS), say.  In this case we can
-  mark x as demanded, and use a case expression for it.
-
-  The situation before is that we didn't "know" that there is the u(SS) 
-  demand on the argument, so we simply computed that the body of the let 
-  expression is lazy in x, and marked x as lazily-demanded.  Then even after
-  f was w/w'd we got
-
-       let x = e1 in case (x,x) of (a,b) -> $wf a b
-
-  and hence
-
-       let x = e1 in $wf a b
-
-  I found a much more complicated situation in spectral/sphere/Main.shade,
-  which improved quite a bit with this change.
-* Moved the StrictnessInfo type from IdInfo to Demand.  It's the logical
-  place for it, and helps avoid module loops
-
-* Do worker/wrapper for coerces even if the arity is zero.  Thus:
-       stdout = coerce Handle (..blurg..)
-  ==>
-       wibble = (...blurg...)
-       stdout = coerce Handle wibble
-  This is good because I found places where we were saying 
-       case coerce t stdout of { MVar a ->
-       ...
-       case coerce t stdout of { MVar b -> 
-       ...
-  and the redundant case wasn't getting eliminated because of the coerce.
-
-
-
-End December
-~~~~~~~~~~~~
-* Fix a few renamer bugs
-
-* Substantially reorganise the Prelude to eliminate all orphan declarations.
-  Details in PrelBase.lhs
-
-* Do a much better job of appending literal strings
-   - remove NoRepStr
-   - move unpackCString stuff to PrelBase
-   - add BuiltinRules to the Rule type
-   - add fold/build rules for literal strings
-
-  
-
-Week of Mon 25 Oct
-~~~~~~~~~~~~~~~~~~
-* Fix a terrible bug in Simplify.mkDupableAlt; we were duplicating a small
-  *InAlt*, but doing so invalidated occurrence info, which could lead to
-  substantial code duplication.
-
-* Fix a bug in WwLib.mkWWcpr; I was generating CPR wrappers like
-       I# (case x of ...)
-  which is utterly wrong.  It should be 
-       case x of ...(I# r)
-  (The effect was to make functions stricter than they really are.)
-
-* Try doing no inlining at all in phase 0.  This noticeably improved
-  spectral/fish (esp Main.hs I think), by improving floating.
-  This single change has quite a large effect on some programs (allocation)
-
-                       Don't inline      Don't inline
-                       wrappers          anything  
-                       in phase 0        in phase 0
-         awards                 113k          -7.08%
-       cichelli               28962k          -3.12%
-      wave4main               88089k        +130.45%
-       fibheaps               31731k         +19.01%
-           fish                8273k          -1.64%
-      typecheck              148713k          +4.91%
-
-  But I found that fish worked much better if we inline *local* things
-  in phase 0, but not *imported* things.  
-
-* Fix a terrible bug in Simplify.mkLamBndrZapper.  It was counting
-  type args in one place, but not type binders, so it was sometimes
-  inlining into unsaturated lambdas!
-
-* I found that there were some very bad loss-of-arity cases in PrelShow.  
-  In particular, we had:
-
-       showl ""       = showChar '"' s
-       showl ('"':xs) = showString "\\\"" . showl xs
-       showl (x:xs)   = showLitChar x . showl xs
-
-  Trouble is, we get
-       showl = \xs -> case xs of
-                         ...
-                         (x:xs) -> let f = showLitChar x
-                                       g = showl xs
-                                   in \s -> f (g x)
-  which is TERRIBLE.  We can't spot that showLitChar has arity 2 because
-  it looks like this:
-
-       ...other eqns...
-        showLitChar c = showString ('\\' : asciiTab!!ord c)
-
-  notice that the (asciiTab!!orc c) is outside the \s, so GHC can't rewrite it to
-
-       showLitChar c =  \s -> showString ('\\' : asciiTab!!ord c) s
-
-  So I've changed PrelShow.showLitChar to use explicit \s.  Even then, showl
-  doesn't work, because GHC can't see that showl xs can be pushed inside the \s.
-  So I've put an explict \s there too.  
-
-       showl ""       s = showChar '"' s
-       showl ('"':xs) s = showString "\\\"" (showl xs s)
-       showl (x:xs)   s = showLitChar x (showl xs s)
-
-  Net result: imaginary/gen_regexps more than halves in allocation!
-
-  Turns out that the mkLamBndrZapper bug (above) meant that showl was
-  erroneously inlining showLitChar x and showl xs, which is why this
-  problem hasn't shown up before.
-  
-* Improve CSE a bit.  In ptic
-       case h x of y -> ...(h x)...
-  replaces (h x) by y.
-
-* Inline INLINE things very agressively, even though we get code duplication 
-  thereby.  Reason: otherwise we sometimes call the original un-inlined INLINE
-  defns, which have constructors etc still un-inlined in their RHSs.  The 
-  improvement is dramatic for a few programs:
-
-      typecheck              150865k          -1.43%
-      wave4main              114216k         -22.87%
-          boyer               28793k          -7.86%
-       cichelli               33786k         -14.28%
-            ida               59505k          -1.79%
-        rewrite               14665k          -4.91%
-          sched               17641k          -4.22%
-
-  Code size increases by 10% which is not so good.  There must be a better way.
-  Another bad thing showed up in fish/Main.hs.  Here we have
-       (x1,y1) `vec_add` (x2,y2) = (x1+x2, y1+y2)
-  which tends to get inlined.  But if we first inline (+), it looks big,
-  so we don't inline it.  Sigh.
-
-
-* Don't inline constructors in INLINE RHSs.  Ever.  Otherwise rules don't match.
-  E.g. build
-
-* In ebnf2ps/Lexer.uncommentString, it would be a good idea to inline a constructor
-  that occurs once in each branch of a case.  That way it doesn't get allocated
-  in the branches that don't use it.  And in fact in this particular case
-  something else good happens.  So CoreUnfold now does that.
-
-* Reverted to n_val_binders+2 in calcUnfoldingGuidance
-  Otherwise wrappers are inlined even if there's no benefit.
-
-
-Week of Mon 18 Oct
-~~~~~~~~~~
-* Arrange that simplConArgs works in one less pass than before.
-  This exposed a bug: a bogus call to completeBeta.
-
-* Add a top-level flag in CoreUnfolding, used in callSiteInline
-
-* Extend w/w to use etaExpandArity, so it does eta/coerce expansion
-
-* Don't float anything out of an INLINE.
-  Don't float things to top level unless they also escape a value lambda.
-       [see comments with SetLevels.lvlMFE
-  Without at least one of these changes, I found that 
-       {-# INLINE concat #-}
-       concat = __inline (/\a -> foldr (++) [])
-  was getting floated to
-       concat = __inline( /\a -> lvl a )
-       lvl = ...inlined version of foldr...
-
-  Subsequently I found that not floating constants out of an INLINE
-  gave really bad code like
-       __inline (let x = e in \y -> ...)
-  so I now let things float out of INLINE
-
-* Implement inline phases.   The meaning of the inline pragmas is
-  described in CoreUnfold.lhs
-
-* Implement the "reverse-mapping" idea for CSE; actually it turned out to be easier
-  to implement it in SetLevels, and may benefit full laziness too.
-
-Thurs 14 Oct
-~~~~~~~~~~~~
-* It's a good idea to inline inRange. Consider
-
-       index (l,h) i = case inRange (l,h) i of
-                         True ->  l+i
-                         False -> error 
-  inRange itself isn't strict in h, but if it't inlined then 'index'
-  *does* become strict in h.  Interesting!
-
-* Big change to the way unfoldings and occurrence info is propagated in the simplifier
-  The plan is described in Subst.lhs with the Subst type
-  Occurrence info is now in a separate IdInfo field than user pragmas
-
-* I found that
-       (coerce T (coerce S (\x.e))) y
-  didn't simplify in one round. First we get to
-       (\x.e) y
-  and only then do the beta. Solution: cancel the coerces in the continuation
-
-* Amazingly, CoreUnfold wasn't counting the cost of a function an application.
-
-Early Oct
-~~~~~~~~~
-* No commas between for-alls in RULES
-
-* Disable rules in initial simplifier run.  Otherwise full laziness
-  doesn't get a chance to lift out a MFE before a rule (e.g. fusion)
-  zaps it.  queens is a case in point
-
-* Improve float-out stuff significantly.  The big change is that if we have
-
-       \x -> ... /\a -> ...let p = ..a.. in let q = ...p...
-
-  where p's rhs doesn't x, we abstract a from p, so that we can get p past x.
-  (We did that before.)  But we also substitute (p a) for p in q, and then
-  we can do the same thing for q.  (We didn't do that, so q got stuck.)
-  This is much better.  It involves doing a substitution "as we go" in SetLevels,
-  though.
-
-
-Weds 15 Sept
-~~~~~~~~~~~~
-* exprIsDupable for an application (f e1 .. en) wasn't calling exprIsDupable
-  on the arguments!!  So applications with few, but large, args were being dupliated.
-
-* sizeExpr on an application wasn't doing a nukeScrutDiscount on the arg of
-  an application!!  So bogus discounts could accumulate from arguments!
-
-* Improve handling of INLINE pragmas in calcUnfoldingGuidance.  It was really
-  wrong before
-
-* Substantially improve handling of coerces in worker/wrapper
-
-Tuesday 6 June
-~~~~~~~~~~~~~~
-* Fix Kevin Atkinson's cant-find-instance bug.  Turns out that Rename.slurpSourceRefs
-  needs to repeatedly call getImportedInstDecls, and then go back to slurping
-  source-refs.  Comments with Rename.slurpSourceRefs.
-
-* Add a case to Simplify.mkDupableAlt for the quite-common case where there's
-  a very simple alternative, in which case there's no point in creating a 
-  join-point binding.
-
-* Fix CoreUtils.exprOkForSpeculation so that it returns True of (==# a# b#).
-  This lack meant that 
-       case ==# a# b# of { True -> x; False -> x }
-  was not simplifying
-
-* Make float-out dump bindings at the top of a function argument, as
-  at the top of a let(rec) rhs.  See notes with FloatOut.floatRhs
-
-* Make the ArgOf case of mkDupableAlt generate a OneShot lambda.
-  This gave a noticeable boost to spectral/boyer2
-
-
-Monday 5 June
-~~~~~~~~~~~~~
-Work, using IO.hPutStr as an example, to reduce the number of coerces.
-The main idea is in WwLib.mkWWcoerce.  The gloss is that we must do
-the w/w split even for small non-recursive things.  See notes with
-WorkWrap.tryWw.
-
-
-Friday 2 June
-~~~~~~~~~~~~~
-Study why gen_regexps is slower than before.  Problem is in IO.writeLines,
-in particular the local defn shoveString.  Two things are getting
-in the way of arity expansion, which means we build far more function
-closures than we should:
-       shove = \ x -> let lvl = \s -> ...
-                      in \s -> ... lvl ...
-
-The two things are:
-       a) coerces
-       b) full laziness floats
-
-
-Solution to (a): add coerces to the worker/wrapper stuff.
-See notes with WwLib.mkWWcoerce.
-
-This further complicated getWorkerId, so I finally bit the bullet and
-make the workerInfo field of the IdInfo work properly, including
-under substitutions.  Death to getWorkerId.
-
-
-
-Solution to (b): make all lambdas over realWorldStatePrimTy
-into one-shot lambdas.  This is a GROSS HACK.
-
-* Also make the occurrence analyser aware of one-shot lambdas.
-
-
-Thurs 1 June
-~~~~~~~~~~~~
-Fix SetLevels so that it does not clone top-level bindings, but it
-*does* clone bindings that are destined for the top level.
-
-The global invariant is that the top level bindings are always
-unique, and never cloned.
diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs
new file mode 100644 (file)
index 0000000..758a104
--- /dev/null
@@ -0,0 +1,114 @@
+--
+-- (c) The University of Glasgow
+--
+
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
+module Avail (
+    Avails,
+    AvailInfo(..),
+    availsToNameSet,
+    availsToNameEnv,
+    availName, availNames,
+    stableAvailCmp,
+    gresFromAvails,
+    gresFromAvail
+  ) where
+
+import Name
+import NameEnv
+import NameSet
+import RdrName
+
+import Outputable
+import Util
+
+-- -----------------------------------------------------------------------------
+-- The AvailInfo type
+
+-- | Records what things are "available", i.e. in scope
+data AvailInfo = Avail Name     -- ^ An ordinary identifier in scope
+              | AvailTC Name
+                        [Name]  -- ^ A type or class in scope. Parameters:
+                                --
+                                --  1) The name of the type or class
+                                --  2) The available pieces of type or class.
+                                -- 
+                                -- The AvailTC Invariant:
+                                 --   * If the type or class is itself
+                                --     to be in scope, it must be
+                                --     *first* in this list.  Thus,
+                                 --     typically: @AvailTC Eq [Eq, ==, \/=]@
+               deriving( Eq )
+                        -- Equality used when deciding if the
+                        -- interface has changed
+
+-- | A collection of 'AvailInfo' - several things that are \"available\"
+type Avails      = [AvailInfo]
+
+-- | Compare lexicographically
+stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
+stableAvailCmp (Avail n1)     (Avail n2)     = n1 `stableNameCmp` n2
+stableAvailCmp (Avail {})     (AvailTC {})   = LT
+stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
+                                               (cmpList stableNameCmp ns ms)
+stableAvailCmp (AvailTC {})   (Avail {})     = GT
+
+
+-- -----------------------------------------------------------------------------
+-- Operations on AvailInfo
+
+availsToNameSet :: [AvailInfo] -> NameSet
+availsToNameSet avails = foldr add emptyNameSet avails
+      where add avail set = addListToNameSet set (availNames avail)
+
+availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
+availsToNameEnv avails = foldr add emptyNameEnv avails
+     where add avail env = extendNameEnvList env
+                                (zip (availNames avail) (repeat avail))
+
+-- | Just the main name made available, i.e. not the available pieces
+-- of type or class brought into scope by the 'GenAvailInfo'
+availName :: AvailInfo -> Name
+availName (Avail n)     = n
+availName (AvailTC n _) = n
+
+-- | All names made available by the availability information
+availNames :: AvailInfo -> [Name]
+availNames (Avail n)      = [n]
+availNames (AvailTC _ ns) = ns
+
+-- | make a 'GlobalRdrEnv' where all the elements point to the same
+-- Provenance (useful for "hiding" imports, or imports with
+-- no details).
+gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
+gresFromAvails prov avails
+  = concatMap (gresFromAvail (const prov)) avails
+
+gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
+gresFromAvail prov_fn avail
+  = [ GRE {gre_name = n,
+           gre_par = parent n avail,
+           gre_prov = prov_fn n}
+    | n <- availNames avail ]
+  where
+    parent _ (Avail _)                 = NoParent
+    parent n (AvailTC m _) | n == m    = NoParent
+                           | otherwise = ParentIs m
+
+-- -----------------------------------------------------------------------------
+-- Printing
+
+instance Outputable AvailInfo where
+   ppr = pprAvail
+
+pprAvail :: AvailInfo -> SDoc
+pprAvail (Avail n)      = ppr n
+pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
+
+
index 5c931d9..c6226ca 100644 (file)
@@ -16,10 +16,19 @@ types that
 \begin{code}
 {-# LANGUAGE DeriveDataTypeable #-}
 
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module BasicTypes(
        Version, bumpVersion, initialVersion,
 
-       Arity, 
+       Arity,
+       
+       Alignment,
 
         FunctionOrData(..),
        
@@ -42,11 +51,12 @@ module BasicTypes(
 
        Boxity(..), isBoxed, 
 
-       TupCon(..), tupleParens,
+        TupleSort(..), tupleSortBoxity, boxityNormalTupleSort,
+        tupleParens,
 
        OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc, 
-       isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
-        nonRuleLoopBreaker,
+       isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isNoOcc,
+        strongLoopBreaker, weakLoopBreaker, 
 
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
@@ -96,6 +106,16 @@ type Arity = Int
 
 %************************************************************************
 %*                                                                     *
+\subsection[Alignment]{Alignment}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection[FunctionOrData]{FunctionOrData}
 %*                                                                     *
 %************************************************************************
@@ -156,9 +176,10 @@ early in the hierarchy), but also in HsSyn.
 
 \begin{code}
 newtype IPName name = IPName name      -- ?x
-  deriving( Eq, Ord, Data, Typeable )
-  -- Ord is used in the IP name cache finite map
-  -- (used in HscTypes.OrigIParamCache)
+  deriving( Eq, Data, Typeable )
+
+instance Functor IPName where
+    fmap = mapIPName
 
 ipNameName :: IPName name -> name
 ipNameName (IPName n) = n
@@ -272,7 +293,7 @@ instance Outputable TopLevelFlag where
 
 %************************************************************************
 %*                                                                     *
-               Top-level/not-top level flag
+               Boxity flag
 %*                                                                     *
 %************************************************************************
 
@@ -351,7 +372,7 @@ data OverlapFlag
   -- instantiating 'b' would change which instance 
   -- was chosen
   | Incoherent { isSafeOverlap :: Bool }
-  deriving( Eq )
+  deriving (Eq, Data, Typeable)
 
 instance Outputable OverlapFlag where
    ppr (NoOverlap  b) = empty <+> pprSafeOverlap b
@@ -370,14 +391,26 @@ pprSafeOverlap False = empty
 %************************************************************************
 
 \begin{code}
-data TupCon = TupCon Boxity Arity
-
-instance Eq TupCon where
-  (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
-   
-tupleParens :: Boxity -> SDoc -> SDoc
-tupleParens Boxed   p = parens p
-tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
+data TupleSort
+  = BoxedTuple
+  | UnboxedTuple
+  | ConstraintTuple
+  deriving( Eq, Data, Typeable )
+
+tupleSortBoxity :: TupleSort -> Boxity
+tupleSortBoxity BoxedTuple     = Boxed
+tupleSortBoxity UnboxedTuple   = Unboxed
+tupleSortBoxity ConstraintTuple = Boxed
+
+boxityNormalTupleSort :: Boxity -> TupleSort
+boxityNormalTupleSort Boxed   = BoxedTuple
+boxityNormalTupleSort Unboxed = UnboxedTuple
+
+tupleParens :: TupleSort -> SDoc -> SDoc
+tupleParens BoxedTuple      p = parens p
+tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples 
+                                         -- directly, we overload the (,,) syntax
+tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 \end{code}
 
 %************************************************************************
@@ -444,24 +477,20 @@ data OccInfo
   -- | This identifier breaks a loop of mutually recursive functions. The field
   -- marks whether it is only a loop breaker due to a reference in a rule
   | IAmALoopBreaker    -- Note [LoopBreaker OccInfo]
-       !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
-                       --          See OccurAnal Note [Weak loop breakers]
+       !RulesOnly
 
 type RulesOnly = Bool
 \end{code}
 
 Note [LoopBreaker OccInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
-An OccInfo of (IAmLoopBreaker False) is used by the occurrence 
-analyser in two ways:
-  (a) to mark loop-breakers in a group of recursive 
-      definitions (hence the name)
-  (b) to mark binders that must not be inlined in this phase
-      (perhaps it has a NOINLINE pragma)
-Things with (IAmLoopBreaker False) do not get an unfolding 
-pinned on to them, so they are completely opaque.
+   IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
+                            Do not preInlineUnconditionally
+
+   IAmALoopBreaker False <=> A "strong" loop breaker
+                             Do not inline at all
 
-See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
+See OccurAnal Note [Weak loop breakers]
 
 
 \begin{code}
@@ -492,16 +521,17 @@ oneBranch, notOneBranch :: OneBranch
 oneBranch    = True
 notOneBranch = False
 
-isLoopBreaker :: OccInfo -> Bool
-isLoopBreaker (IAmALoopBreaker _) = True
-isLoopBreaker _                   = False
+strongLoopBreaker, weakLoopBreaker :: OccInfo
+strongLoopBreaker = IAmALoopBreaker False
+weakLoopBreaker   = IAmALoopBreaker True
 
-isNonRuleLoopBreaker :: OccInfo -> Bool
-isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
-isNonRuleLoopBreaker _                       = False
+isWeakLoopBreaker :: OccInfo -> Bool
+isWeakLoopBreaker (IAmALoopBreaker _) = True
+isWeakLoopBreaker _                   = False
 
-nonRuleLoopBreaker :: OccInfo
-nonRuleLoopBreaker = IAmALoopBreaker False
+isStrongLoopBreaker :: OccInfo -> Bool
+isStrongLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
+isStrongLoopBreaker _                       = False
 
 isDeadOcc :: OccInfo -> Bool
 isDeadOcc IAmDead = True
@@ -558,6 +588,7 @@ data HsBang = HsNoBang
            | HsUnpackFailed   -- An UNPACK pragma that we could not make 
                               -- use of, because the type isn't unboxable; 
                                -- equivalant to HsStrict except for checkValidDataCon
+            | HsNoUnpack       -- {-# NOUNPACK #-} ! (GHC extension, meaning "strict but not unboxed")
   deriving (Eq, Data, Typeable)
 
 instance Outputable HsBang where
@@ -565,6 +596,7 @@ instance Outputable HsBang where
     ppr HsStrict       = char '!'
     ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
     ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
+    ppr HsNoUnpack     = ptext (sLit "{-# NOUNPACK #-} !")
 
 isBanged :: HsBang -> Bool
 isBanged HsNoBang = False
index 312ae94..c2cf0bf 100644 (file)
@@ -5,6 +5,13 @@
 \section[DataCon]{@DataCon@: Data Constructors}
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module DataCon (
         -- * Main data types
        DataCon, DataConIds(..),
@@ -47,15 +54,16 @@ import TyCon
 import Class
 import Name
 import Var
-import BasicTypes
 import Outputable
 import Unique
 import ListSetOps
 import Util
+import BasicTypes
 import FastString
 import Module
 
 import qualified Data.Data as Data
+import qualified Data.Typeable
 import Data.Char
 import Data.Word
 \end{code}
@@ -374,6 +382,7 @@ data DataCon
                                -- Used for Template Haskell and 'deriving' only
                                -- The actual fixity is stored elsewhere
   }
+  deriving Data.Typeable.Typeable
 
 -- | Contains the Ids of the data constructor functions
 data DataConIds
@@ -456,9 +465,6 @@ instance Outputable DataCon where
 instance Show DataCon where
     showsPrec p con = showsPrecSDoc p (ppr con)
 
-instance Data.Typeable DataCon where
-    typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
-
 instance Data.Data DataCon where
     -- don't traverse?
     toConstr _   = abstractConstr "DataCon"
@@ -536,8 +542,8 @@ mkDataCon name declared_infix
        -- source-language arguments.  We add extra ones for the
        -- dictionary arguments right here.
     full_theta   = eqSpecPreds eq_spec ++ theta
-    real_arg_tys = mkPredTys full_theta               ++ orig_arg_tys
-    real_stricts = map mk_dict_strict_mark full_theta ++ arg_stricts
+    real_arg_tys = full_theta                         ++ orig_arg_tys
+    real_stricts = map mk_pred_strict_mark full_theta ++ arg_stricts
 
        -- Representation arguments and demands
        -- To do: eliminate duplication with MkId
@@ -551,11 +557,21 @@ mkDataCon name declared_infix
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 
-mk_dict_strict_mark :: PredType -> HsBang
-mk_dict_strict_mark pred | isStrictPred pred = HsStrict
-                        | otherwise         = HsNoBang
+mk_pred_strict_mark :: PredType -> HsBang
+mk_pred_strict_mark pred 
+  | isEqPred pred = HsUnpack   -- Note [Unpack equality predicates]
+  | otherwise     = HsNoBang
 \end{code}
 
+Note [Unpack equality predicates]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have a GADT with a contructor C :: (a~[b]) => b -> T a
+we definitely want that equality predicate *unboxed* so that it
+takes no space at all.  This is easily done: just give it
+an UNPACK pragma. The rest of the unpack/repack code does the
+heavy lifting.  This one line makes every GADT take a word less
+space for each equality predicate, so it's pretty important!
+
 \begin{code}
 -- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
 dataConName :: DataCon -> Name
@@ -659,7 +675,7 @@ dataConStrictMarks = dcStrictMarks
 -- | Strictness of evidence arguments to the wrapper function
 dataConExStricts :: DataCon -> [HsBang]
 -- Usually empty, so we don't bother to cache this
-dataConExStricts dc = map mk_dict_strict_mark $ (dataConTheta dc)
+dataConExStricts dc = map mk_pred_strict_mark (dataConTheta dc)
 
 -- | Source-level arity of the data constructor
 dataConSourceArity :: DataCon -> Arity
@@ -747,7 +763,7 @@ dataConUserType  (MkData { dcUnivTyVars = univ_tvs,
                           dcOtherTheta = theta, dcOrigArgTys = arg_tys,
                           dcOrigResTy = res_ty })
   = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
-    mkFunTys (mkPredTys theta) $
+    mkFunTys theta $
     mkFunTys arg_tys $
     res_ty
 
@@ -842,11 +858,17 @@ dataConCannotMatch tys con
   | all isTyVarTy tys = False  -- Also common
   | otherwise
   = typesCantMatch [(Type.substTy subst ty1, Type.substTy subst ty2)
-                   | EqPred ty1 ty2 <- theta ]
+                   | (ty1, ty2) <- concatMap predEqs theta ]
   where
     dc_tvs  = dataConUnivTyVars con
     theta   = dataConTheta con
     subst   = zipTopTvSubst dc_tvs tys
+
+    -- TODO: could gather equalities from superclasses too
+    predEqs pred = case classifyPredType pred of
+                     EqPred ty1 ty2 -> [(ty1, ty2)]
+                     TuplePred ts   -> concatMap predEqs ts
+                     _              -> []
 \end{code}
 
 %************************************************************************
@@ -931,9 +953,10 @@ computeRep stricts tys
   where
     unbox HsNoBang       ty = [(NotMarkedStrict, ty)]
     unbox HsStrict       ty = [(MarkedStrict,    ty)]
+    unbox HsNoUnpack     ty = [(MarkedStrict,    ty)]
     unbox HsUnpackFailed ty = [(MarkedStrict,    ty)]
     unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
                       where
                         (_tycon, _tycon_args, arg_dc, arg_tys) 
                            = deepSplitProductType "unbox_strict_arg_ty" ty
-\end{code}
+\end{code}
\ No newline at end of file
index c5e05c9..3477a4b 100644 (file)
@@ -5,4 +5,6 @@ import Name( Name )
 data DataCon
 dataConName      :: DataCon -> Name
 isVanillaDataCon :: DataCon -> Bool
+instance Eq DataCon
+instance Ord DataCon
 \end{code}
index b1e9ccb..c4143ed 100644 (file)
@@ -5,6 +5,13 @@
 \section[Demand]{@Demand@: the amount of demand on a value}
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module Demand(
        Demand(..), 
        topDmd, lazyDmd, seqDmd, evalDmd, errDmd, isStrictDmd, 
index 5ac2612..d1df6cc 100644 (file)
@@ -5,6 +5,13 @@
 \section[Id]{@Ids@: Value and constructor identifiers}
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 -- |
 -- #name_types#
 -- GHC uses several kinds of name internally:
@@ -21,6 +28,7 @@
 --   be global or local, see "Var#globalvslocal"
 --
 -- * 'Var.Var': see "Var#name_types"
+
 module Id (
         -- * The main types
        Var, Id, isId,
@@ -49,16 +57,15 @@ module Id (
         isStrictId,
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector, isNaughtyRecordSelector,
-        isClassOpId_maybe, isDFunId, dfunNSilent,
+        isClassOpId_maybe, isDFunId, 
        isPrimOpId, isPrimOpId_maybe, 
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
         isConLikeId, isBottomingId, idIsFrom,
-        isTickBoxOp, isTickBoxOp_maybe,
-       hasNoBinding, 
+        hasNoBinding,
 
        -- ** Evidence variables
-       DictId, isDictId, isEvVar, evVarPred,
+       DictId, isDictId, isEvVar,
 
        -- ** Inline pragma stuff
        idInlinePragma, setInlinePragma, modifyInlinePragma,
@@ -98,7 +105,7 @@ import IdInfo
 import BasicTypes
 
 -- Imported and re-exported 
-import Var( Var, Id, DictId, EvVar,
+import Var( Var, Id, DictId,
             idInfo, idDetails, globaliseId, varType,
             isId, isLocalId, isGlobalId, isExportedId )
 import qualified Var
@@ -338,11 +345,6 @@ isDFunId id = case Var.idDetails id of
                         DFunId {} -> True
                         _         -> False
 
-dfunNSilent :: Id -> Int
-dfunNSilent id = case Var.idDetails id of
-                   DFunId ns _ -> ns
-                   _ -> pprTrace "dfunSilent: not a dfun:" (ppr id) 0
-
 isPrimOpId_maybe id = case Var.idDetails id of
                         PrimOpId op -> Just op
                         _           -> Nothing
@@ -431,20 +433,6 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
                  | otherwise = False   -- TyVars count as not dead
 \end{code}
 
-\begin{code}
-isTickBoxOp :: Id -> Bool
-isTickBoxOp id = 
-  case Var.idDetails id of
-    TickBoxOpId _    -> True
-    _                -> False
-
-isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
-isTickBoxOp_maybe id = 
-  case Var.idDetails id of
-    TickBoxOpId tick -> Just tick
-    _                -> Nothing
-\end{code}
-
 %************************************************************************
 %*                                                                     *
               Evidence variables                                                                       
@@ -457,12 +445,6 @@ isEvVar var = isPredTy (varType var)
 
 isDictId :: Id -> Bool
 isDictId id = isDictTy (idType id)
-
-evVarPred :: EvVar -> PredType
-evVarPred var
-  = case splitPredTy_maybe (varType var) of
-      Just pred -> pred
-      Nothing   -> pprPanic "evVarPred" (ppr var <+> ppr (varType var))
 \end{code}
 
 %************************************************************************
@@ -513,8 +495,8 @@ isStrictId id
 idUnfolding :: Id -> Unfolding
 -- Do not expose the unfolding of a loop breaker!
 idUnfolding id 
-  | isNonRuleLoopBreaker (occInfo info) = NoUnfolding
-  | otherwise                           = unfoldingInfo info
+  | isStrongLoopBreaker (occInfo info) = NoUnfolding
+  | otherwise                          = unfoldingInfo info
   where
     info = idInfo id
 
@@ -624,9 +606,9 @@ isStateHackType ty
   | opt_NoStateHack 
   = False
   | otherwise
-  = case splitTyConApp_maybe ty of
-       Just (tycon,_) -> tycon == statePrimTyCon
-        _              -> False
+  = case tyConAppTyCon_maybe ty of
+       Just tycon -> tycon == statePrimTyCon
+        _          -> False
        -- This is a gross hack.  It claims that 
        -- every function over realWorldStatePrimTy is a one-shot
        -- function.  This is pretty true in practice, and makes a big
index c106f53..0d715ef 100644 (file)
@@ -8,6 +8,13 @@
 Haskell. [WDP 94/11])
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module IdInfo (
         -- * The IdDetails type
        IdDetails(..), pprIdDetails, coVarDetails,
@@ -38,7 +45,7 @@ module IdInfo (
 
        -- ** The OccInfo type
        OccInfo(..),
-       isDeadOcc, isLoopBreaker,
+       isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
        occInfo, setOccInfo,
 
        InsideLam, OneBranch,
@@ -129,14 +136,7 @@ data IdDetails
 
   | TickBoxOpId TickBoxOp      -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
 
-  | DFunId Int Bool             -- ^ A dictionary function.
-       -- Int = the number of "silent" arguments to the dfun
-       --       e.g.  class D a => C a where ...
-       --             instance C a => C [a]
-       --       has is_silent = 1, because the dfun
-       --       has type  dfun :: (D a, C a) => C [a]
-       --       See the DFun Superclass Invariant in TcInstDcls
-       --
+  | DFunId Bool                 -- ^ A dictionary function.
        -- Bool = True <=> the class has only one method, so may be
        --                  implemented with a newtype, so it might be bad
        --                  to be strict on this dictionary
@@ -158,8 +158,7 @@ pprIdDetails other     = brackets (pp other)
    pp (PrimOpId _)      = ptext (sLit "PrimOp")
    pp (FCallId _)       = ptext (sLit "ForeignCall")
    pp (TickBoxOpId _)   = ptext (sLit "TickBoxOp")
-   pp (DFunId ns nt)    = ptext (sLit "DFunId")
-                             <> ppWhen (ns /= 0) (brackets (int ns))
+   pp (DFunId nt)       = ptext (sLit "DFunId")
                              <> ppWhen nt (ptext (sLit "(nt)"))
    pp (RecSelId { sel_naughty = is_naughty })
                         = brackets $ ptext (sLit "RecSel") 
index da8685e..966dca1 100644 (file)
@@ -5,49 +5,56 @@
 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
 
 \begin{code}
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+{-# OPTIONS -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
-{-# LANGUAGE DeriveDataTypeable #-}
 
 module Literal
-       ( 
-       -- * Main data type
-         Literal(..)           -- Exported to ParseIface
-       
-       -- ** Creating Literals
-       , mkMachInt, mkMachWord
-       , mkMachInt64, mkMachWord64
-       , mkMachFloat, mkMachDouble
-       , mkMachChar, mkMachString
-       
-       -- ** Operations on Literals
-       , literalType
-       , hashLiteral
+        (
+        -- * Main data type
+          Literal(..)           -- Exported to ParseIface
+
+        -- ** Creating Literals
+        , mkMachInt, mkMachWord
+        , mkMachInt64, mkMachWord64
+        , mkMachFloat, mkMachDouble
+        , mkMachChar, mkMachString
+        , mkLitInteger
+
+        -- ** Operations on Literals
+        , literalType
+        , hashLiteral
         , absentLiteralOf
+        , pprLiteral
 
         -- ** Predicates on Literals and their contents
-       , litIsDupable, litIsTrivial
-       , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
-       , isZeroLit
-       , litFitsInChar
+        , litIsDupable, litIsTrivial, litIsLifted
+        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
+        , isZeroLit
+        , litFitsInChar
 
         -- ** Coercions
-       , word2IntLit, int2WordLit
-       , narrow8IntLit, narrow16IntLit, narrow32IntLit
-       , narrow8WordLit, narrow16WordLit, narrow32WordLit
-       , char2IntLit, int2CharLit
-       , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
-       , nullAddrLit, float2DoubleLit, double2FloatLit
-       ) where
+        , word2IntLit, int2WordLit
+        , narrow8IntLit, narrow16IntLit, narrow32IntLit
+        , narrow8WordLit, narrow16WordLit, narrow32WordLit
+        , char2IntLit, int2CharLit
+        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
+        , nullAddrLit, float2DoubleLit, double2FloatLit
+        ) where
+
+#include "HsVersions.h"
 
 import TysPrim
 import PrelNames
 import Type
+import TypeRep
 import TyCon
+import Var
 import Outputable
 import FastTypes
 import FastString
@@ -59,14 +66,15 @@ import Data.Int
 import Data.Ratio
 import Data.Word
 import Data.Char
-import Data.Data( Data, Typeable )
+import Data.Data ( Data, Typeable )
+import Numeric ( fromRat )
 \end{code}
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Literals}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -76,44 +84,70 @@ import Data.Data( Data, Typeable )
 --   which is presumed to be surrounded by appropriate constructors
 --   (@Int#@, etc.), so that the overall thing makes sense.
 --
--- * The literal derived from the label mentioned in a \"foreign label\" 
+-- * The literal derived from the label mentioned in a \"foreign label\"
 --   declaration ('MachLabel')
 data Literal
-  =    ------------------
-       -- First the primitive guys
-    MachChar   Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
+  =     ------------------
+        -- First the primitive guys
+    MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
 
-  | MachStr    FastString      -- ^ A string-literal: stored and emitted
-                               -- UTF-8 encoded, we'll arrange to decode it
-                               -- at runtime.  Also emitted with a @'\0'@
-                               -- terminator. Create with 'mkMachString'
+  | MachStr     FastString      -- ^ A string-literal: stored and emitted
+                                -- UTF-8 encoded, we'll arrange to decode it
+                                -- at runtime.  Also emitted with a @'\0'@
+                                -- terminator. Create with 'mkMachString'
 
   | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
-                                -- that can be represented as a Literal. Create 
+                                -- that can be represented as a Literal. Create
                                 -- with 'nullAddrLit'
 
-  | MachInt    Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
-  | MachInt64  Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
-  | MachWord   Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
-  | MachWord64 Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
+  | MachInt     Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
+  | MachInt64   Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
+  | MachWord    Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
+  | MachWord64  Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
 
-  | MachFloat  Rational        -- ^ @Float#@. Create with 'mkMachFloat'
-  | MachDouble Rational        -- ^ @Double#@. Create with 'mkMachDouble'
+  | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
+  | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
 
   | MachLabel   FastString
-               (Maybe Int)
+                (Maybe Int)
         FunctionOrData
                 -- ^ A label literal. Parameters:
-                       --
-                       -- 1) The name of the symbol mentioned in the declaration
-                       --
-                       -- 2) The size (in bytes) of the arguments
-                               --    the label expects. Only applicable with
-                               --    @stdcall@ labels. @Just x@ => @\<x\>@ will
-                               --    be appended to label name when emitting assembly.
+                        --
+                        -- 1) The name of the symbol mentioned in the declaration
+                        --
+                        -- 2) The size (in bytes) of the arguments
+                                --    the label expects. Only applicable with
+                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
+                                --    be appended to label name when emitting assembly.
+
+  | LitInteger Integer Id      --  ^ Integer literals
+                               -- See Note [Integer literals]
   deriving (Data, Typeable)
 \end{code}
 
+Note [Integer literals]
+~~~~~~~~~~~~~~~~~~~~~~~
+An Integer literal is represented using, well, an Integer, to make it
+easier to write RULEs for them. 
+
+ * The Id is for mkInteger, which we use when finally creating the core.
+
+ * They only get converted into real Core,
+      mkInteger [c1, c2, .., cn]
+   during the CorePrep phase.
+
+ * When we initally build an Integer literal, notably when
+   deserialising it from an interface file (see the Binary instance
+   below), we don't have convenient access to the mkInteger Id.  So we
+   just use an error thunk, and fill in the real Id when we do tcIfaceLit
+   in TcIface.
+
+ * When looking for CAF-hood (in TidyPgm), we must take account of the
+   CAF-hood of the mk_integer field in LitInteger; see TidyPgm.cafRefsL.
+   Indeed this is the only reason we put the mk_integer field in the 
+   literal -- otherwise we could just look it up in CorePrep.
+
+
 Binary instance
 
 \begin{code}
@@ -132,45 +166,50 @@ instance Binary Literal where
              put_ bh aj
              put_ bh mb
              put_ bh fod
+    put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
     get bh = do
-           h <- getByte bh
-           case h of
-             0 -> do
-                   aa <- get bh
-                   return (MachChar aa)
-             1 -> do
-                   ab <- get bh
-                   return (MachStr ab)
-             2 -> do
-                   return (MachNullAddr)
-             3 -> do
-                   ad <- get bh
-                   return (MachInt ad)
-             4 -> do
-                   ae <- get bh
-                   return (MachInt64 ae)
-             5 -> do
-                   af <- get bh
-                   return (MachWord af)
-             6 -> do
-                   ag <- get bh
-                   return (MachWord64 ag)
-             7 -> do
-                   ah <- get bh
-                   return (MachFloat ah)
-             8 -> do
-                   ai <- get bh
-                   return (MachDouble ai)
-             9 -> do
-                   aj <- get bh
-                   mb <- get bh
-                   fod <- get bh
-                   return (MachLabel aj mb fod)
+            h <- getByte bh
+            case h of
+              0 -> do
+                    aa <- get bh
+                    return (MachChar aa)
+              1 -> do
+                    ab <- get bh
+                    return (MachStr ab)
+              2 -> do
+                    return (MachNullAddr)
+              3 -> do
+                    ad <- get bh
+                    return (MachInt ad)
+              4 -> do
+                    ae <- get bh
+                    return (MachInt64 ae)
+              5 -> do
+                    af <- get bh
+                    return (MachWord af)
+              6 -> do
+                    ag <- get bh
+                    return (MachWord64 ag)
+              7 -> do
+                    ah <- get bh
+                    return (MachFloat ah)
+              8 -> do
+                    ai <- get bh
+                    return (MachDouble ai)
+              9 -> do
+                    aj <- get bh
+                    mb <- get bh
+                    fod <- get bh
+                    return (MachLabel aj mb fod)
+              _ -> do
+                    i <- get bh
+                    return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
+                          -- See Note [Integer literals] in Literal
 \end{code}
 
 \begin{code}
 instance Outputable Literal where
-    ppr lit = pprLit lit
+    ppr lit = pprLiteral (\d -> d) lit
 
 instance Show Literal where
     showsPrec p lit = showsPrecSDoc p (ppr lit)
@@ -181,29 +220,25 @@ instance Eq Literal where
 
 instance Ord Literal where
     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
-    a <         b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >         b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
     compare a b = cmpLit a b
 \end{code}
 
 
-       Construction
-       ~~~~~~~~~~~~
+        Construction
+        ~~~~~~~~~~~~
 \begin{code}
 -- | Creates a 'Literal' of type @Int#@
 mkMachInt :: Integer -> Literal
-mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x ) 
-                -- Not true: you can write out of range Int# literals
-                -- For example, one can write (intToWord# 0xffff0000) to
-                -- get a particular Word bit-pattern, and there's no other
-                -- convenient way to write such literals, which is why we allow it.
-                MachInt x
+mkMachInt  x   = ASSERT2( inIntRange x,  integer x )
+                 MachInt x
 
 -- | Creates a 'Literal' of type @Word#@
 mkMachWord :: Integer -> Literal
-mkMachWord x   = -- ASSERT2( inWordRange x, integer x ) 
-                MachWord x
+mkMachWord x   = ASSERT2( inWordRange x, integer x )
+                 MachWord x
 
 -- | Creates a 'Literal' of type @Int64#@
 mkMachInt64 :: Integer -> Literal
@@ -230,9 +265,12 @@ mkMachChar = MachChar
 mkMachString :: String -> Literal
 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 
+mkLitInteger :: Integer -> Id -> Literal
+mkLitInteger = LitInteger
+
 inIntRange, inWordRange :: Integer -> Bool
 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
-inWordRange x = x >= 0             && x <= tARGET_MAX_WORD
+inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 
 inCharRange :: Char -> Bool
 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
@@ -248,8 +286,8 @@ isZeroLit (MachDouble 0) = True
 isZeroLit _              = False
 \end{code}
 
-       Coercions
-       ~~~~~~~~~
+        Coercions
+        ~~~~~~~~~
 \begin{code}
 word2IntLit, int2WordLit,
   narrow8IntLit, narrow16IntLit, narrow32IntLit,
@@ -259,63 +297,85 @@ word2IntLit, int2WordLit,
   float2DoubleLit, double2FloatLit
   :: Literal -> Literal
 
-word2IntLit (MachWord w) 
+word2IntLit (MachWord w)
   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
-  | otherwise         = MachInt w
+  | otherwise          = MachInt w
+word2IntLit l = pprPanic "word2IntLit" (ppr l)
 
 int2WordLit (MachInt i)
-  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)     -- (-1)  --->  tARGET_MAX_WORD
+  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
   | otherwise = MachWord i
+int2WordLit l = pprPanic "int2WordLit" (ppr l)
 
 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
+narrow8IntLit    l            = pprPanic "narrow8IntLit" (ppr l)
 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
+narrow16IntLit   l            = pprPanic "narrow16IntLit" (ppr l)
 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
+narrow32IntLit   l            = pprPanic "narrow32IntLit" (ppr l)
 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
+narrow8WordLit   l            = pprPanic "narrow8WordLit" (ppr l)
 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
+narrow16WordLit  l            = pprPanic "narrow16WordLit" (ppr l)
 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
+narrow32WordLit  l            = pprPanic "narrow32WordLit" (ppr l)
 
 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
+char2IntLit l            = pprPanic "char2IntLit" (ppr l)
 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
+int2CharLit l            = pprPanic "int2CharLit" (ppr l)
 
 float2IntLit (MachFloat f) = MachInt   (truncate    f)
+float2IntLit l             = pprPanic "float2IntLit" (ppr l)
 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
+int2FloatLit l             = pprPanic "int2FloatLit" (ppr l)
 
 double2IntLit (MachDouble f) = MachInt    (truncate    f)
-int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
+double2IntLit l              = pprPanic "double2IntLit" (ppr l)
+int2DoubleLit (MachInt    i) = MachDouble (fromInteger i)
+int2DoubleLit l              = pprPanic "int2DoubleLit" (ppr l)
 
 float2DoubleLit (MachFloat  f) = MachDouble f
+float2DoubleLit l              = pprPanic "float2DoubleLit" (ppr l)
 double2FloatLit (MachDouble d) = MachFloat  d
+double2FloatLit l              = pprPanic "double2FloatLit" (ppr l)
 
 nullAddrLit :: Literal
 nullAddrLit = MachNullAddr
 \end{code}
 
-       Predicates
-       ~~~~~~~~~~
+        Predicates
+        ~~~~~~~~~~
 \begin{code}
 -- | True if there is absolutely no penalty to duplicating the literal.
 -- False principally of strings
 litIsTrivial :: Literal -> Bool
---     c.f. CoreUtils.exprIsTrivial
-litIsTrivial (MachStr _) = False
-litIsTrivial _           = True
+--      c.f. CoreUtils.exprIsTrivial
+litIsTrivial (MachStr _)      = False
+litIsTrivial (LitInteger {})  = False
+litIsTrivial _                = True
 
 -- | True if code space does not go bad if we duplicate this literal
 -- Currently we treat it just like 'litIsTrivial'
 litIsDupable :: Literal -> Bool
---     c.f. CoreUtils.exprIsDupable
-litIsDupable (MachStr _) = False
-litIsDupable _           = True
+--      c.f. CoreUtils.exprIsDupable
+litIsDupable (MachStr _)      = False
+litIsDupable (LitInteger i _) = inIntRange i
+litIsDupable _                = True
 
 litFitsInChar :: Literal -> Bool
 litFitsInChar (MachInt i)
-                        = fromInteger i <= ord minBound 
-                        && fromInteger i >= ord maxBound 
+                         = fromInteger i <= ord minBound
+                        && fromInteger i >= ord maxBound
 litFitsInChar _         = False
+
+litIsLifted :: Literal -> Bool
+litIsLifted (LitInteger {}) = True
+litIsLifted _               = False
 \end{code}
 
-       Types
-       ~~~~~
+        Types
+        ~~~~~
 \begin{code}
 -- | Find the Haskell 'Type' the literal occupies
 literalType :: Literal -> Type
@@ -329,6 +389,12 @@ literalType (MachWord64  _) = word64PrimTy
 literalType (MachFloat _)   = floatPrimTy
 literalType (MachDouble _)  = doublePrimTy
 literalType (MachLabel _ _ _) = addrPrimTy
+literalType (LitInteger _ mk_integer_id)
+      -- We really mean idType, rather than varType, but importing Id
+      -- causes a module import loop
+    = case varType mk_integer_id of
+        FunTy _ (FunTy _ integerTy) -> integerTy
+        _ -> panic "literalType: mkIntegerId has the wrong type"
 
 absentLiteralOf :: TyCon -> Maybe Literal
 -- Return a literal of the appropriate primtive
@@ -337,32 +403,33 @@ absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
 
 absent_lits :: UniqFM Literal
 absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
-                       , (charPrimTyConKey,    MachChar 'x')
-                       , (intPrimTyConKey,     MachInt 0)
-                       , (int64PrimTyConKey,   MachInt64 0)
-                       , (floatPrimTyConKey,   MachFloat 0)
-                       , (doublePrimTyConKey,  MachDouble 0)
-                       , (wordPrimTyConKey,    MachWord 0)
-                       , (word64PrimTyConKey,  MachWord64 0) ]
+                        , (charPrimTyConKey,    MachChar 'x')
+                        , (intPrimTyConKey,     MachInt 0)
+                        , (int64PrimTyConKey,   MachInt64 0)
+                        , (floatPrimTyConKey,   MachFloat 0)
+                        , (doublePrimTyConKey,  MachDouble 0)
+                        , (wordPrimTyConKey,    MachWord 0)
+                        , (word64PrimTyConKey,  MachWord64 0) ]
 \end{code}
 
 
-       Comparison
-       ~~~~~~~~~~
+        Comparison
+        ~~~~~~~~~~
 \begin{code}
 cmpLit :: Literal -> Literal -> Ordering
-cmpLit (MachChar      a)   (MachChar      b)   = a `compare` b
-cmpLit (MachStr       a)   (MachStr       b)   = a `compare` b
+cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
+cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
-cmpLit (MachInt       a)   (MachInt       b)   = a `compare` b
-cmpLit (MachWord      a)   (MachWord      b)   = a `compare` b
-cmpLit (MachInt64     a)   (MachInt64     b)   = a `compare` b
-cmpLit (MachWord64    a)   (MachWord64    b)   = a `compare` b
-cmpLit (MachFloat     a)   (MachFloat     b)   = a `compare` b
-cmpLit (MachDouble    a)   (MachDouble    b)   = a `compare` b
+cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
+cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
+cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
+cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
+cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
+cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
-cmpLit lit1               lit2                 | litTag lit1 <# litTag lit2 = LT
-                                               | otherwise                  = GT
+cmpLit (LitInteger    a _) (LitInteger     b _) = a `compare` b
+cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
+                                                | otherwise                  = GT
 
 litTag :: Literal -> FastInt
 litTag (MachChar      _)   = _ILIT(1)
@@ -375,25 +442,30 @@ litTag (MachWord64    _)   = _ILIT(7)
 litTag (MachFloat     _)   = _ILIT(8)
 litTag (MachDouble    _)   = _ILIT(9)
 litTag (MachLabel _ _ _)   = _ILIT(10)
+litTag (LitInteger  {})    = _ILIT(11)
 \end{code}
 
-       Printing
-       ~~~~~~~~
+        Printing
+        ~~~~~~~~
 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
   exceptions: MachFloat gets an initial keyword prefix.
 
 \begin{code}
-pprLit :: Literal -> SDoc
-pprLit (MachChar ch)   = pprHsChar ch
-pprLit (MachStr s)     = pprHsString s
-pprLit (MachInt i)     = pprIntVal i
-pprLit (MachInt64 i)   = ptext (sLit "__int64") <+> integer i
-pprLit (MachWord w)    = ptext (sLit "__word") <+> integer w
-pprLit (MachWord64 w)  = ptext (sLit "__word64") <+> integer w
-pprLit (MachFloat f)   = ptext (sLit "__float") <+> rational f
-pprLit (MachDouble d)  = rational d
-pprLit (MachNullAddr)  = ptext (sLit "__NULL")
-pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
+pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
+-- The function is used on non-atomic literals
+-- to wrap parens around literals that occur in
+-- a context requiring an atomic thing
+pprLiteral _       (MachChar ch)    = pprHsChar ch
+pprLiteral _       (MachStr s)      = pprHsString s
+pprLiteral _       (MachInt i)      = pprIntVal i
+pprLiteral _       (MachDouble d)   = double (fromRat d)
+pprLiteral _       (MachNullAddr)   = ptext (sLit "__NULL")
+pprLiteral add_par (LitInteger i _) = add_par (ptext (sLit "__integer") <+> integer i)
+pprLiteral add_par (MachInt64 i)    = add_par (ptext (sLit "__int64") <+> integer i)
+pprLiteral add_par (MachWord w)     = add_par (ptext (sLit "__word") <+> integer w)
+pprLiteral add_par (MachWord64 w)   = add_par (ptext (sLit "__word64") <+> integer w)
+pprLiteral add_par (MachFloat f)    = add_par (ptext (sLit "__float") <+> float (fromRat f))
+pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
     where b = case mb of
               Nothing -> pprHsString l
               Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
@@ -401,14 +473,14 @@ pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
 pprIntVal :: Integer -> SDoc
 -- ^ Print negative integers with parens to be sure it's unambiguous
 pprIntVal i | i < 0     = parens (integer i)
-           | otherwise = integer i
+            | otherwise = integer i
 \end{code}
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Hashing}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 Hash values should be zero or a positive integer.  No negatives please.
@@ -416,24 +488,25 @@ Hash values should be zero or a positive integer.  No negatives please.
 
 \begin{code}
 hashLiteral :: Literal -> Int
-hashLiteral (MachChar c)       = ord c + 1000  -- Keep it out of range of common ints
-hashLiteral (MachStr s)        = hashFS s
-hashLiteral (MachNullAddr)     = 0
-hashLiteral (MachInt i)        = hashInteger i
-hashLiteral (MachInt64 i)      = hashInteger i
-hashLiteral (MachWord i)       = hashInteger i
-hashLiteral (MachWord64 i)     = hashInteger i
-hashLiteral (MachFloat r)      = hashRational r
-hashLiteral (MachDouble r)     = hashRational r
+hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
+hashLiteral (MachStr s)         = hashFS s
+hashLiteral (MachNullAddr)      = 0
+hashLiteral (MachInt i)         = hashInteger i
+hashLiteral (MachInt64 i)       = hashInteger i
+hashLiteral (MachWord i)        = hashInteger i
+hashLiteral (MachWord64 i)      = hashInteger i
+hashLiteral (MachFloat r)       = hashRational r
+hashLiteral (MachDouble r)      = hashRational r
 hashLiteral (MachLabel s _ _)     = hashFS s
+hashLiteral (LitInteger i _)    = hashInteger i
 
 hashRational :: Rational -> Int
 hashRational r = hashInteger (numerator r)
 
 hashInteger :: Integer -> Int
 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
-               -- The 1+ is to avoid zero, which is a Bad Number
-               -- since we use * to combine hash values
+                -- The 1+ is to avoid zero, which is a Bad Number
+                -- since we use * to combine hash values
 
 hashFS :: FastString -> Int
 hashFS s = iBox (uniqueOfFS s)
index b72c4be..a40d46f 100644 (file)
@@ -12,11 +12,17 @@ have a standard form, namely:
 - primitive operations
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module MkId (
         mkDictFunId, mkDictFunTy, mkDictSelId,
 
-        mkDataConIds,
-        mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
+        mkDataConIds, mkPrimOpId, mkFCallId,
 
         mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         wrapFamInstBody, unwrapFamInstScrut,
@@ -36,13 +42,13 @@ module MkId (
 
 import Rules
 import TysPrim
-import TysWiredIn      ( unitTy )
+import TysWiredIn
 import PrelRules
 import Type
 import Coercion
 import TcType
 import MkCore
-import CoreUtils       ( exprType, mkCoerce )
+import CoreUtils       ( exprType, mkCast )
 import CoreUnfold
 import Literal
 import TyCon
@@ -65,7 +71,6 @@ import Pair
 import Outputable
 import FastString
 import ListSetOps
-import Module
 \end{code}
 
 %************************************************************************
@@ -293,20 +298,23 @@ mkDataConIds wrap_name wkr_name data_con
         -- extra constraints where necessary.
     wrap_tvs    = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs
     res_ty_args = substTyVars (mkTopTvSubst eq_spec) univ_tvs
-    ev_tys      = mkPredTys other_theta
+    ev_tys      = other_theta
     wrap_ty     = mkForAllTys wrap_tvs $ 
                   mkFunTys ev_tys $
                   mkFunTys orig_arg_tys $ res_ty
 
         ----------- Wrappers for algebraic data types -------------- 
     alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
-    alg_wrap_info = noCafIdInfo         -- The NoCaf-ness is set by noCafIdInfo
+    alg_wrap_info = noCafIdInfo
                     `setArityInfo`         wrap_arity
                         -- It's important to specify the arity, so that partial
                         -- applications are treated as values
                    `setInlinePragInfo`    alwaysInlinePragma
                     `setUnfoldingInfo`     wrap_unf
                     `setStrictnessInfo` Just wrap_sig
+                        -- We need to get the CAF info right here because TidyPgm
+                        -- does not tidy the IdInfo of implicit bindings (like the wrapper)
+                        -- so it not make sure that the CAF info is sane
 
     all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
     wrap_sig = mkStrictSig (mkTopDmdType wrap_arg_dmds cpr_info)
@@ -339,6 +347,8 @@ mkDataConIds wrap_name wkr_name data_con
                                      `mkVarApps` ex_tvs                 
                                      `mkCoApps`  map (mkReflCo . snd) eq_spec
                                      `mkVarApps` reverse rep_ids
+                            -- Dont box the eq_spec coercions since they are
+                            -- marked as HsUnpack by mk_dict_strict_mark
 
     (ev_args,i2) = mkLocals 1  ev_tys
     (id_args,i3) = mkLocals i2 orig_arg_tys
@@ -481,13 +491,15 @@ mkDictSelId no_unf name clas
 
     the_arg_id     = arg_ids !! val_index
     pred                  = mkClassPred clas (mkTyVarTys tyvars)
-    dict_id               = mkTemplateLocal 1 $ mkPredTy pred
+    dict_id               = mkTemplateLocal 1 pred
     arg_ids               = mkTemplateLocalsNum 2 arg_tys
 
     rhs = mkLams tyvars  (Lam dict_id   rhs_body)
     rhs_body | new_tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
              | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
-                                [(DataAlt data_con, arg_ids, Var the_arg_id)]
+                                [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
+                               -- varToCoreExpr needed for equality superclass selectors
+                               --   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
 
 dictSelRule :: Int -> Arity 
             -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
@@ -582,7 +594,7 @@ mkProductBox arg_ids ty
     result_expr
       | isNewTyCon tycon && not (isRecursiveTyCon tycon) 
       = wrap (mkProductBox arg_ids (newTyConInstRhs tycon tycon_args))
-      | otherwise = mkConApp pack_con (map Type tycon_args ++ map Var arg_ids)
+      | otherwise = mkConApp pack_con (map Type tycon_args ++ varsToCoreExprs arg_ids)
 
     wrap expr = wrapNewTypeBody tycon tycon_args expr
 
@@ -671,7 +683,7 @@ wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 wrapNewTypeBody tycon args result_expr
   = ASSERT( isNewTyCon tycon )
     wrapFamInstBody tycon args $
-    mkCoerce (mkSymCo co) result_expr
+    mkCast result_expr (mkSymCo co)
   where
     co = mkAxInstCo (newTyConCo tycon) args
 
@@ -683,7 +695,7 @@ wrapNewTypeBody tycon args result_expr
 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 unwrapNewTypeBody tycon args result_expr
   = ASSERT( isNewTyCon tycon )
-    mkCoerce (mkAxInstCo (newTyConCo tycon) args) result_expr
+    mkCast result_expr (mkAxInstCo (newTyConCo tycon) args)
 
 -- If the type constructor is a representation type of a data instance, wrap
 -- the expression into a cast adjusting the expression type, which is an
@@ -693,14 +705,14 @@ unwrapNewTypeBody tycon args result_expr
 wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 wrapFamInstBody tycon args body
   | Just co_con <- tyConFamilyCoercion_maybe tycon
-  = mkCoerce (mkSymCo (mkAxInstCo co_con args)) body
+  = mkCast body (mkSymCo (mkAxInstCo co_con args))
   | otherwise
   = body
 
 unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
 unwrapFamInstScrut tycon args scrut
   | Just co_con <- tyConFamilyCoercion_maybe tycon
-  = mkCoerce (mkAxInstCo co_con args) scrut
+  = mkCast scrut (mkAxInstCo co_con args)
   | otherwise
   = scrut
 \end{code}
@@ -759,30 +771,6 @@ mkFCallId uniq fcall ty
     (arg_tys, _) = tcSplitFunTys tau
     arity        = length arg_tys
     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
-
--- Tick boxes and breakpoints are both represented as TickBoxOpIds,
--- except for the type:
---
---    a plain HPC tick box has type (State# RealWorld)
---    a breakpoint Id has type forall a.a
---
--- The breakpoint Id will be applied to a list of arbitrary free variables,
--- which is why it needs a polymorphic type.
-
-mkTickBoxOpId :: Unique -> Module -> TickBoxId -> Id
-mkTickBoxOpId uniq mod ix = mkTickBox' uniq mod ix realWorldStatePrimTy
-
-mkBreakPointOpId :: Unique -> Module -> TickBoxId -> Id
-mkBreakPointOpId uniq mod ix = mkTickBox' uniq mod ix ty
- where ty = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
-
-mkTickBox' :: Unique -> Module -> TickBoxId -> Type -> Id
-mkTickBox' uniq mod ix ty = mkGlobalId (TickBoxOpId tickbox) name ty info    
-  where
-    tickbox = TickBox mod ix
-    occ_str = showSDoc (braces (ppr tickbox))
-    name    = mkTickBoxOpName uniq occ_str
-    info    = noCafIdInfo
 \end{code}
 
 
@@ -826,26 +814,17 @@ mkDictFunId :: Name      -- Name to use for the dict fun;
 -- Implements the DFun Superclass Invariant (see TcInstDcls)
 
 mkDictFunId dfun_name tvs theta clas tys
-  = mkExportedLocalVar (DFunId n_silent is_nt)
+  = mkExportedLocalVar (DFunId is_nt)
                        dfun_name
                        dfun_ty
                        vanillaIdInfo
   where
     is_nt = isNewTyCon (classTyCon clas)
-    (n_silent, dfun_ty) = mkDictFunTy tvs theta clas tys
+    dfun_ty = mkDictFunTy tvs theta clas tys
 
-mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> (Int, Type)
+mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type
 mkDictFunTy tvs theta clas tys
-  = (length silent_theta, dfun_ty)
-  where
-    dfun_ty = mkSigmaTy tvs (silent_theta ++ theta) (mkDictTy clas tys)
-    silent_theta = filterOut discard $
-                   substTheta (zipTopTvSubst (classTyVars clas) tys)
-                              (classSCTheta clas)
-                   -- See Note [Silent Superclass Arguments]
-    discard pred = isEmptyVarSet (tyVarsOfPred pred)
-                 || any (`eqPred` pred) theta
-                 -- See the DFun Superclass Invariant in TcInstDcls
+  = mkSigmaTy tvs theta (mkClassPred clas tys)
 \end{code}
 
 
@@ -1045,7 +1024,7 @@ voidArgId       -- :: State# RealWorld
 coercionTokenId :: Id        -- :: () ~ ()
 coercionTokenId -- Used to replace Coercion terms when we go to STG
   = pcMiscPrelId coercionTokenName 
-                 (mkTyConApp eqPredPrimTyCon [unitTy, unitTy])
+                 (mkTyConApp eqPrimTyCon [liftedTypeKind, unitTy, unitTy])
                  noCafIdInfo
 \end{code}
 
index 6e566a2..b5fe77d 100644 (file)
@@ -9,17 +9,18 @@ These are Uniquable, hence we can build Maps with Modules as
 the keys.
 
 \begin{code}
-module Module 
+
+module Module
     (
-       -- * The ModuleName type
-       ModuleName,
-       pprModuleName,
-       moduleNameFS,
-       moduleNameString,
-        moduleNameSlashes,
-       mkModuleName,
-       mkModuleNameFS,
-       stableModuleNameCmp,
+        -- * The ModuleName type
+        ModuleName,
+        pprModuleName,
+        moduleNameFS,
+        moduleNameString,
+        moduleNameSlashes, moduleNameColons,
+        mkModuleName,
+        mkModuleNameFS,
+        stableModuleNameCmp,
 
         -- * The PackageId type
         PackageId,
@@ -27,47 +28,47 @@ module Module
         packageIdFS,
         stringToPackageId,
         packageIdString,
-       stablePackageIdCmp,
-
-       -- * Wired-in PackageIds
-       -- $wired_in_packages
-       primPackageId,
-       integerPackageId,
-       basePackageId,
-       rtsPackageId,
-       thPackageId,
+        stablePackageIdCmp,
+
+        -- * Wired-in PackageIds
+        -- $wired_in_packages
+        primPackageId,
+        integerPackageId,
+        basePackageId,
+        rtsPackageId,
+        thPackageId,
         dphSeqPackageId,
         dphParPackageId,
-       mainPackageId,
+        mainPackageId,
         thisGhcPackageId,
-        
-       -- * The Module type
-       Module,
-       modulePackageId, moduleName,
-       pprModule,
-       mkModule,
+
+        -- * The Module type
+        Module,
+        modulePackageId, moduleName,
+        pprModule,
+        mkModule,
         stableModuleCmp,
 
-       -- * The ModuleLocation type
-       ModLocation(..),
-       addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
-
-       -- * Module mappings
-       ModuleEnv,
-       elemModuleEnv, extendModuleEnv, extendModuleEnvList, 
-       extendModuleEnvList_C, plusModuleEnv_C,
-       delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
-       lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
-       moduleEnvKeys, moduleEnvElts, moduleEnvToList,
+        -- * The ModuleLocation type
+        ModLocation(..),
+        addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
+
+        -- * Module mappings
+        ModuleEnv,
+        elemModuleEnv, extendModuleEnv, extendModuleEnvList,
+        extendModuleEnvList_C, plusModuleEnv_C,
+        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
+        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
+        moduleEnvKeys, moduleEnvElts, moduleEnvToList,
         unitModuleEnv, isEmptyModuleEnv,
         foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
 
-       -- * ModuleName mappings
-       ModuleNameEnv,
+        -- * ModuleName mappings
+        ModuleNameEnv,
 
-       -- * Sets of Modules
-       ModuleSet, 
-       emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
+        -- * Sets of Modules
+        ModuleSet,
+        emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
     ) where
 
 #include "Typeable.h"
@@ -88,9 +89,9 @@ import System.FilePath
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Module locations}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -99,19 +100,19 @@ import System.FilePath
 data ModLocation
    = ModLocation {
         ml_hs_file   :: Maybe FilePath,
-               -- The source file, if we have one.  Package modules
-               -- probably don't have source files.
+                -- The source file, if we have one.  Package modules
+                -- probably don't have source files.
 
         ml_hi_file   :: FilePath,
-               -- Where the .hi file is, whether or not it exists
-               -- yet.  Always of form foo.hi, even if there is an
-               -- hi-boot file (we add the -boot suffix later)
+                -- Where the .hi file is, whether or not it exists
+                -- yet.  Always of form foo.hi, even if there is an
+                -- hi-boot file (we add the -boot suffix later)
 
         ml_obj_file  :: FilePath
-               -- Where the .o file is, whether or not it exists yet.
-               -- (might not exist either because the module hasn't
-               -- been compiled yet, or because it is part of a
-               -- package with a .a file)
+                -- Where the .o file is, whether or not it exists yet.
+                -- (might not exist either because the module hasn't
+                -- been compiled yet, or because it is part of a
+                -- package with a .a file)
   } deriving Show
 
 instance Outputable ModLocation where
@@ -119,7 +120,7 @@ instance Outputable ModLocation where
 \end{code}
 
 For a module in another package, the hs_file and obj_file
-components of ModLocation are undefined.  
+components of ModLocation are undefined.
 
 The locations specified by a ModLocation may or may not
 correspond to actual files yet: for example, even if the object
@@ -141,15 +142,15 @@ addBootSuffixLocn :: ModLocation -> ModLocation
 -- ^ Add the @-boot@ suffix to all file paths associated with the module
 addBootSuffixLocn locn
   = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
-        , ml_hi_file  = addBootSuffix (ml_hi_file locn)
-        , ml_obj_file = addBootSuffix (ml_obj_file locn) }
+         , ml_hi_file  = addBootSuffix (ml_hi_file locn)
+         , ml_obj_file = addBootSuffix (ml_obj_file locn) }
 \end{code}
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{The name of a module}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -187,11 +188,11 @@ stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
 
 pprModuleName :: ModuleName -> SDoc
-pprModuleName (ModuleName nm) = 
+pprModuleName (ModuleName nm) =
     getPprStyle $ \ sty ->
-    if codeStyle sty 
-       then ftext (zEncodeFS nm)
-       else ftext nm
+    if codeStyle sty
+        then ftext (zEncodeFS nm)
+        else ftext nm
 
 moduleNameFS :: ModuleName -> FastString
 moduleNameFS (ModuleName mod) = mod
@@ -205,16 +206,23 @@ mkModuleName s = ModuleName (mkFastString s)
 mkModuleNameFS :: FastString -> ModuleName
 mkModuleNameFS s = ModuleName s
 
--- | Returns the string version of the module name, with dots replaced by slashes
+-- |Returns the string version of the module name, with dots replaced by slashes.
+--
 moduleNameSlashes :: ModuleName -> String
 moduleNameSlashes = dots_to_slashes . moduleNameString
   where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
+
+-- |Returns the string version of the module name, with dots replaced by underscores.
+--
+moduleNameColons :: ModuleName -> String
+moduleNameColons = dots_to_colons . moduleNameString
+  where dots_to_colons = map (\c -> if c == '.' then ':' else c)
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{A fully qualified module}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -245,7 +253,7 @@ instance Data Module where
 -- gives an ordering based on the 'Unique's of the components, which may
 -- not be stable from run to run of the compiler.
 stableModuleCmp :: Module -> Module -> Ordering
-stableModuleCmp (Module p1 n1) (Module p2 n2) 
+stableModuleCmp (Module p1 n1) (Module p2 n2)
    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
      (n1 `stableModuleNameCmp` n2)
 
@@ -260,8 +268,8 @@ pprPackagePrefix :: PackageId -> Module -> SDoc
 pprPackagePrefix p mod = getPprStyle doc
  where
    doc sty
-       | codeStyle sty = 
-          if p == mainPackageId 
+       | codeStyle sty =
+          if p == mainPackageId
                 then empty -- never qualify the main package in code
                 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
        | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
@@ -322,7 +330,7 @@ packageIdString = unpackFS . packageIdFS
 -- -----------------------------------------------------------------------------
 -- $wired_in_packages
 -- Certain packages are known to the compiler, in that we know about certain
--- entities that reside in these packages, and the compiler needs to 
+-- entities that reside in these packages, and the compiler needs to
 -- declare static Modules and Names that refer to these packages.  Hence
 -- the wired-in packages can't include version numbers, since we don't want
 -- to bake the version numbers of these packages into GHC.
@@ -356,7 +364,7 @@ thisGhcPackageId   = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
 -- | This is the package Id for the current program.  It is the default
 -- package Id if you don't specify a package name.  We don't add this prefix
 -- to symbol names, since there can be only one main package per program.
-mainPackageId     = fsToPackageId (fsLit "main")
+mainPackageId      = fsToPackageId (fsLit "main")
 \end{code}
 
 %************************************************************************
@@ -438,7 +446,7 @@ foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
 -- | A set of 'Module's
 type ModuleSet = Map Module ()
 
-mkModuleSet    :: [Module] -> ModuleSet
+mkModuleSet     :: [Module] -> ModuleSet
 extendModuleSet :: ModuleSet -> Module -> ModuleSet
 emptyModuleSet  :: ModuleSet
 moduleSetElts   :: ModuleSet -> [Module]
@@ -458,3 +466,4 @@ UniqFM.
 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 type ModuleNameEnv elt = UniqFM elt
 \end{code}
+
index e88e4a1..64ca362 100644 (file)
@@ -5,6 +5,13 @@
 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 -- |
 -- #name_types#
 -- GHC uses several kinds of name internally:
@@ -37,19 +44,20 @@ module Name (
        BuiltInSyntax(..),
 
        -- ** Creating 'Name's
-       mkInternalName, mkSystemName, mkDerivedInternalName, 
+       mkSystemName, mkSystemNameAt,
+        mkInternalName, mkDerivedInternalName, 
        mkSystemVarName, mkSysTvName, 
-       mkFCallName, mkIPName,
-        mkTickBoxOpName,
-       mkExternalName, mkWiredInName,
+        mkFCallName,
+        mkExternalName, mkWiredInName,
 
        -- ** Manipulating and deconstructing 'Name's
        nameUnique, setNameUnique,
        nameOccName, nameModule, nameModule_maybe,
        tidyNameOcc, 
        hashName, localiseName,
+  mkLocalisedOccName,
 
-       nameSrcLoc, nameSrcSpan, pprNameLoc,
+       nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
 
        -- ** Predicates on 'Name's
        isSystemName, isInternalName, isExternalName,
@@ -57,7 +65,7 @@ module Name (
        isValName, isVarName,
        isWiredInName, isBuiltInSyntax,
        wiredInNameTyThing_maybe, 
-       nameIsLocalOrFrom,
+       nameIsLocalOrFrom, stableNameCmp,
 
        -- * Class 'NamedThing' and overloaded friends
        NamedThing(..),
@@ -85,9 +93,7 @@ import FastTypes
 import FastString
 import Outputable
 
-import Data.Array
 import Data.Data
-import Data.Word        ( Word32 )
 \end{code}
 
 %************************************************************************
@@ -254,8 +260,8 @@ mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq
        --      * the insides of the compiler don't care: they use the Unique
        --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the
        --        uniques if you get confused
-       --      * for interface files we tidyCore first, which puts the uniques
-       --        into the print name (see setNameVisibility below)
+        --      * for interface files we tidyCore first, which makes
+        --        the OccNames distinct when they need to be
 
 mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
 mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
@@ -277,8 +283,11 @@ mkWiredInName mod occ uniq thing built_in
 
 -- | Create a name brought into being by the compiler
 mkSystemName :: Unique -> OccName -> Name
-mkSystemName uniq occ = Name { n_uniq = getKeyFastInt uniq, n_sort = System, 
-                              n_occ = occ, n_loc = noSrcSpan }
+mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan
+
+mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
+mkSystemNameAt uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = System 
+                                  , n_occ = occ, n_loc = loc }
 
 mkSystemVarName :: Unique -> FastString -> Name
 mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
@@ -288,23 +297,8 @@ mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
 
 -- | Make a name for a foreign call
 mkFCallName :: Unique -> String -> Name
-       -- The encoded string completely describes the ccall
-mkFCallName uniq str =  Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, 
-                              n_occ = mkVarOcc str, n_loc = noSrcSpan }
-
-
-mkTickBoxOpName :: Unique -> String -> Name
-mkTickBoxOpName uniq str 
-   = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal, 
-           n_occ = mkVarOcc str, n_loc = noSrcSpan }
-
--- | Make the name of an implicit parameter
-mkIPName :: Unique -> OccName -> Name
-mkIPName uniq occ
-  = Name { n_uniq = getKeyFastInt uniq,
-          n_sort = Internal,
-          n_occ  = occ,
-          n_loc = noSrcSpan }
+mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan
+   -- The encoded string completely describes the ccall
 \end{code}
 
 \begin{code}
@@ -326,6 +320,19 @@ localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
 \end{code}
 
+\begin{code}
+-- |Create a localised variant of a name.  
+--
+-- If the name is external, encode the original's module name to disambiguate.
+--
+mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName
+mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
+  where
+    origin 
+      | nameIsLocalOrFrom this_mod name = Nothing
+      | otherwise                       = Just (moduleNameColons . moduleName . nameModule $ name)
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsection{Hashing and comparison}
@@ -341,6 +348,26 @@ hashName name = getKey (nameUnique name) + 1
 
 cmpName :: Name -> Name -> Ordering
 cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
+
+stableNameCmp :: Name -> Name -> Ordering
+-- Compare lexicographically
+stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
+             (Name { n_sort = s2, n_occ = occ2 })
+  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)
+    -- The ordinary compare on OccNames is lexicogrpahic
+  where
+    -- Later constructors are bigger
+    sort_cmp (External m1) (External m2)       = m1 `stableModuleCmp` m2
+    sort_cmp (External {}) _                   = LT
+    sort_cmp (WiredIn {}) (External {})        = GT
+    sort_cmp (WiredIn m1 _ _) (WiredIn m2 _ _) = m1 `stableModuleCmp` m2
+    sort_cmp (WiredIn {})     _                = LT
+    sort_cmp Internal         (External {})    = GT
+    sort_cmp Internal         (WiredIn {})     = GT
+    sort_cmp Internal         Internal         = EQ
+    sort_cmp Internal         System           = LT
+    sort_cmp System           System           = EQ
+    sort_cmp System           _                = GT
 \end{code}
 
 %************************************************************************
@@ -386,9 +413,9 @@ instance Binary Name where
       case getUserData bh of 
         UserData{ ud_put_name = put_name } -> put_name bh name
 
-   get bh = do
-        i <- get bh
-        return $! (ud_symtab (getUserData bh) ! fromIntegral (i::Word32))
+   get bh =
+      case getUserData bh of
+        UserData { ud_get_name = get_name } -> get_name bh
 \end{code}
 
 %************************************************************************
@@ -405,27 +432,30 @@ instance OutputableBndr Name where
     pprBndr _ name = pprName name
 
 pprName :: Name -> SDoc
-pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
+pprName n@(Name {n_sort = sort, n_uniq = u, n_occ = occ})
   = getPprStyle $ \ sty ->
     case sort of
-      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
-      External mod           -> pprExternal sty uniq mod occ False UserSyntax
+      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
+      External mod            -> pprExternal sty uniq mod occ n False UserSyntax
       System                         -> pprSystem sty uniq occ
       Internal               -> pprInternal sty uniq occ
   where uniq = mkUniqueGrimily (iBox u)
 
-pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
-pprExternal sty uniq mod occ is_wired is_builtin
+pprExternal :: PprStyle -> Unique -> Module -> OccName -> Name -> Bool -> BuiltInSyntax -> SDoc
+pprExternal sty uniq mod occ name is_wired is_builtin
   | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
        -- In code style, always qualify
        -- ToDo: maybe we could print all wired-in things unqualified
        --       in code style, to reduce symbol table bloat?
-  | debugStyle sty = ppr mod <> dot <> ppr_occ_name occ
+  | debugStyle sty = pp_mod <> ppr_occ_name occ
                     <> braces (hsep [if is_wired then ptext (sLit "(w)") else empty,
                                      pprNameSpaceBrief (occNameSpace occ), 
                                      pprUnique uniq])
   | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
-  | otherwise                  = pprModulePrefix sty mod occ <> ppr_occ_name occ
+  | otherwise                   = pprModulePrefix sty mod name <> ppr_occ_name occ
+  where
+    pp_mod | opt_SuppressModulePrefixes = empty
+           | otherwise                  = ppr mod <> dot 
 
 pprInternal :: PprStyle -> Unique -> OccName -> SDoc
 pprInternal sty uniq occ
@@ -449,14 +479,14 @@ pprSystem sty uniq occ
                                -- so print the unique
 
 
-pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
+pprModulePrefix :: PprStyle -> Module -> Name -> SDoc
 -- Print the "M." part of a name, based on whether it's in scope or not
 -- See Note [Printing original names] in HscTypes
-pprModulePrefix sty mod occ
+pprModulePrefix sty mod name
   | opt_SuppressModulePrefixes = empty
   
   | otherwise
-  = case qualName sty mod occ of                  -- See Outputable.QualifyName:
+  = case qualName sty name of              -- See Outputable.QualifyName:
       NameQual modname -> ppr modname <> dot       -- Name is in scope       
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
       NameNotInScope2  -> ppr (modulePackageId mod) <> colon     -- Module not in
@@ -482,15 +512,23 @@ ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
 
 -- Prints (if mod information is available) "Defined at <loc>" or 
 --  "Defined in <mod>" information for a Name.
-pprNameLoc :: Name -> SDoc
-pprNameLoc name = case nameSrcSpan name of
-                  RealSrcSpan s ->
-                      pprDefnLoc s
-                  UnhelpfulSpan _
-                   | isInternalName name || isSystemName name ->
-                      ptext (sLit "<no location info>")
-                   | otherwise ->
-                      ptext (sLit "Defined in ") <> ppr (nameModule name)
+pprDefinedAt :: Name -> SDoc
+pprDefinedAt name = ptext (sLit "Defined") <+> pprNameDefnLoc name
+
+pprNameDefnLoc :: Name -> SDoc
+-- Prints "at <loc>" or 
+--     or "in <mod>" depending on what info is available
+pprNameDefnLoc name 
+  = case nameSrcLoc name of
+         -- nameSrcLoc rather than nameSrcSpan
+        -- It seems less cluttered to show a location
+        -- rather than a span for the definition point
+       RealSrcLoc s -> ptext (sLit "at") <+> ppr s
+       UnhelpfulLoc s
+         | isInternalName name || isSystemName name
+         -> ptext (sLit "at") <+> ftext s
+         | otherwise 
+         -> ptext (sLit "in") <+> quotes (ppr (nameModule name))
 \end{code}
 
 %************************************************************************
index 167ce42..27b71d9 100644 (file)
@@ -1,5 +1,9 @@
 \begin{code}
 module Name where
 
+import {-# SOURCE #-} Module
+
 data Name
+
+nameModule :: Name -> Module
 \end{code}
index 984f096..8a59e7d 100644 (file)
@@ -5,6 +5,13 @@
 \section[NameEnv]{@NameEnv@: name environments}
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module NameEnv (
        -- * Var, Id and TyVar environments (maps) 
        NameEnv, 
@@ -15,7 +22,7 @@ module NameEnv (
        extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
         extendNameEnvList, extendNameEnvList_C,
        foldNameEnv, filterNameEnv,
-       plusNameEnv, plusNameEnv_C, 
+       plusNameEnv, plusNameEnv_C, alterNameEnv,
        lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
        elemNameEnv, mapNameEnv
     ) where
@@ -41,6 +48,7 @@ emptyNameEnv             :: NameEnv a
 mkNameEnv         :: [(Name,a)] -> NameEnv a
 nameEnvElts               :: NameEnv a -> [a]
 nameEnvUniqueElts  :: NameEnv a -> [(Unique, a)]
+alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
 extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
 extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
 extendNameEnv             :: NameEnv a -> Name -> a -> NameEnv a
@@ -64,6 +72,7 @@ unitNameEnv x y       = unitUFM x y
 extendNameEnv x y z   = addToUFM x y z
 extendNameEnvList x l = addListToUFM x l
 lookupNameEnv x y     = lookupUFM x y
+alterNameEnv          = alterUFM
 mkNameEnv     l       = listToUFM l
 elemNameEnv x y         = elemUFM x y
 foldNameEnv a b c       = foldUFM a b c 
index bef9e92..62fff75 100644 (file)
@@ -4,6 +4,13 @@
 %
 
 \begin{code}
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module NameSet (
        -- * Names set type
        NameSet,
@@ -34,9 +41,6 @@ module NameSet (
 
 import Name
 import UniqSet
-import Util
-
-import Data.Data
 \end{code}
 
 %************************************************************************
@@ -48,20 +52,7 @@ import Data.Data
 \begin{code}
 type NameSet = UniqSet Name
 
--- TODO: These Data/Typeable instances look very dubious. Surely either
--- UniqFM should have the instances, or this should be a newtype?
-
-nameSetTc :: TyCon
-nameSetTc = mkTyCon "NameSet"
-instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] }
-
-instance Data NameSet where
-  gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly
-  toConstr _   = abstractConstr "NameSet"
-  gunfold _ _  = error "gunfold"
-  dataTypeOf _ = mkNoRepType "NameSet"
-
-emptyNameSet      :: NameSet
+emptyNameSet       :: NameSet
 unitNameSet       :: Name -> NameSet
 addListToNameSet   :: NameSet -> [Name] -> NameSet
 addOneToNameSet    :: NameSet -> Name -> NameSet
index ac22824..9f8f32d 100644 (file)
 -- * 'Id.Id': see "Id#name_types"
 --
 -- * 'Var.Var': see "Var#name_types"
+
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module OccName (
        -- * The 'NameSpace' type
        NameSpace, -- Abstract
@@ -45,20 +53,22 @@ module OccName (
         mkDFunOcc,
        mkTupleOcc, 
        setOccNameSpace,
+        demoteOccName,
 
        -- ** Derived 'OccName's
         isDerivedOccName,
        mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkGenDefMethodOcc,
        mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc,
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
-       mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
+       mkClassDataConOcc, mkDictOcc, mkIPOcc, 
        mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
        mkGenD, mkGenR, mkGenRCo, mkGenC, mkGenS,
-       mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
+        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
        mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
        mkInstTyCoOcc, mkEqPredCoOcc,
         mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-        mkPDataTyConOcc, mkPDataDataConOcc,
+        mkPDataTyConOcc,  mkPDataDataConOcc,
+       mkPDatasTyConOcc, mkPDatasDataConOcc,
         mkPReprTyConOcc, 
         mkPADFunOcc,
 
@@ -196,8 +206,35 @@ pprNameSpaceBrief DataName  = char 'd'
 pprNameSpaceBrief VarName   = char 'v'
 pprNameSpaceBrief TvName    = ptext (sLit "tv")
 pprNameSpaceBrief TcClsName = ptext (sLit "tc")
+
+-- demoteNameSpace lowers the NameSpace if possible.  We can not know
+-- in advance, since a TvName can appear in an HsTyVar.
+-- see Note [Demotion]
+demoteNameSpace :: NameSpace -> Maybe NameSpace
+demoteNameSpace VarName = Nothing
+demoteNameSpace DataName = Nothing
+demoteNameSpace TvName = Nothing
+demoteNameSpace TcClsName = Just DataName
 \end{code}
 
+Note [Demotion]
+~~~~~~~~~~~~~~~
+
+When the user writes:
+  data Nat = Zero | Succ Nat
+  foo :: f Zero -> Int
+
+'Zero' in the type signature of 'foo' is parsed as:
+  HsTyVar ("Zero", TcClsName)
+
+When the renamer hits this occurence of 'Zero' it's going to realise
+that it's not in scope. But because it is renaming a type, it knows
+that 'Zero' might be a promoted data constructor, so it will demote
+its namespace to DataName and do a second lookup.
+
+The final result (after the renamer) will be:
+  HsTyVar ("Zero", DataName)
+
 
 %************************************************************************
 %*                                                                     *
@@ -308,6 +345,13 @@ mkClsOcc = mkOccName clsName
 
 mkClsOccFS :: FastString -> OccName
 mkClsOccFS = mkOccNameFS clsName
+
+-- demoteOccName lowers the Namespace of OccName.
+-- see Note [Demotion]
+demoteOccName :: OccName -> Maybe OccName
+demoteOccName (OccName space name) = do
+  space' <- demoteNameSpace space
+  return $ OccName space' name
 \end{code}
 
 
@@ -466,7 +510,7 @@ isDataSymOcc _                    = False
 -- it is a data constructor or variable or whatever)
 isSymOcc :: OccName -> Bool
 isSymOcc (OccName DataName s)  = isLexConSym s
-isSymOcc (OccName TcClsName s) = isLexSym s
+isSymOcc (OccName TcClsName s) = isLexConSym s
 isSymOcc (OccName VarName s)   = isLexSym s
 isSymOcc (OccName TvName s)    = isLexSym s
 -- Pretty inefficient!
@@ -541,14 +585,12 @@ isDerivedOccName occ =
 
 \begin{code}
 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkGenDefMethodOcc,
-       mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc,
+       mkDerivedTyConOcc, mkClassDataConOcc, mkDictOcc,
        mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
        mkGenD, mkGenR, mkGenRCo,
        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
        mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
-        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
-       mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-       mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
@@ -557,8 +599,7 @@ mkWorkerOcc         = mk_simple_deriv varName  "$w"
 mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
 mkGenDefMethodOcc   = mk_simple_deriv varName  "$gdm"
 mkClassOpAuxOcc     = mk_simple_deriv varName  "$c"
-mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"     -- The : prefix makes sure it classifies
-mkClassTyConOcc     = mk_simple_deriv tcName   "T:"    -- as a tycon/datacon
+mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"     -- The : prefix makes sure it classifies as a tycon/datacon
 mkClassDataConOcc   = mk_simple_deriv dataName "D:"    -- We go straight to the "real" data con
                                                        -- for datacons from classes
 mkDictOcc          = mk_simple_deriv varName  "$d"
@@ -598,18 +639,29 @@ mkDataTOcc = mk_simple_deriv varName  "$t"
 mkDataCOcc = mk_simple_deriv varName  "$c"
 
 -- Vectorisation
-mkVectOcc          = mk_simple_deriv varName  "$v_"
-mkVectTyConOcc     = mk_simple_deriv tcName   ":V_"
-mkVectDataConOcc   = mk_simple_deriv dataName ":VD_"
-mkVectIsoOcc       = mk_simple_deriv varName  "$VI_"
-mkPDataTyConOcc    = mk_simple_deriv tcName   ":VP_"
-mkPDataDataConOcc  = mk_simple_deriv dataName ":VPD_"
-mkPReprTyConOcc    = mk_simple_deriv tcName   ":VR_"
-mkPADFunOcc        = mk_simple_deriv varName  "$PA_"
+mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
+ mkPADFunOcc,      mkPReprTyConOcc,
+ mkPDataTyConOcc,  mkPDataDataConOcc,
+ mkPDatasTyConOcc, mkPDatasDataConOcc
+  :: Maybe String -> OccName -> OccName
+mkVectOcc          = mk_simple_deriv_with varName  "$v"
+mkVectTyConOcc     = mk_simple_deriv_with tcName   "V:"
+mkVectDataConOcc   = mk_simple_deriv_with dataName "VD:"
+mkVectIsoOcc       = mk_simple_deriv_with varName  "$vi"
+mkPADFunOcc        = mk_simple_deriv_with varName  "$pa"
+mkPReprTyConOcc    = mk_simple_deriv_with tcName   "VR:"
+mkPDataTyConOcc    = mk_simple_deriv_with tcName   "VP:"
+mkPDatasTyConOcc   = mk_simple_deriv_with tcName   "VPs:"
+mkPDataDataConOcc  = mk_simple_deriv_with dataName "VPD:"
+mkPDatasDataConOcc = mk_simple_deriv_with dataName "VPDs:"
 
 mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 
+mk_simple_deriv_with :: NameSpace -> String -> Maybe String -> OccName -> OccName
+mk_simple_deriv_with sp px Nothing     occ = mk_deriv sp px                  (occNameString occ)
+mk_simple_deriv_with sp px (Just with) occ = mk_deriv sp (px ++ with ++ "_") (occNameString occ)
+
 -- Data constructor workers are made by setting the name space
 -- of the data constructor OccName (which should be a DataName)
 -- to VarName
@@ -620,8 +672,8 @@ mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
 mkSuperDictSelOcc :: Int       -- ^ Index of superclass, e.g. 3
                  -> OccName    -- ^ Class, e.g. @Ord@
                  -> OccName    -- ^ Derived 'Occname', e.g. @$p3Ord@
-mkSuperDictSelOcc index cls_occ
-  = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
+mkSuperDictSelOcc index cls_tc_occ
+  = mk_deriv varName "$p" (show index ++ occNameString cls_tc_occ)
 
 mkLocalOcc :: Unique           -- ^ Unique to combine with the 'OccName'
           -> OccName           -- ^ Local name, e.g. @sat@
@@ -747,24 +799,43 @@ tidyOccName in_scope occ@(OccName occ_sp fs)
 %************************************************************************
 
 \begin{code}
-mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
-mkTupleOcc ns bx ar = OccName ns (mkFastString str)
+mkTupleOcc :: NameSpace -> TupleSort -> Arity -> OccName
+mkTupleOcc ns sort ar = OccName ns (mkFastString str)
   where
        -- no need to cache these, the caching is done in the caller
        -- (TysWiredIn.mk_tuple)
-    str = case bx of
-               Boxed   -> '(' : commas ++ ")"
-               Unboxed -> '(' : '#' : commas ++ "#)"
+    str = case sort of
+               UnboxedTuple    -> '(' : '#' : commas ++ "#)"
+               BoxedTuple      -> '(' : commas ++ ")"
+                ConstraintTuple -> '(' : commas ++ ")"
+                  -- Cute hack: reuse the standard tuple OccNames (and hence code)
+                  -- for fact tuples, but give them different Uniques so they are not equal.
+                  --
+                  -- You might think that this will go wrong because isTupleOcc_maybe won't
+                  -- be able to tell the difference between boxed tuples and fact tuples. BUT:
+                  --  1. Fact tuples never occur directly in user code, so it doesn't matter
+                  --     that we can't detect them in Orig OccNames originating from the user
+                  --     programs (or those built by setRdrNameSpace used on an Exact tuple Name)
+                  --  2. Interface files have a special representation for tuple *occurrences*
+                  --     in IfaceTyCons, their workers (in IfaceSyn) and their DataCons (in case
+                  --     alternatives). Thus we don't rely on the OccName to figure out what kind
+                  --     of tuple an occurrence was trying to use in these situations.
+                  --  3. We *don't* represent tuple data type declarations specially, so those
+                  --     are still turned into wired-in names via isTupleOcc_maybe. But that's OK
+                  --     because we don't actually need to declare fact tuples thanks to this hack.
+                  --
+                  -- So basically any OccName like (,,) flowing to isTupleOcc_maybe will always
+                  -- refer to the standard boxed tuple. Cool :-)
 
     commas = take (ar-1) (repeat ',')
 
-isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
+isTupleOcc_maybe :: OccName -> Maybe (NameSpace, TupleSort, Arity)
 -- Tuples are special, because there are so many of them!
 isTupleOcc_maybe (OccName ns fs)
   = case unpackFS fs of
-       '(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
-       '(':',':rest     -> Just (ns, Boxed,   2 + count_commas rest)
-       _other           -> Nothing
+       '(':'#':',':rest     -> Just (ns, UnboxedTuple, 2 + count_commas rest)
+       '(':',':rest         -> Just (ns, BoxedTuple,   2 + count_commas rest)
+       _other               -> Nothing
   where
     count_commas (',':rest) = 1 + count_commas rest
     count_commas _          = 0
index 3b19356..0353e65 100644 (file)
 -- * 'Id.Id': see "Id#name_types"
 --
 -- * 'Var.Var': see "Var#name_types"
+
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 module RdrName (
         -- * The main type
        RdrName(..),    -- Constructors exported only to BinIface
@@ -32,7 +40,7 @@ module RdrName (
        nameRdrName, getRdrName, 
 
        -- ** Destruction
-       rdrNameOcc, rdrNameSpace, setRdrNameSpace,
+       rdrNameOcc, rdrNameSpace, setRdrNameSpace, demoteRdrName,
        isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, 
        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
 
@@ -66,7 +74,9 @@ import Maybes
 import SrcLoc
 import FastString
 import Outputable
+import Unique
 import Util
+import StaticFlags( opt_PprStyle_Debug )
 
 import Data.Data
 \end{code}
@@ -149,6 +159,14 @@ setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
 setRdrNameSpace (Exact n)    ns = ASSERT( isExternalName n ) 
                                  Orig (nameModule n)
                                       (setOccNameSpace ns (nameOccName n))
+
+-- demoteRdrName lowers the NameSpace of RdrName.
+-- see Note [Demotion] in OccName
+demoteRdrName :: RdrName -> Maybe RdrName
+demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
+demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
+demoteRdrName (Orig _ _) = panic "demoteRdrName"
+demoteRdrName (Exact _) = panic "demoteRdrName"
 \end{code}
 
 \begin{code}
@@ -246,7 +264,9 @@ instance Outputable RdrName where
     ppr (Exact name)   = ppr name
     ppr (Unqual occ)   = ppr occ
     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
-    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
+    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod name <> ppr occ)
+       where name = mkExternalName (mkUniqueGrimily 0) mod occ noSrcSpan
+         -- Note [Outputable Orig RdrName] in HscTypes
 
 instance OutputableBndr RdrName where
     pprBndr _ n 
@@ -320,7 +340,6 @@ extendLocalRdrEnvList env names
   = extendOccEnvList env [(nameOccName n, n) | n <- names]
 
 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
-lookupLocalRdrEnv _   (Exact name) = Just name
 lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
 lookupLocalRdrEnv _   _            = Nothing
 
@@ -367,22 +386,68 @@ data GlobalRdrElt
     }
 
 -- | The children of a Name are the things that are abbreviated by the ".."
---   notation in export lists.  Specifically:
---     TyCon   Children are * data constructors
---                          * record field ids
---     Class   Children are * class operations
--- Each child has the parent thing as its Parent
+--   notation in export lists.  See Note [Parents]
 data Parent = NoParent | ParentIs Name
              deriving (Eq)
 
+{- Note [Parents]
+~~~~~~~~~~~~~~~~~
+  Parent           Children
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  data T           Data constructors
+                  Record-field ids
+
+  data family T    Data constructors and record-field ids
+                   of all visible data instances of T
+
+  class        C          Class operations
+                  Associated type constructors
+
+Note [Combining parents]
+~~~~~~~~~~~~~~~~~~~~~~~~
+With an associated type we might have
+   module M where
+     class C a where
+       data T a
+       op :: T a -> a
+     instance C Int where
+       data T Int = TInt
+     instance C Bool where
+       data T Bool = TBool
+
+Then:   C is the parent of T
+       T is the parent of TInt and TBool
+So: in an export list
+    C(..) is short for C( op, T )
+    T(..) is short for T( TInt, TBool )
+
+Module M exports everything, so its exports will be
+   AvailTC C [C,T,op]
+   AvailTC T [T,TInt,TBool]
+On import we convert to GlobalRdrElt and the combine
+those.  For T that will mean we have 
+  one GRE with Parent C
+  one GRE with NoParent
+That's why plusParent picks the "best" case.
+-} 
+
 instance Outputable Parent where
    ppr NoParent     = empty
    ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
    
 
 plusParent :: Parent -> Parent -> Parent
-plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
-                   p1
+-- See Note [Combining parents]
+plusParent (ParentIs n) p2 = hasParent n p2
+plusParent p1 (ParentIs n) = hasParent n p1
+plusParent _ _ = NoParent
+
+hasParent :: Name -> Parent -> Parent
+#ifdef DEBUG
+hasParent n (ParentIs n') 
+  | n /= n' = pprPanic "hasParent" (ppr n <+> ppr n')  -- Parents should agree
+#endif
+hasParent n _  = ParentIs n
 
 emptyGlobalRdrEnv :: GlobalRdrEnv
 emptyGlobalRdrEnv = emptyOccEnv
@@ -391,17 +456,15 @@ globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
 globalRdrEnvElts env = foldOccEnv (++) [] env
 
 instance Outputable GlobalRdrElt where
-  ppr gre = ppr name <+> parens (ppr (gre_par gre) <+> pprNameProvenance gre)
-         where
-           name = gre_name gre
+  ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))
+               2 (pprNameProvenance gre)
 
 pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
 pprGlobalRdrEnv env
   = vcat (map pp (occEnvElts env))
   where
     pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+> 
-             vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
-                  | gre <- gres]
+             vcat (map ppr gres)
 \end{code}
 
 \begin{code}
@@ -429,8 +492,9 @@ lookupGRE_Name env name
 getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
 -- Returns all the qualifiers by which 'x' is in scope
 -- Nothing means "the unqualified version is in scope"
+-- [] means the thing is not in scope at all
 getGRE_NameQualifier_maybes env
-  = map qualifier_maybe . map gre_prov . lookupGRE_Name env
+  = map (qualifier_maybe . gre_prov) . lookupGRE_Name env
   where
     qualifier_maybe LocalDef       = Nothing
     qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
@@ -671,22 +735,39 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
   = ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
   = case whys of
-       (why:_) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
+       (why:_) | opt_PprStyle_Debug -> vcat (map pp_why whys)
+                | otherwise          -> pp_why why
        [] -> panic "pprNameProvenance"
+  where
+    pp_why why = sep [ppr why, ppr_defn_site why name]
 
 -- If we know the exact definition point (which we may do with GHCi)
 -- then show that too.  But not if it's just "imported from X".
-ppr_defn :: SrcLoc -> SDoc
-ppr_defn (RealSrcLoc loc) = parens (ptext (sLit "defined at") <+> ppr loc)
-ppr_defn (UnhelpfulLoc _) = empty
+ppr_defn_site :: ImportSpec -> Name -> SDoc
+ppr_defn_site imp_spec name 
+  | same_module && not (isGoodSrcSpan loc)
+  = empty             -- Nothing interesting to say
+  | otherwise
+  = parens $ hang (ptext (sLit "and originally defined") <+> pp_mod)
+                2 (pprLoc loc)
+  where
+    loc = nameSrcSpan name
+    defining_mod = nameModule name
+    same_module = importSpecModule imp_spec == moduleName defining_mod
+    pp_mod | same_module = empty
+           | otherwise   = ptext (sLit "in") <+> quotes (ppr defining_mod)
+
 
 instance Outputable ImportSpec where
    ppr imp_spec
-     = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec) 
-       <+> pprLoc
+     = ptext (sLit "imported") <+> qual 
+        <+> ptext (sLit "from") <+> quotes (ppr (importSpecModule imp_spec))
+       <+> pprLoc (importSpecLoc imp_spec)
      where
-       loc = importSpecLoc imp_spec
-       pprLoc = case loc of
-                RealSrcSpan s -> ptext (sLit "at") <+> ppr s
-                UnhelpfulSpan _ -> empty
+       qual | is_qual (is_decl imp_spec) = ptext (sLit "qualified")
+            | otherwise                  = empty
+
+pprLoc :: SrcSpan -> SDoc
+pprLoc (RealSrcSpan s)    = ptext (sLit "at") <+> ppr s
+pprLoc (UnhelpfulSpan {}) = empty
 \end{code}
index f15d0da..bb7c4c3 100644 (file)
@@ -8,6 +8,13 @@
    -- When the earliest compiler we want to boostrap with is
    -- GHC 7.2, we can make RealSrcLoc properly abstract
 
+{-# OPTIONS -fno-warn-tabs #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and
+-- detab the module (please do the detabbing in a separate patch). See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
+-- for details
+
 
 -- | This module contains types that relate to the positions of things
 -- in source files, and allow tagging of those things with locations
@@ -31,9 +38,6 @@ module SrcLoc (
        srcLocLine,             -- return the line part
        srcLocCol,              -- return the column part
        
-       -- ** Misc. operations on SrcLoc
-       pprDefnLoc,
-
         -- * SrcSpan
        RealSrcSpan,            -- Abstract
        SrcSpan(..),
@@ -101,6 +105,7 @@ data RealSrcLoc
   = SrcLoc     FastString      -- A precise location (file name)
                {-# UNPACK #-} !Int             -- line number, begins at 1
                {-# UNPACK #-} !Int             -- column number, begins at 1
+  deriving Show
 
 data SrcLoc
   = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
@@ -253,24 +258,16 @@ data RealSrcSpan
          srcSpanLine     :: {-# UNPACK #-} !Int,
          srcSpanCol      :: {-# UNPACK #-} !Int
        }
-#ifdef