ru_rhs :: CoreExpr,
-- Locality
- ru_local :: Bool, -- The fn at the head of the rule is
+ ru_local :: Bool -- The fn at the head of the rule is
-- defined in the same module as the rule
-
- -- Orphan-hood; see Note [Orphans] in InstEnv
- ru_orph :: Maybe OccName }
+ }
| BuiltinRule { -- Built-in rules are used for constant folding
ru_name :: RuleName, -- and suchlike. It has no free variables.
-- NB we can't use isLocalId in the orphan test,
-- because isLocalId isn't true of class methods
fn_name = idName fn_id
- lhs_names = fn_name : nameSetToList (exprsFreeNames args)
- -- No need to delete bndrs, because
- -- exprsFreeNames finds only External names
-
- -- A rule is an orphan only if none of the variables
- -- mentioned on its left-hand side are locally defined
- orph = case filter (nameIsLocalOrFrom mod) lhs_names of
- (n:ns) -> Just (nameOccName n)
- [] -> Nothing
rule = Rule { ru_name = name, ru_fn = fn_name, ru_act = act,
ru_bndrs = bndrs', ru_args = args, ru_rhs = rhs',
ru_rough = roughTopNames args,
- ru_local = local_rule, ru_orph = orph }
+ ru_local = local_rule }
; return (Just rule)
} } }
where
import BasicTypes
import Outputable
import FastString
-import Module
import Data.List
import Data.Maybe
ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
ifDFun :: Name, -- The dfun
ifOFlag :: OverlapFlag, -- Overlap flag
- ifInstOrph :: Maybe OccName } -- See is_orph in defn of Instance
+ ifInstOrph :: Maybe OccName } -- See Note [Orphans]
-- There's always a separate IfaceDecl for the DFun, which gives
-- its IdInfo with its full type and version number.
-- The instance declarations taken together have a version number,
data IfaceBinding
= IfaceNonRec IfaceIdBndr IfaceExpr
| IfaceRec [(IfaceIdBndr, IfaceExpr)]
+\end{code}
+
+Note [Orphans]: the ifInstOrph and ifRuleOrph fields
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If a module contains any "orphans", then its interface file is read
+regardless, so that its instances are not missed.
+
+Roughly speaking, an instance is an orphan if its head (after the =>)
+mentions nothing defined in this module. Functional dependencies
+complicate the situation though. Consider
+
+ module M where { class C a b | a -> b }
+
+and suppose we are compiling module X:
+
+ module X where
+ import M
+ data T = ...
+ instance C Int T where ...
+
+This instance is an orphan, because when compiling a third module Y we
+might get a constraint (C Int v), and we'd want to improve v to T. So
+we must make sure X's instances are loaded, even if we do not directly
+use anything from X.
+
+More precisely, an instance is an orphan iff
+
+ If there are no fundeps, then at least of the names in
+ the instance head is locally defined.
+
+ If there are fundeps, then for every fundep, at least one of the
+ names free in a *non-determined* part of the instance head is
+ defined in this module.
+
+(Note that these conditions hold trivially if the class is locally
+defined.)
+Note [Versioning of instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Now consider versioning. If we *use* an instance decl in one compilation,
+we'll depend on the dfun id for that instance, so we'll recompile if it changes.
+But suppose we *don't* (currently) use an instance! We must recompile if
+the instance is changed in such a way that it becomes important. (This would
+only matter with overlapping instances, else the importing module wouldn't have
+compiled before and the recompilation check is irrelevant.)
+
+The is_orph field is set to (Just n) if the instance is not an orphan.
+The 'n' is *any* of the locally-defined names mentioned anywhere in the
+instance head. This name is used for versioning; the instance decl is
+considered part of the defn of this 'n'.
+
+I'm worried about whether this works right if we pick a name from
+a functionally-dependent part of the instance decl. E.g.
+
+ module M where { class C a b | a -> b }
+
+and suppose we are compiling module X:
+
+ module X where
+ import M
+ data S = ...
+ data T = ...
+ instance C S T where ...
+
+If we base the instance verion on T, I'm worried that changing S to S'
+would change T's version, but not S or S'. But an importing module might
+not depend on T, and so might not be recompiled even though the new instance
+(C S' T) might be relevant. I have not been able to make a concrete example,
+and it seems deeply obscure, so I'm going to leave it for now.
+
+
+Note [Versioning of rules]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+A rule that is not an orphan has an ifRuleOrph field of (Just n), where
+n appears on the LHS of the rule; any change in the rule changes the version of n.
+
+
+\begin{code}
-- -----------------------------------------------------------------------------
-- Utils on IfaceSyn
import IdInfo
import NewDemand
import CoreSyn
+import CoreFVs
import Class
import TyCon
import DataCon
; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
; deprecs = mkIfaceDeprec src_deprecs
- ; iface_rules = map coreRuleToIfaceRule rules
+ ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
; iface_insts = map instanceToIfaceInst insts
; iface_fam_insts = map famInstToIfaceFamInst fam_insts
addVersionInfo ver_fn Nothing new_iface new_decls
-- No old interface, so definitely write a new one!
- = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
- || anyNothing ifRuleOrph (mi_rules new_iface)
+ = (new_iface { mi_orphan = not (null orph_insts && null orph_rules)
, mi_finsts = not . null $ mi_fam_insts new_iface
, mi_decls = [(initialVersion, decl) | decl <- new_decls]
, mi_ver_fn = mkIfaceVerCache (zip (repeat initialVersion)
= (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
| otherwise = (non_orphs, d:orphs)
-anyNothing :: (a -> Maybe b) -> [a] -> Bool
-anyNothing p [] = False
-anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs
-
----------------------
mkIfaceDeprec :: Deprecations -> IfaceDeprecs
mkIfaceDeprec NoDeprecs = NoDeprecs
--------------------------
instanceToIfaceInst :: Instance -> IfaceInst
instanceToIfaceInst ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
- is_cls = cls, is_tcs = mb_tcs,
- is_orph = orph })
- = IfaceInst { ifDFun = getName dfun_id,
+ is_cls = cls_name, is_tcs = mb_tcs })
+ = ASSERT( cls_name == className cls )
+ IfaceInst { ifDFun = dfun_name,
ifOFlag = oflag,
- ifInstCls = cls,
+ ifInstCls = cls_name,
ifInstTys = map do_rough mb_tcs,
ifInstOrph = orph }
where
do_rough Nothing = Nothing
do_rough (Just n) = Just (toIfaceTyCon_name n)
+ dfun_name = idName dfun_id
+ mod = nameModule dfun_name
+ is_local name = nameIsLocalOrFrom mod name
+
+ -- Compute orphanhood. See Note [Orphans] in IfaceSyn
+ (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
+ -- Slightly awkward: we need the Class to get the fundeps
+ (tvs, fds) = classTvsFds cls
+ arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
+ orph | is_local cls_name = Just (nameOccName cls_name)
+ | all isJust mb_ns = head mb_ns
+ | otherwise = Nothing
+
+ mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
+ -- that is not in the "determined" arguments
+ mb_ns | null fds = [choose_one arg_names]
+ | otherwise = map do_one fds
+ do_one (ltvs,rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
+ , not (tv `elem` rtvs)]
+
+ choose_one :: [NameSet] -> Maybe OccName
+ choose_one nss = case nameSetToList (unionManyNameSets nss) of
+ [] -> Nothing
+ (n:ns) -> Just (nameOccName n)
+
--------------------------
famInstToIfaceFamInst :: FamInst -> IfaceFamInst
famInstToIfaceFamInst fi@(FamInst { fi_tycon = tycon,
| otherwise = Just (HsInline inline_prag)
--------------------------
-coreRuleToIfaceRule :: CoreRule -> IfaceRule
-coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
+coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
+coreRuleToIfaceRule mod (BuiltinRule { ru_fn = fn})
= pprTrace "toHsRule: builtin" (ppr fn) $
bogusIfaceRule fn
-coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
- ru_act = act, ru_bndrs = bndrs,
- ru_args = args, ru_rhs = rhs, ru_orph = orph })
+coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
+ ru_act = act, ru_bndrs = bndrs,
+ ru_args = args, ru_rhs = rhs })
= IfaceRule { ifRuleName = name, ifActivation = act,
ifRuleBndrs = map toIfaceBndr bndrs,
ifRuleHead = fn,
do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
do_arg arg = toIfaceExpr arg
+ -- Compute orphanhood. See Note [Orphans] in IfaceSyn
+ -- A rule is an orphan only if none of the variables
+ -- mentioned on its left-hand side are locally defined
+ lhs_names = fn : nameSetToList (exprsFreeNames args)
+ -- No need to delete bndrs, because
+ -- exprsFreeNames finds only External names
+
+ orph = case filter (nameIsLocalOrFrom mod) lhs_names of
+ (n:ns) -> Just (nameOccName n)
+ [] -> Nothing
+
bogusIfaceRule :: Name -> IfaceRule
bogusIfaceRule id_name
= IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
= do { dfun <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
tcIfaceExtId dfun_occ
; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
- ; return (mkImportedInstance cls mb_tcs' orph dfun oflag) }
+ ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
; let this_module = if_mod lcl
; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act,
ru_bndrs = bndrs', ru_args = args',
- ru_rhs = rhs', ru_orph = orph,
+ ru_rhs = rhs',
ru_rough = mb_tcs,
ru_local = nameModule fn == this_module }) }
where
let
imp_mod = mi_module iface
deprecs = mi_deprecs iface
- is_orph = mi_orphan iface
+ orph_iface = mi_orphan iface
has_finsts = mi_finsts iface
deps = mi_deps iface
let
-- Compute new transitive dependencies
- orphans | is_orph = ASSERT( not (imp_mod `elem` dep_orphs deps) )
- imp_mod : dep_orphs deps
- | otherwise = dep_orphs deps
+ orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
+ imp_mod : dep_orphs deps
+ | otherwise = dep_orphs deps
finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
imp_mod : dep_finsts deps
= Rule { ru_name = name, ru_fn = fn, ru_act = act,
ru_bndrs = bndrs, ru_args = args,
ru_rhs = rhs, ru_rough = roughTopNames args,
- ru_orph = Just (nameOccName fn), ru_local = True }
+ ru_local = True }
--------------
roughTopNames :: [CoreExpr] -> [Maybe Name]
= [ (eqn, p_inst, pred)
| fd <- cls_fds -- Iterate through the fundeps first,
-- because there often are none!
- , let rough_fd_tcs = trimRoughMatchTcs cls_tvs fd rough_tcs
+ , let trimmed_tcs = trimRoughMatchTcs cls_tvs fd rough_tcs
+ -- Trim the rough_tcs based on the head of the fundep.
+ -- Remember that instanceCantMatch treats both argumnents
+ -- symmetrically, so it's ok to trim the rough_tcs,
+ -- rather than trimming each inst_tcs in turn
, ispec@(Instance { is_tvs = qtvs, is_tys = tys_inst,
- is_tcs = mb_tcs_inst }) <- instances
- , not (instanceCantMatch mb_tcs_inst rough_fd_tcs)
+ is_tcs = inst_tcs }) <- instances
+ , not (instanceCantMatch inst_tcs trimmed_tcs)
, eqn <- checkClsFD qtvs fd cls_tvs tys_inst tys
, let p_inst = (mkClassPred cls tys_inst,
ptext SLIT("arising from the instance declaration at")
badFunDeps cls_insts clas ins_tv_set ins_tys
= [ ispec | fd <- fds, -- fds is often empty
let trimmed_tcs = trimRoughMatchTcs clas_tvs fd rough_tcs,
- ispec@(Instance { is_tcs = mb_tcs, is_tvs = tvs,
+ ispec@(Instance { is_tcs = inst_tcs, is_tvs = tvs,
is_tys = tys }) <- cls_insts,
-- Filter out ones that can't possibly match,
-- based on the head of the fundep
- not (instanceCantMatch trimmed_tcs mb_tcs),
+ not (instanceCantMatch inst_tcs trimmed_tcs),
notNull (checkClsFD (tvs `unionVarSet` ins_tv_set)
fd clas_tvs tys ins_tys)
]
trimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [Maybe Name] -> [Maybe Name]
-- Computing rough_tcs for a particular fundep
--- class C a b c | a c -> b where ...
+-- class C a b c | a -> b where ...
-- For each instance .... => C ta tb tc
--- we want to match only on the types ta, tb; so our
+-- we want to match only on the types ta, tc; so our
-- rough-match thing must similarly be filtered.
-- Hence, we Nothing-ise the tb type right here
-trimRoughMatchTcs clas_tvs (ltvs,_) mb_tcs
+trimRoughMatchTcs clas_tvs (_,rtvs) mb_tcs
= zipWith select clas_tvs mb_tcs
where
- select clas_tv mb_tc | clas_tv `elem` ltvs = mb_tc
- | otherwise = Nothing
+ select clas_tv mb_tc | clas_tv `elem` rtvs = Nothing
+ | otherwise = mb_tc
\end{code}
import Var
import VarSet
import Name
-import OccName
-import NameSet
-import Type
import TcType
import TyCon
import TcGadt
data Instance
= Instance { is_cls :: Name -- Class name
- -- Used for "rough matching"; see note below
+ -- Used for "rough matching"; see Note [Rough-match field]
-- INVARIANT: is_tcs = roughMatchTcs is_tys
, is_tcs :: [Maybe Name] -- Top of type args
- -- Used for "proper matching"; see note
+ -- Used for "proper matching"; see Note [Proper-match fields]
, is_tvs :: TyVarSet -- Template tyvars for full match
, is_tys :: [Type] -- Full arg types
-- INVARIANT: is_dfun Id has type
, is_dfun :: DFunId
, is_flag :: OverlapFlag -- See detailed comments with
-- the decl of BasicTypes.OverlapFlag
-
- , is_orph :: Maybe OccName }
+ }
\end{code}
-The "rough-match" fields
-~~~~~~~~~~~~~~~~~~~~~~~~~
-The is_cls, is_args fields allow a "rough match" to be done
+Note [Rough-match field]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The is_cls, is_tcs fields allow a "rough match" to be done
without poking inside the DFunId. Poking the DFunId forces
us to suck in all the type constructors etc it involves,
which is a total waste of time if it has no chance of matching
different real tycons can't.)
NB: newtypes are not transparent, though!
-The "proper-match" fields
+Note [Proper-match fields]
~~~~~~~~~~~~~~~~~~~~~~~~~
The is_tvs, is_tys fields are simply cached values, pulled
out (lazily) from the dfun id. They are cached here simply so
instantiate the dfun's context.)
-Note [Orphans]: the "is_orph" field
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-An instance is an orphan if its head (after the =>) mentions
-nothing defined in this module.
-
- Just n The head mentions n, which is defined in this module
- This is used for versioning; the instance decl is
- considered part of the defn of n when computing versions
-
- Nothing The head mentions nothing defined in this module
-
-If a module contains any orphans, then its interface file is read
-regardless, so that its instances are not missed.
-
-Functional dependencies worsen the situation a bit. Consider
- class C a b | a -> b
-In some other module we might have
- module M where
- data T = ...
- instance C Int T where ...
-This isn't considered an orphan, so we will only read M's interface
-if something from M is used (e.g. T). So there's a risk we'll
-miss the improvement from the instance. Workaround: import M.
-
-Rules are orphans and versioned in much the same way.
\begin{code}
instanceDFunId :: Instance -> DFunId
mkLocalInstance dfun oflag
= Instance { is_flag = oflag, is_dfun = dfun,
is_tvs = mkVarSet tvs, is_tys = tys,
- is_cls = cls_name, is_tcs = roughMatchTcs tys,
- is_orph = orph }
+ is_cls = className cls, is_tcs = roughMatchTcs tys }
where
(tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
- mod = nameModule (idName dfun)
- cls_name = getName cls
- tycl_names = foldr (unionNameSets . tyClsNamesOfType)
- (unitNameSet cls_name) tys
- orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
- [] -> Nothing
- (n:ns) -> Just (getOccName n)
-
-mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
+
+mkImportedInstance :: Name -> [Maybe Name]
-> DFunId -> OverlapFlag -> Instance
-- Used for imported instances, where we get the rough-match stuff
-- from the interface file
-mkImportedInstance cls mb_tcs orph dfun oflag
+mkImportedInstance cls mb_tcs dfun oflag
= Instance { is_flag = oflag, is_dfun = dfun,
is_tvs = mkVarSet tvs, is_tys = tys,
- is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
+ is_cls = cls, is_tcs = mb_tcs }
where
(tvs, _, _, tys) = tcSplitDFunTy (idType dfun)