Commit 931d0a7d authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Move orphan instance/rule warnings to typechecker/desugarer.



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: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1297
parent f64f7c36
...@@ -381,12 +381,12 @@ dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs)) ...@@ -381,12 +381,12 @@ dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs))
fn_name = idName fn_id fn_name = idName fn_id
final_rhs = simpleOptExpr rhs'' -- De-crap it final_rhs = simpleOptExpr rhs'' -- De-crap it
rule_name = snd (unLoc name) 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) arg_ids = varSetElems (exprsSomeFreeVars isId args `delVarSetList` final_bndrs)
; dflags <- getDynFlags ; dflags <- getDynFlags
; rule <- dsMkUserRule this_mod is_local
rule_name rule_act fn_name final_bndrs args
final_rhs
; when (wopt Opt_WarnInlineRuleShadowing dflags) $ ; when (wopt Opt_WarnInlineRuleShadowing dflags) $
warnRuleShadowing rule_name rule_act fn_id arg_ids warnRuleShadowing rule_name rule_act fn_id arg_ids
......
...@@ -13,7 +13,7 @@ lower levels it is preserved with @let@/@letrec@s). ...@@ -13,7 +13,7 @@ lower levels it is preserved with @let@/@letrec@s).
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec, module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -69,7 +69,7 @@ import DynFlags ...@@ -69,7 +69,7 @@ import DynFlags
import FastString import FastString
import Util import Util
import MonadUtils 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)) ...@@ -450,7 +450,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
spec_id = mkLocalId spec_name spec_ty spec_id = mkLocalId spec_name spec_ty
`setInlinePragma` inl_prag `setInlinePragma` inl_prag
`setIdUnfolding` spec_unf `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)) (mkFastString ("SPEC " ++ showPpr dflags poly_name))
rule_act poly_name rule_act poly_name
rule_bndrs args rule_bndrs args
...@@ -503,6 +503,17 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) ...@@ -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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
...@@ -110,7 +110,6 @@ import Maybes ...@@ -110,7 +110,6 @@ import Maybes
import ListSetOps import ListSetOps
import Binary import Binary
import Fingerprint import Fingerprint
import Bag
import Exception import Exception
import Control.Monad import Control.Monad
...@@ -135,11 +134,10 @@ mkIface :: HscEnv ...@@ -135,11 +134,10 @@ mkIface :: HscEnv
-> Maybe Fingerprint -- The old fingerprint, if we have it -> Maybe Fingerprint -- The old fingerprint, if we have it
-> ModDetails -- The trimmed, tidied interface -> ModDetails -- The trimmed, tidied interface
-> ModGuts -- Usages, deprecations, etc -> ModGuts -- Usages, deprecations, etc
-> IO (Messages, -> IO (ModIface, -- The new one
Maybe (ModIface, -- The new one Bool) -- True <=> there was an old Iface, and the
Bool)) -- True <=> there was an old Iface, and the -- new one is identical, so no need
-- new one is identical, so no need -- to write it
-- to write it
mkIface hsc_env maybe_old_fingerprint mod_details mkIface hsc_env maybe_old_fingerprint mod_details
ModGuts{ mg_module = this_mod, ModGuts{ mg_module = this_mod,
...@@ -198,7 +196,7 @@ mkIfaceTc :: HscEnv ...@@ -198,7 +196,7 @@ mkIfaceTc :: HscEnv
-> SafeHaskellMode -- The safe haskell mode -> SafeHaskellMode -- The safe haskell mode
-> ModDetails -- gotten from mkBootModDetails, probably -> ModDetails -- gotten from mkBootModDetails, probably
-> TcGblEnv -- Usages, deprecations, etc -> TcGblEnv -- Usages, deprecations, etc
-> IO (Messages, Maybe (ModIface, Bool)) -> IO (ModIface, Bool)
mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
tc_result@TcGblEnv{ tcg_mod = this_mod, tc_result@TcGblEnv{ tcg_mod = this_mod,
tcg_src = hsc_src, tcg_src = hsc_src,
...@@ -268,7 +266,7 @@ mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource ...@@ -268,7 +266,7 @@ mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource
-> [FilePath] -> [FilePath]
-> SafeHaskellMode -> SafeHaskellMode
-> ModDetails -> ModDetails
-> IO (Messages, Maybe (ModIface, Bool)) -> IO (ModIface, Bool)
mkIface_ hsc_env maybe_old_fingerprint mkIface_ hsc_env maybe_old_fingerprint
this_mod hsc_src used_names used_th deps rdr_env fix_env src_warns 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 hpc_info dir_imp_mods pkg_trust_req dependent_files safe_mode
...@@ -354,38 +352,17 @@ mkIface_ hsc_env maybe_old_fingerprint ...@@ -354,38 +352,17 @@ mkIface_ hsc_env maybe_old_fingerprint
addFingerprints hsc_env maybe_old_fingerprint addFingerprints hsc_env maybe_old_fingerprint
intermediate_iface decls intermediate_iface decls
-- Warn about orphans -- Debug printing
-- See Note [Orphans and auto-generated rules] dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
let warn_orphs = wopt Opt_WarnOrphans dflags (pprModIface new_iface)
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)
-- bug #1617: on reload we weren't updating the PrintUnqualified -- bug #1617: on reload we weren't updating the PrintUnqualified
-- correctly. This stems from the fact that the interface had -- correctly. This stems from the fact that the interface had
-- not changed, so addFingerprints returns the old ModIface -- not changed, so addFingerprints returns the old ModIface
-- with the old GlobalRdrEnv (mi_globals). -- with the old GlobalRdrEnv (mi_globals).
let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env } 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 where
dflags = hsc_dflags hsc_env dflags = hsc_dflags hsc_env
...@@ -725,25 +702,6 @@ mkIfaceAnnCache anns ...@@ -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 ...@@ -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 -- mkOrphMap partitions instance decls or rules into
-- (a) an OccEnv for ones that are not orphans, -- (a) an OccEnv for ones that are not orphans,
......
...@@ -2876,7 +2876,8 @@ fWarningFlags = [ ...@@ -2876,7 +2876,8 @@ fWarningFlags = [
Opt_WarnAlternativeLayoutRuleTransitional, Opt_WarnAlternativeLayoutRuleTransitional,
flagSpec' "warn-amp" Opt_WarnAMP flagSpec' "warn-amp" Opt_WarnAMP
(\_ -> deprecate "it has no effect, and will be removed in GHC 7.12"), (\_ -> 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-deferred-type-errors" Opt_WarnDeferredTypeErrors,
flagSpec "warn-deprecations" Opt_WarnWarningsDeprecations, flagSpec "warn-deprecations" Opt_WarnWarningsDeprecations,
flagSpec "warn-deprecated-flags" Opt_WarnDeprecatedFlags, flagSpec "warn-deprecated-flags" Opt_WarnDeprecatedFlags,
......
...@@ -460,7 +460,7 @@ makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails ...@@ -460,7 +460,7 @@ makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails
-> IO (ModIface,Bool) -> IO (ModIface,Bool)
makeSimpleIface hsc_env maybe_old_iface tc_result details = runHsc hsc_env $ do makeSimpleIface hsc_env maybe_old_iface tc_result details = runHsc hsc_env $ do
safe_mode <- hscGetSafeMode tc_result safe_mode <- hscGetSafeMode tc_result
ioMsgMaybe $ do liftIO $ do
mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) safe_mode mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) safe_mode
details tc_result details tc_result
...@@ -1216,7 +1216,7 @@ hscSimpleIface' tc_result mb_old_iface = do ...@@ -1216,7 +1216,7 @@ hscSimpleIface' tc_result mb_old_iface = do
safe_mode <- hscGetSafeMode tc_result safe_mode <- hscGetSafeMode tc_result
(new_iface, no_change) (new_iface, no_change)
<- {-# SCC "MkFinalIface" #-} <- {-# SCC "MkFinalIface" #-}
ioMsgMaybe $ liftIO $
mkIfaceTc hsc_env mb_old_iface safe_mode details tc_result mkIfaceTc hsc_env mb_old_iface safe_mode details tc_result
-- And the answer is ... -- And the answer is ...
liftIO $ dumpIfaceStats hsc_env liftIO $ dumpIfaceStats hsc_env
...@@ -1244,7 +1244,7 @@ hscNormalIface' simpl_result mb_old_iface = do ...@@ -1244,7 +1244,7 @@ hscNormalIface' simpl_result mb_old_iface = do
-- until after code output -- until after code output
(new_iface, no_change) (new_iface, no_change)
<- {-# SCC "MkFinalIface" #-} <- {-# SCC "MkFinalIface" #-}
ioMsgMaybe $ liftIO $
mkIface hsc_env mb_old_iface details simpl_result mkIface hsc_env mb_old_iface details simpl_result
liftIO $ dumpIfaceStats hsc_env liftIO $ dumpIfaceStats hsc_env
......
...@@ -1324,6 +1324,26 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs ...@@ -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 bindAuxiliaryDicts
:: SpecEnv :: SpecEnv
-> [DictId] -> [CoreExpr] -- Original dict bndrs, and the witnessing expressions -> [DictId] -> [CoreExpr] -- Original dict bndrs, and the witnessing expressions
......
...@@ -441,7 +441,21 @@ newClsInst overlap_mode dfun_name tvs theta clas tys ...@@ -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, -- Not sure if this is really the right place to do so,
-- but it'll do fine -- but it'll do fine
; oflag <- getOverlapFlag overlap_mode ; 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 tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
-- Add new locally-defined instances -- Add new locally-defined instances
......
...@@ -14,7 +14,6 @@ module TcGenGenerics (canDoGenerics, canDoGenerics1, ...@@ -14,7 +14,6 @@ module TcGenGenerics (canDoGenerics, canDoGenerics1,
MetaTyCons, genGenericMetaTyCons, MetaTyCons, genGenericMetaTyCons,
gen_Generic_binds, get_gen1_constrained_tys) where gen_Generic_binds, get_gen1_constrained_tys) where
import DynFlags
import HsSyn import HsSyn
import Type import Type
import Kind ( isKind ) import Kind ( isKind )
...@@ -33,15 +32,14 @@ import BasicTypes ...@@ -33,15 +32,14 @@ import BasicTypes
import TysPrim import TysPrim
import TysWiredIn import TysWiredIn
import PrelNames import PrelNames
import InstEnv
import TcEnv import TcEnv
import MkId
import TcRnMonad import TcRnMonad
import HscTypes import HscTypes
import ErrUtils( Validity(..), andValid ) import ErrUtils( Validity(..), andValid )
import BuildTyCl import BuildTyCl
import SrcLoc import SrcLoc
import Bag import Bag
import Inst
import VarSet (elemVarSet) import VarSet (elemVarSet)
import Outputable import Outputable
import FastString import FastString
...@@ -113,8 +111,7 @@ genGenericMetaTyCons tc = ...@@ -113,8 +111,7 @@ genGenericMetaTyCons tc =
-- both the tycon declarations and related instances -- both the tycon declarations and related instances
metaTyConsToDerivStuff :: TyCon -> MetaTyCons -> TcM BagDerivStuff metaTyConsToDerivStuff :: TyCon -> MetaTyCons -> TcM BagDerivStuff
metaTyConsToDerivStuff tc metaDts = metaTyConsToDerivStuff tc metaDts =
do dflags <- getDynFlags do dClas <- tcLookupClass datatypeClassName
dClas <- tcLookupClass datatypeClassName
d_dfun_name <- newDFunName' dClas tc d_dfun_name <- newDFunName' dClas tc
cClas <- tcLookupClass constructorClassName cClas <- tcLookupClass constructorClassName
c_dfun_names <- sequence [ (conTy,) <$> newDFunName' cClas tc c_dfun_names <- sequence [ (conTy,) <$> newDFunName' cClas tc
...@@ -129,16 +126,18 @@ metaTyConsToDerivStuff tc metaDts = ...@@ -129,16 +126,18 @@ metaTyConsToDerivStuff tc metaDts =
let let
(dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc
mk_inst clas tc dfun_name mk_inst clas tc dfun_name
= mkLocalInstance (mkDictFunId dfun_name [] [] clas tys) = newClsInst (Just (NoOverlap "")) dfun_name [] [] clas tys
OverlapFlag { overlapMode = (NoOverlap "")
, isSafeOverlap = safeLanguageOn dflags }
[] clas tys
where where
tys = [mkTyConTy tc] 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 d_binds = InstBindings { ib_binds = dBinds
, ib_tyvars = [] , ib_tyvars = []
, ib_pragmas = [] , ib_pragmas = []
...@@ -147,7 +146,6 @@ metaTyConsToDerivStuff tc metaDts = ...@@ -147,7 +146,6 @@ metaTyConsToDerivStuff tc metaDts =
d_mkInst = DerivInst (InstInfo { iSpec = d_inst, iBinds = d_binds }) d_mkInst = DerivInst (InstInfo { iSpec = d_inst, iBinds = d_binds })
-- Constructor -- Constructor
c_insts = [ mk_inst cClas c ds | (c, ds) <- c_dfun_names ]
c_binds = [ InstBindings { ib_binds = c c_binds = [ InstBindings { ib_binds = c
, ib_tyvars = [] , ib_tyvars = []
, ib_pragmas = [] , ib_pragmas = []
...@@ -158,7 +156,6 @@ metaTyConsToDerivStuff tc metaDts = ...@@ -158,7 +156,6 @@ metaTyConsToDerivStuff tc metaDts =
| (is,bs) <- myZip1 c_insts c_binds ] | (is,bs) <- myZip1 c_insts c_binds ]
-- Selector -- Selector
s_insts = map (map (\(s,ds) -> mk_inst sClas s ds)) s_dfun_names
s_binds = [ [ InstBindings { ib_binds = s s_binds = [ [ InstBindings { ib_binds = s
, ib_tyvars = [] , ib_tyvars = []
, ib_pragmas = [] , ib_pragmas = []
......
...@@ -203,7 +203,9 @@ instanceSig ispec = tcSplitDFunTy (idType (is_dfun ispec)) ...@@ -203,7 +203,9 @@ instanceSig ispec = tcSplitDFunTy (idType (is_dfun ispec))
mkLocalInstance :: DFunId -> OverlapFlag mkLocalInstance :: DFunId -> OverlapFlag
-> [TyVar] -> Class -> [Type] -> [TyVar] -> Class -> [Type]
-> ClsInst -> 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 mkLocalInstance dfun oflag tvs cls tys
= ClsInst { is_flag = oflag, is_dfun = dfun = ClsInst { is_flag = oflag, is_dfun = dfun
, is_tvs = tvs , is_tvs = tvs
......
...@@ -40,7 +40,7 @@ standard “packages” of warnings: ...@@ -40,7 +40,7 @@ standard “packages” of warnings:
code. The warnings that are *not* enabled by ``-Wall`` are code. The warnings that are *not* enabled by ``-Wall`` are
``-fwarn-incomplete-uni-patterns``, ``-fwarn-incomplete-uni-patterns``,
``-fwarn-incomplete-record-updates``, ``-fwarn-incomplete-record-updates``,
``-fwarn-monomorphism-restriction``, ``-fwarn-auto-orphans``, ``-fwarn-monomorphism-restriction``,
``-fwarn-implicit-prelude``, ``-fwarn-missing-local-sigs``, ``-fwarn-implicit-prelude``, ``-fwarn-missing-local-sigs``,
``-fwarn-missing-exported-sigs``, ``-fwarn-missing-import-lists`` ``-fwarn-missing-exported-sigs``, ``-fwarn-missing-import-lists``
and ``-fwarn-identities``. and ``-fwarn-identities``.
...@@ -563,10 +563,9 @@ command line. ...@@ -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:: .. index::
single: -fwarn-orphans single: -fwarn-orphans
single: -fwarn-auto-orphans
single: orphan instances, warning single: orphan instances, warning
single: orphan rules, warning single: orphan rules, warning
...@@ -584,10 +583,7 @@ command line. ...@@ -584,10 +583,7 @@ command line.
otherwise be of any use. See :ref:`orphan-modules` for details. otherwise be of any use. See :ref:`orphan-modules` for details.
The flag ``-fwarn-orphans`` warns about user-written orphan rules or The flag ``-fwarn-orphans`` warns about user-written orphan rules or
instances. The flag ``-fwarn-auto-orphans`` warns about instances.
automatically-generated orphan rules, notably as a result of
specialising functions, for type classes (``Specialise``) or
argument values (``-fspec-constr``).
``-fwarn-overlapping-patterns`` ``-fwarn-overlapping-patterns``
.. index:: .. index::
......
T4912.hs:10:10: warning: T4912.hs:10:1: warning:
Orphan instance: instance [safe] Foo TheirData Orphan instance: instance Foo TheirData
To avoid this To avoid this
move the instance declaration to the module of the class or of the type, or 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. wrap the type with a newtype and declare the instance on the new type.
T4912.hs:13:10: warning: T4912.hs:13:1: warning:
Orphan instance: instance [safe] Bar OurData Orphan instance: instance Bar OurData
To avoid this To avoid this
move the instance declaration to the module of the class or of the type, or 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. wrap the type with a newtype and declare the instance on the new type.
[1 of 2] Compiling T9178DataType ( T9178DataType.hs, T9178DataType.o ) [1 of 2] Compiling T9178DataType ( T9178DataType.hs, T9178DataType.o )
[2 of 2] Compiling T9178 ( T9178.hs, T9178.o ) [2 of 2] Compiling T9178 ( T9178.hs, T9178.o )
T9178.hs:8:10: warning: T9178.hs:8:1: warning:
Orphan instance: instance [safe] Show T9178_Type Orphan instance: instance Show T9178_Type
To avoid this To avoid this
move the instance declaration to the module of the class or of the type, or 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. wrap the type with a newtype and declare the instance on the new type.
...@@ -155,12 +155,12 @@ warningsOptions = ...@@ -155,12 +155,12 @@ warningsOptions =
, flagType = DynamicFlag , flagType = DynamicFlag
, flagReverse = "-fno-warn-name-shadowing" , flagReverse = "-fno-warn-name-shadowing"
} }
, flag { flagName = "-fwarn-orphans, -fwarn-auto-orphans" , flag { flagName = "-fwarn-orphans"
, flagDescription = , flagDescription =
"warn when the module contains :ref:`orphan instance declarations "++ "warn when the module contains :ref:`orphan instance declarations "++
"or rewrite rules <orphan-modules>`" "or rewrite rules <orphan-modules>`"