Commit 28122dd6 authored by simonpj's avatar simonpj
Browse files

[project @ 2005-04-29 23:39:12 by simonpj]

Wibbles to new hs-boot instance story
parent a7032af4
......@@ -23,7 +23,7 @@ module SrcLoc (
srcLocFile, -- return the file name part
srcLocLine, -- return the line part
srcLocCol, -- return the column part
pprDefnLoc,
SrcSpan, -- Abstract
noSrcSpan,
......@@ -304,6 +304,12 @@ combineSrcSpans start end
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 ->
......
......@@ -27,7 +27,7 @@ import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..),
pprIfaceDeclHead, pprParendIfaceType,
pprIfaceForAllPart, pprIfaceType )
import FunDeps ( pprFundeps )
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import SrcLoc ( SrcLoc, pprDefnLoc )
import OccName ( OccName, parenSymOcc, occNameUserString )
import BasicTypes ( StrictnessMark(..), defaultFixity )
......@@ -538,12 +538,9 @@ showThing exts (wanted_str, thing, fixity, src_loc, insts)
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
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("--")
......
......@@ -364,15 +364,10 @@ hscBootBackEnd hsc_env mod_summary maybe_old_iface (Just ds_result)
; 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
; return (HscRecomp final_details
new_iface
; return (HscRecomp details new_iface
False False Nothing)
}
......
......@@ -63,7 +63,7 @@ import DataCon ( dataConWrapId )
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
......@@ -109,6 +109,7 @@ import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
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 )
......@@ -176,11 +177,14 @@ tcRnModule hsc_env hsc_src save_rn_decls
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
......@@ -587,7 +591,7 @@ missingBootThing thing
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)
= hang (ppr inst)
2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
\end{code}
......
......@@ -37,6 +37,7 @@ import Unify ( tcMatchTys, tcUnifyTys, BindFlag(..) )
import Outputable
import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
import Id ( idType, idName )
import SrcLoc ( pprDefnLoc )
import Maybe ( isJust, isNothing )
\end{code}
......@@ -154,7 +155,7 @@ pprInstance :: Instance -> SDoc
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment