Wibbles to new hs-boot instance story
srcLocFile, -- return the file name part
srcLocLine, -- return the line part
srcLocCol, -- return the column part
srcLocFile, -- return the file name part
srcLocLine, -- return the line part
srcLocCol, -- return the column part
SrcSpan, -- Abstract
noSrcSpan,
SrcSpan, -- Abstract
noSrcSpan,
col2 = srcSpanEndCol end
file = srcSpanFile start
col2 = srcSpanEndCol end
file = srcSpanFile start
+pprDefnLoc :: SrcLoc -> SDoc
+-- "defined at ..." or "imported from ..."
+pprDefnLoc loc
+ | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
+ | otherwise = ppr loc
+
instance Outputable SrcSpan where
ppr span
= getPprStyle $ \ sty ->
instance Outputable SrcSpan where
ppr span
= getPprStyle $ \ sty ->
pprIfaceDeclHead, pprParendIfaceType,
pprIfaceForAllPart, pprIfaceType )
import FunDeps ( pprFundeps )
pprIfaceDeclHead, pprParendIfaceType,
pprIfaceForAllPart, pprIfaceType )
import FunDeps ( pprFundeps )
-import SrcLoc ( SrcLoc, isGoodSrcLoc )
+import SrcLoc ( SrcLoc, pprDefnLoc )
import OccName ( OccName, parenSymOcc, occNameUserString )
import BasicTypes ( StrictnessMark(..), defaultFixity )
import OccName ( OccName, parenSymOcc, occNameUserString )
import BasicTypes ( StrictnessMark(..), defaultFixity )
showWithLoc :: SrcLoc -> SDoc -> SDoc
showWithLoc loc doc
showWithLoc :: SrcLoc -> SDoc -> SDoc
showWithLoc loc doc
- = hang doc 2 (char '\t' <> show_loc loc)
+ = hang doc 2 (char '\t' <> comment <+> pprDefnLoc loc)
-- The tab tries to make them line up a bit
where
-- The tab tries to make them line up a bit
where
- show_loc loc -- The ppr function for SrcLocs is a bit wonky
- | isGoodSrcLoc loc = comment <+> ptext SLIT("Defined at") <+> ppr loc
- | otherwise = comment <+> ppr loc
comment = ptext SLIT("--")
comment = ptext SLIT("--")
; writeIfaceFile hsc_env (ms_location mod_summary) new_iface no_change
; writeIfaceFile hsc_env (ms_location mod_summary) new_iface no_change
- ; let { final_details = ModDetails { md_types = mg_types ds_result,
- md_exports = mg_exports ds_result,
- md_insts = mg_insts ds_result,
- md_rules = mg_rules ds_result } }
-- And the answer is ...
; dumpIfaceStats hsc_env
-- And the answer is ...
; dumpIfaceStats hsc_env
- ; return (HscRecomp final_details
- new_iface
+ ; return (HscRecomp details new_iface
import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( Id, mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( Id, mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
-import Module ( Module, ModuleEnv, mkModule, moduleEnvElts, lookupModuleEnv )
+import Module ( Module, ModuleEnv, mkModule, moduleEnvElts, elemModuleEnv )
import OccName ( mkVarOcc )
import Name ( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName )
import NameSet
import OccName ( mkVarOcc )
import Name ( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName )
import NameSet
import IfaceType ( IfaceType, toIfaceType,
interactiveExtNameFun )
import IfaceEnv ( lookupOrig, ifaceExportNames )
import IfaceType ( IfaceType, toIfaceType,
interactiveExtNameFun )
import IfaceEnv ( lookupOrig, ifaceExportNames )
+import Module ( lookupModuleEnv )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( isImplicitId, setIdType, globalIdDetails, mkExportedLocalId )
import MkId ( unsafeCoerceId )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( isImplicitId, setIdType, globalIdDetails, mkExportedLocalId )
import MkId ( unsafeCoerceId )
let { dep_mods :: ModuleEnv (Module, IsBootInterface)
; dep_mods = imp_dep_mods imports
let { dep_mods :: ModuleEnv (Module, IsBootInterface)
; dep_mods = imp_dep_mods imports
- ; is_dep_mod :: Module -> Bool
- ; is_dep_mod mod = case lookupModuleEnv dep_mods mod of
- Nothing -> False
- Just (_, is_boot) -> not is_boot
- ; home_insts = hptInstances hsc_env is_dep_mod
+ -- We want instance declarations from all home-package
+ -- modules below this one, including boot modules, except
+ -- ourselves. The 'except ourselves' is so that we don't
+ -- get the instances from this module's hs-boot file
+ ; want_instances :: Module -> Bool
+ ; want_instances mod = mod `elemModuleEnv` dep_mods
+ && mod /= this_mod
+ ; home_insts = hptInstances hsc_env want_instances
} ;
-- Record boot-file info in the EPS, so that it's
} ;
-- Record boot-file info in the EPS, so that it's
bootMisMatch thing
= ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
instMisMatch inst
bootMisMatch thing
= ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
instMisMatch inst
- = hang (ptext SLIT("instance") <+> ppr inst)
2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
\end{code}
2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
\end{code}
import Outputable
import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
import Id ( idType, idName )
import Outputable
import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
import Id ( idType, idName )
+import SrcLoc ( pprDefnLoc )
import Maybe ( isJust, isNothing )
\end{code}
import Maybe ( isJust, isNothing )
\end{code}
pprInstance ispec@(Instance { is_flag = flag })
= hang (ptext SLIT("instance") <+> ppr flag
<+> sep [pprThetaArrow theta, pprClassPred clas tys])
pprInstance ispec@(Instance { is_flag = flag })
= hang (ptext SLIT("instance") <+> ppr flag
<+> sep [pprThetaArrow theta, pprClassPred clas tys])
- 2 (ppr (getSrcLoc ispec))
+ 2 (parens (pprDefnLoc (getSrcLoc ispec)))
where
(_, theta, clas, tys) = instanceHead ispec
-- Print without the for-all, which the programmer doesn't write
where
(_, theta, clas, tys) = instanceHead ispec
-- Print without the for-all, which the programmer doesn't write