diff options
author | Austin Seipp <austin@well-typed.com> | 2013-09-09 13:40:06 -0500 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2013-09-11 19:54:36 -0500 |
commit | 75a9664af1c4e6f87794b49a215adb235b20696d (patch) | |
tree | 1748f512a2bde8c58b1e9c34c22203b0b20541ca /compiler/prelude/PrelNames.lhs | |
parent | b20cf4ecbf244f091f4084c11ae2350d248ce6ef (diff) | |
download | haskell-75a9664af1c4e6f87794b49a215adb235b20696d.tar.gz |
Implement the AMP warning (#8004)
This patch implements a warning when definitions conflict with the
Applicative-Monad Proposal (AMP), described in #8004. Namely, this will
cause a warning iff:
* You have an instance of Monad, but not Applicative
* You have an instance of MonadPlus, but not Alternative
* You locally defined a function named join, <*>, or pure.
In GHC 7.10, these warnings will actually be enforced with superclass
constraints through changes in base, so programs will fail to compile
then.
This warning is enabled by default. Unfortunately, not all of
our upstream libraries have accepted the appropriate patches. So we
temporarily fix ./validate by ignoring the AMP warning.
Dan Rosén made an initial implementation of this change, and the
remaining work was finished off by David Luposchainsky. I finally made
some minor refactorings.
Authored-by: Dan Rosén <danr@chalmers.se>
Authored-by: David Luposchainsky <dluposchainsky@gmail.com>
Signed-off-by: Austin Seipp <austin@well-typed.com>
Diffstat (limited to 'compiler/prelude/PrelNames.lhs')
-rw-r--r-- | compiler/prelude/PrelNames.lhs | 31 |
1 files changed, 28 insertions, 3 deletions
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 3e5384bc5f..b428f6e375 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -184,6 +184,7 @@ basicKnownKeyNames dataClassName, isStringClassName, applicativeClassName, + alternativeClassName, foldableClassName, traversableClassName, typeableClassName, -- derivable @@ -203,10 +204,15 @@ basicKnownKeyNames enumFromName, enumFromThenName, enumFromThenToName, enumFromToName, + -- Applicative/Alternative stuff + pureAName, + apAName, + -- Monad stuff thenIOName, bindIOName, returnIOName, failIOName, failMName, bindMName, thenMName, returnMName, fmapName, + joinMName, -- MonadRec stuff mfixName, @@ -701,8 +707,8 @@ notAssocDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "NotAssociative") fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, foldMap_RDR, traverse_RDR, mempty_RDR, mappend_RDR :: RdrName fmap_RDR = varQual_RDR gHC_BASE (fsLit "fmap") -pure_RDR = varQual_RDR cONTROL_APPLICATIVE (fsLit "pure") -ap_RDR = varQual_RDR cONTROL_APPLICATIVE (fsLit "<*>") +pure_RDR = nameRdrName pureAName +ap_RDR = nameRdrName apAName foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr") foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") @@ -821,6 +827,24 @@ applicativeClassName = clsQual cONTROL_APPLICATIVE (fsLit "Applicative") appli foldableClassName = clsQual dATA_FOLDABLE (fsLit "Foldable") foldableClassKey traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") traversableClassKey + + +-- AMP additions + +joinMName, apAName, pureAName, alternativeClassName :: Name +joinMName = methName mONAD (fsLit "join") joinMIdKey +apAName = methName cONTROL_APPLICATIVE (fsLit "<*>") apAClassOpKey +pureAName = methName cONTROL_APPLICATIVE (fsLit "pure") pureAClassOpKey +alternativeClassName = clsQual cONTROL_APPLICATIVE (fsLit "Alternative") alternativeClassKey + +joinMIdKey, apAClassOpKey, pureAClassOpKey, alternativeClassKey :: Unique +joinMIdKey = mkPreludeMiscIdUnique 750 +apAClassOpKey = mkPreludeMiscIdUnique 751 -- <*> +pureAClassOpKey = mkPreludeMiscIdUnique 752 +alternativeClassKey = mkPreludeMiscIdUnique 753 + + + -- Functions for GHC extensions groupWithName :: Name groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey @@ -1812,7 +1836,8 @@ standardClassKeys = derivableClassKeys ++ numericClassKeys functorClassKey, monadClassKey, monadPlusClassKey, isStringClassKey, - applicativeClassKey, foldableClassKey, traversableClassKey + applicativeClassKey, foldableClassKey, + traversableClassKey, alternativeClassKey ] \end{code} |