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
30c122df
Commit
30c122df
authored
Mar 29, 2008
by
Ian Lynagh
Browse files
Don't import FastString in HsVersions.h
Modules that need it import it themselves instead.
parent
7c7104a5
Changes
118
Hide whitespace changes
Inline
Side-by-side
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
...
...
Prev
1
2
3
4
5
6
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