Deprecate the AMP warnings.

Now that we're in development mode, Applicative will soon be a
superclass of Monad in HEAD. So let's go ahead and deprecate the
-fno-warn-amp flag, remove the checks, and tweak a few tests

Signed-off-by: Austin Seipp <austin@well-typed.com>

14 files changed, 14 insertions, 232 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 6702b73826..1f7044c097 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -2604,7 +2604,8 @@ fWarningFlags = [
   ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, nop ),
   ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
-  ( "warn-amp",                         Opt_WarnAMP, nop ),
+  ( "warn-amp",                         Opt_WarnAMP,
+    \_ -> deprecate "it has no effect, and will be removed in GHC 7.12" ),
   ( "warn-orphans",                     Opt_WarnOrphans, nop ),
   ( "warn-identities",                  Opt_WarnIdentities, nop ),
   ( "warn-auto-orphans",                Opt_WarnAutoOrphans, nop ),
@@ -3026,7 +3027,6 @@ standardWarnings
     = [ Opt_WarnOverlappingPatterns,
         Opt_WarnWarningsDeprecations,
         Opt_WarnDeprecatedFlags,
-        Opt_WarnAMP,
         Opt_WarnTypedHoles,
         Opt_WarnUnrecognisedPragmas,
         Opt_WarnPointlessPragmas,
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 12eb96f19d..5b39132254 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -79,7 +79,7 @@ import DataCon
 import Type
 import Class
 import CoAxiom
-import Inst     ( tcGetInstEnvs, tcGetInsts )
+import Inst     ( tcGetInstEnvs )
 import Annotations
 import Data.List ( sortBy )
 import Data.IORef ( readIORef )
@@ -939,218 +939,6 @@ rnTopSrcDecls extra_deps group
 
 %************************************************************************
 %*                                                                      *
-                AMP warnings
-     The functions defined here issue warnings according to
-     the 2013 Applicative-Monad proposal. (Trac #8004)
-%*                                                                      *
-%************************************************************************
-
-Note [No AMP warning with NoImplicitPrelude]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If you have -XNoImplicitPrelude, then we suppress the AMP warnings.
-The AMP warnings need access to Monad, Applicative, etc, and they
-are defined in 'base'. If, when compiling package 'ghc-prim' (say),
-you try to load Monad (from 'base'), chaos results because 'base'
-depends on 'ghc-prim'.  See Note [Home module load error] in LoadIface,
-and Trac #8320.
-
-Using -XNoImplicitPrelude is a proxy for ensuring that all the
-'base' modules are below the home module in the dependency tree.
-
-\begin{code}
--- | Main entry point for generating AMP warnings
-tcAmpWarn :: TcM ()
-tcAmpWarn =
-    do { implicit_prel <- xoptM Opt_ImplicitPrelude
-       ; warnFlag <- woptM Opt_WarnAMP
-       ; when (warnFlag && implicit_prel) $ do {
-              -- See Note [No AMP warning with NoImplicitPrelude]
-
-         -- Monad without Applicative
-       ; tcAmpMissingParentClassWarn monadClassName
-                                     applicativeClassName
-
-         -- MonadPlus without Alternative
-       ; tcAmpMissingParentClassWarn monadPlusClassName
-                                     alternativeClassName
-
-         -- Custom local definitions of join/pure/<*>
-       ; mapM_ tcAmpFunctionWarn [joinMName, apAName, pureAName]
-    }}
-
-
-
--- | Warn on local definitions of names that would clash with Prelude versions,
---   i.e. join/pure/<*>
---
---   A name clashes if the following criteria are met:
---       1. It would is imported (unqualified) from Prelude
---       2. It is locally defined in the current module
---       3. It has the same literal name as the reference function
---       4. It is not identical to the reference function
-tcAmpFunctionWarn :: Name -- ^ Name to check, e.g. joinMName for join
-                  -> TcM ()
-tcAmpFunctionWarn name = do
-    { traceTc "tcAmpFunctionWarn/wouldBeImported" empty
-    -- Is the name imported (unqualified) from Prelude? (Point 4 above)
-    ; rnImports <- fmap (map unLoc . tcg_rn_imports) getGblEnv
-    -- (Note that this automatically handles -XNoImplicitPrelude, as Prelude
-    -- will not appear in rnImports automatically if it is set.)
-
-    -- Continue only the name is imported from Prelude
-    ; when (tcAmpImportViaPrelude name rnImports) $ do
-      -- Handle 2.-4.
-    { rdrElts <- fmap (concat . occEnvElts . tcg_rdr_env) getGblEnv
-
-    ; let clashes :: GlobalRdrElt -> Bool
-          clashes x = and [ gre_prov x == LocalDef
-                          , nameOccName (gre_name x) == nameOccName name
-                          , gre_name x /= name
-                          ]
-
-          -- List of all offending definitions
-          clashingElts :: [GlobalRdrElt]
-          clashingElts = filter clashes rdrElts
-
-    ; traceTc "tcAmpFunctionWarn/amp_prelude_functions"
-                (hang (ppr name) 4 (sep [ppr clashingElts]))
-
-    ; let warn_msg x = addWarnAt (nameSrcSpan $ gre_name x) . hsep $
-              [ ptext (sLit "Local definition of")
-              , quotes . ppr . nameOccName $ gre_name x
-              , ptext (sLit "clashes with a future Prelude name")
-              , ptext (sLit "- this will become an error in GHC 7.10,")
-              , ptext (sLit "under the Applicative-Monad Proposal.")
-              ]
-    ; mapM_ warn_msg clashingElts
-    }}
-
--- | Is the given name imported via Prelude?
---
---   This function makes sure that e.g. "import Prelude (map)" should silence
---   AMP warnings about "join" even when they are locally defined.
---
---   Possible scenarios:
---     a) Prelude is imported implicitly, issue warnings.
---     b) Prelude is imported explicitly, but without mentioning the name in
---        question. Issue no warnings.
---     c) Prelude is imported hiding the name in question. Issue no warnings.
---     d) Qualified import of Prelude, no warnings.
-tcAmpImportViaPrelude :: Name
-                      -> [ImportDecl Name]
-                      -> Bool
-tcAmpImportViaPrelude name = any importViaPrelude
-  where
-    isPrelude :: ImportDecl Name -> Bool
-    isPrelude imp = unLoc (ideclName imp) == pRELUDE_NAME
-
-    -- Implicit (Prelude) import?
-    isImplicit :: ImportDecl Name -> Bool
-    isImplicit = ideclImplicit
-
-    -- Unqualified import?
-    isUnqualified :: ImportDecl Name -> Bool
-    isUnqualified = not . ideclQualified
-
-    second :: (a -> b) -> (x, a) -> (x, b)
-    second f (x, y) = (x, f y)
-
-    -- List of explicitly imported (or hidden) Names from a single import.
-    --   Nothing -> No explicit imports
-    --   Just (False, <names>) -> Explicit import list of <names>
-    --   Just (True , <names>) -> Explicit hiding of <names>
-    importList :: ImportDecl Name -> Maybe (Bool, [Name])
-    importList = fmap (second (map (ieName . unLoc))) . ideclHiding
-
-    -- Check whether the given name would be imported (unqualified) from
-    -- an import declaration.
-    importViaPrelude :: ImportDecl Name -> Bool
-    importViaPrelude x = isPrelude x && isUnqualified x && or [
-        -- Whole Prelude imported -> potential clash
-          isImplicit x
-        -- Explicit import/hiding list, if applicable
-        , case importList x of
-            Just (False, explicit) -> nameOccName name `elem`    map nameOccName explicit
-            Just (True , hidden  ) -> nameOccName name `notElem` map nameOccName hidden
-            Nothing                -> False
-        ]
-
--- | Issue a warning for instance definitions lacking a should-be parent class.
---   Used for Monad without Applicative and MonadPlus without Alternative.
-tcAmpMissingParentClassWarn :: Name -- ^ Class instance is defined for
-                            -> Name -- ^ Class it should also be instance of
-                            -> TcM ()
-
--- Notation: is* is for classes the type is an instance of, should* for those
---           that it should also be an instance of based on the corresponding
---           is*.
---           Example: in case of Applicative/Monad: is = Monad,
---                                                  should = Applicative
-tcAmpMissingParentClassWarn isName shouldName
-  = do { isClass'     <- tcLookupClass_maybe isName
-       ; shouldClass' <- tcLookupClass_maybe shouldName
-       ; case (isClass', shouldClass') of
-              (Just isClass, Just shouldClass) -> do
-                  { localInstances <- tcGetInsts
-                  ; let isInstance m = is_cls m == isClass
-                        isInsts = filter isInstance localInstances
-                  ; traceTc "tcAmpMissingParentClassWarn/isInsts" (ppr isInsts)
-                  ; forM_ isInsts $ checkShouldInst isClass shouldClass
-                  }
-              _ -> return ()
-       }
-  where
-    -- Checks whether the desired superclass exists in a given environment.
-    checkShouldInst :: Class   -- ^ Class of existing instance
-                    -> Class   -- ^ Class there should be an instance of
-                    -> ClsInst -- ^ Existing instance
-                    -> TcM ()
-    checkShouldInst isClass shouldClass isInst
-      = do { instEnv <- tcGetInstEnvs
-           ; let (instanceMatches, shouldInsts, _)
-                    = lookupInstEnv instEnv shouldClass (is_tys isInst)
-
-           ; traceTc "tcAmpMissingParentClassWarn/checkShouldInst"
-                     (hang (ppr isInst) 4
-                         (sep [ppr instanceMatches, ppr shouldInsts]))
-
-           -- "<location>: Warning: <type> is an instance of <is> but not <should>"
-           -- e.g. "Foo is an instance of Monad but not Applicative"
-           ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst
-                 warnMsg (Just name:_) =
-                      addWarnAt instLoc . hsep $
-                           [ quotes (ppr $ nameOccName name)
-                           , ptext (sLit "is an instance of")
-                           , ppr . nameOccName $ className isClass
-                           , ptext (sLit "but not")
-                           , ppr . nameOccName $ className shouldClass
-                           , ptext (sLit "- this will become an error in GHC 7.10,")
-                           , ptext (sLit "under the Applicative-Monad Proposal.")
-                           ]
-                 warnMsg _ = return ()
-           ; when (null shouldInsts && null instanceMatches) $
-                  warnMsg (is_tcs isInst)
-           }
-
-
--- | Looks up a class, returning Nothing on failure. Similar to
---   TcEnv.tcLookupClass, but does not issue any error messages.
---
--- In particular, it may be called by the AMP check on, say, 
--- Control.Applicative.Applicative, well before Control.Applicative 
--- has been compiled.  In this case we just return Nothing, and the
--- AMP test is silently dropped.
-tcLookupClass_maybe :: Name -> TcM (Maybe Class)
-tcLookupClass_maybe name
-  = do { mb_thing <- tcLookupImported_maybe name
-       ; case mb_thing of
-            Succeeded (ATyCon tc) | Just cls <- tyConClass_maybe tc -> return (Just cls)
-            _ -> return Nothing }
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
                 tcTopSrcDecls
 %*                                                                      *
 %************************************************************************
@@ -1182,7 +970,6 @@ tcTopSrcDecls boot_details
 
                 -- Generate Applicative/Monad proposal (AMP) warnings
         traceTc "Tc3b" empty ;
-        tcAmpWarn ;
 
                 -- Foreign import declarations next.
         traceTc "Tc4" empty ;
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 0ad6fc2f6c..43af1d7489 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1513,7 +1513,7 @@
 
           <row>
             <entry><option>-fwarn-amp</option></entry>
-            <entry>warn on definitions conflicting with the Applicative-Monad Proposal (AMP)</entry>
+            <entry><emphasis>(deprecated)</emphasis> warn on definitions conflicting with the Applicative-Monad Proposal (AMP)</entry>
             <entry>dynamic</entry>
             <entry><option>-fno-warn-amp</option></entry>
           </row>
diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr
index a8ca98bf23..bd0d45de38 100644
--- a/testsuite/tests/ghci.debugger/scripts/break006.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr
@@ -9,7 +9,7 @@
       instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
         -- Defined in ‘GHC.Real’
-      ...plus 24 others
+      ...plus 23 others
     In a stmt of an interactive GHCi command: print it
 
 <interactive>:8:1:
@@ -22,5 +22,5 @@
       instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
         -- Defined in ‘GHC.Real’
