Move orphan instance/rule warnings to typechecker/desugarer.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 1 Oct 2015 22:24:41 +0000 (15:24 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 8 Oct 2015 22:55:08 +0000 (15:55 -0700)
Summary:
Instead of doing these warnings at MkIface time, we do them
when we create the instances/rules in the typechecker/desugarer.

Emitting warnings for auto-generated instances was a pain
(since the specialization monad doesn't have the capacity
to emit warnings) so instead I just deprecated -fwarn-auto-orphans.
Auto rule orphans are pretty harmless anyway: they don't cause
interface files to be eagerly loaded in.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1297

13 files changed:
compiler/deSugar/Desugar.hs
compiler/deSugar/DsBinds.hs
compiler/iface/MkIface.hs
compiler/main/DynFlags.hs
compiler/main/HscMain.hs
compiler/specialise/Specialise.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcGenGenerics.hs
compiler/types/InstEnv.hs
docs/users_guide/using-warnings.rst
testsuite/tests/typecheck/should_compile/T4912.stderr
testsuite/tests/warnings/should_compile/T9178.stderr
utils/mkUserGuidePart/Options/Warnings.hs

index 1508922..dceebc1 100644 (file)
@@ -381,12 +381,12 @@ dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs))
               fn_name   = idName fn_id
               final_rhs = simpleOptExpr rhs''    -- De-crap it
               rule_name = snd (unLoc name)
               fn_name   = idName fn_id
               final_rhs = simpleOptExpr rhs''    -- De-crap it
               rule_name = snd (unLoc name)
-              rule      = mkRule this_mod False {- Not auto -} is_local
-                                 rule_name rule_act fn_name final_bndrs args
-                                 final_rhs
               arg_ids = varSetElems (exprsSomeFreeVars isId args `delVarSetList` final_bndrs)
 
         ; dflags <- getDynFlags
               arg_ids = varSetElems (exprsSomeFreeVars isId args `delVarSetList` final_bndrs)
 
         ; dflags <- getDynFlags
+        ; rule <- dsMkUserRule this_mod is_local
+                         rule_name rule_act fn_name final_bndrs args
+                         final_rhs
         ; when (wopt Opt_WarnInlineRuleShadowing dflags) $
           warnRuleShadowing rule_name rule_act fn_id arg_ids
 
         ; when (wopt Opt_WarnInlineRuleShadowing dflags) $
           warnRuleShadowing rule_name rule_act fn_id arg_ids
 
index 28e866d..b8df7b8 100644 (file)
@@ -13,7 +13,7 @@ lower levels it is preserved with @let@/@letrec@s).
 {-# LANGUAGE CPP #-}
 
 module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
 {-# LANGUAGE CPP #-}
 
 module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
-                 dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds
+                 dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule
   ) where
 
 #include "HsVersions.h"
   ) where
 
 #include "HsVersions.h"
@@ -69,7 +69,7 @@ import DynFlags
 import FastString
 import Util
 import MonadUtils
 import FastString
 import Util
 import MonadUtils
