Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
b1ab4b8a
Commit
b1ab4b8a
authored
May 10, 2007
by
Michael D. Adams
Browse files
Warning fix for unused and redundant imports
parent
e46cab34
Changes
32
Hide whitespace changes
Inline
Side-by-side
compiler/codeGen/CgClosure.lhs
View file @
b1ab4b8a
...
...
@@ -36,7 +36,6 @@ import Cmm
import CmmUtils
import CLabel
import StgSyn
import StaticFlags
import CostCentre
import Id
import Name
...
...
compiler/codeGen/CgInfoTbls.hs
View file @
b1ab4b8a
...
...
@@ -43,18 +43,10 @@ import Name
import
DataCon
import
Unique
import
StaticFlags
import
FastString
import
Packages
import
Module
import
Maybes
import
Constants
import
Outputable
import
Data.Char
import
Data.Word
-------------------------------------------------------------------------
--
-- Generating the info table and code for a closure
...
...
compiler/coreSyn/MkExternalCore.lhs
View file @
b1ab4b8a
...
...
@@ -10,16 +10,14 @@ module MkExternalCore (
#include "HsVersions.h"
import qualified ExternalCore as C
import Char
import Module
import CoreSyn
import HscTypes
import TyCon
import TypeRep
import Type
import PprExternalCore
-- Instances
import PprExternalCore
()
-- Instances
import DataCon
import CoreSyn
import Coercion
import Var
import IdInfo
...
...
compiler/deSugar/Check.lhs
View file @
b1ab4b8a
...
...
@@ -11,7 +11,6 @@ module Check ( check , ExhaustivePat ) where
import HsSyn
import TcHsSyn
import TcType
import DsUtils
import MatchLit
import Id
...
...
compiler/deSugar/DsGRHSs.lhs
View file @
b1ab4b8a
...
...
@@ -14,14 +14,12 @@ import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds )
import {-# SOURCE #-} Match ( matchSinglePat )
import HsSyn
import HsUtils
import CoreSyn
import Var
import Type
import DsMonad
import DsUtils
import Unique
import PrelInfo
import TysWiredIn
import PrelNames
...
...
compiler/deSugar/DsListComp.lhs
View file @
b1ab4b8a
...
...
@@ -21,7 +21,6 @@ import DsMonad -- the monadery used in the desugarer
import DsUtils
import DynFlags
import StaticFlags
import CoreUtils
import Var
import Type
...
...
compiler/deSugar/DsMonad.lhs
View file @
b1ab4b8a
...
...
@@ -55,8 +55,6 @@ import NameEnv
import OccName
import DynFlags
import ErrUtils
import Bag
import OccName
import Data.IORef
...
...
compiler/deSugar/Match.lhs
View file @
b1ab4b8a
...
...
@@ -26,7 +26,6 @@ import DataCon
import MatchCon
import MatchLit
import PrelInfo
import TcType
import Type
import TysWiredIn
import BasicTypes
...
...
compiler/deSugar/MatchLit.lhs
View file @
b1ab4b8a
...
...
@@ -27,12 +27,10 @@ import TcType
import Type
import PrelNames
import TysWiredIn
import PrelNames
import Unique
import Literal
import SrcLoc
import Ratio
import SrcLoc
import Outputable
import Util
import FastString
...
...
compiler/hsSyn/HsBinds.lhs
View file @
b1ab4b8a
...
...
@@ -17,7 +17,7 @@ import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
import {-# SOURCE #-} HsPat ( LPat )
import HsTypes
import PprCore
import PprCore
()
import Coercion
import Type
import Name
...
...
compiler/iface/BuildTyCl.lhs
View file @
b1ab4b8a
...
...
@@ -28,7 +28,6 @@ import Class
import TyCon
import Type
import Coercion
import Outputable
import Data.List
\end{code}
...
...
compiler/iface/LoadIface.lhs
View file @
b1ab4b8a
...
...
@@ -38,7 +38,6 @@ import InstEnv
import FamInstEnv
import Name
import NameEnv
import NameSet
import MkId
import Module
import OccName
...
...
@@ -52,7 +51,6 @@ import Outputable
import BinIface
import Panic
import Control.Monad (when)
import Data.List
import Data.Maybe
import Data.IORef
...
...
compiler/main/DriverPipeline.hs
View file @
b1ab4b8a
...
...
@@ -30,7 +30,6 @@ import Packages
import
HeaderInfo
import
DriverPhases
import
SysTools
import
qualified
SysTools
import
HscMain
import
Finder
import
HscTypes
...
...
@@ -60,7 +59,6 @@ import Control.Monad
import
Data.List
(
isSuffixOf
)
import
Data.Maybe
import
System.Exit
import
System.Cmd
import
System.Environment
-- ---------------------------------------------------------------------------
...
...
compiler/main/ErrUtils.lhs
View file @
b1ab4b8a
...
...
@@ -31,15 +31,13 @@ module ErrUtils (
import Bag ( Bag, bagToList, isEmptyBag, emptyBag )
import SrcLoc ( SrcSpan )
import Util ( sortLe
, global
)
import Util ( sortLe )
import Outputable
import qualified Pretty
import SrcLoc ( srcSpanStart, noSrcSpan )
import DynFlags ( DynFlags(..), DynFlag(..), dopt )
import StaticFlags ( opt_ErrorSpans )
import System.Exit ( ExitCode(..), exitWith )
import System.IO ( hPutStrLn, stderr )
import Data.Dynamic
...
...
compiler/main/HeaderInfo.hs
View file @
b1ab4b8a
...
...
@@ -23,7 +23,6 @@ import PrelNames ( gHC_PRIM, mAIN_NAME )
import
StringBuffer
(
StringBuffer
(
..
),
hGetStringBuffer
,
hGetStringBufferBlock
,
appendStringBuffers
)
import
SrcLoc
import
FastString
(
mkFastString
)
import
DynFlags
import
ErrUtils
import
Util
...
...
compiler/main/SysTools.lhs
View file @
b1ab4b8a
...
...
@@ -75,7 +75,6 @@ import GHC.IOBase ( IOErrorType(..) )
#else
import System.Process ( runInteractiveProcess, getProcessExitCode )
import Control.Concurrent( forkIO, newChan, readChan, writeChan )
import Data.Char ( isSpace )
import FastString ( mkFastString )
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
#endif
...
...
compiler/nativeGen/AsmCodeGen.lhs
View file @
b1ab4b8a
...
...
@@ -26,16 +26,12 @@ import CmmOpt ( cmmMiniInline, cmmMachOpFold )
import PprCmm ( pprStmt, pprCmms )
import MachOp
import CLabel
#if powerpc_TARGET_ARCH
import CLabel ( mkRtsCodeLabel )
#endif
import UniqFM
import Unique ( Unique, getUnique )
import UniqSupply
import FastTypes
import List ( groupBy, sortBy )
import CLabel ( pprCLabel )
import ErrUtils ( dumpIfSet_dyn )
import DynFlags
import StaticFlags ( opt_Static, opt_PIC )
...
...
compiler/ndpFlatten/Flattening.hs
View file @
b1ab4b8a
...
...
@@ -55,12 +55,11 @@ module Flattening (
#
include
"HsVersions.h"
-- friends
import
NDPCoreUtils
(
tupleTyArgs
,
funTyArgs
,
parrElemTy
,
isDefault
,
import
NDPCoreUtils
(
tupleTyArgs
,
funTyArgs
,
isDefault
,
isLit
,
mkPArrTy
,
mkTuple
,
isSimpleExpr
,
substIdEnv
)
import
FlattenMonad
(
Flatten
,
runFlatten
,
mkBind
,
extendContext
,
packContext
,
liftVar
,
liftConst
,
intersectWithContext
,
mk'fst
,
mk'lengthP
,
mk'replicateP
,
mk'mapP
,
mk'bpermuteDftP
,
mk'indexOfP
,
mk'eq
,
mk'neq
)
mk'mapP
,
mk'bpermuteDftP
,
mk'indexOfP
,
mk'eq
,
mk'neq
)
-- GHC
import
TcType
(
tcIsForAllTy
,
tcView
)
...
...
@@ -75,9 +74,9 @@ import Literal (Literal, literalType)
import
Var
(
Var
(
..
),
idType
,
isTyVar
)
import
Id
(
setIdType
)
import
DataCon
(
DataCon
,
dataConTag
)
import
HscTypes
(
ModGuts
(
..
),
ModGuts
,
HscEnv
(
..
),
hscEPS
)
import
HscTypes
(
ModGuts
(
..
),
HscEnv
(
..
),
hscEPS
)
import
CoreFVs
(
exprFreeVars
)
import
CoreSyn
(
Expr
(
..
),
Bind
(
..
),
Alt
(
..
)
,
AltCon
(
..
),
Note
(
..
),
import
CoreSyn
(
Expr
(
..
),
Bind
(
..
),
Alt
,
AltCon
(
..
),
CoreBndr
,
CoreExpr
,
CoreBind
,
mkLams
,
mkLets
,
mkApps
,
mkIntLitInt
)
import
PprCore
(
pprCoreExpr
)
...
...
compiler/parser/HaddockLex.x
View file @
b1ab4b8a
...
...
@@ -12,15 +12,12 @@ module HaddockLex (
tokenise
) where
import HsSyn
import Lexer hiding (Token)
import Parser ( parseIdentifier )
import StringBuffer
import OccName
import RdrName
import SrcLoc
import DynFlags
import DynFlags
import Char
import Numeric
...
...
compiler/parser/LexCore.hs
View file @
b1ab4b8a
module
LexCore
where
import
ParserCoreUtils
import
Ratio
import
Char
import
Numeric
...
...
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment