Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
56f5bc18
Commit
56f5bc18
authored
Jan 27, 2005
by
simonpj
Browse files
[project @ 2005-01-27 11:51:56 by simonpj]
Import trimming
parent
281bcf70
Changes
4
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/rename/RnEnv.lhs
View file @
56f5bc18
...
...
@@ -32,9 +32,11 @@ module RnEnv (
import LoadIface ( loadHomeInterface, loadSrcInterface )
import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
import HsSyn
import HsSyn ( FixitySig(..), ReboundNames, HsExpr(..),
HsType(..), HsExplicitForAll(..), LHsTyVarBndr, LHsType,
LSig, Sig(..), Fixity, hsLTyVarName, hsLTyVarLocNames, replaceTyVarName )
import RdrHsSyn ( extractHsTyRdrTyVars )
import RdrName ( RdrName, rdrNameModule,
rdrNameOcc,
isQual, isUnqual, isOrig,
import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
pprGlobalRdrEnv, lookupGRE_RdrName,
isExact_maybe, isSrcRdrName,
...
...
@@ -42,7 +44,6 @@ import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
Provenance(..), pprNameProvenance, ImportSpec(..)
)
import HsTypes ( replaceTyVarName )
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
import Name ( Name, nameIsLocalOrFrom, mkInternalName,
...
...
@@ -60,7 +61,6 @@ import Util ( sortLe )
import ListSetOps ( removeDups )
import List ( nubBy )
import CmdLineOpts
import FastString ( FastString )
\end{code}
%*********************************************************
...
...
ghc/compiler/rename/RnSource.lhs
View file @
56f5bc18
...
...
@@ -41,7 +41,6 @@ import NameEnv
import Outputable
import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
import CmdLineOpts ( DynFlag(..) )
import DriverPhases ( isHsBoot )
import Maybes ( seqMaybe )
import Maybe ( catMaybes, isNothing )
\end{code}
...
...
ghc/compiler/typecheck/TcClassDcl.lhs
View file @
56f5bc18
...
...
@@ -18,7 +18,7 @@ import RnHsSyn ( maybeGenericMatch, extractHsTyVars )
import RnExpr ( rnLExpr )
import RnEnv ( lookupTopBndrRn, lookupImportedName )
import Inst (
Inst, InstOrigin(..),
instToId, newDicts, newDictsAtLoc, newMethod )
import Inst ( instToId, newDicts, newDictsAtLoc, newMethod )
import TcEnv ( tcLookupLocatedClass, tcExtendIdEnv2,
tcExtendTyVarEnv,
InstInfo(..), pprInstInfoDetails,
...
...
ghc/compiler/typecheck/TcHsType.lhs
View file @
56f5bc18
...
...
@@ -39,9 +39,9 @@ import TcUnify ( unifyFunKind, checkExpectedKind )
import TcType ( Type, PredType(..), ThetaType,
MetaDetails(Flexi), hoistForAllTys,
TcType, TcTyVar, TcKind, TcThetaType, TcTauType,
mkForAllTys, mkFunTys, tcEqType, isPredTy,
mkFunTy,
mkFunTy,
mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys,
tcSplitFunTy_maybe, tcSplitForAllTys,
typeKind )
typeKind )
import Kind ( Kind, isLiftedTypeKind, liftedTypeKind, ubxTupleKind,
openTypeKind, argTypeKind, splitKindFunTys )
import Id ( idName )
...
...
@@ -52,14 +52,12 @@ import Name ( Name, mkInternalName )
import OccName ( mkOccName, tvName )
import NameSet
import PrelNames ( genUnitTyConName )
import Type ( deShadowTy )
import TysWiredIn ( mkListTy, mkPArrTy, mkTupleTy )
import Bag ( bagToList )
import BasicTypes ( Boxity(..) )
import SrcLoc ( Located(..), unLoc, noLoc, srcSpanStart )
import UniqSupply ( uniqsFromSupply )
import Outputable
import List ( nubBy )
\end{code}
...
...
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