Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Alex D
GHC
Commits
30c122df
Commit
30c122df
authored
Mar 29, 2008
by
Ian Lynagh
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Don't import FastString in HsVersions.h
Modules that need it import it themselves instead.
parent
7c7104a5
Changes
118
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
118 changed files
with
86 additions
and
116 deletions
+86
-116
compiler/HsVersions.h
compiler/HsVersions.h
+4
-13
compiler/basicTypes/BasicTypes.lhs
compiler/basicTypes/BasicTypes.lhs
+1
-1
compiler/basicTypes/IdInfo.lhs
compiler/basicTypes/IdInfo.lhs
+1
-0
compiler/basicTypes/NameEnv.lhs
compiler/basicTypes/NameEnv.lhs
+0
-2
compiler/basicTypes/NameSet.lhs
compiler/basicTypes/NameSet.lhs
+0
-2
compiler/basicTypes/NewDemand.lhs
compiler/basicTypes/NewDemand.lhs
+0
-2
compiler/basicTypes/VarEnv.lhs
compiler/basicTypes/VarEnv.lhs
+1
-0
compiler/basicTypes/VarSet.lhs
compiler/basicTypes/VarSet.lhs
+0
-2
compiler/cmm/CmmCPSGen.hs
compiler/cmm/CmmCPSGen.hs
+1
-0
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmInfo.hs
+0
-3
compiler/cmm/CmmLint.hs
compiler/cmm/CmmLint.hs
+1
-0
compiler/cmm/CmmOpt.hs
compiler/cmm/CmmOpt.hs
+0
-2
compiler/cmm/MachOp.hs
compiler/cmm/MachOp.hs
+1
-0
compiler/cmm/MkZipCfg.hs
compiler/cmm/MkZipCfg.hs
+0
-2
compiler/cmm/OptimizationFuel.hs
compiler/cmm/OptimizationFuel.hs
+0
-5
compiler/cmm/ZipCfg.hs
compiler/cmm/ZipCfg.hs
+0
-2
compiler/cmm/ZipDataflow0.hs
compiler/cmm/ZipDataflow0.hs
+0
-4
compiler/codeGen/CgBindery.lhs
compiler/codeGen/CgBindery.lhs
+1
-0
compiler/codeGen/CgCon.lhs
compiler/codeGen/CgCon.lhs
+1
-0
compiler/codeGen/CgForeignCall.hs
compiler/codeGen/CgForeignCall.hs
+1
-0
compiler/codeGen/CgHeapery.lhs
compiler/codeGen/CgHeapery.lhs
+1
-0
compiler/codeGen/CgPrimOp.hs
compiler/codeGen/CgPrimOp.hs
+1
-0
compiler/codeGen/CgTailCall.lhs
compiler/codeGen/CgTailCall.lhs
+0
-5
compiler/codeGen/SMRep.lhs
compiler/codeGen/SMRep.lhs
+1
-0
compiler/coreSyn/CoreFVs.lhs
compiler/coreSyn/CoreFVs.lhs
+0
-2
compiler/coreSyn/CoreLint.lhs
compiler/coreSyn/CoreLint.lhs
+1
-0
compiler/coreSyn/CorePrep.lhs
compiler/coreSyn/CorePrep.lhs
+1
-0
compiler/coreSyn/CoreSubst.lhs
compiler/coreSyn/CoreSubst.lhs
+1
-0
compiler/coreSyn/CoreTidy.lhs
compiler/coreSyn/CoreTidy.lhs
+0
-2
compiler/coreSyn/CoreUnfold.lhs
compiler/coreSyn/CoreUnfold.lhs
+1
-0
compiler/deSugar/DsGRHSs.lhs
compiler/deSugar/DsGRHSs.lhs
+0
-2
compiler/deSugar/DsListComp.lhs
compiler/deSugar/DsListComp.lhs
+0
-2
compiler/deSugar/DsMonad.lhs
compiler/deSugar/DsMonad.lhs
+1
-0
compiler/deSugar/Match.lhs
compiler/deSugar/Match.lhs
+1
-0
compiler/deSugar/MatchCon.lhs
compiler/deSugar/MatchCon.lhs
+0
-2
compiler/ghci/RtClosureInspect.hs
compiler/ghci/RtClosureInspect.hs
+1
-0
compiler/hsSyn/HsBinds.lhs
compiler/hsSyn/HsBinds.lhs
+1
-0
compiler/hsSyn/HsDoc.hs
compiler/hsSyn/HsDoc.hs
+0
-2
compiler/hsSyn/HsSyn.lhs
compiler/hsSyn/HsSyn.lhs
+1
-0
compiler/hsSyn/HsTypes.lhs
compiler/hsSyn/HsTypes.lhs
+1
-0
compiler/iface/LoadIface.lhs
compiler/iface/LoadIface.lhs
+1
-0
compiler/iface/TcIface.lhs
compiler/iface/TcIface.lhs
+2
-1
compiler/main/CmdLineParser.hs
compiler/main/CmdLineParser.hs
+0
-2
compiler/main/Constants.lhs
compiler/main/Constants.lhs
+0
-2
compiler/main/DriverMkDepend.hs
compiler/main/DriverMkDepend.hs
+1
-0
compiler/main/DriverPipeline.hs
compiler/main/DriverPipeline.hs
+1
-0
compiler/main/DynFlags.hs
compiler/main/DynFlags.hs
+0
-2
compiler/main/ErrUtils.lhs
compiler/main/ErrUtils.lhs
+0
-2
compiler/main/GHC.hs
compiler/main/GHC.hs
+1
-0
compiler/main/HscStats.lhs
compiler/main/HscStats.lhs
+0
-2
compiler/main/HscTypes.lhs
compiler/main/HscTypes.lhs
+1
-1
compiler/main/PackageConfig.hs
compiler/main/PackageConfig.hs
+0
-4
compiler/main/PprTyThing.hs
compiler/main/PprTyThing.hs
+1
-0
compiler/main/StaticFlags.hs
compiler/main/StaticFlags.hs
+1
-1
compiler/main/SysTools.lhs
compiler/main/SysTools.lhs
+1
-1
compiler/main/TidyPgm.lhs
compiler/main/TidyPgm.lhs
+0
-3
compiler/nativeGen/PositionIndependentCode.hs
compiler/nativeGen/PositionIndependentCode.hs
+1
-0
compiler/nativeGen/RegAllocLinear.hs
compiler/nativeGen/RegAllocLinear.hs
+1
-0
compiler/nativeGen/RegLiveness.hs
compiler/nativeGen/RegLiveness.hs
+1
-0
compiler/prelude/ForeignCall.lhs
compiler/prelude/ForeignCall.lhs
+1
-1
compiler/prelude/TysPrim.lhs
compiler/prelude/TysPrim.lhs
+1
-1
compiler/profiling/SCCfinal.lhs
compiler/profiling/SCCfinal.lhs
+0
-2
compiler/rename/RnBinds.lhs
compiler/rename/RnBinds.lhs
+1
-0
compiler/rename/RnNames.lhs
compiler/rename/RnNames.lhs
+1
-0
compiler/rename/RnSource.lhs
compiler/rename/RnSource.lhs
+1
-0
compiler/rename/RnTypes.lhs
compiler/rename/RnTypes.lhs
+1
-0
compiler/simplCore/CSE.lhs
compiler/simplCore/CSE.lhs
+1
-0
compiler/simplCore/FloatOut.lhs
compiler/simplCore/FloatOut.lhs
+1
-0
compiler/simplCore/OccurAnal.lhs
compiler/simplCore/OccurAnal.lhs
+0
-2
compiler/simplCore/SimplEnv.lhs
compiler/simplCore/SimplEnv.lhs
+1
-0
compiler/simplCore/SimplMonad.lhs
compiler/simplCore/SimplMonad.lhs
+1
-1
compiler/simplCore/SimplUtils.lhs
compiler/simplCore/SimplUtils.lhs
+1
-0
compiler/simplCore/Simplify.lhs
compiler/simplCore/Simplify.lhs
+1
-0
compiler/simplStg/SRT.lhs
compiler/simplStg/SRT.lhs
+0
-2
compiler/simplStg/SimplStg.lhs
compiler/simplStg/SimplStg.lhs
+0
-2
compiler/simplStg/StgStats.lhs
compiler/simplStg/StgStats.lhs
+0
-2
compiler/stgSyn/CoreToStg.lhs
compiler/stgSyn/CoreToStg.lhs
+1
-0
compiler/stgSyn/StgLint.lhs
compiler/stgSyn/StgLint.lhs
+1
-0
compiler/stgSyn/StgSyn.lhs
compiler/stgSyn/StgSyn.lhs
+1
-0
compiler/stranal/WwLib.lhs
compiler/stranal/WwLib.lhs
+1
-0
compiler/typecheck/FamInst.lhs
compiler/typecheck/FamInst.lhs
+1
-0
compiler/typecheck/Inst.lhs
compiler/typecheck/Inst.lhs
+1
-1
compiler/typecheck/TcArrows.lhs
compiler/typecheck/TcArrows.lhs
+1
-0
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcBinds.lhs
+1
-0
compiler/typecheck/TcDefaults.lhs
compiler/typecheck/TcDefaults.lhs
+1
-0
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcDeriv.lhs
+1
-0
compiler/typecheck/TcEnv.lhs
compiler/typecheck/TcEnv.lhs
+1
-0
compiler/typecheck/TcForeign.lhs
compiler/typecheck/TcForeign.lhs
+1
-0
compiler/typecheck/TcGadt.lhs
compiler/typecheck/TcGadt.lhs
+1
-0
compiler/typecheck/TcHsSyn.lhs
compiler/typecheck/TcHsSyn.lhs
+1
-0
compiler/typecheck/TcHsType.lhs
compiler/typecheck/TcHsType.lhs
+1
-0
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcMType.lhs
+1
-0
compiler/typecheck/TcMatches.lhs
compiler/typecheck/TcMatches.lhs
+1
-0
compiler/typecheck/TcRnTypes.lhs
compiler/typecheck/TcRnTypes.lhs
+1
-0
compiler/typecheck/TcRules.lhs
compiler/typecheck/TcRules.lhs
+1
-0
compiler/typecheck/TcSimplify.lhs
compiler/typecheck/TcSimplify.lhs
+1
-0
compiler/typecheck/TcTyClsDecls.lhs
compiler/typecheck/TcTyClsDecls.lhs
+1
-0
compiler/typecheck/TcTyFuns.lhs
compiler/typecheck/TcTyFuns.lhs
+1
-0
compiler/typecheck/TcType.lhs
compiler/typecheck/TcType.lhs
+1
-0
compiler/typecheck/TcUnify.lhs
compiler/typecheck/TcUnify.lhs
+1
-0
compiler/types/Class.lhs
compiler/types/Class.lhs
+1
-0
compiler/types/Coercion.lhs
compiler/types/Coercion.lhs
+2
-2
compiler/types/FamInstEnv.lhs
compiler/types/FamInstEnv.lhs
+1
-0
compiler/types/FunDeps.lhs
compiler/types/FunDeps.lhs
+2
-0
compiler/types/InstEnv.lhs
compiler/types/InstEnv.lhs
+1
-0
compiler/types/Type.lhs
compiler/types/Type.lhs
+1
-0
compiler/types/Unify.lhs
compiler/types/Unify.lhs
+0
-2
compiler/utils/Digraph.lhs
compiler/utils/Digraph.lhs
+0
-2
compiler/utils/Encoding.hs
compiler/utils/Encoding.hs
+0
-1
compiler/utils/FastFunctions.lhs
compiler/utils/FastFunctions.lhs
+0
-1
compiler/utils/FastString.lhs
compiler/utils/FastString.lhs
+0
-3
compiler/utils/FastTypes.lhs
compiler/utils/FastTypes.lhs
+0
-1
compiler/utils/Interval.hs
compiler/utils/Interval.hs
+2
-2
compiler/utils/Panic.lhs
compiler/utils/Panic.lhs
+0
-2
compiler/utils/UniqFM.lhs
compiler/utils/UniqFM.lhs
+0
-4
compiler/utils/Util.lhs
compiler/utils/Util.lhs
+0
-2
compiler/vectorise/VectCore.hs
compiler/vectorise/VectCore.hs
+0
-2
compiler/vectorise/VectType.hs
compiler/vectorise/VectType.hs
+1
-0
No files found.
compiler/HsVersions.h
View file @
30c122df
...
...
@@ -60,21 +60,12 @@ name = Util.global (value);
#define WARN(e,msg) if False && (e) then pprPanic "WARN" (msg) else
#endif
--
This
conditional
lets
us
switch
off
the
"import FastString"
--
when
compiling
FastString
itself
,
or
when
compiling
modules
that
--
don
'
t
use
it
(
and
would
otherwise
get
warnings
,
which
we
treat
--
as
errors
).
Can
we
do
this
more
nicely
?
#if !defined(COMPILING_FAST_STRING) && !defined(FAST_STRING_NOT_NEEDED)
--
import
qualified
FastString
as
FS
#endif
#if defined(__GLASGOW_HASKELL__)
#define SLIT(x) (F
S
.mkLitString# (x#))
#define FSLIT(x) (F
S
.mkFastString# (x#))
#define SLIT(x) (F
astString
.mkLitString# (x#))
#define FSLIT(x) (F
astString
.mkFastString# (x#))
#else
#define SLIT(x) (F
S
.mkLitString (x))
#define FSLIT(x) (F
S
.mkFastString (x))
#define SLIT(x) (F
astString
.mkLitString (x))
#define FSLIT(x) (F
astString
.mkFastString (x))
#endif
--
Useful
for
declaring
arguments
to
be
strict
...
...
compiler/basicTypes/BasicTypes.lhs
View file @
30c122df
...
...
@@ -58,7 +58,7 @@ module BasicTypes(
#include "HsVersions.h"
import FastString
( FastString )
import FastString
import Outputable
\end{code}
...
...
compiler/basicTypes/IdInfo.lhs
View file @
30c122df
...
...
@@ -92,6 +92,7 @@ import ForeignCall
import NewDemand
import Outputable
import Module
import FastString
import Data.Maybe
...
...
compiler/basicTypes/NameEnv.lhs
View file @
30c122df
...
...
@@ -16,8 +16,6 @@ module NameEnv (
elemNameEnv, mapNameEnv
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import Name
...
...
compiler/basicTypes/NameSet.lhs
View file @
30c122df
...
...
@@ -22,8 +22,6 @@ module NameSet (
findUses, duDefs, duUses, allUses
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import Name
...
...
compiler/basicTypes/NewDemand.lhs
View file @
30c122df
...
...
@@ -23,8 +23,6 @@ module NewDemand(
pprIfaceStrictSig, appIsBottom, isBottomingSig, seqStrictSig,
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import StaticFlags
...
...
compiler/basicTypes/VarEnv.lhs
View file @
30c122df
...
...
@@ -46,6 +46,7 @@ import Maybes
import Outputable
import FastTypes
import StaticFlags
import FastString
\end{code}
...
...
compiler/basicTypes/VarSet.lhs
View file @
30c122df
...
...
@@ -17,8 +17,6 @@ module VarSet (
elemVarSetByKey
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import Var
...
...
compiler/cmm/CmmCPSGen.hs
View file @
30c122df
...
...
@@ -33,6 +33,7 @@ import StaticFlags
import
Unique
import
Maybe
import
List
import
FastString
import
Panic
...
...
compiler/cmm/CmmInfo.hs
View file @
30c122df
...
...
@@ -276,6 +276,3 @@ mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
type_lit
=
packHalfWordsCLit
cl_type
srt_len
_unused
::
FS
.
FastString
-- stops a warning
_unused
=
undefined
compiler/cmm/CmmLint.hs
View file @
30c122df
...
...
@@ -27,6 +27,7 @@ import Outputable
import
PprCmm
import
Unique
import
Constants
import
FastString
import
Control.Monad
...
...
compiler/cmm/CmmOpt.hs
View file @
30c122df
...
...
@@ -574,5 +574,3 @@ isComparisonExpr _other = False
isPicReg
(
CmmReg
(
CmmGlobal
PicBaseReg
))
=
True
isPicReg
_
=
False
_unused
::
FS
.
FastString
-- stops a warning
_unused
=
undefined
compiler/cmm/MachOp.hs
View file @
30c122df
...
...
@@ -90,6 +90,7 @@ module MachOp (
import
Constants
import
Outputable
import
FastString
-- -----------------------------------------------------------------------------
-- MachRep
...
...
compiler/cmm/MkZipCfg.hs
View file @
30c122df
...
...
@@ -360,5 +360,3 @@ Emitting a Branch at this point is fine:
freshBlockId
::
String
->
UniqSM
BlockId
freshBlockId
_
=
do
{
u
<-
getUniqueUs
;
return
$
BlockId
u
}
_unused
::
FS
.
FastString
_unused
=
undefined
compiler/cmm/OptimizationFuel.hs
View file @
30c122df
...
...
@@ -48,11 +48,6 @@ oneLessFuel f = f
diffFuel
_
_
=
0
#
endif
-- stop warnings about things that aren't used
_unused
::
{-State#-}
()
->
FS
.
FastString
_unused
=
undefined
panic
data
FuelState
=
FuelState
{
fs_fuellimit
::
OptimizationFuel
,
fs_lastpass
::
String
}
newtype
FuelMonad
a
=
FuelMonad
(
FuelState
->
(
a
,
FuelState
))
...
...
compiler/cmm/ZipCfg.hs
View file @
30c122df
...
...
@@ -707,5 +707,3 @@ pprGraph (Graph tail blockenv) =
where
pprBlock
(
Block
id
tail
)
=
ppr
id
<>
colon
$$
ppr
tail
blocks
=
postorder_dfs_from
blockenv
tail
_unused
::
FS
.
FastString
_unused
=
undefined
compiler/cmm/ZipDataflow0.hs
View file @
30c122df
...
...
@@ -1088,10 +1088,6 @@ subAnalysis' m =
where
pprFacts
env
=
nest
2
$
vcat
$
map
pprFact
$
ufmToList
env
pprFact
(
id
,
a
)
=
hang
(
ppr
id
<>
colon
)
4
(
ppr
a
)
_unused
::
FS
.
FastString
_unused
=
undefined
null_b_ft
=
BComp
"do nothing"
Nothing
no2
no2
no2
where
no2
_
_
=
Nothing
...
...
compiler/codeGen/CgBindery.lhs
View file @
30c122df
...
...
@@ -62,6 +62,7 @@ import StgSyn
import Unique
import UniqSet
import Outputable
import FastString
\end{code}
...
...
compiler/codeGen/CgCon.lhs
View file @
30c122df
...
...
@@ -52,6 +52,7 @@ import PrelInfo
import Outputable
import ListSetOps
import Util
import FastString
\end{code}
...
...
compiler/codeGen/CgForeignCall.hs
View file @
30c122df
...
...
@@ -43,6 +43,7 @@ import ClosureInfo
import
Constants
import
StaticFlags
import
Outputable
import
FastString
import
Control.Monad
...
...
compiler/codeGen/CgHeapery.lhs
View file @
30c122df
...
...
@@ -52,6 +52,7 @@ import Util
import Constants
import PackageConfig
import Outputable
import FastString
import Data.List
\end{code}
...
...
compiler/codeGen/CgPrimOp.hs
View file @
30c122df
...
...
@@ -35,6 +35,7 @@ import PrimOp
import
SMRep
import
Constants
import
Outputable
import
FastString
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
...
...
compiler/codeGen/CgTailCall.lhs
View file @
30c122df
...
...
@@ -474,8 +474,3 @@ adjustSpAndHp newRealSp
}
\end{code}
Some things are unused.
\begin{code}
_unused :: FS.FastString
_unused = undefined
\end{code}
compiler/codeGen/SMRep.lhs
View file @
30c122df
...
...
@@ -53,6 +53,7 @@ import MachOp
import StaticFlags
import Constants
import Outputable
import FastString
import Data.Word
\end{code}
...
...
compiler/coreSyn/CoreFVs.lhs
View file @
30c122df
...
...
@@ -30,8 +30,6 @@ module CoreFVs (
freeVarsOf -- CoreExprWithFVs -> IdSet
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import CoreSyn
...
...
compiler/coreSyn/CoreLint.lhs
View file @
30c122df
...
...
@@ -39,6 +39,7 @@ import StaticFlags
import ListSetOps
import DynFlags
import Outputable
import FastString
import Util
import Data.Maybe
\end{code}
...
...
compiler/coreSyn/CorePrep.lhs
View file @
30c122df
...
...
@@ -35,6 +35,7 @@ import DynFlags
import Util
import Outputable
import MonadUtils
import FastString
\end{code}
-- ---------------------------------------------------------------------------
...
...
compiler/coreSyn/CoreSubst.lhs
View file @
30c122df
...
...
@@ -43,6 +43,7 @@ import UniqSupply
import Maybes
import Outputable
import PprCore () -- Instances
import FastString
import Data.List
\end{code}
...
...
compiler/coreSyn/CoreTidy.lhs
View file @
30c122df
...
...
@@ -11,8 +11,6 @@ module CoreTidy (
tidyExpr, tidyVarOcc, tidyRule, tidyRules
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import CoreSyn
...
...
compiler/coreSyn/CoreUnfold.lhs
View file @
30c122df
...
...
@@ -48,6 +48,7 @@ import Type
import PrelNames
import Bag
import FastTypes
import FastString
import Outputable
\end{code}
...
...
compiler/deSugar/DsGRHSs.lhs
View file @
30c122df
...
...
@@ -15,8 +15,6 @@ Matching guarded right-hand-sides (GRHSs)
module DsGRHSs ( dsGuarded, dsGRHSs ) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds )
...
...
compiler/deSugar/DsListComp.lhs
View file @
30c122df
...
...
@@ -15,8 +15,6 @@ Desugaring list comprehensions and array comprehensions
module DsListComp ( dsListComp, dsPArrComp ) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds )
...
...
compiler/deSugar/DsMonad.lhs
View file @
30c122df
...
...
@@ -59,6 +59,7 @@ import OccName
import DynFlags
import ErrUtils
import MonadUtils
import FastString
import Data.IORef
\end{code}
...
...
compiler/deSugar/Match.lhs
View file @
30c122df
...
...
@@ -43,6 +43,7 @@ import Maybes
import Util
import Name
import Outputable
import FastString
\end{code}
This function is a wrapper of @match@, it must be called from all the parts where
...
...
compiler/deSugar/MatchCon.lhs
View file @
30c122df
...
...
@@ -15,8 +15,6 @@ Pattern-matching constructors
module MatchCon ( matchConFamily ) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import {-# SOURCE #-} Match ( match )
...
...
compiler/ghci/RtClosureInspect.hs
View file @
30c122df
...
...
@@ -68,6 +68,7 @@ import PrelNames
import
TysWiredIn
import
Outputable
import
FastString
import
Panic
#
ifndef
GHCI_TABLES_NEXT_TO_CODE
...
...
compiler/hsSyn/HsBinds.lhs
View file @
30c122df
...
...
@@ -35,6 +35,7 @@ import SrcLoc
import Util
import Var
import Bag
import FastString
\end{code}
%************************************************************************
...
...
compiler/hsSyn/HsDoc.hs
View file @
30c122df
...
...
@@ -6,8 +6,6 @@ module HsDoc (
ppr_mbDoc
)
where
-- XXX This define is a bit of a hack, and should be done more nicely
#
define
FAST_STRING_NOT_NEEDED
1
#
include
"HsVersions.h"
import
Outputable
...
...
compiler/hsSyn/HsSyn.lhs
View file @
30c122df
...
...
@@ -46,6 +46,7 @@ import IfaceSyn ( IfaceBinding )
import Outputable
import SrcLoc ( Located(..) )
import Module ( Module, ModuleName )
import FastString
\end{code}
All we actually declare here is the top-level structure for a module.
...
...
compiler/hsSyn/HsTypes.lhs
View file @
30c122df
...
...
@@ -38,6 +38,7 @@ import BasicTypes
import SrcLoc
import StaticFlags
import Outputable
import FastString
\end{code}
...
...
compiler/iface/LoadIface.lhs
View file @
30c122df
...
...
@@ -58,6 +58,7 @@ import Outputable
import BinIface
import Panic
import Util
import FastString
import Control.Monad
import Data.List
...
...
compiler/iface/TcIface.lhs
View file @
30c122df
...
...
@@ -58,8 +58,9 @@ import Maybes
import SrcLoc
import DynFlags
import Util
import
Control.Monad
import
FastString
import Control.Monad
import Data.List
import Data.Maybe
\end{code}
...
...
compiler/main/CmdLineParser.hs
View file @
30c122df
...
...
@@ -14,8 +14,6 @@ module CmdLineParser (
CmdLineP
(
..
),
getCmdLineState
,
putCmdLineState
)
where
-- XXX This define is a bit of a hack, and should be done more nicely
#
define
FAST_STRING_NOT_NEEDED
1
#
include
"HsVersions.h"
import
Util
...
...
compiler/main/Constants.lhs
View file @
30c122df
...
...
@@ -13,8 +13,6 @@ import Data.Bits (shiftL)
-- we want; if we just hope a -I... will get the right one, we could
-- be in trouble.
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
#include "../includes/MachRegs.h"
#include "../includes/Constants.h"
...
...
compiler/main/DriverMkDepend.hs
View file @
30c122df
...
...
@@ -35,6 +35,7 @@ import Panic
import
SrcLoc
import
Data.List
import
CmdLineParser
import
FastString
import
ErrUtils
(
debugTraceMsg
,
putMsg
)
...
...
compiler/main/DriverPipeline.hs
View file @
30c122df
...
...
@@ -45,6 +45,7 @@ import Maybes ( expectJust )
import
ParserCoreUtils
(
getCoreModuleName
)
import
SrcLoc
(
unLoc
)
import
SrcLoc
(
Located
(
..
)
)
import
FastString
import
Control.Exception
as
Exception
import
Data.IORef
(
readIORef
,
writeIORef
,
IORef
)
...
...
compiler/main/DynFlags.hs
View file @
30c122df
...
...
@@ -60,8 +60,6 @@ module DynFlags (
compilerInfo
,
)
where
-- XXX This define is a bit of a hack, and should be done more nicely
#
define
FAST_STRING_NOT_NEEDED
1
#
include
"HsVersions.h"
import
Module
...
...
compiler/main/ErrUtils.lhs
View file @
30c122df
...
...
@@ -28,8 +28,6 @@ module ErrUtils (
debugTraceMsg,
) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import Bag ( Bag, bagToList, isEmptyBag, emptyBag )
...
...
compiler/main/GHC.hs
View file @
30c122df
...
...
@@ -266,6 +266,7 @@ import BasicTypes
import
Maybes
(
expectJust
,
mapCatMaybes
)
import
HaddockParse
import
HaddockLex
(
tokenise
)
import
FastString
import
Control.Concurrent
import
System.Directory
(
getModificationTime
,
doesFileExist
,
...
...
compiler/main/HscStats.lhs
View file @
30c122df
...
...
@@ -6,8 +6,6 @@
\begin{code}
module HscStats ( ppSourceStats ) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import HsSyn
...
...
compiler/main/HscTypes.lhs
View file @
30c122df
...
...
@@ -112,7 +112,7 @@ import BreakArray
import SrcLoc ( SrcSpan, Located )
import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString
( FastString )
import FastString
import StringBuffer ( StringBuffer )
import System.FilePath
...
...
compiler/main/PackageConfig.hs
View file @
30c122df
...
...
@@ -22,10 +22,6 @@ import Distribution.Package
import
Distribution.Version
import
Distribution.Compat.ReadP
(
readP_to_S
)
-- warning suppression
_unused
::
FS
.
FastString
_unused
=
FSLIT
(
""
)
-- -----------------------------------------------------------------------------
-- Our PackageConfig type is just InstalledPackageInfo from Cabal. Later we
-- might need to extend it with some GHC-specific stuff, but for now it's fine.
...
...
compiler/main/PprTyThing.hs
View file @
30c122df
...
...
@@ -27,6 +27,7 @@ import TcType
import
Var
import
Name
import
Outputable
import
FastString
-- -----------------------------------------------------------------------------
-- Pretty-printing entities that we get from the GHC API
...
...
compiler/main/StaticFlags.hs
View file @
30c122df
...
...
@@ -75,7 +75,7 @@ module StaticFlags (
import
CmdLineParser
import
Config
import
FastString
(
FastString
,
mkFastString
)
import
FastString
import
Util
import
Maybes
(
firstJust
)
import
Panic
...
...
compiler/main/SysTools.lhs
View file @
30c122df
...
...
@@ -74,7 +74,7 @@ import CString ( CString, peekCString )
import System.Process ( runInteractiveProcess, getProcessExitCode )
import Control.Concurrent( forkIO, newChan, readChan, writeChan )
import FastString
( mkFastString )
import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
\end{code}
...
...
compiler/main/TidyPgm.lhs
View file @
30c122df
...
...
@@ -45,9 +45,6 @@ import FastBool hiding ( fastOr )
import Data.List ( partition )
import Data.Maybe ( isJust )
import Data.IORef ( IORef, readIORef, writeIORef )
_dummy :: FS.FastString
_dummy = FSLIT("")
\end{code}
...
...
compiler/nativeGen/PositionIndependentCode.hs
View file @
30c122df
...
...
@@ -76,6 +76,7 @@ import qualified Outputable
import
Panic
(
panic
)
import
DynFlags
import
FastString
-- The most important function here is cmmMakeDynamicReference.
...
...
compiler/nativeGen/RegAllocLinear.hs
View file @
30c122df
...
...
@@ -101,6 +101,7 @@ import UniqFM
import
UniqSupply
import
Outputable
import
State
import
FastString
import
Data.Maybe
import
Data.List
...
...
compiler/nativeGen/RegLiveness.hs
View file @
30c122df
...
...
@@ -46,6 +46,7 @@ import UniqFM
import
UniqSupply
import
Bag
import
State
import
FastString
import
Data.List
import
Data.Maybe
...
...
compiler/prelude/ForeignCall.lhs
View file @
30c122df
...
...
@@ -26,7 +26,7 @@ module ForeignCall (
#include "HsVersions.h"
import FastString
( FastString, unpackFS )
import FastString
import Char ( isAlphaNum )
import Binary
import Outputable
...
...
compiler/prelude/TysPrim.lhs
View file @
30c122df
...
...
@@ -68,7 +68,7 @@ import SrcLoc
import Unique ( mkAlphaTyVarUnique, pprUnique )
import PrelNames
import StaticFlags
import FastString
( FastString, mkFastString )
import FastString
import Outputable
import Char ( ord, chr )
...
...
compiler/profiling/SCCfinal.lhs
View file @
30c122df
...
...
@@ -25,8 +25,6 @@ This is now a sort-of-normal STG-to-STG pass (WDP 94/06), run by stg2stg.
\begin{code}
module SCCfinal ( stgMassageForProfiling ) where
-- XXX This define is a bit of a hack, and should be done more nicely
#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import StgSyn
...
...
compiler/rename/RnBinds.lhs
View file @
30c122df
...
...
@@ -60,6 +60,7 @@ import BasicTypes ( RecFlag(..) )
import Digraph ( SCC(..), stronglyConnComp )
import Bag
import Outputable
import FastString
import Maybes ( orElse )
import Util ( filterOut )
import Monad ( foldM, unless )
...
...
compiler/rename/RnNames.lhs
View file @
30c122df
...
...
@@ -49,6 +49,7 @@ import ErrUtils
import BasicTypes ( DeprecTxt, Fixity )
import DriverPhases ( isHsBoot )
import Util
import FastString
import ListSetOps
import Data.List ( partition, concatMap, (\\), delete )
import IO ( openFile, IOMode(..) )
...
...
compiler/rename/RnSource.lhs
View file @
30c122df
...
...
@@ -49,6 +49,7 @@ import NameEnv
import LazyUniqFM
import OccName
import Outputable
import FastString
import SrcLoc ( Located(..), unLoc, noLoc )
import DynFlags ( DynFlag(..) )
import Maybe ( isNothing )
...
...
compiler/rename/RnTypes.lhs
View file @
30c122df
...
...
@@ -31,6 +31,7 @@ import NameSet
import BasicTypes ( compareFixity, funTyFixity, negateFixity,
Fixity(..), FixityDirection(..) )
import Outputable
import FastString
#include "HsVersions.h"
\end{code}
...
...
compiler/simplCore/CSE.lhs