Commit 01e0566e authored by simonpj's avatar simonpj
Browse files

[project @ 2000-11-07 13:12:21 by simonpj]

More small changes
parent f5448f5c
...@@ -40,7 +40,7 @@ module OccName ( ...@@ -40,7 +40,7 @@ module OccName (
#include "HsVersions.h" #include "HsVersions.h"
import Char ( isDigit, isAlpha, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt ) import Char ( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
import Util ( thenCmp ) import Util ( thenCmp )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM ) import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
import Outputable import Outputable
......
...@@ -16,8 +16,6 @@ module PprEnv ( ...@@ -16,8 +16,6 @@ module PprEnv (
#include "HsVersions.h" #include "HsVersions.h"
import {-# SOURCE #-} DataCon ( DataCon )
import Var ( Id, TyVar ) import Var ( Id, TyVar )
import CostCentre ( CostCentre ) import CostCentre ( CostCentre )
import Type ( Type ) import Type ( Type )
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: CgCase.lhs,v 1.46 2000/09/06 12:21:15 simonmar Exp $ % $Id: CgCase.lhs,v 1.47 2000/11/07 13:12:22 simonpj Exp $
% %
%******************************************************** %********************************************************
%* * %* *
...@@ -33,7 +33,7 @@ import CgBindery ( getVolatileRegs, getArgAmodes, ...@@ -33,7 +33,7 @@ import CgBindery ( getVolatileRegs, getArgAmodes,
buildContLivenessMask, nukeDeadBindings, buildContLivenessMask, nukeDeadBindings,
) )
import CgCon ( bindConArgs, bindUnboxedTupleComponents ) import CgCon ( bindConArgs, bindUnboxedTupleComponents )
import CgHeapery ( altHeapCheck, yield ) import CgHeapery ( altHeapCheck )
import CgRetConv ( dataReturnConvPrim, ctrlReturnConvAlg, import CgRetConv ( dataReturnConvPrim, ctrlReturnConvAlg,
CtrlReturnConvention(..) CtrlReturnConvention(..)
) )
...@@ -41,13 +41,12 @@ import CgStackery ( allocPrimStack, allocStackTop, ...@@ -41,13 +41,12 @@ import CgStackery ( allocPrimStack, allocStackTop,
deAllocStackTop, freeStackSlots, dataStackSlots deAllocStackTop, freeStackSlots, dataStackSlots
) )
import CgTailCall ( tailCallFun ) import CgTailCall ( tailCallFun )
import CgUsages ( getSpRelOffset, getRealSp ) import CgUsages ( getSpRelOffset )
import CLabel ( CLabel, mkVecTblLabel, mkReturnPtLabel, import CLabel ( mkVecTblLabel, mkClosureTblLabel,
mkDefaultLabel, mkAltLabel, mkReturnInfoLabel, mkDefaultLabel, mkAltLabel, mkReturnInfoLabel
mkErrorStdEntryLabel, mkClosureTblLabel
) )
import ClosureInfo ( mkLFArgument ) import ClosureInfo ( mkLFArgument )
import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros ) import CmdLineOpts ( opt_SccProfilingOn )
import Id ( Id, idPrimRep, isDeadBinder ) import Id ( Id, idPrimRep, isDeadBinder )
import DataCon ( DataCon, dataConTag, fIRST_TAG, ConTag, import DataCon ( DataCon, dataConTag, fIRST_TAG, ConTag,
isUnboxedTupleCon ) isUnboxedTupleCon )
...@@ -57,7 +56,7 @@ import PrimOp ( primOpOutOfLine, PrimOp(..) ) ...@@ -57,7 +56,7 @@ import PrimOp ( primOpOutOfLine, PrimOp(..) )
import PrimRep ( getPrimRepSize, retPrimRepSize, PrimRep(..) import PrimRep ( getPrimRepSize, retPrimRepSize, PrimRep(..)
) )
import TyCon ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon, import TyCon ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
isNewTyCon, isAlgTyCon, isFunTyCon, isPrimTyCon, isFunTyCon, isPrimTyCon,
) )
import Type ( Type, typePrimRep, splitAlgTyConApp, import Type ( Type, typePrimRep, splitAlgTyConApp,
splitTyConApp_maybe, repType ) splitTyConApp_maybe, repType )
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: CgExpr.lhs,v 1.36 2000/10/03 08:43:00 simonpj Exp $ % $Id: CgExpr.lhs,v 1.37 2000/11/07 13:12:22 simonpj Exp $
% %
%******************************************************** %********************************************************
%* * %* *
...@@ -39,11 +39,9 @@ import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo, ...@@ -39,11 +39,9 @@ import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
import CostCentre ( sccAbleCostCentre, isSccCountCostCentre ) import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id ) import Id ( idPrimRep, idType, Id )
import VarSet import VarSet
import DataCon ( DataCon, dataConTyCon ) import DataCon ( dataConTyCon )
import PrimOp ( primOpOutOfLine, ccallMayGC, import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) import PrimRep ( PrimRep(..), isFollowableRep )
)
import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
import TyCon ( maybeTyConSingleCon, import TyCon ( maybeTyConSingleCon,
isUnboxedTupleTyCon, isEnumerationTyCon ) isUnboxedTupleTyCon, isEnumerationTyCon )
import Type ( Type, typePrimRep, splitTyConApp_maybe, repType ) import Type ( Type, typePrimRep, splitTyConApp_maybe, repType )
......
...@@ -56,7 +56,6 @@ import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE, ...@@ -56,7 +56,6 @@ import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE,
sTD_ITBL_SIZE, pROF_ITBL_SIZE, sTD_ITBL_SIZE, pROF_ITBL_SIZE,
gRAN_ITBL_SIZE, tICKY_ITBL_SIZE ) gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
import Outputable import Outputable
import GlaExts ( Int(..), Int#, (<#), (==#), (<#), (>#) )
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
...@@ -16,7 +16,7 @@ module HsDecls ( ...@@ -16,7 +16,7 @@ module HsDecls (
DeprecDecl(..), DeprecTxt, DeprecDecl(..), DeprecTxt,
hsDeclName, instDeclName, tyClDeclName, tyClDeclNames, hsDeclName, instDeclName, tyClDeclName, tyClDeclNames,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls, isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
mkClassDeclSysNames, isIfaceRuleDecl, mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,
getClassDeclSysNames getClassDeclSysNames
) where ) where
...@@ -36,7 +36,7 @@ import CallConv ( CallConv, pprCallConv ) ...@@ -36,7 +36,7 @@ import CallConv ( CallConv, pprCallConv )
-- others: -- others:
import FunDeps ( pprFundeps ) import FunDeps ( pprFundeps )
import Class ( FunDep ) import Class ( FunDep, DefMeth(..) )
import CStrings ( CLabelString, pprCLabelString ) import CStrings ( CLabelString, pprCLabelString )
import Outputable import Outputable
import SrcLoc ( SrcLoc ) import SrcLoc ( SrcLoc )
...@@ -296,13 +296,17 @@ eq_hsFD env (ns1,ms1) (ns2,ms2) ...@@ -296,13 +296,17 @@ eq_hsFD env (ns1,ms1) (ns2,ms2)
eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _) eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
= n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2 = n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
where where
-- Ignore the name of the default method. -- Ignore the name of the default method for (DefMeth id)
-- This is used for comparing declarations before putting -- This is used for comparing declarations before putting
-- them into interface files, and the name of the default -- them into interface files, and the name of the default
-- method isn't relevant -- method isn't relevant
(Just (explicit_dm1)) `eq_dm` (Just (explicit_dm2)) = explicit_dm1 == explicit_dm2
Nothing `eq_dm` Nothing = True Nothing `eq_dm` Nothing = True
(Just NoDefMeth) `eq_dm` (Just NoDefMeth) = True
(Just GenDefMeth) `eq_dm` (Just GenDefMeth) = True
(Just (DefMeth _)) `eq_dm` (Just (DefMeth _)) = True
dm1 `eq_dm` dm2 = False dm1 `eq_dm` dm2 = False
\end{code} \end{code}
\begin{code} \begin{code}
...@@ -424,7 +428,7 @@ conDeclsNames cons ...@@ -424,7 +428,7 @@ conDeclsNames cons
eq_ConDecl env (ConDecl n1 _ tvs1 cxt1 cds1 _) eq_ConDecl env (ConDecl n1 _ tvs1 cxt1 cds1 _)
(ConDecl n2 _ tvs2 cxt2 cds2 _) (ConDecl n2 _ tvs2 cxt2 cds2 _)
= n1 == n2 && = n1 == n2 &&
(eqWithHsTyVars tvs1 tvs2 $ \ env -> (eq_hsTyVars env tvs1 tvs2 $ \ env ->
eq_hsContext env cxt1 cxt2 && eq_hsContext env cxt1 cxt2 &&
eq_ConDetails env cds1 cds2) eq_ConDetails env cds1 cds2)
...@@ -642,6 +646,11 @@ data RuleDecl name pat ...@@ -642,6 +646,11 @@ data RuleDecl name pat
isIfaceRuleDecl (HsRule _ _ _ _ _ _) = False isIfaceRuleDecl (HsRule _ _ _ _ _ _) = False
isIfaceRuleDecl other = True isIfaceRuleDecl other = True
ifaceRuleDeclName :: RuleDecl name pat -> name
ifaceRuleDeclName (IfaceRule _ _ n _ _ _) = n
ifaceRuleDeclName (IfaceRuleOut n r) = n
ifaceRuleDeclName (HsRule fs _ _ _ _ _) = pprPanic "ifaceRuleDeclName" (ppr fs)
data RuleBndr name data RuleBndr name
= RuleBndr name = RuleBndr name
| RuleBndrSig name (HsType name) | RuleBndrSig name (HsType name)
......
...@@ -17,7 +17,7 @@ module HsTypes ( ...@@ -17,7 +17,7 @@ module HsTypes (
-- Equality over Hs things -- Equality over Hs things
, EqHsEnv, emptyEqHsEnv, extendEqHsEnv, , EqHsEnv, emptyEqHsEnv, extendEqHsEnv,
, eqWithHsTyVars, eq_hsVar, eq_hsVars, eq_hsType, eq_hsContext, eqListBy , eqWithHsTyVars, eq_hsVar, eq_hsVars, eq_hsTyVars, eq_hsType, eq_hsContext, eqListBy
-- Converting from Type to HsType -- Converting from Type to HsType
, toHsType, toHsTyVar, toHsTyVars, toHsContext, toHsFDs , toHsType, toHsTyVar, toHsTyVars, toHsContext, toHsFDs
......
...@@ -81,11 +81,6 @@ clazz = \mfs -> \n -> \x -> \is -> \ms -> ...@@ -81,11 +81,6 @@ clazz = \mfs -> \n -> \x -> \is -> \ms ->
$$ indent ms $$ indent ms
$$ text "}" $$ text "}"
staticblock = \ss ->
text "static" <+> text "{"
$$ indent ss
$$ text "}"
modifiers mfs = hsep (map modifier mfs) modifiers mfs = hsep (map modifier mfs)
modifier mf = text $ map toLower (show mf) modifier mf = text $ map toLower (show mf)
......
...@@ -341,10 +341,6 @@ lookup_def_int sw def = case (lookup_str sw) of ...@@ -341,10 +341,6 @@ lookup_def_int sw def = case (lookup_str sw) of
Nothing -> def -- Use default Nothing -> def -- Use default
Just xx -> read xx Just xx -> read xx
lookup_def_char sw def = case (lookup_str sw) of
Just (xx:_) -> xx
_ -> def -- Use default
lookup_def_float sw def = case (lookup_str sw) of lookup_def_float sw def = case (lookup_str sw) of
Nothing -> def -- Use default Nothing -> def -- Use default
Just xx -> read xx Just xx -> read xx
...@@ -604,11 +600,6 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* ...@@ -604,11 +600,6 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
|| sw `is_elem` ss || sw `is_elem` ss
\end{code} \end{code}
Default settings for simplifier switches
\begin{code}
defaultSimplSwitches = [MaxSimplifierIterations 1]
\end{code}
%************************************************************************ %************************************************************************
%* * %* *
......
...@@ -31,7 +31,6 @@ import ErrUtils ( dumpIfSet_dyn ) ...@@ -31,7 +31,6 @@ import ErrUtils ( dumpIfSet_dyn )
import Outputable import Outputable
import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName ) import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName )
import TmpFiles ( newTempName ) import TmpFiles ( newTempName )
import UniqSupply ( mkSplitUniqSupply )
import IO ( IOMode(..), hClose, openFile, Handle ) import IO ( IOMode(..), hClose, openFile, Handle )
\end{code} \end{code}
......
...@@ -13,7 +13,7 @@ module HscTypes ( ...@@ -13,7 +13,7 @@ module HscTypes (
lookupIface, lookupIfaceByModName, lookupIface, lookupIfaceByModName,
emptyModIface, emptyModIface,
IfaceDecls(..), IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo, VersionInfo(..), initialVersionInfo,
...@@ -60,7 +60,7 @@ import TyCon ( TyCon ) ...@@ -60,7 +60,7 @@ import TyCon ( TyCon )
import BasicTypes ( Version, initialVersion, Fixity ) import BasicTypes ( Version, initialVersion, Fixity )
import HsSyn ( DeprecTxt ) import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl ) import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
...@@ -71,7 +71,7 @@ import Bag ( Bag ) ...@@ -71,7 +71,7 @@ import Bag ( Bag )
import Maybes ( seqMaybe ) import Maybes ( seqMaybe )
import Outputable import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc ) import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Util ( thenCmp ) import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply ) import UniqSupply ( UniqSupply )
\end{code} \end{code}
...@@ -144,6 +144,32 @@ data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted ...@@ -144,6 +144,32 @@ data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
dcl_rules :: [RenamedRuleDecl], -- Sorted dcl_rules :: [RenamedRuleDecl], -- Sorted
dcl_insts :: [RenamedInstDecl] } -- Unsorted dcl_insts :: [RenamedInstDecl] } -- Unsorted
mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
mkIfaceDecls tycls rules insts
= IfaceDecls { dcl_tycl = sortLt lt_tycl tycls,
dcl_rules = sortLt lt_rule rules,
dcl_insts = insts }
where
d1 `lt_tycl` d2 = nameOccName (tyClDeclName d1) < nameOccName (tyClDeclName d2)
r1 `lt_rule` r2 = nameOccName (ifaceRuleDeclName r1) < nameOccName (ifaceRuleDeclName r2)
-- I wanted to sort just by the Name, but there's a problem: we are comparing
-- the old version of an interface with the new version. The latter will use
-- local names like 'lvl23' that were constructed not by the renamer but by
-- the simplifier. So the unqiues aren't going to line up.
--
-- It's ok to compare by OccName because this comparison only drives the
-- computation of new version numbers.
--
-- Better solutions: Compare in a way that is insensitive to the name used
-- for local things. This would decrease the wobbles due
-- to 'lvl23' changing to 'lvl24'.
--
-- NB: there's a related comparision on MkIface.diffDecls!
-- typechecker should only look at this, not ModIface -- typechecker should only look at this, not ModIface
-- Should be able to construct ModDetails from mi_decls in ModIface -- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails data ModDetails
......
...@@ -20,7 +20,8 @@ import BasicTypes ( Fixity(..), NewOrData(..), ...@@ -20,7 +20,8 @@ import BasicTypes ( Fixity(..), NewOrData(..),
import RnMonad import RnMonad
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl ) import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
import TcHsSyn ( TypecheckedRuleDecl ) import TcHsSyn ( TypecheckedRuleDecl )
import HscTypes ( VersionInfo(..), IfaceDecls(..), ModIface(..), ModDetails(..), import HscTypes ( VersionInfo(..), ModIface(..), ModDetails(..),
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
TyThing(..), DFunId, TypeEnv, isTyClThing, Avails, TyThing(..), DFunId, TypeEnv, isTyClThing, Avails,
WhatsImported(..), GenAvailInfo(..), WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..) ImportVersion, AvailInfo, Deprecations(..)
...@@ -136,10 +137,7 @@ completeIface :: Maybe ModIface -- The old interface, if we have it ...@@ -136,10 +137,7 @@ completeIface :: Maybe ModIface -- The old interface, if we have it
completeIface maybe_old_iface new_iface mod_details completeIface maybe_old_iface new_iface mod_details
= addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls }) = addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls })
where where
new_decls = IfaceDecls { dcl_tycl = ty_cls_dcls, new_decls = mkIfaceDecls ty_cls_dcls rule_dcls inst_dcls
dcl_insts = inst_dcls,
dcl_rules = rule_dcls }
inst_dcls = map ifaceInstance (md_insts mod_details) inst_dcls = map ifaceInstance (md_insts mod_details)
ty_cls_dcls = foldNameEnv ifaceTyCls [] (md_types mod_details) ty_cls_dcls = foldNameEnv ifaceTyCls [] (md_types mod_details)
rule_dcls = map ifaceRule (md_rules mod_details) rule_dcls = map ifaceRule (md_rules mod_details)
...@@ -585,7 +583,7 @@ diffDecls old_vers old_fixities new_fixities old new ...@@ -585,7 +583,7 @@ diffDecls old_vers old_fixities new_fixities old new
diff ok_so_far pp new_vers old [] = (False, pp, new_vers) diff ok_so_far pp new_vers old [] = (False, pp, new_vers)
diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] nds diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] nds
diff ok_so_far pp new_vers (od:ods) (nd:nds) diff ok_so_far pp new_vers (od:ods) (nd:nds)
= case od_name `compare` nd_name of = case nameOccName od_name `compare` nameOccName nd_name of
LT -> diff False (pp $$ only_old od) new_vers ods (nd:nds) LT -> diff False (pp $$ only_old od) new_vers ods (nd:nds)
GT -> diff False (pp $$ only_new nd) new_vers (od:ods) nds GT -> diff False (pp $$ only_new nd) new_vers (od:ods) nds
EQ | od `eq_tc` nd -> diff ok_so_far pp new_vers ods nds EQ | od `eq_tc` nd -> diff ok_so_far pp new_vers ods nds
......
...@@ -27,7 +27,7 @@ import RnIfaces ( slurpImpDecls, mkImportInfo, ...@@ -27,7 +27,7 @@ import RnIfaces ( slurpImpDecls, mkImportInfo,
) )
import RnHiFiles ( readIface, removeContext, import RnHiFiles ( readIface, removeContext,
loadExports, loadFixDecls, loadDeprecs ) loadExports, loadFixDecls, loadDeprecs )
import RnEnv ( availName, import RnEnv ( availsToNameSet,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails, emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules, warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupOrigNames, lookupSrcName, newGlobalName lookupOrigNames, lookupSrcName, newGlobalName
...@@ -63,7 +63,8 @@ import Outputable ...@@ -63,7 +63,8 @@ import Outputable
import IO ( openFile, IOMode(..) ) import IO ( openFile, IOMode(..) )
import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..), ModIface(..), WhatsImported(..),
VersionInfo(..), ImportVersion, IfaceDecls(..), VersionInfo(..), ImportVersion,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo, GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo,
Provenance(..), ImportReason(..), initialVersionInfo, Provenance(..), ImportReason(..), initialVersionInfo,
Deprecations(..), lookupDeprec, lookupIface Deprecations(..), lookupDeprec, lookupIface
...@@ -136,15 +137,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc) ...@@ -136,15 +137,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
-- SLURP IN ALL THE NEEDED DECLARATIONS -- SLURP IN ALL THE NEEDED DECLARATIONS
implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs -> implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
let let
-- The export_fvs make the exported names look just as if they slurp_fvs = implicit_fvs `plusFV` source_fvs
-- occurred in the source program. For the reasoning, see the
-- comments with RnIfaces.getImportVersions.
-- We only need the 'parent name' of the avail;
-- that's enough to suck in the declaration.
export_fvs = mkNameSet (map availName export_avails)
real_source_fvs = source_fvs `plusFV` export_fvs
slurp_fvs = implicit_fvs `plusFV` real_source_fvs
-- It's important to do the "plus" this way round, so that -- It's important to do the "plus" this way round, so that
-- when compiling the prelude, locally-defined (), Bool, etc -- when compiling the prelude, locally-defined (), Bool, etc
-- override the implicit ones. -- override the implicit ones.
...@@ -188,11 +181,19 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc) ...@@ -188,11 +181,19 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
mi_deprecs = my_deprecs, mi_deprecs = my_deprecs,
mi_decls = panic "mi_decls" mi_decls = panic "mi_decls"
} }
-- The export_fvs make the exported names look just as if they
-- occurred in the source program.
-- We only need the 'parent name' of the avail;
-- that's enough to suck in the declaration.
export_fvs = availsToNameSet export_avails
used_vars = source_fvs `plusFV` export_fvs
in in
-- REPORT UNUSED NAMES, AND DEBUG DUMP -- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_iface imports global_avail_env reportUnusedNames mod_iface imports global_avail_env
real_source_fvs rn_imp_decls `thenRn_` used_vars rn_imp_decls `thenRn_`
returnRn (Just (mod_iface, final_decls)) returnRn (Just (mod_iface, final_decls))
where where
...@@ -425,9 +426,7 @@ loadOldIface parsed_iface ...@@ -425,9 +426,7 @@ loadOldIface parsed_iface
vers_rules = rule_vers, vers_rules = rule_vers,
vers_decls = decls_vers } vers_decls = decls_vers }
decls = IfaceDecls { dcl_tycl = new_decls, decls = mkIfaceDecls new_decls new_rules new_insts
dcl_rules = new_rules,
dcl_insts = new_insts }
mod_iface = ModIface { mi_module = mod, mi_version = version, mod_iface = ModIface { mi_module = mod, mi_version = version,
mi_exports = avails, mi_usages = usages, mi_exports = avails, mi_usages = usages,
......
...@@ -162,9 +162,9 @@ instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _) ...@@ -162,9 +162,9 @@ instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
---------------- ----------------
ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
ruleDeclFVs (IfaceRule _ vars _ _ rhs _) ruleDeclFVs (IfaceRule _ vars _ args rhs _)
= delFVs (map ufBinderName vars) $ = delFVs (map ufBinderName vars) $
ufExprFVs rhs ufExprFVs rhs `plusFV` plusFVs (map ufExprFVs args)
---------------- ----------------
conDeclFVs (ConDecl _ _ tyvars context details _) conDeclFVs (ConDecl _ _ tyvars context details _)
......
...@@ -85,53 +85,14 @@ getInterfaceExports mod_name from ...@@ -85,53 +85,14 @@ getInterfaceExports mod_name from
%* * %* *
%********************************************************* %*********************************************************
getImportVersions figures out what the ``usage information'' for this mkImportInof figures out what the ``usage information'' for this
moudule is; that is, what it must record in its interface file as the moudule is; that is, what it must record in its interface file as the
things it uses. It records: things it uses.
\begin{itemize} We produce a line for every module B below the module, A, currently being
\item (a) anything reachable from its body code compiled:
\item (b) any module exported with a @module Foo@ import B <n> ;
\item (c) anything reachable from an exported item to record the fact that A does import B indireclty. This is used to decide
\end{itemize}
Why (b)? Because if @Foo@ changes then this module's export list
will change, so we must recompile this module at least as far as
making a new interface file --- but in practice that means complete
recompilation.
Why (c)? Consider this:
\begin{verbatim}
module A( f, g ) where | module B( f ) where
import B( f ) | f = h 3
g = ... | h = ...
\end{verbatim}
Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
@A@'s usages? Our idea is that we aren't going to touch A.hi if it is
*identical* to what it was before. If anything about @B.f@ changes
than anyone who imports @A@ should be recompiled in case they use
@B.f@ (they'll get an early exit if they don't). So, if anything
about @B.f@ changes we'd better make sure that something in A.hi
changes, and the convenient way to do that is to record the version
number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
complete recompiation of A, which is overkill but it's the only way to
write a new, slightly different, A.hi.
But the example is tricker. Even if @B.f@ doesn't change at all,
@B.h@ may do so, and this change may not be reflected in @f@'s version
number. But with -O, a module that imports A must be recompiled if
@B.h@ changes! So A must record a dependency on @B.h@. So we treat
the occurrence of @B.f@ in the export list *just as if* it were in the
code of A, and thereby haul in all the stuff reachable from it.
[NB: If B was compiled with -O, but A isn't, we should really *still*
haul in all the unfoldings for B, in case the module that imports A *is*
compiled with -O. I think this is the case.]
Even if B is used at all we get a usage line for B
import B <n> :: ... ;
in A.hi, to record the fact that A does import B. This is used to decide
to look to look for B.hi rather than B.hi-boot when compiling a module that to look to look for B.hi rather than B.hi-boot when compiling a module that
imports A. This line says that A imports B, but uses nothing in it. imports A. This line says that A imports B, but uses nothing in it.
So we'll get an early bale-out when compiling A if B's version changes. So we'll get an early bale-out when compiling A if B's version changes.
...@@ -317,8 +278,12 @@ closeDecls decls needed ...@@ -317,8 +278,12 @@ closeDecls decls needed
case rule_decls of case rule_decls of
[] -> returnRn decls -- No new rules, so we are done [] -> returnRn decls -- No new rules, so we are done
other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' -> other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' ->
closeDecls (map RuleD rule_decls' ++ decls) let
(plusFVs (map ruleDeclFVs rule_decls')) rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
in
traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs))) `thenRn_`
closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
------------------------------------------------------- -------------------------------------------------------
...@@ -644,7 +609,13 @@ importDecl name ...@@ -644,7 +609,13 @@ importDecl name
returnRn AlreadySlurped returnRn AlreadySlurped
else else
-- STEP 2: Check if it's already in the type environment -- STEP 2: Check if we've slurped it in while compiling this module
getIfacesRn `thenRn` \ ifaces ->
if name `elemNameSet` iSlurp ifaces then
returnRn AlreadySlurped
else
-- STEP 3: Check if it's already in the type environment
getTypeEnvRn `thenRn` \ lookup -> getTypeEnvRn `thenRn` \ lookup ->
case lookup name of {