#include "HsVersions.h"
import IfaceSyn -- All of it
-import IfaceType ( toIfaceTvBndrs, toIfaceType, toIfaceContext )
+import IfaceType ( toIfaceTvBndrs, toIfaceType, toIfaceContext,
+ ifaceTyConOccName )
import LoadIface ( readIface, loadInterface, pprModIface )
import Id ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
import TcType ( deNoteType )
import TysPrim ( alphaTyVars )
import InstEnv ( Instance(..) )
+import FamInstEnv ( FamInst(..) )
import TcRnMonad
import HscTypes ( ModIface(..), ModDetails(..),
ModGuts(..), HscEnv(..), hscEPS, Dependencies(..),
FixItem(..),
ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
- typeEnvElts, mkIfaceFamInstsCache,
+ typeEnvElts,
GenAvailInfo(..), availName,
ExternalPackageState(..),
Usage(..), IsBootInterface,
import Outputable
import BasicTypes ( Version, initialVersion, bumpVersion, isAlwaysActive,
Activation(..), RecFlag(..), boolToRecFlag )
-import Outputable
import Util ( createDirectoryHierarchy, directoryOf, sortLe, seqList, lengthIs )
import BinIface ( writeBinIface )
import Unique ( Unique, Uniquable(..) )
-- is identical, so no need to write it
mkIface hsc_env maybe_old_iface
- (ModGuts{ mg_module = this_mod,
- mg_boot = is_boot,
- mg_usages = usages,
- mg_deps = deps,
- mg_rdr_env = rdr_env,
- mg_fix_env = fix_env,
- mg_deprecs = src_deprecs })
- (ModDetails{ md_insts = insts,
- md_fam_insts= _fam_inst, -- we use the type_env instead
- md_rules = rules,
- md_types = type_env,
- md_exports = exports })
+ (ModGuts{ mg_module = this_mod,
+ mg_boot = is_boot,
+ mg_usages = usages,
+ mg_deps = deps,
+ mg_rdr_env = rdr_env,
+ mg_fix_env = fix_env,
+ mg_deprecs = src_deprecs })
+ (ModDetails{ md_insts = insts,
+ md_fam_insts = fam_insts,
+ md_rules = rules,
+ md_types = type_env,
+ md_exports = exports })
-- NB: notice that mkIface does not look at the bindings
-- only at the TypeEnv. The previous Tidy phase has
; iface_rules = map (coreRuleToIfaceRule
ext_nm_lhs ext_nm_rhs) rules
; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
- ; iface_fam_insts = extractIfFamInsts decls
+ ; iface_fam_insts = map (famInstToIfaceFamInst ext_nm_lhs)
+ fam_insts
; intermediate_iface = ModIface {
mi_module = this_mod,
mi_usages = usages,
mi_exports = mkIfaceExports exports,
mi_insts = sortLe le_inst iface_insts,
- mi_fam_insts= mkIfaceFamInstsCache decls,
+ mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
mi_rules = sortLe le_rule iface_rules,
mi_fixities = fixities,
mi_deprecs = deprecs,
; return (new_iface, no_change_at_all) }
where
- r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
- i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2
+ r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
+ i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2
+ i1 `le_fam_inst` i2 = ifFamInstTyConOcc i1 <= ifFamInstTyConOcc i2
dflags = hsc_dflags hsc_env
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
+ ifFamInstTyConOcc = ifaceTyConOccName . ifFamInstTyCon
-----------------------------
}
check_old_iface hsc_env mod_summary source_unchanged maybe_iface
- = -- CHECK WHETHER THE SOURCE HAS CHANGED
- ifM (not source_unchanged)
- (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
- `thenM_`
+ = do -- CHECK WHETHER THE SOURCE HAS CHANGED
+ { ifM (not source_unchanged)
+ (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
-- If the source has changed and we're in interactive mode, avoid reading
-- an interface; just return the one we might have been supplied with.
- getGhcMode `thenM` \ ghc_mode ->
- if (ghc_mode == Interactive || ghc_mode == JustTypecheck)
- && not source_unchanged then
- returnM (outOfDate, maybe_iface)
- else
-
- case maybe_iface of {
- Just old_iface -> do -- Use the one we already have
- recomp <- checkVersions hsc_env source_unchanged old_iface
- return (recomp, Just old_iface)
-
- ; Nothing ->
+ ; ghc_mode <- getGhcMode
+ ; if (ghc_mode == Interactive || ghc_mode == JustTypecheck)
+ && not source_unchanged then
+ return (outOfDate, maybe_iface)
+ else
+ case maybe_iface of {
+ Just old_iface -> do -- Use the one we already have
+ { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
+ ; recomp <- checkVersions hsc_env source_unchanged old_iface
+ ; return (recomp, Just old_iface) }
+
+ ; Nothing -> do
-- Try and read the old interface for the current module
-- from the .hi file left from the last time we compiled it
- let
- iface_path = msHiFilePath mod_summary
- in
- readIface (ms_mod mod_summary) iface_path False `thenM` \ read_result ->
- case read_result of {
- Failed err -> -- Old interface file not found, or garbled; give up
- traceIf (text "FYI: cannot read old interface file:"
- $$ nest 4 err) `thenM_`
- returnM (outOfDate, Nothing)
+ { let iface_path = msHiFilePath mod_summary
+ ; read_result <- readIface (ms_mod mod_summary) iface_path False
+ ; case read_result of {
+ Failed err -> do -- Old interface file not found, or garbled; give up
+ { traceIf (text "FYI: cannot read old interface file:"
+ $$ nest 4 err)
+ ; return (outOfDate, Nothing) }
- ; Succeeded iface ->
+ ; Succeeded iface -> do
-- We have got the old iface; check its versions
- checkVersions hsc_env source_unchanged iface `thenM` \ recomp ->
- returnM (recomp, Just iface)
- }}
+ { traceIf (text "Read the interface file" <+> text iface_path)
+ ; recomp <- checkVersions hsc_env source_unchanged iface
+ ; returnM (recomp, Just iface)
+ }}}}}
\end{code}
@recompileRequired@ is called from the HscMain. It checks whether
-- (in which case we are done with this module) or it'll fail (in which
-- case we'll compile the module from scratch anyhow).
--
- -- We do this regardless of compilation mode
+ -- We do this regardless of compilation mode, although in --make mode
+ -- all the dependent modules should be in the HPT already, so it's
+ -- quite redundant
; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
; let this_pkg = thisPackage (hsc_dflags hsc_env)
famInstToIface Nothing = Nothing
famInstToIface (Just (famTyCon, instTys)) =
- Just $ IfaceFamInst { ifFamInstTyCon = toIfaceTyCon ext famTyCon
- , ifFamInstTys = map (toIfaceType ext) instTys
- }
+ Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys)
tyThingToIfaceDecl ext (ADataCon dc)
= pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
--------------------------
+famInstToIfaceFamInst :: (Name -> IfaceExtName) -> FamInst -> IfaceFamInst
+famInstToIfaceFamInst ext_lhs fi@(FamInst { fi_tycon = tycon,
+ fi_fam = fam, fi_tcs = mb_tcs })
+ = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon ext_lhs tycon
+ , ifFamInstFam = ext_lhs fam
+ , ifFamInstTys = map do_rough mb_tcs }
+ where
+ do_rough Nothing = Nothing
+ do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
+
+--------------------------
toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
toIfaceIdInfo ext id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
projects / ghc-hetmet.git / blobdiff