-      ...plus 24 others
+      ...plus 23 others
     In a stmt of an interactive GHCi command: print it
diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr
index 8ba1a1dc22..e6a9159836 100644
--- a/testsuite/tests/ghci.debugger/scripts/print019.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr
@@ -8,5 +8,5 @@
       instance Show a => Show (List1 a) -- Defined at ../Test.hs:11:12
       instance Show MyInt -- Defined at ../Test.hs:14:16
       instance Show a => Show (MkT a) -- Defined at ../Test.hs:17:13
-      ...plus 32 others
+      ...plus 31 others
     In a stmt of an interactive GHCi command: print it
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
index cd18d1c39c..cfa2b94a55 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
@@ -7,7 +7,7 @@ overloadedlistsfail01.hs:5:8:
       instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
         -- Defined in ‘GHC.Real’
-      ...plus 24 others
+      ...plus 23 others
     In the expression: print [1]
     In an equation for ‘main’: main = print [1]
 
diff --git a/testsuite/tests/rename/should_compile/T7145b.hs b/testsuite/tests/rename/should_compile/T7145b.hs
index 54200c320f..2d753c8bf7 100644
--- a/testsuite/tests/rename/should_compile/T7145b.hs
+++ b/testsuite/tests/rename/should_compile/T7145b.hs
@@ -1,7 +1,4 @@
 {-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# OPTIONS_GHC -fno-warn-amp #-}
-#endif
 module T7145b ( A.Applicative(pure) ) where
 
 import qualified Control.Applicative as A
diff --git a/testsuite/tests/rename/should_compile/T7145b.stderr b/testsuite/tests/rename/should_compile/T7145b.stderr
index 12ce9a5b72..ed2333e8c4 100644
--- a/testsuite/tests/rename/should_compile/T7145b.stderr
+++ b/testsuite/tests/rename/should_compile/T7145b.stderr
@@ -1,2 +1,2 @@
 
-T7145b.hs:10:1: Warning: Defined but not used: ‘pure’
+T7145b.hs:7:1: Warning: Defined but not used: ‘pure’
diff --git a/testsuite/tests/simplCore/should_compile/spec001.hs b/testsuite/tests/simplCore/should_compile/spec001.hs
index 0afdaf4a5b..c4f9205d25 100644
--- a/testsuite/tests/simplCore/should_compile/spec001.hs
+++ b/testsuite/tests/simplCore/should_compile/spec001.hs
@@ -81,7 +81,8 @@ import Prelude hiding (
 	lines,
 	unlines,
 	words,
-	unwords
+	unwords,
+	join
  )
 
 import GHC.Exts
diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr
index e953827e4a..0c7e5666b4 100644
--- a/testsuite/tests/typecheck/should_compile/holes2.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes2.stderr
@@ -7,7 +7,7 @@ holes2.hs:3:5: Warning:
       instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
         -- Defined in ‘GHC.Real’
-      ...plus 24 others
+      ...plus 23 others
     In the expression: show _
     In an equation for ‘f’: f = show _
 
diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr
index 25f1185425..614c99cb11 100644
--- a/testsuite/tests/typecheck/should_fail/T5095.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5095.stderr
@@ -56,8 +56,6 @@ T5095.hs:9:11:
       instance Eq Ordering -- Defined in ‘GHC.Classes’
       instance Eq GHC.Types.Word -- Defined in ‘GHC.Classes’
       instance Eq a => Eq [a] -- Defined in ‘GHC.Classes’
-      instance Eq a => Eq (Control.Applicative.ZipList a)
-        -- Defined in ‘Control.Applicative’
       instance Eq Integer -- Defined in ‘integer-gmp:GHC.Integer.Type’
     (The choice depends on the instantiation of ‘a’
      To pick the first instance above, use IncoherentInstances
diff --git a/testsuite/tests/typecheck/should_fail/tcfail072.stderr b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
index aa5fcc9c7e..dc301a8e60 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail072.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
@@ -11,6 +11,6 @@ tcfail072.hs:23:13:
         -- Defined in ‘GHC.Real’
       instance Ord () -- Defined in ‘GHC.Classes’
       instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
-      ...plus 23 others
+      ...plus 22 others
     In the expression: g A
     In an equation for ‘g’: g (B _ _) = g A
diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr
index 8d03d24347..b23b9447ae 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr
@@ -10,7 +10,7 @@ tcfail133.hs:68:7:
       instance Show One -- Defined at tcfail133.hs:9:28
       instance (Show a, Show b, Number a, Digit b) => Show (a :@ b)
         -- Defined at tcfail133.hs:11:54
-      ...plus 27 others
+      ...plus 26 others
     In the expression: show
     In the expression: show $ add (One :@ Zero) (One :@ One)
     In an equation for ‘foo’:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail181.stderr b/testsuite/tests/typecheck/should_fail/tcfail181.stderr
index 905a523174..3502f2bbea 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail181.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail181.stderr
@@ -10,7 +10,6 @@ tcfail181.hs:17:9:
       instance Monad ((->) r) -- Defined in ‘GHC.Base’
       instance Monad IO -- Defined in ‘GHC.Base’
       instance Monad [] -- Defined in ‘GHC.Base’
-      ...plus one other
     In the expression: foo
     In the expression: foo {bar = return True}
     In an equation for ‘wog’: wog x = foo {bar = return True}