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

More small changes

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 6a1de96..ea370e2 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -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 FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
 import Outputable
 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 a2df826..36293f3 100644 (file)
--- a/ghc/compiler/basicTypes/PprEnv.lhs
+++ b/ghc/compiler/basicTypes/PprEnv.lhs
@@ -16,8 +16,6 @@ module PprEnv (
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 

-import {-# SOURCE #-} DataCon ( DataCon )
-

 import Var             ( Id, TyVar )
 import CostCentre      ( CostCentre )
 import Type            ( Type )
 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 481ef02..2bca305 100644 (file)
--- 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
 %
 %
 % (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 )
                          buildContLivenessMask, nukeDeadBindings,
                        )
 import CgCon           ( bindConArgs, bindUnboxedTupleComponents )

-import CgHeapery       ( altHeapCheck, yield )
+import CgHeapery       ( altHeapCheck )

 import CgRetConv       ( dataReturnConvPrim, ctrlReturnConvAlg,
                          CtrlReturnConvention(..)
                        )
 import CgRetConv       ( dataReturnConvPrim, ctrlReturnConvAlg,
                          CtrlReturnConvention(..)
                        )

@@ -41,13 +41,12 @@ import CgStackery   ( allocPrimStack, allocStackTop,
                          deAllocStackTop, freeStackSlots, dataStackSlots
                        )
 import CgTailCall      ( tailCallFun )
                          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 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 )
 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,
 import PrimRep         ( getPrimRepSize, retPrimRepSize, PrimRep(..)
                        )
 import TyCon           ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,

-                         isNewTyCon, isAlgTyCon, isFunTyCon, isPrimTyCon,
+                         isFunTyCon, isPrimTyCon,

                        )
 import Type            ( Type, typePrimRep, splitAlgTyConApp, 
                          splitTyConApp_maybe, repType )
                        )
 import Type            ( Type, typePrimRep, splitAlgTyConApp, 
                          splitTyConApp_maybe, repType )

diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 37ef6e8..90509f3 100644 (file)
--- 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
 %
 %
 % (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 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 )
 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 c338cf8..d2bb4f7 100644 (file)
--- 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
                          sTD_ITBL_SIZE, pROF_ITBL_SIZE,
                          gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
 import Outputable

-import GlaExts         ( Int(..), Int#, (<#), (==#), (<#), (>#) )

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 54f993d..2592136 100644 (file)
--- 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,
        DeprecDecl(..), DeprecTxt,
        hsDeclName, instDeclName, tyClDeclName, tyClDeclNames,
        isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,

-       mkClassDeclSysNames, isIfaceRuleDecl,
+       mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,

        getClassDeclSysNames
     ) where
 
        getClassDeclSysNames
     ) where
 

@@ -36,7 +36,7 @@ import CallConv               ( CallConv, pprCallConv )
 
 -- others:
 import FunDeps         ( pprFundeps )
 
 -- others:
 import FunDeps         ( pprFundeps )

-import Class           ( FunDep )
+import Class           ( FunDep, DefMeth(..) )

 import CStrings                ( CLabelString, pprCLabelString )
 import Outputable      
 import SrcLoc          ( SrcLoc )
 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
 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
        -- 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}
 \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 &&
 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)
 
      eq_hsContext env cxt1 cxt2        &&
      eq_ConDetails env cds1 cds2)
 

@@ -642,6 +646,11 @@ data RuleDecl name pat
 isIfaceRuleDecl (HsRule _ _ _ _ _ _) = False
 isIfaceRuleDecl other               = True
 
 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)
 data RuleBndr name
   = RuleBndr name
   | RuleBndrSig name (HsType name)

diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 956b02f..bd51781 100644 (file)
--- 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,
 
        -- 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
 
        -- 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 edaf8e5..eb2811d 100644 (file)
--- 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 "}"
 
   $$ indent ms 
   $$ text "}"
 

-staticblock = \ss ->
-  text "static" <+> text "{"
-  $$ indent ss
-  $$ text "}"
-    

 modifiers mfs = hsep (map modifier mfs)
     
 modifier mf = text $ map toLower (show mf)
 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 747ad04..69b8565 100644 (file)
--- 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
 
                            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
 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}
 
                            || 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 91ff5ed..63a090e 100644 (file)
--- 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 Outputable
 import CmdLineOpts     ( DynFlags, HscLang(..), dopt_OutName )
 import TmpFiles                ( newTempName )

