[commit: ghc] master: Merge branch 'master' of http://darcs.haskell.org/ghc (fb02fa0)
Simon Peyton Jones
simonpj at microsoft.com
Tue Feb 12 14:55:21 CET 2013
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/fb02fa090a5370d214e5303da88005cc6f55427a
>---------------------------------------------------------------
commit fb02fa090a5370d214e5303da88005cc6f55427a
Merge: bcbfdd0... f52b4ad...
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Sat Feb 9 00:08:39 2013 +0000
Merge branch 'master' of http://darcs.haskell.org/ghc
Conflicts:
compiler/typecheck/TcInstDcls.lhs
.gitignore | 1 -
.gitmodules | 3 +
aclocal.m4 | 65 +-
compiler/basicTypes/BasicTypes.lhs | 17 +
compiler/basicTypes/DataCon.lhs | 60 -
compiler/basicTypes/Demand.lhs | 470 ++++----
compiler/basicTypes/IdInfo.lhs | 2 +-
compiler/basicTypes/MkId.lhs | 13 +-
compiler/basicTypes/SrcLoc.lhs | 4 +-
compiler/basicTypes/Var.lhs | 2 +-
compiler/cmm/CLabel.hs | 1 -
compiler/cmm/CmmCallConv.hs | 9 +-
compiler/cmm/CmmCommonBlockElim.hs | 1 +
compiler/cmm/CmmExpr.hs | 17 +
compiler/cmm/CmmLex.x | 3 +
compiler/cmm/CmmMachOp.hs | 69 ++
compiler/cmm/CmmParse.y | 2 +
compiler/cmm/CmmType.hs | 86 ++-
compiler/cmm/CmmUtils.hs | 65 +-
compiler/cmm/PprC.hs | 75 ++-
compiler/cmm/PprCmmExpr.hs | 2 +
compiler/codeGen/CgUtils.hs | 7 +
compiler/codeGen/StgCmmCon.hs | 2 +-
compiler/codeGen/StgCmmLayout.hs | 64 +-
compiler/codeGen/StgCmmPrim.hs | 643 ++++++++---
compiler/coreSyn/CoreArity.lhs | 2 +-
compiler/coreSyn/CoreFVs.lhs | 11 +-
compiler/coreSyn/CoreLint.lhs | 14 +-
compiler/coreSyn/CoreSubst.lhs | 17 +-
compiler/coreSyn/CoreSyn.lhs | 11 +-
compiler/coreSyn/CoreUtils.lhs | 2 +-
compiler/coreSyn/PprCore.lhs | 5 +-
compiler/coreSyn/PprExternalCore.lhs | 5 -
compiler/deSugar/Coverage.lhs | 2 +-
compiler/deSugar/Desugar.lhs | 4 +-
compiler/deSugar/DsBinds.lhs | 4 +-
compiler/deSugar/DsCCall.lhs | 45 +-
compiler/deSugar/DsExpr.lhs | 4 +-
compiler/deSugar/DsForeign.lhs | 2 +-
compiler/deSugar/DsListComp.lhs | 2 +-
compiler/deSugar/DsMeta.hs | 6 +-
compiler/deSugar/DsUtils.lhs | 2 +-
compiler/deSugar/MatchLit.lhs | 2 +-
compiler/ghc.cabal.in | 1 +
compiler/ghci/ByteCodeAsm.lhs | 26 +-
compiler/ghci/ByteCodeItbls.lhs | 2 +-
compiler/ghci/ByteCodeLink.lhs | 2 +-
compiler/ghci/LibFFI.hsc | 4 +-
compiler/ghci/Linker.lhs | 26 +-
compiler/hsSyn/HsDecls.lhs | 12 +-
compiler/hsSyn/HsExpr.lhs | 11 +-
compiler/hsSyn/HsTypes.lhs | 7 +-
compiler/iface/BinIface.hs | 2 +-
compiler/iface/IfaceSyn.lhs | 2 +-
compiler/iface/LoadIface.lhs | 16 +-
compiler/iface/MkIface.lhs | 20 +-
compiler/iface/TcIface.lhs | 30 +-
compiler/llvmGen/Llvm.hs | 2 +-
compiler/llvmGen/Llvm/AbsSyn.hs | 15 +
compiler/llvmGen/Llvm/PpLlvm.hs | 39 +-
compiler/llvmGen/Llvm/Types.hs | 67 +-
compiler/llvmGen/LlvmCodeGen/Base.hs | 14 +-
compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 183 +++-
compiler/llvmGen/LlvmCodeGen/Data.hs | 8 +
compiler/llvmGen/LlvmCodeGen/Regs.hs | 7 +
compiler/main/DriverMkDepend.hs | 6 +-
compiler/main/DriverPipeline.hs | 19 +-
compiler/main/DynFlags.hs | 21 +-
compiler/main/DynamicLoading.hs | 4 +-
compiler/main/ErrUtils.lhs | 3 +-
compiler/main/GHC.hs | 16 +-
compiler/main/GhcMake.hs | 2 +-
compiler/main/HscTypes.lhs | 56 +-
compiler/main/InteractiveEval.hs | 30 +-
compiler/main/Packages.lhs | 13 +-
compiler/main/PlatformConstants.hs | 12 +
compiler/main/StaticFlags.hs | 4 +-
compiler/main/SysTools.lhs | 10 +-
compiler/main/TidyPgm.lhs | 24 +-
compiler/nativeGen/AsmCodeGen.lhs | 47 +-
compiler/nativeGen/PPC/CodeGen.hs | 1 +
compiler/nativeGen/PPC/Instr.hs | 42 +-
compiler/nativeGen/SPARC/CodeGen.hs | 1 +
compiler/nativeGen/X86/CodeGen.hs | 65 +-
compiler/parser/Parser.y.pp | 31 +-
compiler/parser/RdrHsSyn.lhs | 115 +-
compiler/prelude/PrelNames.lhs | 9 +
compiler/prelude/PrelRules.lhs | 2 +-
compiler/prelude/TysPrim.lhs | 51 +-
compiler/prelude/primops.txt.pp | 494 ++++++++
compiler/rename/RnEnv.lhs | 4 +-
compiler/rename/RnExpr.lhs | 22 +-
compiler/rename/RnNames.lhs | 4 +-
compiler/rename/RnSource.lhs | 26 +-
compiler/rename/RnTypes.lhs | 3 +-
compiler/simplCore/LiberateCase.lhs | 2 +-
compiler/simplCore/OccurAnal.lhs | 12 +-
compiler/simplCore/SimplCore.lhs | 30 +-
compiler/simplCore/SimplEnv.lhs | 16 +-
compiler/simplCore/SimplUtils.lhs | 4 +-
compiler/simplCore/Simplify.lhs | 11 +-
compiler/specialise/SpecConstr.lhs | 144 ++--
compiler/specialise/Specialise.lhs | 2 +-
compiler/stgSyn/StgLint.lhs | 2 +-
compiler/stgSyn/StgSyn.lhs | 4 +-
compiler/stranal/DmdAnal.lhs | 47 +-
compiler/stranal/WwLib.lhs | 237 ++--
compiler/typecheck/TcBinds.lhs | 9 +-
compiler/typecheck/TcCanonical.lhs | 11 +-
compiler/typecheck/TcErrors.lhs | 14 +-
compiler/typecheck/TcExpr.lhs | 24 +-
compiler/typecheck/TcGenDeriv.lhs | 4 +-
compiler/typecheck/TcHsSyn.lhs | 8 +-
compiler/typecheck/TcHsType.lhs | 10 +-
compiler/typecheck/TcInstDcls.lhs | 3 +-
compiler/typecheck/TcInteract.lhs | 2 +-
compiler/typecheck/TcMType.lhs | 13 +-
compiler/typecheck/TcPat.lhs | 4 +-
compiler/typecheck/TcRnDriver.lhs | 2 +-
compiler/typecheck/TcRnTypes.lhs | 9 +-
compiler/typecheck/TcSimplify.lhs | 2 +-
compiler/typecheck/TcSplice.lhs | 4 +-
compiler/typecheck/TcTyClsDecls.lhs | 71 +-
compiler/typecheck/TcUnify.lhs | 2 +-
compiler/types/Coercion.lhs | 62 +-
compiler/types/FamInstEnv.lhs | 26 +-
compiler/types/InstEnv.lhs | 2 +-
compiler/types/OptCoercion.lhs | 4 +-
compiler/types/TyCon.lhs | 79 +-
compiler/types/Type.lhs | 26 +-
compiler/types/TypeRep.lhs | 2 +-
compiler/utils/Exception.hs | 5 +-
compiler/utils/Panic.lhs | 7 +-
compiler/vectorise/Vectorise.hs | 397 +++----
compiler/vectorise/Vectorise/Builtins/Base.hs | 3 +-
.../vectorise/Vectorise/Builtins/Initialise.hs | 8 +-
compiler/vectorise/Vectorise/Convert.hs | 22 +-
compiler/vectorise/Vectorise/Env.hs | 121 +-
compiler/vectorise/Vectorise/Exp.hs | 1238 +++++++++++---------
compiler/vectorise/Vectorise/Monad.hs | 29 +-
compiler/vectorise/Vectorise/Monad/Global.hs | 73 +-
compiler/vectorise/Vectorise/Monad/InstEnv.hs | 13 +-
compiler/vectorise/Vectorise/Monad/Local.hs | 117 +-
compiler/vectorise/Vectorise/Type/Classify.hs | 51 +-
compiler/vectorise/Vectorise/Type/Env.hs | 220 ++--
compiler/vectorise/Vectorise/Type/Type.hs | 13 +-
compiler/vectorise/Vectorise/Utils.hs | 25 +-
configure.ac | 31 +-
distrib/configure.ac.in | 7 +-
distrib/mkDocs/mkDocs | 27 +-
docs/storage-mgt/rp.tex | 2 +-
docs/users_guide/7.6.1-notes.xml | 427 -------
docs/users_guide/7.8.1-notes.xml | 33 +
docs/users_guide/glasgow_exts.xml | 72 +-
docs/users_guide/parallel.xml | 2 +-
docs/users_guide/phases.xml | 15 +
docs/users_guide/safe_haskell.xml | 4 +-
docs/users_guide/ug-ent.xml.in | 2 +-
docs/users_guide/using.xml | 28 +-
ghc.mk | 5 +-
ghc/InteractiveUI.hs | 2 +-
includes/Cmm.h | 8 +-
includes/CodeGen.Platform.hs | 27 +
includes/Rts.h | 2 +-
includes/rts/Ticky.h | 2 +-
includes/rts/storage/FunTypes.h | 35 +-
includes/rts/storage/TSO.h | 3 +-
includes/stg/HaskellMachRegs.h | 2 +-
includes/stg/MachRegs.h | 39 +-
includes/stg/MiscClosures.h | 4 +
includes/stg/Regs.h | 42 +
includes/stg/RtsMachRegs.h | 2 +-
includes/stg/Types.h | 2 +
.../Distribution/InstalledPackageInfo/Binary.hs | 2 +-
libraries/gen_contents_index | 24 +-
libraries/random | 1 +
mk/config.mk.in | 1 -
packages | 4 +-
rts/Linker.c | 15 +-
rts/STM.c | 17 +-
rts/Schedule.c | 1 +
rts/Schedule.h | 2 +-
rts/StgMiscClosures.cmm | 12 +
rts/ghc.mk | 10 +-
rts/posix/OSMem.c | 2 +-
rts/win32/AsyncIO.c | 6 +-
rts/win32/AsyncIO.h | 2 +-
rts/win32/IOManager.c | 42 +-
rts/win32/IOManager.h | 4 +-
ghc/Makefile => rules/add-dependency.mk | 9 +-
rules/build-prog.mk | 8 +
utils/deriveConstants/DeriveConstants.hs | 6 +
utils/genapply/GenApply.hs | 68 +-
utils/genprimopcode/Main.hs | 35 +-
utils/ghc-cabal/ghc.mk | 3 +-
utils/ghc-pkg/ghc.mk | 48 +-
utils/hp2ps/ghc.mk | 2 +-
197 files changed, 4766 insertions(+), 3085 deletions(-)
diff --cc compiler/typecheck/TcInstDcls.lhs
index 02c8ace,16a656e..e943558
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@@ -717,7 -721,130 +717,6 @@@ tcDataFamInstDecl mb_clsinfo fam_t
; return fam_inst } }
\end{code}
--
-Note [Associated type instances]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We allow this:
- class C a where
- type T x a
- instance C Int where
- type T (S y) Int = y
- type T Z Int = Char
-
-Note that
- a) The variable 'x' is not bound by the class decl
- b) 'x' is instantiated to a non-type-variable in the instance
- c) There are several type instance decls for T in the instance
-
-All this is fine. Of course, you can't give any *more* instances
-for (T ty Int) elsewhere, because it's an *associated* type.
-
-Note [Checking consistent instantiation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- class C a b where
- type T a x b
-
- instance C [p] Int
- type T [p] y Int = (p,y,y) -- Induces the family instance TyCon
- -- type TR p y = (p,y,y)
-
-So we
- * Form the mini-envt from the class type variables a,b
- to the instance decl types [p],Int: [a->[p], b->Int]
-
- * Look at the tyvars a,x,b of the type family constructor T
- (it shares tyvars with the class C)
-
- * Apply the mini-evnt to them, and check that the result is
- consistent with the instance types [p] y Int
-
-We do *not* assume (at this point) the the bound variables of
-the assoicated type instance decl are the same as for the parent
-instance decl. So, for example,
-
- instance C [p] Int
- type T [q] y Int = ...
-
-would work equally well. Reason: making the *kind* variables line
-up is much harder. Example (Trac #7282):
- class Foo (xs :: [k]) where
- type Bar xs :: *
-
- instance Foo '[] where
- type Bar '[] = Int
-Here the instance decl really looks like
- instance Foo k ('[] k) where
- type Bar k ('[] k) = Int
-but the k's are not scoped, and hence won't match Uniques.
-
-So instead we just match structure, with tcMatchTyX, and check
-that distinct type variales match 1-1 with distinct type variables.
-
-HOWEVER, we *still* make the instance type variables scope over the
-type instances, to pick up non-obvious kinds. Eg
- class Foo (a :: k) where
- type F a
- instance Foo (b :: k -> k) where
- type F b = Int
-Here the instance is kind-indexed and really looks like
- type F (k->k) (b::k->k) = Int
-But if the 'b' didn't scope, we would make F's instance too
-poly-kinded.
-
-\begin{code}
-checkConsistentFamInst
- :: Maybe ( Class
- , VarEnv Type ) -- ^ Class of associated type
- -- and instantiation of class TyVars
- -> SDoc -- ^ "flavor" of the instance
- -> TyCon -- ^ Family tycon
- -> [TyVar] -- ^ Type variables of the family instance
- -> [Type] -- ^ Type patterns from instance
- -> TcM ()
--- See Note [Checking consistent instantiation]
-
-checkConsistentFamInst Nothing _ _ _ _ = return ()
-checkConsistentFamInst (Just (clas, mini_env)) flav fam_tc at_tvs at_tys
- = tcAddFamInstCtxt flav (tyConName fam_tc) $
- do { -- Check that the associated type indeed comes from this class
- checkTc (Just clas == tyConAssoc_maybe fam_tc)
- (badATErr (className clas) (tyConName fam_tc))
-
- -- See Note [Checking consistent instantiation] in TcTyClsDecls
- -- Check right to left, so that we spot type variable
- -- inconsistencies before (more confusing) kind variables
- ; discardResult $ foldrM check_arg emptyTvSubst $
- tyConTyVars fam_tc `zip` at_tys }
- where
- at_tv_set = mkVarSet at_tvs
-
- check_arg :: (TyVar, Type) -> TvSubst -> TcM TvSubst
- check_arg (fam_tc_tv, at_ty) subst
- | Just inst_ty <- lookupVarEnv mini_env fam_tc_tv
- = case tcMatchTyX at_tv_set subst at_ty inst_ty of
- Just subst | all_distinct subst -> return subst
- _ -> failWithTc $ wrongATArgErr at_ty inst_ty
- -- No need to instantiate here, because the axiom
- -- uses the same type variables as the assocated class
- | otherwise
- = return subst -- Allow non-type-variable instantiation
- -- See Note [Associated type instances]
-
- all_distinct :: TvSubst -> Bool
- -- True if all the variables mapped the substitution
- -- map to *distinct* type *variables*
- all_distinct subst = go [] at_tvs
- where
- go _ [] = True
- go acc (tv:tvs) = case lookupTyVar subst tv of
- Nothing -> go acc tvs
- Just ty | Just tv' <- tcGetTyVar_maybe ty
- , tv' `notElem` acc
- -> go (tv' : acc) tvs
- _other -> False
-\end{code}
-
-
%************************************************************************
%* *
Type-checking instance declarations, pass 2
More information about the ghc-commits
mailing list