Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
b4774598
Commit
b4774598
authored
Mar 13, 2020
by
Brian Foley
Committed by
Marge Bot
Mar 15, 2020
Browse files
Remove some dead code
From the notes.ghc.drop list found using weeder in
#17713
parent
d30aeb4b
Pipeline
#16737
passed with stages
in 407 minutes and 19 seconds
Changes
9
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
compiler/GHC/Cmm/Dataflow/Block.hs
View file @
b4774598
...
...
@@ -66,13 +66,7 @@ data MaybeO ex t where
JustO
::
t
->
MaybeO
O
t
NothingO
::
MaybeO
C
t
-- | Maybe type indexed by closed/open
data
MaybeC
ex
t
where
JustC
::
t
->
MaybeC
C
t
NothingC
::
MaybeC
O
t
deriving
instance
Functor
(
MaybeO
ex
)
deriving
instance
Functor
(
MaybeC
ex
)
-- -----------------------------------------------------------------------------
-- The Block type
...
...
compiler/GHC/Cmm/Parser.y
View file @
b4774598
...
...
@@ -873,17 +873,6 @@ section s = OtherSection s
mkString :: String -> CmmStatic
mkString s = CmmString (BS8.pack s)
-- |
-- Given an info table, decide what the entry convention for the proc
-- is. That is, for an INFO_TABLE_RET we want the return convention,
-- otherwise it is a NativeNodeCall.
--
infoConv :: Maybe CmmInfoTable -> Convention
infoConv Nothing = NativeNodeCall
infoConv (Just info)
| isStackRep (cit_rep info) = NativeReturn
| otherwise = NativeNodeCall
-- mkMachOp infers the type of the MachOp from the type of its first
-- argument. We assume that this is correct: for MachOps that don't have
-- symmetrical args (e.g. shift ops), the first arg determines the type of
...
...
compiler/GHC/Core/Utils.hs
View file @
b4774598
...
...
@@ -27,7 +27,7 @@ module GHC.Core.Utils (
getIdFromTrivialExpr_maybe
,
exprIsCheap
,
exprIsExpandable
,
exprIsCheapX
,
CheapAppFun
,
exprIsHNF
,
exprOkForSpeculation
,
exprOkForSideEffects
,
exprIsWorkFree
,
exprIsBig
,
exprIsConLike
,
exprIsConLike
,
isCheapApp
,
isExpandableApp
,
exprIsTickedString
,
exprIsTickedString_maybe
,
exprIsTopLevelBindable
,
...
...
@@ -2075,8 +2075,6 @@ c.f. add_evals in Simplify.simplAlt
-- | A cheap equality test which bales out fast!
-- If it returns @True@ the arguments are definitely equal,
-- otherwise, they may or may not be equal.
--
-- See also 'exprIsBig'
cheapEqExpr
::
Expr
b
->
Expr
b
->
Bool
cheapEqExpr
=
cheapEqExpr'
(
const
False
)
...
...
@@ -2100,17 +2098,6 @@ cheapEqExpr' ignoreTick e1 e2
go
_
_
=
False
exprIsBig
::
Expr
b
->
Bool
-- ^ Returns @True@ of expressions that are too big to be compared by 'cheapEqExpr'
exprIsBig
(
Lit
_
)
=
False
exprIsBig
(
Var
_
)
=
False
exprIsBig
(
Type
_
)
=
False
exprIsBig
(
Coercion
_
)
=
False
exprIsBig
(
Lam
_
e
)
=
exprIsBig
e
exprIsBig
(
App
f
a
)
=
exprIsBig
f
||
exprIsBig
a
exprIsBig
(
Cast
e
_
)
=
exprIsBig
e
-- Hopefully coercions are not too big!
exprIsBig
(
Tick
_
e
)
=
exprIsBig
e
exprIsBig
_
=
True
eqExpr
::
InScopeSet
->
CoreExpr
->
CoreExpr
->
Bool
-- Compares for equality, modulo alpha
...
...
compiler/GHC/HsToCore/Utils.hs
View file @
b4774598
...
...
@@ -38,7 +38,7 @@ module GHC.HsToCore.Utils (
mkSelectorBinds
,
selectSimpleMatchVarL
,
selectMatchVars
,
selectMatchVar
,
mkOptTickBox
,
mkBinaryTickBox
,
decideBangHood
,
addBang
,
mkOptTickBox
,
mkBinaryTickBox
,
decideBangHood
,
isTrueLHsExpr
)
where
...
...
@@ -957,19 +957,6 @@ decideBangHood dflags lpat
BangPat
_
_
->
lp
_
->
L
l
(
BangPat
noExtField
lp
)
-- | Unconditionally make a 'Pat' strict.
addBang
::
LPat
GhcTc
-- ^ Original pattern
->
LPat
GhcTc
-- ^ Banged pattern
addBang
=
go
where
go
lp
@
(
L
l
p
)
=
case
p
of
ParPat
x
p
->
L
l
(
ParPat
x
(
go
p
))
LazyPat
_
lp'
->
L
l
(
BangPat
noExtField
lp'
)
-- Should we bring the extension value over?
BangPat
_
_
->
lp
_
->
L
l
(
BangPat
noExtField
lp
)
isTrueLHsExpr
::
LHsExpr
GhcTc
->
Maybe
(
CoreExpr
->
DsM
CoreExpr
)
-- Returns Just {..} if we're sure that the expression is True
...
...
compiler/main/Annotations.hs
View file @
b4774598
...
...
@@ -9,7 +9,6 @@ module Annotations (
-- * Main Annotation data types
Annotation
(
..
),
AnnPayload
,
AnnTarget
(
..
),
CoreAnnTarget
,
getAnnTargetName_maybe
,
-- * AnnEnv for collecting and querying Annotations
AnnEnv
,
...
...
@@ -57,11 +56,6 @@ data AnnTarget name
-- | The kind of annotation target found in the middle end of the compiler
type
CoreAnnTarget
=
AnnTarget
Name
-- | Get the 'name' of an annotation target if it exists.
getAnnTargetName_maybe
::
AnnTarget
name
->
Maybe
name
getAnnTargetName_maybe
(
NamedTarget
nm
)
=
Just
nm
getAnnTargetName_maybe
_
=
Nothing
instance
Outputable
name
=>
Outputable
(
AnnTarget
name
)
where
ppr
(
NamedTarget
nm
)
=
text
"Named target"
<+>
ppr
nm
ppr
(
ModuleTarget
mod
)
=
text
"Module target"
<+>
ppr
mod
...
...
compiler/simplCore/CoreMonad.hs
View file @
b4774598
...
...
@@ -29,7 +29,7 @@ module CoreMonad (
-- ** Reading from the monad
getHscEnv
,
getRuleBase
,
getModule
,
getDynFlags
,
getOrigNameCache
,
getPackageFamInstEnv
,
getDynFlags
,
getPackageFamInstEnv
,
getVisibleOrphanMods
,
getUniqMask
,
getPrintUnqualified
,
getSrcSpanM
,
...
...
@@ -66,7 +66,6 @@ import FastString
import
ErrUtils
(
Severity
(
..
),
DumpFormat
(
..
),
dumpOptionsFromFlag
)
import
UniqSupply
import
MonadUtils
import
NameCache
import
NameEnv
import
SrcLoc
import
Data.Bifunctor
(
bimap
)
...
...
@@ -74,7 +73,6 @@ import ErrUtils (dumpAction)
import
Data.List
(
intersperse
,
groupBy
,
sortBy
)
import
Data.Ord
import
Data.Dynamic
import
Data.IORef
import
Data.Map
(
Map
)
import
qualified
Data.Map
as
Map
import
qualified
Data.Map.Strict
as
MapStrict
...
...
@@ -709,13 +707,6 @@ instance HasDynFlags CoreM where
instance
HasModule
CoreM
where
getModule
=
read
cr_module
-- | The original name cache is the current mapping from 'Module' and
-- 'OccName' to a compiler-wide unique 'Name'
getOrigNameCache
::
CoreM
OrigNameCache
getOrigNameCache
=
do
nameCacheRef
<-
fmap
hsc_NC
getHscEnv
liftIO
$
fmap
nsNames
$
readIORef
nameCacheRef
getPackageFamInstEnv
::
CoreM
PackageFamInstEnv
getPackageFamInstEnv
=
do
hsc_env
<-
getHscEnv
...
...
compiler/typecheck/Constraint.hs
View file @
b4774598
...
...
@@ -55,7 +55,7 @@ module Constraint (
isWanted
,
isGiven
,
isDerived
,
isGivenOrWDeriv
,
ctEvRole
,
wrapType
,
wrapTypeWithImplication
,
wrapType
,
CtFlavour
(
..
),
ShadowInfo
(
..
),
ctEvFlavour
,
CtFlavourRole
,
ctEvFlavourRole
,
ctFlavourRole
,
...
...
@@ -86,7 +86,6 @@ import Coercion
import
Class
import
TyCon
import
Var
import
Id
import
TcType
import
TcEvidence
...
...
@@ -1292,17 +1291,6 @@ pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)
-- | Wraps the given type with the constraints (via ic_given) in the given
-- implication, according to the variables mentioned (via ic_skols)
-- in the implication, but taking care to only wrap those variables
-- that are mentioned in the type or the implication.
wrapTypeWithImplication
::
Type
->
Implication
->
Type
wrapTypeWithImplication
ty
impl
=
wrapType
ty
mentioned_skols
givens
where
givens
=
map
idType
$
ic_given
impl
skols
=
ic_skols
impl
freeVars
=
fvVarSet
$
tyCoFVsOfTypes
(
ty
:
givens
)
mentioned_skols
=
filter
(`
elemVarSet
`
freeVars
)
skols
wrapType
::
Type
->
[
TyVar
]
->
[
PredType
]
->
Type
wrapType
ty
skols
givens
=
mkSpecForAllTys
skols
$
mkPhiTy
givens
ty
...
...
compiler/types/CoAxiom.hs
View file @
b4774598
...
...
@@ -26,7 +26,7 @@ module CoAxiom (
Role
(
..
),
fsFromRole
,
CoAxiomRule
(
..
),
TypeEqn
,
BuiltInSynFamily
(
..
)
,
trivialBuiltInFamily
BuiltInSynFamily
(
..
)
)
where
import
GhcPrelude
...
...
@@ -563,11 +563,3 @@ data BuiltInSynFamily = BuiltInSynFamily
,
sfInteractInert
::
[
Type
]
->
Type
->
[
Type
]
->
Type
->
[
TypeEqn
]
}
-- Provides default implementations that do nothing.
trivialBuiltInFamily
::
BuiltInSynFamily
trivialBuiltInFamily
=
BuiltInSynFamily
{
sfMatchFam
=
\
_
->
Nothing
,
sfInteractTop
=
\
_
_
->
[]
,
sfInteractInert
=
\
_
_
_
_
->
[]
}
compiler/utils/Binary.hs
View file @
b4774598
...
...
@@ -31,10 +31,8 @@ module Binary
-- closeBin,
seekBin
,
seekBy
,
tellBin
,
castBin
,
isEOFBin
,
withBinBuffer
,
writeBinMem
,
...
...
@@ -184,21 +182,6 @@ seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do
then
do
expandBin
h
p
;
writeFastMutInt
ix_r
p
else
writeFastMutInt
ix_r
p
seekBy
::
BinHandle
->
Int
->
IO
()
seekBy
h
@
(
BinMem
_
ix_r
sz_r
_
)
!
off
=
do
sz
<-
readFastMutInt
sz_r
ix
<-
readFastMutInt
ix_r
let
ix'
=
ix
+
off
if
(
ix'
>=
sz
)
then
do
expandBin
h
ix'
;
writeFastMutInt
ix_r
ix'
else
writeFastMutInt
ix_r
ix'
isEOFBin
::
BinHandle
->
IO
Bool
isEOFBin
(
BinMem
_
ix_r
sz_r
_
)
=
do
ix
<-
readFastMutInt
ix_r
sz
<-
readFastMutInt
sz_r
return
(
ix
>=
sz
)
writeBinMem
::
BinHandle
->
FilePath
->
IO
()
writeBinMem
(
BinMem
_
ix_r
_
arr_r
)
fn
=
do
h
<-
openBinaryFile
fn
WriteMode
...
...
Marge Bot
💬
@marge-bot
mentioned in merge request
!2882 (closed)
·
Mar 15, 2020
mentioned in merge request
!2882 (closed)
mentioned in merge request !2882
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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