Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
e07185ed
Commit
e07185ed
authored
Aug 07, 2008
by
batterseapower
Browse files
Move allM to MonadUtils
parent
393f2662
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/utils/Digraph.lhs
View file @
e07185ed
...
...
@@ -40,6 +40,7 @@ module Digraph(
import Util ( sortLe )
import Outputable
import Maybes ( expectJust )
import MonadUtils ( allM )
-- Extensions
import Control.Monad ( filterM, liftM, liftM2 )
...
...
@@ -588,8 +589,4 @@ vertexGroupsS provided g to_provide
vertexReady :: Set s -> IntGraph -> Vertex -> ST s Bool
vertexReady provided g v = liftM2 (&&) (liftM not $ provided `contains` v) (allM (provided `contains`) (g!v))
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM _ [] = return True
allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)
\end{code}
compiler/utils/MonadUtils.hs
View file @
e07185ed
...
...
@@ -13,7 +13,7 @@ module MonadUtils
,
mapAccumLM
,
mapSndM
,
concatMapM
,
anyM
,
anyM
,
allM
,
foldlM
,
foldrM
)
where
...
...
@@ -116,13 +116,18 @@ mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
concatMapM
::
Monad
m
=>
(
a
->
m
[
b
])
->
[
a
]
->
m
[
b
]
concatMapM
f
xs
=
liftM
concat
(
mapM
f
xs
)
-- | Monadic version of 'any', aborts the computation at the first
False
value
-- | Monadic version of 'any', aborts the computation at the first
@True@
value
anyM
::
Monad
m
=>
(
a
->
m
Bool
)
->
[
a
]
->
m
Bool
anyM
_
[]
=
return
False
anyM
f
(
x
:
xs
)
=
do
b
<-
f
x
if
b
then
return
True
else
anyM
f
xs
-- | Monad version of 'all', aborts the computation at the first @False@ value
allM
::
Monad
m
=>
(
a
->
m
Bool
)
->
[
a
]
->
m
Bool
allM
_
[]
=
return
True
allM
f
(
b
:
bs
)
=
(
f
b
)
>>=
(
\
bv
->
if
bv
then
allM
f
bs
else
return
False
)
-- | Monadic version of foldl
foldlM
::
(
Monad
m
)
=>
(
a
->
b
->
m
a
)
->
a
->
[
b
]
->
m
a
foldlM
=
foldM
...
...
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