From 01e0566e61e4222600c7ba0a2d35d6102fd1afb5 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Tue, 7 Nov 2000 13:12:24 +0000
Subject: [PATCH] [project @ 2000-11-07 13:12:21 by simonpj] More small changes
---
ghc/compiler/basicTypes/OccName.lhs | 2 +-
ghc/compiler/basicTypes/PprEnv.lhs | 2 -
ghc/compiler/codeGen/CgCase.lhs | 15 +++--
ghc/compiler/codeGen/CgExpr.lhs | 10 ++-
ghc/compiler/codeGen/SMRep.lhs | 1 -
ghc/compiler/hsSyn/HsDecls.lhs | 23 ++++---
ghc/compiler/hsSyn/HsTypes.lhs | 2 +-
ghc/compiler/javaGen/PrintJava.lhs | 5 --
ghc/compiler/main/CmdLineOpts.lhs | 9 ---
ghc/compiler/main/CodeOutput.lhs | 1 -
ghc/compiler/main/HscTypes.lhs | 32 +++++++++-
ghc/compiler/main/MkIface.lhs | 10 ++-
ghc/compiler/rename/Rename.lhs | 29 +++++----
ghc/compiler/rename/RnHsSyn.lhs | 4 +-
ghc/compiler/rename/RnIfaces.lhs | 83 +++++++------------------
ghc/compiler/rename/RnMonad.lhs | 5 ++
ghc/compiler/simplCore/BinderInfo.lhs | 3 +-
ghc/compiler/stranal/SaAbsInt.lhs | 10 +--
ghc/compiler/typecheck/TcEnv.lhs | 2 +-
ghc/compiler/typecheck/TcModule.lhs | 9 +++
ghc/compiler/typecheck/TcTyClsDecls.lhs | 9 +--
ghc/compiler/typecheck/TcTyDecls.lhs | 2 +-
ghc/compiler/typecheck/TcUnify.lhs | 1 -
ghc/compiler/types/Generics.hi-boot-5 | 2 +-
ghc/compiler/types/Generics.lhs | 8 +--
ghc/compiler/types/InstEnv.lhs | 1 -
ghc/compiler/types/Variance.lhs | 3 +-
ghc/compiler/utils/FiniteMap.lhs | 4 --
ghc/compiler/utils/Outputable.lhs | 2 -
ghc/compiler/utils/StringBuffer.lhs | 1 -
ghc/compiler/utils/UnicodeUtil.lhs | 4 +-
31 files changed, 135 insertions(+), 159 deletions(-)
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 6a1de9652c8e..ea370e26fdeb 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -40,7 +40,7 @@ module OccName (
#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 FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
import Outputable
diff --git a/ghc/compiler/basicTypes/PprEnv.lhs b/ghc/compiler/basicTypes/PprEnv.lhs
index a2df826fa7d6..36293f36888c 100644
--- a/ghc/compiler/basicTypes/PprEnv.lhs
+++ b/ghc/compiler/basicTypes/PprEnv.lhs
@@ -16,8 +16,6 @@ module PprEnv (
#include "HsVersions.h"
-import {-# SOURCE #-} DataCon ( DataCon )
-
import Var ( Id, TyVar )
import CostCentre ( CostCentre )
import Type ( Type )
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 481ef028555e..2bca305bddb6 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
%
% (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,
buildContLivenessMask, nukeDeadBindings,
)
import CgCon ( bindConArgs, bindUnboxedTupleComponents )
-import CgHeapery ( altHeapCheck, yield )
+import CgHeapery ( altHeapCheck )
import CgRetConv ( dataReturnConvPrim, ctrlReturnConvAlg,
CtrlReturnConvention(..)
)
@@ -41,13 +41,12 @@ import CgStackery ( allocPrimStack, allocStackTop,
deAllocStackTop, freeStackSlots, dataStackSlots
)
import CgTailCall ( tailCallFun )
-import CgUsages ( getSpRelOffset, getRealSp )
-import CLabel ( CLabel, mkVecTblLabel, mkReturnPtLabel,
- mkDefaultLabel, mkAltLabel, mkReturnInfoLabel,
- mkErrorStdEntryLabel, mkClosureTblLabel
+import CgUsages ( getSpRelOffset )
+import CLabel ( mkVecTblLabel, mkClosureTblLabel,
+ mkDefaultLabel, mkAltLabel, mkReturnInfoLabel
)
import ClosureInfo ( mkLFArgument )
-import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
+import CmdLineOpts ( opt_SccProfilingOn )
import Id ( Id, idPrimRep, isDeadBinder )
import DataCon ( DataCon, dataConTag, fIRST_TAG, ConTag,
isUnboxedTupleCon )
@@ -57,7 +56,7 @@ import PrimOp ( primOpOutOfLine, PrimOp(..) )
import PrimRep ( getPrimRepSize, retPrimRepSize, PrimRep(..)
)
import TyCon ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
- isNewTyCon, isAlgTyCon, isFunTyCon, isPrimTyCon,
+ isFunTyCon, isPrimTyCon,
)
import Type ( Type, typePrimRep, splitAlgTyConApp,
splitTyConApp_maybe, repType )
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 37ef6e8817a3..90509f3646ae 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
%
% (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,
import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
-import DataCon ( DataCon, dataConTyCon )
-import PrimOp ( primOpOutOfLine, ccallMayGC,
- getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
- )
-import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
+import DataCon ( dataConTyCon )
+import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
+import PrimRep ( PrimRep(..), isFollowableRep )
import TyCon ( maybeTyConSingleCon,
isUnboxedTupleTyCon, isEnumerationTyCon )
import Type ( Type, typePrimRep, splitTyConApp_maybe, repType )
diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
index c338cf8b3f3b..d2bb4f7ae2cd 100644
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ b/ghc/compiler/codeGen/SMRep.lhs
@@ -56,7 +56,6 @@ import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE,
sTD_ITBL_SIZE, pROF_ITBL_SIZE,
gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
import Outputable
-import GlaExts ( Int(..), Int#, (<#), (==#), (<#), (>#) )
\end{code}
%************************************************************************
diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 54f993da7fc2..25921364bbd9 100644
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -16,7 +16,7 @@ module HsDecls (
DeprecDecl(..), DeprecTxt,
hsDeclName, instDeclName, tyClDeclName, tyClDeclNames,
isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
- mkClassDeclSysNames, isIfaceRuleDecl,
+ mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,
getClassDeclSysNames
) where
@@ -36,7 +36,7 @@ import CallConv ( CallConv, pprCallConv )
-- others:
import FunDeps ( pprFundeps )
-import Class ( FunDep )
+import Class ( FunDep, DefMeth(..) )
import CStrings ( CLabelString, pprCLabelString )
import Outputable
import SrcLoc ( SrcLoc )
@@ -296,13 +296,17 @@ eq_hsFD env (ns1,ms1) (ns2,ms2)
eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
= n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
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
-- them into interface files, and the name of the default
-- method isn't relevant
- (Just (explicit_dm1)) `eq_dm` (Just (explicit_dm2)) = explicit_dm1 == explicit_dm2
- Nothing `eq_dm` Nothing = True
- dm1 `eq_dm` dm2 = False
+ 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
+
+
\end{code}
\begin{code}
@@ -424,7 +428,7 @@ conDeclsNames cons
eq_ConDecl env (ConDecl n1 _ tvs1 cxt1 cds1 _)
(ConDecl n2 _ tvs2 cxt2 cds2 _)
= n1 == n2 &&
- (eqWithHsTyVars tvs1 tvs2 $ \ env ->
+ (eq_hsTyVars env tvs1 tvs2 $ \ env ->
eq_hsContext env cxt1 cxt2 &&
eq_ConDetails env cds1 cds2)
@@ -642,6 +646,11 @@ data RuleDecl name pat
isIfaceRuleDecl (HsRule _ _ _ _ _ _) = False
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
= RuleBndr name
| RuleBndrSig name (HsType name)
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 956b02f3dc13..bd5178112fcf 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -17,7 +17,7 @@ module HsTypes (
-- Equality over Hs things
, 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
, toHsType, toHsTyVar, toHsTyVars, toHsContext, toHsFDs
diff --git a/ghc/compiler/javaGen/PrintJava.lhs b/ghc/compiler/javaGen/PrintJava.lhs
index edaf8e594fd8..eb2811d38f1e 100644
--- a/ghc/compiler/javaGen/PrintJava.lhs
+++ b/ghc/compiler/javaGen/PrintJava.lhs
@@ -81,11 +81,6 @@ clazz = \mfs -> \n -> \x -> \is -> \ms ->
$$ indent ms
$$ text "}"
-staticblock = \ss ->
- text "static" <+> text "{"
- $$ indent ss
- $$ text "}"
-
modifiers mfs = hsep (map modifier mfs)
modifier mf = text $ map toLower (show mf)
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 747ad0455ac2..69b856595bc7 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -341,10 +341,6 @@ lookup_def_int sw def = case (lookup_str sw) of
Nothing -> def -- Use default
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
Nothing -> def -- Use default
Just xx -> read xx
@@ -604,11 +600,6 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
|| sw `is_elem` ss
\end{code}
-Default settings for simplifier switches
-
-\begin{code}
-defaultSimplSwitches = [MaxSimplifierIterations 1]
-\end{code}
%************************************************************************
%* *
diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 91ff5ed46557..63a090e82c3b 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -31,7 +31,6 @@ import ErrUtils ( dumpIfSet_dyn )
import Outputable
import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName )
import TmpFiles ( newTempName )
-import UniqSupply ( mkSplitUniqSupply )
import IO ( IOMode(..), hClose, openFile, Handle )
\end{code}
diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index d29b7f47705c..498add4732e1 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -13,7 +13,7 @@ module HscTypes (
lookupIface, lookupIfaceByModName,
emptyModIface,
- IfaceDecls(..),
+ IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
VersionInfo(..), initialVersionInfo,
@@ -60,7 +60,7 @@ import TyCon ( TyCon )
import BasicTypes ( Version, initialVersion, Fixity )
-import HsSyn ( DeprecTxt )
+import HsSyn ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
import RdrHsSyn ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
@@ -71,7 +71,7 @@ import Bag ( Bag )
import Maybes ( seqMaybe )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import Util ( thenCmp )
+import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply )
\end{code}
@@ -144,6 +144,32 @@ data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
dcl_rules :: [RenamedRuleDecl], -- Sorted
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
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 8540f9f5f493..5ec45f18fec8 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -20,7 +20,8 @@ import BasicTypes ( Fixity(..), NewOrData(..),
import RnMonad
import RnHsSyn ( RenamedInstDecl, RenamedTyClDecl )
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,
WhatsImported(..), GenAvailInfo(..),
ImportVersion, AvailInfo, Deprecations(..)
@@ -136,10 +137,7 @@ completeIface :: Maybe ModIface -- The old interface, if we have it
completeIface maybe_old_iface new_iface mod_details
= addVersionInfo maybe_old_iface (new_iface { mi_decls = new_decls })
where
- new_decls = IfaceDecls { dcl_tycl = ty_cls_dcls,
- dcl_insts = inst_dcls,
- dcl_rules = rule_dcls }
-
+ new_decls = mkIfaceDecls ty_cls_dcls rule_dcls inst_dcls
inst_dcls = map ifaceInstance (md_insts mod_details)
ty_cls_dcls = foldNameEnv ifaceTyCls [] (md_types mod_details)
rule_dcls = map ifaceRule (md_rules mod_details)
@@ -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 [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] 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)
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
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index edec9523d91a..75a8f6f329a3 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -27,7 +27,7 @@ import RnIfaces ( slurpImpDecls, mkImportInfo,
)
import RnHiFiles ( readIface, removeContext,
loadExports, loadFixDecls, loadDeprecs )
-import RnEnv ( availName,
+import RnEnv ( availsToNameSet,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupOrigNames, lookupSrcName, newGlobalName
@@ -63,7 +63,8 @@ import Outputable
import IO ( openFile, IOMode(..) )
import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..),
- VersionInfo(..), ImportVersion, IfaceDecls(..),
+ VersionInfo(..), ImportVersion,
+ IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo,
Provenance(..), ImportReason(..), initialVersionInfo,
Deprecations(..), lookupDeprec, lookupIface
@@ -136,15 +137,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
-- SLURP IN ALL THE NEEDED DECLARATIONS
implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
let
- -- The export_fvs make the exported names look just as if they
- -- 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
+ slurp_fvs = implicit_fvs `plusFV` source_fvs
-- It's important to do the "plus" this way round, so that
-- when compiling the prelude, locally-defined (), Bool, etc
-- override the implicit ones.
@@ -188,11 +181,19 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
mi_deprecs = my_deprecs,
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
-- REPORT UNUSED NAMES, AND DEBUG DUMP
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))
where
@@ -425,9 +426,7 @@ loadOldIface parsed_iface
vers_rules = rule_vers,
vers_decls = decls_vers }
- decls = IfaceDecls { dcl_tycl = new_decls,
- dcl_rules = new_rules,
- dcl_insts = new_insts }
+ decls = mkIfaceDecls new_decls new_rules new_insts
mod_iface = ModIface { mi_module = mod, mi_version = version,
mi_exports = avails, mi_usages = usages,
diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index fefcf7c325de..dc4bd87fea0a 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -162,9 +162,9 @@ instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
----------------
ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
-ruleDeclFVs (IfaceRule _ vars _ _ rhs _)
+ruleDeclFVs (IfaceRule _ vars _ args rhs _)
= delFVs (map ufBinderName vars) $
- ufExprFVs rhs
+ ufExprFVs rhs `plusFV` plusFVs (map ufExprFVs args)
----------------
conDeclFVs (ConDecl _ _ tyvars context details _)
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 91ce7596e05e..d4a6f32cf04c 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -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
-things it uses. It records:
-
-\begin{itemize}
-\item (a) anything reachable from its body code
-\item (b) any module exported with a @module Foo@
-\item (c) anything reachable from an exported item
-\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
+things it uses.
+
+We produce a line for every module B below the module, A, currently being
+compiled:
+ import B <n> ;
+to record the fact that A does import B indireclty. This is used to decide
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.
So we'll get an early bale-out when compiling A if B's version changes.
@@ -317,8 +278,12 @@ closeDecls decls needed
case rule_decls of
[] -> returnRn decls -- No new rules, so we are done
other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' ->
- closeDecls (map RuleD rule_decls' ++ decls)
- (plusFVs (map ruleDeclFVs rule_decls'))
+ let
+ 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
returnRn AlreadySlurped
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 ->
case lookup name of {
Just ty_thing | name `elemNameEnv` wiredInThingEnv
@@ -658,12 +629,6 @@ importDecl name
Nothing ->
- -- STEP 3: Check if we've slurped it in while compiling this module
- getIfacesRn `thenRn` \ ifaces ->
- if name `elemNameSet` iSlurp ifaces then
- returnRn AlreadySlurped
- else
-
-- STEP 4: OK, we have to slurp it in from an interface file
-- First load the interface file
traceRn nd_doc `thenRn_`
@@ -711,11 +676,11 @@ recompileRequired :: FilePath -- Only needed for debug msgs
-> ModIface -- Old interface
-> RnMG RecompileRequired
recompileRequired iface_path source_unchanged iface
- = traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
+ = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
-- CHECK WHETHER THE SOURCE HAS CHANGED
if not source_unchanged then
- traceRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
+ traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
returnRn outOfDate
else
@@ -819,8 +784,8 @@ checkEntityUsage new_vers (name,old_vers)
| new_vers == old_vers -> returnRn upToDate
| otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
-up_to_date msg = traceRn msg `thenRn_` returnRn upToDate
-out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
+up_to_date msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
+out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
\end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 0d562d3114e7..b5978923f764 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -96,6 +96,11 @@ traceRn msg
= doptRn Opt_D_dump_rn_trace `thenRn` \b ->
if b then putDocRn msg else returnRn ()
+traceHiDiffsRn :: SDoc -> RnM d ()
+traceHiDiffsRn msg
+ = doptRn Opt_D_dump_hi_diffs `thenRn` \b ->
+ if b then putDocRn msg else returnRn ()
+
putDocRn :: SDoc -> RnM d ()
putDocRn msg = ioToRnM (printErrs msg) `thenRn_`
returnRn ()
diff --git a/ghc/compiler/simplCore/BinderInfo.lhs b/ghc/compiler/simplCore/BinderInfo.lhs
index 1623bcd70248..d98ea9e4a6ff 100644
--- a/ghc/compiler/simplCore/BinderInfo.lhs
+++ b/ghc/compiler/simplCore/BinderInfo.lhs
@@ -24,8 +24,7 @@ module BinderInfo (
#include "HsVersions.h"
-import IdInfo ( OccInfo(..), InsideLam, OneBranch, insideLam, notInsideLam, oneBranch )
-import GlaExts ( Int(..), (+#) )
+import IdInfo ( OccInfo(..), InsideLam, insideLam, notInsideLam )
import Outputable
\end{code}
diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
index 3d209c965de8..47afd991c4fd 100644
--- a/ghc/compiler/stranal/SaAbsInt.lhs
+++ b/ghc/compiler/stranal/SaAbsInt.lhs
@@ -17,16 +17,16 @@ module SaAbsInt (
import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
import CoreSyn
-import CoreUnfold ( Unfolding, maybeUnfoldingTemplate )
-import Id ( Id, idType, idArity, idStrictness, idUnfolding, isDataConId_maybe )
+import CoreUnfold ( maybeUnfoldingTemplate )
+import Id ( Id, idType, idStrictness, idUnfolding, isDataConId_maybe )
import DataCon ( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
import IdInfo ( StrictnessInfo(..) )
-import Demand ( Demand(..), wwPrim, wwStrict, wwEnum, wwUnpackData, wwLazy, wwUnpackNew,
+import Demand ( Demand(..), wwPrim, wwStrict, wwUnpackData, wwLazy, wwUnpackNew,
mkStrictnessInfo, isLazy
)
import SaLib
-import TyCon ( isProductTyCon, isRecursiveTyCon, isEnumerationTyCon, isNewTyCon )
-import BasicTypes ( Arity, NewOrData(..) )
+import TyCon ( isProductTyCon, isRecursiveTyCon, isNewTyCon )
+import BasicTypes ( NewOrData(..) )
import Type ( splitTyConApp_maybe,
isUnLiftedType, Type )
import TyCon ( tyConUnique )
diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index bf2ef1d3d087..ba28d134567e 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -165,7 +165,7 @@ getTcGEnv (TcEnv { tcGEnv = genv }) = genv
-- This data type is used to help tie the knot
-- when type checking type and class declarations
data TyThingDetails = SynTyDetails Type
- | DataTyDetails ClassContext [DataCon] [Class]
+ | DataTyDetails ClassContext [DataCon]
| ClassDetails ClassContext [Id] [ClassOpItem] DataCon
\end{code}
diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index bc1a87d09a69..7e63ec1f4a99 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -131,6 +131,7 @@ tcModule :: PersistentCompilerState
tcModule pcs hst get_fixity this_mod decls unf_env
= -- Type-check the type and class decls
+ traceTc (text "Tc1") `thenTc_`
tcTyAndClassDecls unf_env decls `thenTc` \ env ->
tcSetEnv env $
let
@@ -139,12 +140,14 @@ tcModule pcs hst get_fixity this_mod decls unf_env
in
-- Typecheck the instance decls, includes deriving
+ traceTc (text "Tc2") `thenTc_`
tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
hst unf_env get_fixity this_mod
tycons decls `thenTc` \ (new_pcs_insts, inst_env, local_inst_info, deriv_binds) ->
tcSetInstEnv inst_env $
-- Default declarations
+ traceTc (text "Tc3") `thenTc_`
tcDefaults decls `thenTc` \ defaulting_tys ->
tcSetDefaultTys defaulting_tys $
@@ -157,7 +160,9 @@ tcModule pcs hst get_fixity this_mod decls unf_env
-- We must do this before mkImplicitDataBinds (which comes next), since
-- the latter looks up unpackCStringId, for example, which is usually
-- imported
+ traceTc (text "Tc3") `thenTc_`
tcInterfaceSigs unf_env decls `thenTc` \ sig_ids ->
+ traceTc (text "Tc5") `thenTc_` (
tcExtendGlobalValEnv sig_ids $
tcGetEnv `thenTc` \ unf_env ->
@@ -180,15 +185,18 @@ tcModule pcs hst get_fixity this_mod decls unf_env
tcExtendGlobalValEnv cls_ids $
-- Foreign import declarations next
+ traceTc (text "Tc6") `thenTc_`
tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
tcExtendGlobalValEnv fo_ids $
-- Value declarations next.
-- We also typecheck any extra binds that came out of the "deriving" process
+ traceTc (text "Tc7") `thenTc_`
tcTopBinds (get_binds decls `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
tcSetEnv env $
-- Foreign export declarations next
+ traceTc (text "Tc8") `thenTc_`
tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
-- Second pass over class and instance declarations,
@@ -253,6 +261,7 @@ tcModule pcs hst get_fixity this_mod decls unf_env
tc_fords = foi_decls ++ foe_decls',
tc_rules = local_rules'
})
+ )
get_binds decls = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
\end{code}
diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index b92276e02357..6cd8799f87ab 100644
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -10,6 +10,7 @@ module TcTyClsDecls (
#include "HsVersions.h"
+import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
import HsSyn ( HsDecl(..), TyClDecl(..),
HsTyVarBndr,
ConDecl(..),
@@ -47,7 +48,6 @@ import Maybes ( mapMaybe )
import ErrUtils ( Message )
import HsDecls ( getClassDeclSysNames )
import Generics ( mkTyConGenInfo )
-import CmdLineOpts ( DynFlags )
\end{code}
@@ -296,11 +296,12 @@ buildTyConOrClass dflags is_rec kenv rec_vrcs rec_details
where
tycon = mkAlgTyConRep tycon_name tycon_kind tyvars ctxt argvrcs
data_cons nconstrs
- derived_classes
flavour is_rec gen_info
- gen_info = mkTyConGenInfo dflags tycon name1 name2
- DataTyDetails ctxt data_cons derived_classes = lookupNameEnv_NF rec_details tycon_name
+ gen_info | not (dopt Opt_Generics dflags) = Nothing
+ | otherwise = mkTyConGenInfo tycon name1 name2
+
+ DataTyDetails ctxt data_cons = lookupNameEnv_NF rec_details tycon_name
tycon_kind = lookupNameEnv_NF kenv tycon_name
tyvars = mkTyClTyVars tycon_kind tyvar_names
diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index 24896abd4966..76b91d5223a2 100644
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -24,7 +24,7 @@ import TcMonoType ( tcHsType, tcHsSigType, tcHsBoxedSigType, tcHsTyVars, tcClass
kcHsContext, kcHsSigType
)
import TcEnv ( tcExtendTyVarEnv,
- tcLookupTyCon, tcLookupClass, tcLookupGlobalId,
+ tcLookupTyCon, tcLookupGlobalId,
TyThingDetails(..)
)
import TcMonad
diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs
index 8289392c23aa..0944e639f7af 100644
--- a/ghc/compiler/typecheck/TcUnify.lhs
+++ b/ghc/compiler/typecheck/TcUnify.lhs
@@ -324,7 +324,6 @@ uUnboundVar swapped tv1 maybe_ty1 ps_ty2 ty2@(TyVarTy tv2)
uUnboundVar swapped tv1 maybe_ty1 ps_ty2 non_var_ty2
= checkKinds swapped tv1 non_var_ty2 `thenTc_`
occur_check non_var_ty2 `thenTc_`
- ASSERT( isNotUsgTy ps_ty2 )
checkTcM (not (isSigTyVar tv1))
(failWithTcM (unifyWithSigErr tv1 ps_ty2)) `thenTc_`
diff --git a/ghc/compiler/types/Generics.hi-boot-5 b/ghc/compiler/types/Generics.hi-boot-5
index 3a9ab2ceda51..f57436d6a03b 100644
--- a/ghc/compiler/types/Generics.hi-boot-5
+++ b/ghc/compiler/types/Generics.hi-boot-5
@@ -1,4 +1,4 @@
__interface Generics 1 0 where
__export Generics mkTyConGenInfo ;
-1 mkTyConGenInfo :: TyCon.TyCon -> Name.Name -> Name.Name -> PrelMaybe.Maybe (BasicTypes.EP Var.Id) ;
+2 mkTyConGenInfo :: TyCon.TyCon -> Name.Name -> Name.Name -> PrelMaybe.Maybe (BasicTypes.EP Var.Id) ;
diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
index 6c48a1fb270e..89e36c4fa1af 100644
--- a/ghc/compiler/types/Generics.lhs
+++ b/ghc/compiler/types/Generics.lhs
@@ -4,7 +4,6 @@ module Generics ( mkTyConGenInfo, mkGenericRhs,
) where
-import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
import RnHsSyn ( RenamedHsExpr )
import HsSyn ( HsExpr(..), InPat(..), mkSimpleMatch )
@@ -219,7 +218,7 @@ valid ty
%************************************************************************
\begin{code}
-mkTyConGenInfo :: DynFlags -> TyCon -> Name -> Name -> Maybe (EP Id)
+mkTyConGenInfo :: TyCon -> Name -> Name -> Maybe (EP Id)
-- mkTyConGenInfo is called twice
-- once from TysWiredIn for Tuples
-- once the typechecker TcTyDecls
@@ -230,10 +229,7 @@ mkTyConGenInfo :: DynFlags -> TyCon -> Name -> Name -> Maybe (EP Id)
-- The two names are the names constructed by the renamer
-- for the fromT and toT conversion functions.
-mkTyConGenInfo dflags tycon from_name to_name
- | not (dopt Opt_Generics dflags)
- = Nothing
-
+mkTyConGenInfo tycon from_name to_name
| null datacons -- Abstractly imported types don't have
= Nothing -- to/from operations, (and should not need them)
diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs
index 7ca6cf60074e..ad2bd1f9b5a0 100644
--- a/ghc/compiler/types/InstEnv.lhs
+++ b/ghc/compiler/types/InstEnv.lhs
@@ -26,7 +26,6 @@ import Type ( Type, splitTyConApp_maybe,
splitSigmaTy, splitDFunTy, tyVarsOfTypes
)
import PprType ( )
-import DataCon ( DataCon )
import TyCon ( TyCon )
import Outputable
import Unify ( matchTys, unifyTyListsX )
diff --git a/ghc/compiler/types/Variance.lhs b/ghc/compiler/types/Variance.lhs
index 57119ff98816..724d9d8cff39 100644
--- a/ghc/compiler/types/Variance.lhs
+++ b/ghc/compiler/types/Variance.lhs
@@ -12,14 +12,13 @@ module Variance(
#include "HsVersions.h"
import TypeRep ( Type(..), TyNote(..) ) -- friend
-import TyCon ( TyCon, ArgVrcs, tyConKind, tyConArity, tyConDataConsIfAvailable, tyConTyVars,
+import TyCon ( TyCon, ArgVrcs, tyConArity, tyConDataConsIfAvailable, tyConTyVars,
tyConArgVrcs_maybe, getSynTyConDefn, isSynTyCon, isAlgTyCon )
import DataCon ( dataConRepArgTys )
import FiniteMap
import Var ( TyVar )
import VarSet
-import Name ( Name, getName )
import Maybes ( expectJust )
import Outputable
\end{code}
diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
index cb7da6d2be19..b4c4f60faa69 100644
--- a/ghc/compiler/utils/FiniteMap.lhs
+++ b/ghc/compiler/utils/FiniteMap.lhs
@@ -57,9 +57,7 @@ module FiniteMap (
#define OUTPUTABLE_key {--}
#endif
-import {-# SOURCE #-} Name ( Name )
import GlaExts
-import FastString
import Maybes
import Bag ( Bag, foldrBag )
import Outputable
@@ -587,8 +585,6 @@ glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr)
| otherwise -- We now need the same two cases as in glueBal above.
= glueBal fm_l fm_r
where
- (mid_key_l,mid_elt_l) = findMax fm_l
- (mid_key_r,mid_elt_r) = findMin fm_r
size_l = sizeFM fm_l
size_r = sizeFM fm_r
\end{code}
diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 5f38e9b896f1..9cb9fa8edcfa 100644
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -55,8 +55,6 @@ import FastString
import qualified Pretty
import Pretty ( Doc, Mode(..), TextDetails(..), fullRender )
import Panic
-import ST ( runST )
-import Foreign
import Char ( chr, ord, isDigit )
\end{code}
diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 84bfeb334bad..8fe48e084f3e 100644
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -68,7 +68,6 @@ module StringBuffer
import GlaExts
import PrelAddr ( Addr(..) )
import Foreign
-import ST
import Char ( chr )
-- urk!
diff --git a/ghc/compiler/utils/UnicodeUtil.lhs b/ghc/compiler/utils/UnicodeUtil.lhs
index 0123e67305f7..64062dd3c7d8 100644
--- a/ghc/compiler/utils/UnicodeUtil.lhs
+++ b/ghc/compiler/utils/UnicodeUtil.lhs
@@ -7,8 +7,8 @@ module UnicodeUtil(
#include "HsVersions.h"
-import Panic (panic)
-import Char (chr, ord)
+import Panic ( panic )
+import Char ( chr )
\end{code}
\begin{code}
--
GitLab