[commit: ghc] wip/orf-reboot: Fix unused imports/declarations/constraints and missing deriving Typeable (2936eee)
git at git.haskell.org
git at git.haskell.org
Tue Jul 14 20:53:20 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/orf-reboot
Link : http://ghc.haskell.org/trac/ghc/changeset/2936eeeeeeecdac15478aafe45ab2a5a24765a3a/ghc
>---------------------------------------------------------------
commit 2936eeeeeeecdac15478aafe45ab2a5a24765a3a
Author: Adam Gundry <adam at well-typed.com>
Date: Tue Jul 14 20:40:37 2015 +0100
Fix unused imports/declarations/constraints and missing deriving Typeable
>---------------------------------------------------------------
2936eeeeeeecdac15478aafe45ab2a5a24765a3a
compiler/basicTypes/FieldLabel.hs | 2 +-
compiler/deSugar/DsExpr.hs | 1 -
compiler/deSugar/DsMeta.hs | 1 -
compiler/hsSyn/HsExpr.hs | 1 -
compiler/hsSyn/HsPat.hs | 4 ++--
compiler/hsSyn/HsTypes.hs | 2 +-
compiler/hsSyn/PlaceHolder.hs | 1 -
compiler/iface/TcIface.hs | 1 -
compiler/rename/RnExpr.hs | 1 -
compiler/rename/RnSource.hs | 11 +----------
compiler/rename/RnTypes.hs | 2 +-
compiler/typecheck/TcInstDcls.hs | 2 +-
12 files changed, 7 insertions(+), 22 deletions(-)
diff --git a/compiler/basicTypes/FieldLabel.hs b/compiler/basicTypes/FieldLabel.hs
index 6c4a9cc..4829dd6 100644
--- a/compiler/basicTypes/FieldLabel.hs
+++ b/compiler/basicTypes/FieldLabel.hs
@@ -100,7 +100,7 @@ data FieldLbl a = FieldLabel {
-- in the defining module for this datatype?
flSelector :: a -- ^ Record selector function
}
- deriving (Functor, Foldable, Traversable)
+ deriving (Functor, Foldable, Traversable, Typeable)
deriving instance Data a => Data (FieldLbl a)
instance Outputable a => Outputable (FieldLbl a) where
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 48e2ff4..fa21130 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -22,7 +22,6 @@ import DsArrows
import DsMonad
import Name
import NameEnv
-import RdrName
import FamInstEnv( topNormaliseType )
import DsMeta
import HsSyn
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 68bcd6e..7b22455 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -50,7 +50,6 @@ import CoreUtils
import SrcLoc
import Unique
import BasicTypes
-import FieldLabel
import Outputable
import Bag
import DynFlags
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 12a5b49..432ee9a 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -28,7 +28,6 @@ import TcEvidence
import CoreSyn
import Var
import Name
-import RdrName
import BasicTypes
import DataCon
import SrcLoc
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 7f2c4e8..145bd0e 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -428,7 +428,7 @@ pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
pprConArgs (RecCon rpats) = ppr rpats
-instance (OutputableBndr id, Outputable arg)
+instance (Outputable arg)
=> Outputable (HsRecFields id arg) where
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
= braces (fsep (punctuate comma (map ppr flds)))
@@ -437,7 +437,7 @@ instance (OutputableBndr id, Outputable arg)
where
dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
-instance (OutputableBndr id, Outputable arg)
+instance (Outputable arg)
=> Outputable (HsRecField id arg) where
ppr (HsRecField { hsRecFieldLbl = f, hsRecFieldArg = arg,
hsRecPun = pun })
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 1307826..1d90755 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -73,7 +73,6 @@ import TysWiredIn
import PrelNames( ipClassName )
import HsDoc
import BasicTypes
-import FieldLabel
import SrcLoc
import StaticFlags
import Outputable
@@ -563,6 +562,7 @@ type LFieldOcc name = Located (FieldOcc name)
-- both the 'RdrName' the user originally wrote, and after the
-- renamer, the selector function.
data FieldOcc name = FieldOcc RdrName (PostRn name name)
+ deriving Typeable
deriving instance (DataId name) => Data (FieldOcc name)
instance Outputable (FieldOcc name) where
diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs
index f7da3ef..2f29f54 100644
--- a/compiler/hsSyn/PlaceHolder.hs
+++ b/compiler/hsSyn/PlaceHolder.hs
@@ -12,7 +12,6 @@ import NameSet
import RdrName
import Var
import Coercion
-import FieldLabel
import Data.Data hiding ( Fixity )
import BasicTypes (Fixity)
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index d1b615a..879a035 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -46,7 +46,6 @@ import TyCon
import CoAxiom
import ConLike
import DataCon
-import FieldLabel
import PrelNames
import TysWiredIn
import TysPrim ( superKindTyConName )
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index d39a43f..c14ab00 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -30,7 +30,6 @@ import RnPat
import DynFlags
import BasicTypes ( FixityDirection(..), Fixity(..), minPrecedence )
import PrelNames
-import FieldLabel
import Name
import NameSet
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index dd36652..aaa4b73 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -25,7 +25,6 @@ import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcAnnotations ( annCtxt )
import TcRnMonad
-import IfaceEnv
import ForeignCall ( CCallTarget(..) )
import Module
import HscTypes ( Warnings(..), plusWarns )
@@ -35,7 +34,6 @@ import Name
import NameSet
import NameEnv
import Avail
-import DataCon
import Outputable
import Bag
import BasicTypes ( RuleName )
@@ -46,11 +44,10 @@ import HscTypes ( HscEnv, hsc_dflags )
import ListSetOps ( findDupsEq, removeDups )
import Digraph ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
import Util ( mapSnd )
-import State
import Control.Monad
import Data.List( partition, sortBy )
-import Maybes( orElse, mapMaybe, expectJust )
+import Maybes( orElse, mapMaybe )
#if __GLASGOW_HASKELL__ < 709
import Data.Traversable (traverse)
#endif
@@ -218,12 +215,6 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls,
return (final_tcg_env, rn_group)
}}}}
--- some utils because we do this a bunch above
--- compute and install the new env
-inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
-inNewEnv env cont = do e <- env
- setGblEnv e $ cont e
-
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
-- This function could be defined lower down in the module hierarchy,
-- but there doesn't seem anywhere very logical to put it.
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 6fec5f2..208fbf1 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -48,7 +48,7 @@ import BasicTypes ( compareFixity, funTyFixity, negateFixity,
import Outputable
import FastString
import Maybes
-import Data.List ( nub, nubBy, find, deleteFirstsBy )
+import Data.List ( nub, nubBy, deleteFirstsBy )
import Control.Monad ( unless, when )
#if __GLASGOW_HASKELL__ < 709
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index 9742e71..2c9a980 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -61,7 +61,7 @@ import Util
import BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )
import Control.Monad
-import Maybes ( isNothing, isJust, whenIsJust, catMaybes, expectJust )
+import Maybes ( isNothing, isJust, whenIsJust, catMaybes )
import Data.List ( mapAccumL, partition )
{-
More information about the ghc-commits
mailing list