-import Control.Monad(liftM)
+import Control.Monad(liftM,when)
 import Fingerprint(Fingerprint(..), fingerprintString)
 
 {-
 import Fingerprint(Fingerprint(..), fingerprintString)
 
 {-
@@ -450,7 +450,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
              spec_id   = mkLocalId spec_name spec_ty
                             `setInlinePragma` inl_prag
                             `setIdUnfolding`  spec_unf
              spec_id   = mkLocalId spec_name spec_ty
                             `setInlinePragma` inl_prag
                             `setIdUnfolding`  spec_unf
-             rule =  mkRule this_mod False {- Not auto -} is_local_id
+       ; rule <- dsMkUserRule this_mod is_local_id
                         (mkFastString ("SPEC " ++ showPpr dflags poly_name))
                         rule_act poly_name
                         rule_bndrs args
                         (mkFastString ("SPEC " ++ showPpr dflags poly_name))
                         rule_act poly_name
                         rule_bndrs args
@@ -503,6 +503,17 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
              | otherwise   = spec_prag_act                   -- Specified by user
 
 
              | otherwise   = spec_prag_act                   -- Specified by user
 
 
+dsMkUserRule :: Module -> Bool -> RuleName -> Activation
+       -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> DsM CoreRule
+dsMkUserRule this_mod is_local name act fn bndrs args rhs = do
+    let rule = mkRule this_mod False is_local name act fn bndrs args rhs
+    dflags <- getDynFlags
+    when (isOrphan (ru_orphan rule) && wopt Opt_WarnOrphans dflags) $
+        warnDs (ruleOrphWarn rule)
+    return rule
+
+ruleOrphWarn :: CoreRule -> SDoc
+ruleOrphWarn rule = ptext (sLit "Orphan rule:") <+> ppr rule
 
 {- Note [SPECIALISE on INLINE functions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 {- Note [SPECIALISE on INLINE functions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 99544c4..43e57cd 100644 (file)
@@ -110,7 +110,6 @@ import Maybes
 import ListSetOps
 import Binary
 import Fingerprint
 import ListSetOps
 import Binary
 import Fingerprint
-import Bag
 import Exception
 
 import Control.Monad
 import Exception
 
 import Control.Monad
@@ -135,11 +134,10 @@ mkIface :: HscEnv
         -> Maybe Fingerprint    -- The old fingerprint, if we have it
         -> ModDetails           -- The trimmed, tidied interface
         -> ModGuts              -- Usages, deprecations, etc
         -> Maybe Fingerprint    -- The old fingerprint, if we have it
         -> ModDetails           -- The trimmed, tidied interface
         -> ModGuts              -- Usages, deprecations, etc
-        -> IO (Messages,
-               Maybe (ModIface, -- The new one
-                      Bool))    -- True <=> there was an old Iface, and the
-                                --          new one is identical, so no need
-                                --          to write it
+        -> IO (ModIface, -- The new one
+               Bool)     -- True <=> there was an old Iface, and the
+                         --          new one is identical, so no need
+                         --          to write it
 
 mkIface hsc_env maybe_old_fingerprint mod_details
          ModGuts{     mg_module       = this_mod,
 
 mkIface hsc_env maybe_old_fingerprint mod_details
          ModGuts{     mg_module       = this_mod,
@@ -198,7 +196,7 @@ mkIfaceTc :: HscEnv
           -> SafeHaskellMode    -- The safe haskell mode
           -> ModDetails         -- gotten from mkBootModDetails, probably
           -> TcGblEnv           -- Usages, deprecations, etc
           -> SafeHaskellMode    -- The safe haskell mode
           -> ModDetails         -- gotten from mkBootModDetails, probably
           -> TcGblEnv           -- Usages, deprecations, etc
-          -> IO (Messages, Maybe (ModIface, Bool))
+          -> IO (ModIface, Bool)
 mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
   tc_result@TcGblEnv{ tcg_mod = this_mod,
                       tcg_src = hsc_src,
 mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
   tc_result@TcGblEnv{ tcg_mod = this_mod,
                       tcg_src = hsc_src,
@@ -268,7 +266,7 @@ mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource
          -> [FilePath]
          -> SafeHaskellMode
          -> ModDetails
          -> [FilePath]
          -> SafeHaskellMode
          -> ModDetails
-         -> IO (Messages, Maybe (ModIface, Bool))
+         -> IO (ModIface, Bool)
 mkIface_ hsc_env maybe_old_fingerprint
          this_mod hsc_src used_names used_th deps rdr_env fix_env src_warns
          hpc_info dir_imp_mods pkg_trust_req dependent_files safe_mode
 mkIface_ hsc_env maybe_old_fingerprint
          this_mod hsc_src used_names used_th deps rdr_env fix_env src_warns
          hpc_info dir_imp_mods pkg_trust_req dependent_files safe_mode
@@ -354,38 +352,17 @@ mkIface_ hsc_env maybe_old_fingerprint
                    addFingerprints hsc_env maybe_old_fingerprint
                                    intermediate_iface decls
 
                    addFingerprints hsc_env maybe_old_fingerprint
                                    intermediate_iface decls
 
-    -- Warn about orphans
-    -- See Note [Orphans and auto-generated rules]
-    let warn_orphs      = wopt Opt_WarnOrphans dflags
-        warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
-        orph_warnings   --- Laziness means no work done unless -fwarn-orphans
-          | warn_orphs || warn_auto_orphs = rule_warns `unionBags` inst_warns
-          | otherwise                     = emptyBag
-        errs_and_warns = (orph_warnings, emptyBag)
-        unqual = mkPrintUnqualified dflags rdr_env
-        inst_warns = listToBag [ instOrphWarn dflags unqual d
-                               | (d,i) <- insts `zip` iface_insts
-                               , isOrphan (ifInstOrph i) ]
-        rule_warns = listToBag [ ruleOrphWarn dflags unqual this_mod r
-                               | r <- iface_rules
-                               , isOrphan (ifRuleOrph r)
-                               , if ifRuleAuto r then warn_auto_orphs
-                                                 else warn_orphs ]
-
-    if errorsFound dflags errs_and_warns
-      then return ( errs_and_warns, Nothing )
-      else do
-        -- Debug printing
-        dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
-                      (pprModIface new_iface)
+    -- Debug printing
+    dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
+                  (pprModIface new_iface)
 
 
-        -- bug #1617: on reload we weren't updating the PrintUnqualified
-        -- correctly.  This stems from the fact that the interface had
-        -- not changed, so addFingerprints returns the old ModIface
-        -- with the old GlobalRdrEnv (mi_globals).
-        let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
+    -- bug #1617: on reload we weren't updating the PrintUnqualified
+    -- correctly.  This stems from the fact that the interface had
+    -- not changed, so addFingerprints returns the old ModIface
+    -- with the old GlobalRdrEnv (mi_globals).
+    let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
 
 
-        return (errs_and_warns, Just (final_iface, no_change_at_all))
+    return (final_iface, no_change_at_all)
   where
 
      dflags = hsc_dflags hsc_env
   where
 
      dflags = hsc_dflags hsc_env
@@ -725,25 +702,6 @@ mkIfaceAnnCache anns
     env = mkOccEnv_C (flip (++)) (map pair anns)
 
 {-
     env = mkOccEnv_C (flip (++)) (map pair anns)
 
 {-
-Note [Orphans and auto-generated rules]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we specialise an INLINEABLE function, or when we have
--fspecialise-aggressively, we auto-generate RULES that are orphans.
-We don't want to warn about these, at least not by default, or we'd
-generate a lot of warnings.  Hence -fwarn-auto-orphans.
-
-Indeed, we don't even treat the module as an oprhan module if it has
-auto-generated *rule* orphans.  Orphan modules are read every time we
-compile, so they are pretty obtrusive and slow down every compilation,
-even non-optimised ones.  (Reason: for type class instances it's a
-type correctness issue.)  But specialisation rules are strictly for
-*optimisation* only so it's fine not to read the interface.
-
-What this means is that a SPEC rules from auto-specialisation in
-module M will be used in other modules only if M.hi has been read for
-some other reason, which is actually pretty likely.
-
-
 ************************************************************************
 *                                                                      *
           The ABI of an IfaceDecl
 ************************************************************************
 *                                                                      *
           The ABI of an IfaceDecl
@@ -945,27 +903,6 @@ oldMD5 dflags bh = do
         return $! readHexFingerprint hash_str
 -}
 
         return $! readHexFingerprint hash_str
 -}
 
-instOrphWarn :: DynFlags -> PrintUnqualified -> ClsInst -> WarnMsg
-instOrphWarn dflags unqual inst
-  = mkWarnMsg dflags (getSrcSpan inst) unqual $
-    hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst)
-    $$ text "To avoid this"
-    $$ nest 4 (vcat possibilities)
-  where
-    possibilities =
-      text "move the instance declaration to the module of the class or of the type, or" :
-      text "wrap the type with a newtype and declare the instance on the new type." :
-      []
-
-ruleOrphWarn :: DynFlags -> PrintUnqualified -> Module -> IfaceRule -> WarnMsg
-ruleOrphWarn dflags unqual mod rule
-  = mkWarnMsg dflags silly_loc unqual $
-    ptext (sLit "Orphan rule:") <+> ppr rule
-  where
-    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
-    -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
-    -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
-
 ----------------------
 -- mkOrphMap partitions instance decls or rules into
 --      (a) an OccEnv for ones that are not orphans,
 ----------------------
 -- mkOrphMap partitions instance decls or rules into
 --      (a) an OccEnv for ones that are not orphans,
index 0978c11..4d5d727 100644 (file)
@@ -2876,7 +2876,8 @@ fWarningFlags = [
                                       Opt_WarnAlternativeLayoutRuleTransitional,
   flagSpec' "warn-amp"                        Opt_WarnAMP
     (\_ -> deprecate "it has no effect, and will be removed in GHC 7.12"),
                                       Opt_WarnAlternativeLayoutRuleTransitional,
   flagSpec' "warn-amp"                        Opt_WarnAMP
     (\_ -> deprecate "it has no effect, and will be removed in GHC 7.12"),
-  flagSpec "warn-auto-orphans"                Opt_WarnAutoOrphans,
+  flagSpec' "warn-auto-orphans"               Opt_WarnAutoOrphans
+    (\_ -> deprecate "it has no effect"),
   flagSpec "warn-deferred-type-errors"        Opt_WarnDeferredTypeErrors,
   flagSpec "warn-deprecations"                Opt_WarnWarningsDeprecations,
   flagSpec "warn-deprecated-flags"            Opt_WarnDeprecatedFlags,
   flagSpec "warn-deferred-type-errors"        Opt_WarnDeferredTypeErrors,
   flagSpec "warn-deprecations"                Opt_WarnWarningsDeprecations,
   flagSpec "warn-deprecated-flags"            Opt_WarnDeprecatedFlags,
index f783a9a..1a35af1 100644 (file)
@@ -460,7 +460,7 @@ makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails
                 -> IO (ModIface,Bool)
 makeSimpleIface hsc_env maybe_old_iface tc_result details = runHsc hsc_env $ do
     safe_mode <- hscGetSafeMode tc_result
                 -> IO (ModIface,Bool)
 makeSimpleIface hsc_env maybe_old_iface tc_result details = runHsc hsc_env $ do
     safe_mode <- hscGetSafeMode tc_result
-    ioMsgMaybe $ do
+    liftIO $ do
         mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) safe_mode
                   details tc_result
 
         mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) safe_mode
                   details tc_result
 
@@ -1216,7 +1216,7 @@ hscSimpleIface' tc_result mb_old_iface = do
     safe_mode <- hscGetSafeMode tc_result
     (new_iface, no_change)
         <- {-# SCC "MkFinalIface" #-}
     safe_mode <- hscGetSafeMode tc_result
     (new_iface, no_change)
         <- {-# SCC "MkFinalIface" #-}
-           ioMsgMaybe $
+           liftIO $
                mkIfaceTc hsc_env mb_old_iface safe_mode details tc_result
     -- And the answer is ...
     liftIO $ dumpIfaceStats hsc_env
                mkIfaceTc hsc_env mb_old_iface safe_mode details tc_result
     -- And the answer is ...
     liftIO $ dumpIfaceStats hsc_env
@@ -1244,7 +1244,7 @@ hscNormalIface' simpl_result mb_old_iface = do
     -- until after code output
     (new_iface, no_change)
         <- {-# SCC "MkFinalIface" #-}
     -- until after code output
     (new_iface, no_change)
         <- {-# SCC "MkFinalIface" #-}
-           ioMsgMaybe $
+           liftIO $
                mkIface hsc_env mb_old_iface details simpl_result
 
     liftIO $ dumpIfaceStats hsc_env
                mkIface hsc_env mb_old_iface details simpl_result
 
     liftIO $ dumpIfaceStats hsc_env
index e3501df..8e76492 100644 (file)
@@ -1324,6 +1324,26 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs
 
            ; return (Just ((spec_f_w_arity, spec_rhs), final_uds, spec_env_rule)) } }
 
 
            ; return (Just ((spec_f_w_arity, spec_rhs), final_uds, spec_env_rule)) } }
 
+{-
+Note [Orphans and auto-generated rules]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When we specialise an INLINEABLE function, or when we have
+-fspecialise-aggressively, we auto-generate RULES that are orphans.
+We don't want to warn about these, or we'd generate a lot of warnings.
+Thus, we only warn about user-specified orphan rules.
+
+Indeed, we don't even treat the module as an orphan module if it has
+auto-generated *rule* orphans.  Orphan modules are read every time we
+compile, so they are pretty obtrusive and slow down every compilation,
+even non-optimised ones.  (Reason: for type class instances it's a
+type correctness issue.)  But specialisation rules are strictly for
+*optimisation* only so it's fine not to read the interface.
+
+What this means is that a SPEC rules from auto-specialisation in
+module M will be used in other modules only if M.hi has been read for
+some other reason, which is actually pretty likely.
+-}
+
 bindAuxiliaryDicts
         :: SpecEnv
         -> [DictId] -> [CoreExpr]   -- Original dict bndrs, and the witnessing expressions
 bindAuxiliaryDicts
         :: SpecEnv
         -> [DictId] -> [CoreExpr]   -- Original dict bndrs, and the witnessing expressions
index f4caf2b..53fd19f 100644 (file)
@@ -441,7 +441,21 @@ newClsInst overlap_mode dfun_name tvs theta clas tys
              -- Not sure if this is really the right place to do so,
              -- but it'll do fine
        ; oflag <- getOverlapFlag overlap_mode
              -- Not sure if this is really the right place to do so,
              -- but it'll do fine
        ; oflag <- getOverlapFlag overlap_mode
-       ; return (mkLocalInstance dfun oflag tvs' clas tys') }
+       ; let inst = mkLocalInstance dfun oflag tvs' clas tys'
+       ; dflags <- getDynFlags
+       ; warnIf (isOrphan (is_orphan inst) && wopt Opt_WarnOrphans dflags) (instOrphWarn inst)
+       ; return inst }
+
+instOrphWarn :: ClsInst -> SDoc
+instOrphWarn inst
+  = hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst)
+    $$ text "To avoid this"
+    $$ nest 4 (vcat possibilities)
+  where
+    possibilities =
+      text "move the instance declaration to the module of the class or of the type, or" :
+      text "wrap the type with a newtype and declare the instance on the new type." :
+      []
 
 tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
   -- Add new locally-defined instances
 
 tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
   -- Add new locally-defined instances
index 9a2b988..3514393 100644 (file)
@@ -14,7 +14,6 @@ module TcGenGenerics (canDoGenerics, canDoGenerics1,
                       MetaTyCons, genGenericMetaTyCons,
                       gen_Generic_binds, get_gen1_constrained_tys) where
 
                       MetaTyCons, genGenericMetaTyCons,
                       gen_Generic_binds, get_gen1_constrained_tys) where
 
-import DynFlags
 import HsSyn
 import Type
 import Kind             ( isKind )
 import HsSyn
 import Type
 import Kind             ( isKind )
@@ -33,15 +32,14 @@ import BasicTypes
 import TysPrim
 import TysWiredIn
 import PrelNames
 import TysPrim
 import TysWiredIn
 import PrelNames
-import InstEnv
 import TcEnv
 import TcEnv
-import MkId
 import TcRnMonad
 import HscTypes
 import ErrUtils( Validity(..), andValid )
 import BuildTyCl
 import SrcLoc
 import Bag
 import TcRnMonad
 import HscTypes
 import ErrUtils( Validity(..), andValid )
 import BuildTyCl
 import SrcLoc
 import Bag
+import Inst
 import VarSet (elemVarSet)
 import Outputable
 import FastString
 import VarSet (elemVarSet)
 import Outputable
 import FastString
@@ -113,8 +111,7 @@ genGenericMetaTyCons tc =
 -- both the tycon declarations and related instances
 metaTyConsToDerivStuff :: TyCon -> MetaTyCons -> TcM BagDerivStuff
 metaTyConsToDerivStuff tc metaDts =
 -- both the tycon declarations and related instances
 metaTyConsToDerivStuff :: TyCon -> MetaTyCons -> TcM BagDerivStuff
 metaTyConsToDerivStuff tc metaDts =
-  do  dflags <- getDynFlags
-      dClas <- tcLookupClass datatypeClassName
+  do  dClas <- tcLookupClass datatypeClassName
       d_dfun_name <- newDFunName' dClas tc
       cClas <- tcLookupClass constructorClassName
       c_dfun_names <- sequence [ (conTy,) <$> newDFunName' cClas tc
       d_dfun_name <- newDFunName' dClas tc
       cClas <- tcLookupClass constructorClassName
       c_dfun_names <- sequence [ (conTy,) <$> newDFunName' cClas tc
@@ -129,16 +126,18 @@ metaTyConsToDerivStuff tc metaDts =
       let
         (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc
         mk_inst clas tc dfun_name
       let
         (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc
         mk_inst clas tc dfun_name
-          = mkLocalInstance (mkDictFunId dfun_name [] [] clas tys)
-                            OverlapFlag { overlapMode   = (NoOverlap "")
-                                        , isSafeOverlap = safeLanguageOn dflags }
-                            [] clas tys
+          = newClsInst (Just (NoOverlap "")) dfun_name [] [] clas tys
           where
             tys = [mkTyConTy tc]
 
           where
             tys = [mkTyConTy tc]
 
+
+      let d_metaTycon = metaD metaDts
+      d_inst <- mk_inst dClas d_metaTycon d_dfun_name
+      c_insts <- sequence [ mk_inst cClas c ds | (c, ds) <- c_dfun_names ]
+      s_insts <- mapM (mapM (\(s,ds) -> mk_inst sClas s ds)) s_dfun_names
+
+      let
         -- Datatype
         -- Datatype
-        d_metaTycon = metaD metaDts
-        d_inst   = mk_inst dClas d_metaTycon d_dfun_name
         d_binds  = InstBindings { ib_binds = dBinds
                                 , ib_tyvars = []
                                 , ib_pragmas = []
         d_binds  = InstBindings { ib_binds = dBinds
                                 , ib_tyvars = []
                                 , ib_pragmas = []
@@ -147,7 +146,6 @@ metaTyConsToDerivStuff tc metaDts =
         d_mkInst = DerivInst (InstInfo { iSpec = d_inst, iBinds = d_binds })
 
         -- Constructor
         d_mkInst = DerivInst (InstInfo { iSpec = d_inst, iBinds = d_binds })
 
         -- Constructor
-        c_insts = [ mk_inst cClas c ds | (c, ds) <- c_dfun_names ]
         c_binds = [ InstBindings { ib_binds = c
                                  , ib_tyvars = []
                                  , ib_pragmas = []
         c_binds = [ InstBindings { ib_binds = c
                                  , ib_tyvars = []
                                  , ib_pragmas = []
@@ -158,7 +156,6 @@ metaTyConsToDerivStuff tc metaDts =
                    | (is,bs) <- myZip1 c_insts c_binds ]
 
         -- Selector
                    | (is,bs) <- myZip1 c_insts c_binds ]
 
         -- Selector
-        s_insts = map (map (\(s,ds) -> mk_inst sClas s ds)) s_dfun_names
         s_binds = [ [ InstBindings { ib_binds = s
                                    , ib_tyvars = []
                                    , ib_pragmas = []
         s_binds = [ [ InstBindings { ib_binds = s
                                    , ib_tyvars = []
                                    , ib_pragmas = []
index b8a3e6a..56df3a5 100644 (file)
@@ -203,7 +203,9 @@ instanceSig ispec = tcSplitDFunTy (idType (is_dfun ispec))
 mkLocalInstance :: DFunId -> OverlapFlag
                 -> [TyVar] -> Class -> [Type]
                 -> ClsInst
 mkLocalInstance :: DFunId -> OverlapFlag
                 -> [TyVar] -> Class -> [Type]
                 -> ClsInst
--- Used for local instances, where we can safely pull on the DFunId
+-- Used for local instances, where we can safely pull on the DFunId.
+-- Consider using newClsInst instead; this will also warn if
+-- the instance is an orphan.
 mkLocalInstance dfun oflag tvs cls tys
   = ClsInst { is_flag = oflag, is_dfun = dfun
             , is_tvs = tvs
 mkLocalInstance dfun oflag tvs cls tys
   = ClsInst { is_flag = oflag, is_dfun = dfun
             , is_tvs = tvs
index 0b3faa4..c3271d0 100644 (file)
@@ -40,7 +40,7 @@ standard “packages” of warnings:
     code. The warnings that are *not* enabled by ``-Wall`` are
     ``-fwarn-incomplete-uni-patterns``,
     ``-fwarn-incomplete-record-updates``,
     code. The warnings that are *not* enabled by ``-Wall`` are
     ``-fwarn-incomplete-uni-patterns``,
     ``-fwarn-incomplete-record-updates``,
-    ``-fwarn-monomorphism-restriction``, ``-fwarn-auto-orphans``,
+    ``-fwarn-monomorphism-restriction``,
     ``-fwarn-implicit-prelude``, ``-fwarn-missing-local-sigs``,
     ``-fwarn-missing-exported-sigs``, ``-fwarn-missing-import-lists``
     and ``-fwarn-identities``.
     ``-fwarn-implicit-prelude``, ``-fwarn-missing-local-sigs``,
     ``-fwarn-missing-exported-sigs``, ``-fwarn-missing-import-lists``
     and ``-fwarn-identities``.
@@ -563,10 +563,9 @@ command line.
 
         f x = do { _ignore <- this; _ignore <- that; return (the other) }
 
 
         f x = do { _ignore <- this; _ignore <- that; return (the other) }
 
-``-fwarn-orphans, -fwarn-auto-orphans``
+``-fwarn-orphans``
     .. index::
        single: -fwarn-orphans
     .. index::
        single: -fwarn-orphans
-       single: -fwarn-auto-orphans
        single: orphan instances, warning
        single: orphan rules, warning
 
        single: orphan instances, warning
        single: orphan rules, warning
 
@@ -584,10 +583,7 @@ command line.
     otherwise be of any use. See :ref:`orphan-modules` for details.
 
     The flag ``-fwarn-orphans`` warns about user-written orphan rules or
     otherwise be of any use. See :ref:`orphan-modules` for details.
 
     The flag ``-fwarn-orphans`` warns about user-written orphan rules or
-    instances. The flag ``-fwarn-auto-orphans`` warns about
-    automatically-generated orphan rules, notably as a result of
-    specialising functions, for type classes (``Specialise``) or
-    argument values (``-fspec-constr``).
+    instances.
 
 ``-fwarn-overlapping-patterns``
     .. index::
 
 ``-fwarn-overlapping-patterns``
     .. index::
index 855d365..02ff1ad 100644 (file)
@@ -1,12 +1,12 @@
 
 
-T4912.hs:10:10: warning:
-    Orphan instance: instance [safe] Foo TheirData
+T4912.hs:10:1: warning:
+    Orphan instance: instance Foo TheirData
     To avoid this
         move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
 
     To avoid this
         move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
 
-T4912.hs:13:10: warning:
-    Orphan instance: instance [safe] Bar OurData
+T4912.hs:13:1: warning:
+    Orphan instance: instance Bar OurData
     To avoid this
         move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
     To avoid this
         move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
index c1e99bc..d22f428 100644 (file)
@@ -1,8 +1,8 @@
 [1 of 2] Compiling T9178DataType    ( T9178DataType.hs, T9178DataType.o )
 [2 of 2] Compiling T9178            ( T9178.hs, T9178.o )
 
 [1 of 2] Compiling T9178DataType    ( T9178DataType.hs, T9178DataType.o )
 [2 of 2] Compiling T9178            ( T9178.hs, T9178.o )
 
-T9178.hs:8:10: warning:
-    Orphan instance: instance [safe] Show T9178_Type
+T9178.hs:8:1: warning:
+    Orphan instance: instance Show T9178_Type
     To avoid this
         move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
     To avoid this
         move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
index a79c3a8..688a7e6 100644 (file)
@@ -155,12 +155,12 @@ warningsOptions =
          , flagType = DynamicFlag
          , flagReverse = "-fno-warn-name-shadowing"
          }
          , flagType = DynamicFlag
          , flagReverse = "-fno-warn-name-shadowing"
          }
-  , flag { flagName = "-fwarn-orphans, -fwarn-auto-orphans"
+  , flag { flagName = "-fwarn-orphans"
          , flagDescription =
            "warn when the module contains :ref:`orphan instance declarations "++
            "or rewrite rules <orphan-modules>`"
          , flagType = DynamicFlag
          , flagDescription =
            "warn when the module contains :ref:`orphan instance declarations "++
            "or rewrite rules <orphan-modules>`"
          , flagType = DynamicFlag
-         , flagReverse = "-fno-warn-orphans, -fno-warn-auto-orphans"
+         , flagReverse = "-fno-warn-orphans"
          }
   , flag { flagName = "-fwarn-overlapping-patterns"
          , flagDescription = "warn about overlapping patterns"
          }
   , flag { flagName = "-fwarn-overlapping-patterns"
          , flagDescription = "warn about overlapping patterns"