Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
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
Shayne Fletcher
Glasgow Haskell Compiler
Commits
5c804e5d
Commit
5c804e5d
authored
Mar 12, 2018
by
Ömer Sinan Ağacan
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove splitEithers, use partitionEithers from base
parent
e3ae0eb8
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
11 additions
and
15 deletions
+11
-15
compiler/cmm/Debug.hs
compiler/cmm/Debug.hs
+3
-2
compiler/ghci/ByteCodeGen.hs
compiler/ghci/ByteCodeGen.hs
+2
-1
compiler/main/DriverPipeline.hs
compiler/main/DriverPipeline.hs
+3
-2
compiler/rename/RnEnv.hs
compiler/rename/RnEnv.hs
+2
-1
compiler/utils/Util.hs
compiler/utils/Util.hs
+1
-9
No files found.
compiler/cmm/Debug.hs
View file @
5c804e5d
...
@@ -35,7 +35,7 @@ import Outputable
...
@@ -35,7 +35,7 @@ import Outputable
import
PprCore
()
import
PprCore
()
import
PprCmmExpr
(
pprExpr
)
import
PprCmmExpr
(
pprExpr
)
import
SrcLoc
import
SrcLoc
import
Util
import
Util
(
seqList
)
import
Hoopl.Block
import
Hoopl.Block
import
Hoopl.Collections
import
Hoopl.Collections
...
@@ -46,6 +46,7 @@ import Data.Maybe
...
@@ -46,6 +46,7 @@ import Data.Maybe
import
Data.List
(
minimumBy
,
nubBy
)
import
Data.List
(
minimumBy
,
nubBy
)
import
Data.Ord
(
comparing
)
import
Data.Ord
(
comparing
)
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
import
Data.Either
(
partitionEithers
)
-- | Debug information about a block of code. Ticks scope over nested
-- | Debug information about a block of code. Ticks scope over nested
-- blocks.
-- blocks.
...
@@ -100,7 +101,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
...
@@ -100,7 +101,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
-- Analyse tick scope structure: Each one is either a top-level
-- Analyse tick scope structure: Each one is either a top-level
-- tick scope, or the child of another.
-- tick scope, or the child of another.
(
topScopes
,
childScopes
)
(
topScopes
,
childScopes
)
=
split
Eithers
$
map
(
\
a
->
findP
a
a
)
$
Map
.
keys
blockCtxs
=
partition
Eithers
$
map
(
\
a
->
findP
a
a
)
$
Map
.
keys
blockCtxs
findP
tsc
GlobalScope
=
Left
tsc
-- top scope
findP
tsc
GlobalScope
=
Left
tsc
-- top scope
findP
tsc
scp
|
scp'
`
Map
.
member
`
blockCtxs
=
Right
(
scp'
,
tsc
)
findP
tsc
scp
|
scp'
`
Map
.
member
`
blockCtxs
=
Right
(
scp'
,
tsc
)
|
otherwise
=
findP
tsc
scp'
|
otherwise
=
findP
tsc
scp'
...
...
compiler/ghci/ByteCodeGen.hs
View file @
5c804e5d
...
@@ -73,6 +73,7 @@ import qualified Data.IntMap as IntMap
...
@@ -73,6 +73,7 @@ import qualified Data.IntMap as IntMap
import
qualified
FiniteMap
as
Map
import
qualified
FiniteMap
as
Map
import
Data.Ord
import
Data.Ord
import
GHC.Stack.CCS
import
GHC.Stack.CCS
import
Data.Either
(
partitionEithers
)
-- -----------------------------------------------------------------------------
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
-- Generating byte code for a complete module
...
@@ -89,7 +90,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
...
@@ -89,7 +90,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
(
const
()
)
$
do
(
const
()
)
$
do
-- Split top-level binds into strings and others.
-- Split top-level binds into strings and others.
-- See Note [generating code for top-level string literal bindings].
-- See Note [generating code for top-level string literal bindings].
let
(
strings
,
flatBinds
)
=
split
Eithers
$
do
let
(
strings
,
flatBinds
)
=
partition
Eithers
$
do
(
bndr
,
rhs
)
<-
flattenBinds
binds
(
bndr
,
rhs
)
<-
flattenBinds
binds
return
$
case
exprIsTickedString_maybe
rhs
of
return
$
case
exprIsTickedString_maybe
rhs
of
Just
str
->
Left
(
bndr
,
str
)
Just
str
->
Left
(
bndr
,
str
)
...
...
compiler/main/DriverPipeline.hs
View file @
5c804e5d
...
@@ -73,6 +73,7 @@ import Control.Monad
...
@@ -73,6 +73,7 @@ import Control.Monad
import
Data.List
(
isSuffixOf
,
intercalate
)
import
Data.List
(
isSuffixOf
,
intercalate
)
import
Data.Maybe
import
Data.Maybe
import
Data.Version
import
Data.Version
import
Data.Either
(
partitionEithers
)
-- ---------------------------------------------------------------------------
-- ---------------------------------------------------------------------------
-- Pre-process
-- Pre-process
...
@@ -453,7 +454,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
...
@@ -453,7 +454,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
-- first check object files and extra_ld_inputs
-- first check object files and extra_ld_inputs
let
extra_ld_inputs
=
[
f
|
FileOption
_
f
<-
ldInputs
dflags
]
let
extra_ld_inputs
=
[
f
|
FileOption
_
f
<-
ldInputs
dflags
]
e_extra_times
<-
mapM
(
tryIO
.
getModificationUTCTime
)
extra_ld_inputs
e_extra_times
<-
mapM
(
tryIO
.
getModificationUTCTime
)
extra_ld_inputs
let
(
errs
,
extra_times
)
=
split
Eithers
e_extra_times
let
(
errs
,
extra_times
)
=
partition
Eithers
e_extra_times
let
obj_times
=
map
linkableTime
linkables
++
extra_times
let
obj_times
=
map
linkableTime
linkables
++
extra_times
if
not
(
null
errs
)
||
any
(
t
<
)
obj_times
if
not
(
null
errs
)
||
any
(
t
<
)
obj_times
then
return
True
then
return
True
...
@@ -469,7 +470,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
...
@@ -469,7 +470,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
if
any
isNothing
pkg_libfiles
then
return
True
else
do
if
any
isNothing
pkg_libfiles
then
return
True
else
do
e_lib_times
<-
mapM
(
tryIO
.
getModificationUTCTime
)
e_lib_times
<-
mapM
(
tryIO
.
getModificationUTCTime
)
(
catMaybes
pkg_libfiles
)
(
catMaybes
pkg_libfiles
)
let
(
lib_errs
,
lib_times
)
=
split
Eithers
e_lib_times
let
(
lib_errs
,
lib_times
)
=
partition
Eithers
e_lib_times
if
not
(
null
lib_errs
)
||
any
(
t
<
)
lib_times
if
not
(
null
lib_errs
)
||
any
(
t
<
)
lib_times
then
return
True
then
return
True
else
checkLinkInfo
dflags
pkg_deps
exe_file
else
checkLinkInfo
dflags
pkg_deps
exe_file
...
...
compiler/rename/RnEnv.hs
View file @
5c804e5d
...
@@ -79,6 +79,7 @@ import RnUnbound
...
@@ -79,6 +79,7 @@ import RnUnbound
import
RnUtils
import
RnUtils
import
Data.Maybe
(
isJust
)
import
Data.Maybe
(
isJust
)
import
qualified
Data.Semigroup
as
Semi
import
qualified
Data.Semigroup
as
Semi
import
Data.Either
(
partitionEithers
)
{-
{-
*********************************************************
*********************************************************
...
@@ -1436,7 +1437,7 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
...
@@ -1436,7 +1437,7 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
-- See Note [Fixity signature lookup]
-- See Note [Fixity signature lookup]
lookupLocalTcNames
ctxt
what
rdr_name
lookupLocalTcNames
ctxt
what
rdr_name
=
do
{
mb_gres
<-
mapM
lookup
(
dataTcOccs
rdr_name
)
=
do
{
mb_gres
<-
mapM
lookup
(
dataTcOccs
rdr_name
)
;
let
(
errs
,
names
)
=
split
Eithers
mb_gres
;
let
(
errs
,
names
)
=
partition
Eithers
mb_gres
;
when
(
null
names
)
$
addErr
(
head
errs
)
-- Bleat about one only
;
when
(
null
names
)
$
addErr
(
head
errs
)
-- Bleat about one only
;
return
names
}
;
return
names
}
where
where
...
...
compiler/utils/Util.hs
View file @
5c804e5d
...
@@ -25,7 +25,7 @@ module Util (
...
@@ -25,7 +25,7 @@ module Util (
mapFst
,
mapSnd
,
chkAppend
,
mapFst
,
mapSnd
,
chkAppend
,
mapAndUnzip
,
mapAndUnzip3
,
mapAccumL2
,
mapAndUnzip
,
mapAndUnzip3
,
mapAccumL2
,
nOfThem
,
filterOut
,
partitionWith
,
splitEithers
,
nOfThem
,
filterOut
,
partitionWith
,
dropWhileEndLE
,
spanEnd
,
dropWhileEndLE
,
spanEnd
,
...
@@ -296,14 +296,6 @@ partitionWith f (x:xs) = case f x of
...
@@ -296,14 +296,6 @@ partitionWith f (x:xs) = case f x of
Right
c
->
(
bs
,
c
:
cs
)
Right
c
->
(
bs
,
c
:
cs
)
where
(
bs
,
cs
)
=
partitionWith
f
xs
where
(
bs
,
cs
)
=
partitionWith
f
xs
splitEithers
::
[
Either
a
b
]
->
([
a
],
[
b
])
-- ^ Teases a list of 'Either's apart into two lists
splitEithers
[]
=
(
[]
,
[]
)
splitEithers
(
e
:
es
)
=
case
e
of
Left
x
->
(
x
:
xs
,
ys
)
Right
y
->
(
xs
,
y
:
ys
)
where
(
xs
,
ys
)
=
splitEithers
es
chkAppend
::
[
a
]
->
[
a
]
->
[
a
]
chkAppend
::
[
a
]
->
[
a
]
->
[
a
]
-- Checks for the second argument being empty
-- Checks for the second argument being empty
-- Used in situations where that situation is common
-- Used in situations where that situation is common
...
...
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