Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
5f3bef9e
Commit
5f3bef9e
authored
Nov 30, 2004
by
simonpj
Browse files
[project @ 2004-11-30 14:28:02 by simonpj]
Import trimming
parent
09a35a9a
Changes
5
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/coreSyn/CoreLint.lhs
View file @
5f3bef9e
...
...
@@ -19,7 +19,7 @@ import Unify ( coreRefineTys )
import Bag
import Literal ( literalType )
import DataCon ( dataConRepType, isVanillaDataCon, dataConTyCon, dataConResTy )
import Var ( Var, Id, TyVar, idType, tyVarKind,
isTyVar, isId,
mustHaveLocalBinding )
import Var ( Var, Id, TyVar, idType, tyVarKind, mustHaveLocalBinding )
import VarSet
import Name ( getSrcLoc )
import PprCore
...
...
@@ -34,7 +34,7 @@ import Type ( Type, tyVarsOfType, eqType,
substTyWith, emptyTvSubst, extendTvInScope,
TvSubst, TvSubstEnv, setTvSubstEnv, substTy,
extendTvSubst, isInScope )
import TyCon ( isPrimTyCon
, TyCon
)
import TyCon ( isPrimTyCon )
import BasicTypes ( RecFlag(..), isNonRec )
import CmdLineOpts
import Outputable
...
...
ghc/compiler/coreSyn/CoreUtils.lhs
View file @
5f3bef9e
...
...
@@ -41,7 +41,7 @@ import GLAEXTS -- For `xori`
import CoreSyn
import PprCore ( pprCoreExpr )
import Var ( Var
, isId, isTyVar
)
import Var ( Var )
import VarEnv
import Name ( hashName )
import Packages ( isDllName )
...
...
@@ -62,8 +62,7 @@ import Type ( Type, mkFunTy, mkForAllTy, splitFunTy_maybe,
splitFunTy,
applyTys, isUnLiftedType, seqType, mkTyVarTy,
splitForAllTy_maybe, isForAllTy, splitRecNewType_maybe,
splitTyConApp_maybe, eqType, funResultTy, applyTy,
funResultTy, applyTy
splitTyConApp_maybe, eqType, funResultTy, applyTy
)
import TyCon ( tyConArity )
-- gaw 2004
...
...
ghc/compiler/typecheck/TcDeriv.lhs
View file @
5f3bef9e
...
...
@@ -36,7 +36,7 @@ import DataCon ( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys )
import Maybes ( catMaybes )
import RdrName ( RdrName )
import Name ( Name, getSrcLoc )
import NameSet (
NameSet, emptyNameSet,
duDefs )
import NameSet ( duDefs )
import Kind ( splitKindFunTys )
import TyCon ( tyConTyVars, tyConDataCons, tyConArity, tyConHasGenerics,
tyConStupidTheta, isProductTyCon, isDataTyCon, newTyConRhs,
...
...
ghc/compiler/typecheck/TcInstDcls.lhs
View file @
5f3bef9e
...
...
@@ -34,7 +34,7 @@ import Var ( Id, idName, idType )
import MkId ( mkDictFunId, rUNTIME_ERROR_ID )
import FunDeps ( checkInstFDs )
import Name ( Name, getSrcLoc )
import NameSet ( unitNameSet, emptyNameSet
, unionNameSets
)
import NameSet ( unitNameSet, emptyNameSet )
import UnicodeUtil ( stringToUtf8 )
import Maybe ( catMaybes )
import SrcLoc ( srcLocSpan, unLoc, noLoc, Located(..), srcSpanStart )
...
...
ghc/compiler/typecheck/TcType.lhs
View file @
5f3bef9e
...
...
@@ -122,11 +122,10 @@ import TypeRep ( Type(..), TyNote(..), funTyCon ) -- friend
import Type ( -- Re-exports
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
tyVarsOfTheta, Kind,
Type,
PredType(..),
tyVarsOfTheta, Kind, PredType(..),
ThetaType, unliftedTypeKind,
liftedTypeKind, openTypeKind, mkArrowKind,
isLiftedTypeKind, isUnliftedTypeKind,
isOpenTypeKind,
mkArrowKinds, mkForAllTy, mkForAllTys,
defaultKind, isArgTypeKind, isOpenTypeKind,
mkFunTy, mkFunTys, zipFunTys,
...
...
@@ -169,7 +168,6 @@ import OccName ( OccName, mkDictOcc )
import PrelNames -- Lots (e.g. in isFFIArgumentTy)
import TysWiredIn ( unitTyCon, charTyCon, listTyCon )
import BasicTypes ( IPName(..), ipNameName )
import Unique ( Unique, Uniquable(..) )
import SrcLoc ( SrcLoc, SrcSpan )
import Util ( cmpList, thenCmp, snocView )
import Maybes ( maybeToBool, expectJust )
...
...
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