-import UniqSupply      ( mkSplitUniqSupply )

 
 import IO              ( IOMode(..), hClose, openFile, Handle )
 \end{code}
 
 import IO              ( IOMode(..), hClose, openFile, Handle )
 \end{code}

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index d29b7f4..498add4 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -13,7 +13,7 @@ module HscTypes (
        lookupIface, lookupIfaceByModName,
        emptyModIface,
 
        lookupIface, lookupIfaceByModName,
        emptyModIface,
 

-       IfaceDecls(..), 
+       IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,

 
        VersionInfo(..), initialVersionInfo,
 
 
        VersionInfo(..), initialVersionInfo,
 

@@ -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 RnHsSyn         ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
 
 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 Maybes          ( seqMaybe )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )

-import Util            ( thenCmp )
+import Util            ( thenCmp, sortLt )

 import UniqSupply      ( UniqSupply )
 \end{code}
 
 import UniqSupply      ( UniqSupply )
 \end{code}
 

@@ -144,6 +144,32 @@ data IfaceDecls = IfaceDecls { dcl_tycl  :: [RenamedTyClDecl],     -- Sorted
                               dcl_rules :: [RenamedRuleDecl],  -- Sorted
                               dcl_insts :: [RenamedInstDecl] } -- Unsorted
 
                               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
 -- 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 8540f9f..5ec45f1 100644 (file)
--- 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 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(..)
                          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
 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)
      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)
     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
                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 edec952..75a8f6f 100644 (file)
--- 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 RnHiFiles       ( readIface, removeContext, 
                          loadExports, loadFixDecls, loadDeprecs )

-import RnEnv           ( availName, 
+import RnEnv           ( availsToNameSet,

                          emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
                          warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
                          lookupOrigNames, lookupSrcName, newGlobalName
                          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(..), 
 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
                          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
        -- 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. 
                -- 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"
                    }
                                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
     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
 
     returnRn (Just (mod_iface, final_decls))
   where

@@ -425,9 +426,7 @@ loadOldIface parsed_iface
                                vers_rules   = rule_vers,
                                vers_decls   = decls_vers }
 
                                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,
 
        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 fefcf7c..dc4bd87 100644 (file)
--- 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 (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 _)

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 91ce759..d4a6f32 100644 (file)
--- 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
 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.
 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' ->
     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
 
        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
     getTypeEnvRn                       `thenRn` \ lookup ->
     case lookup name of {
        Just ty_thing | name `elemNameEnv` wiredInThingEnv

@@ -658,12 +629,6 @@ importDecl name
 
        Nothing -> 
 
 
        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_`
        -- 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
                  -> 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
 
        -- 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
 
        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])
 
          | 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}
 
 
 \end{code}
 
 

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 0d562d3..b597892 100644 (file)
--- 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 ()
 
    = 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 ()
 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 1623bcd..d98ea9e 100644 (file)
--- a/ghc/compiler/simplCore/BinderInfo.lhs
+++ b/ghc/compiler/simplCore/BinderInfo.lhs
@@ -24,8 +24,7 @@ module BinderInfo (
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 

-import IdInfo          ( OccInfo(..), InsideLam, OneBranch, insideLam, notInsideLam, oneBranch )
-import GlaExts         ( Int(..), (+#) )
+import IdInfo          ( OccInfo(..), InsideLam, insideLam, notInsideLam )

 import Outputable
 \end{code}
 
 import Outputable
 \end{code}
 

diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
index 3d209c9..47afd99 100644 (file)
--- 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 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 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
                          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 )
 import Type            ( splitTyConApp_maybe, 
                          isUnLiftedType, Type )
 import TyCon           ( tyConUnique )

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index bf2ef1d..ba28d13 100644 (file)
--- 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
 -- 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}
 
                    | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
 \end{code}
 

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index bc1a87d..7e63ec1 100644 (file)
--- 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
 
 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
     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
     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
     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             $
     
     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
     -- 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 ->
     tcInterfaceSigs unf_env decls              `thenTc` \ sig_ids ->

+    traceTc (text "Tc5")       `thenTc_` (

     tcExtendGlobalValEnv sig_ids               $
     tcGetEnv                                   `thenTc` \ unf_env ->
     
     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
     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
     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
     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,
     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'
                         })
                          tc_fords   = foi_decls ++ foe_decls',
                          tc_rules   = local_rules'
                         })

+    )

 
 get_binds decls = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
 \end{code}
 
 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 b92276e..6cd8799 100644 (file)
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -10,6 +10,7 @@ module TcTyClsDecls (
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 

+import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )

 import HsSyn           ( HsDecl(..), TyClDecl(..),
                          HsTyVarBndr,
                          ConDecl(..), 
 import HsSyn           ( HsDecl(..), TyClDecl(..),
                          HsTyVarBndr,
                          ConDecl(..), 

@@ -47,7 +48,6 @@ import Maybes         ( mapMaybe )
 import ErrUtils                ( Message )
 import HsDecls          ( getClassDeclSysNames )
 import Generics         ( mkTyConGenInfo )
 import ErrUtils                ( Message )
 import HsDecls          ( getClassDeclSysNames )
 import Generics         ( mkTyConGenInfo )

-import CmdLineOpts     ( DynFlags )

 \end{code}
 
 
 \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
   where
        tycon = mkAlgTyConRep tycon_name tycon_kind tyvars ctxt argvrcs
                           data_cons nconstrs

-                          derived_classes

                           flavour is_rec gen_info
                           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
 
        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 24896ab..76b91d5 100644 (file)
--- 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, 
                          kcHsContext, kcHsSigType
                        )
 import TcEnv           ( tcExtendTyVarEnv, 

-                         tcLookupTyCon, tcLookupClass, tcLookupGlobalId, 
+                         tcLookupTyCon, tcLookupGlobalId, 

                          TyThingDetails(..)
                        )
 import TcMonad
                          TyThingDetails(..)
                        )
 import TcMonad

diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs
index 8289392..0944e63 100644 (file)
--- 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_`
 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_`
 
     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 3a9ab2c..f57436d 100644 (file)
--- 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 ;
 
 __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 6c48a1f..89e36c4 100644 (file)
--- a/ghc/compiler/types/Generics.lhs
+++ b/ghc/compiler/types/Generics.lhs
@@ -4,7 +4,6 @@ module Generics ( mkTyConGenInfo, mkGenericRhs,
     ) where
 
 
     ) where
 
 

-import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )

 import RnHsSyn         ( RenamedHsExpr )
 import HsSyn           ( HsExpr(..), InPat(..), mkSimpleMatch )
 
 import RnHsSyn         ( RenamedHsExpr )
 import HsSyn           ( HsExpr(..), InPat(..), mkSimpleMatch )
 

@@ -219,7 +218,7 @@ valid ty
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \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 
 -- 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.
 
 -- 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)
 
   | 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 7ca6cf6..ad2bd1f 100644 (file)
--- 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         ( )
                          splitSigmaTy, splitDFunTy, tyVarsOfTypes
                        )
 import PprType         ( )

-import DataCon         ( DataCon )

 import TyCon           ( TyCon )
 import Outputable
 import Unify           ( matchTys, unifyTyListsX )
 import TyCon           ( TyCon )
 import Outputable
 import Unify           ( matchTys, unifyTyListsX )

diff --git a/ghc/compiler/types/Variance.lhs b/ghc/compiler/types/Variance.lhs
index 57119ff..724d9d8 100644 (file)
--- 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
 #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
                           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}
 import Maybes           ( expectJust )
 import Outputable
 \end{code}

diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
index cb7da6d..b4c4f60 100644 (file)
--- a/ghc/compiler/utils/FiniteMap.lhs
+++ b/ghc/compiler/utils/FiniteMap.lhs
@@ -57,9 +57,7 @@ module FiniteMap (
 #define OUTPUTABLE_key {--}
 #endif
 
 #define OUTPUTABLE_key {--}
 #endif
 

-import {-# SOURCE #-} Name ( Name )

 import GlaExts
 import GlaExts

-import FastString

 import Maybes
 import Bag       ( Bag, foldrBag )
 import Outputable
 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
   | 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}
     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 5f38e9b..9cb9fa8 100644 (file)
--- 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 qualified Pretty
 import Pretty          ( Doc, Mode(..), TextDetails(..), fullRender )
 import Panic

-import ST              ( runST )
-import Foreign

 import Char             ( chr, ord, isDigit )
 \end{code}
 
 import Char             ( chr, ord, isDigit )
 \end{code}
 

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 84bfeb3..8fe48e0 100644 (file)
--- 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 GlaExts
 import PrelAddr        ( Addr(..) )
 import Foreign

-import ST

 import Char            ( chr )
 
 -- urk!
 import Char            ( chr )
 
 -- urk!

diff --git a/ghc/compiler/utils/UnicodeUtil.lhs b/ghc/compiler/utils/UnicodeUtil.lhs
index 0123e67..64062dd 100644 (file)
--- a/ghc/compiler/utils/UnicodeUtil.lhs
+++ b/ghc/compiler/utils/UnicodeUtil.lhs
@@ -7,8 +7,8 @@ module UnicodeUtil(
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 

-import Panic (panic)
-import Char  (chr, ord)
+import Panic ( panic )
+import Char  ( chr )

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}