summaryrefslogtreecommitdiff
path: root/compiler/utils
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/utils')
-rw-r--r--compiler/utils/Maybes.lhs5
-rw-r--r--compiler/utils/UniqFM.lhs2
-rw-r--r--compiler/utils/Util.lhs10
3 files changed, 15 insertions, 2 deletions
diff --git a/compiler/utils/Maybes.lhs b/compiler/utils/Maybes.lhs
index 8a612fbb60..859908e266 100644
--- a/compiler/utils/Maybes.lhs
+++ b/compiler/utils/Maybes.lhs
@@ -14,6 +14,7 @@ module Maybes (
mapCatMaybes,
allMaybes,
firstJust, firstJusts,
+ whenIsJust,
expectJust,
maybeToBool,
@@ -68,6 +69,10 @@ mapCatMaybes _ [] = []
mapCatMaybes f (x:xs) = case f x of
Just y -> y : mapCatMaybes f xs
Nothing -> mapCatMaybes f xs
+
+whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenIsJust (Just x) f = f x
+whenIsJust Nothing _ = return ()
\end{code}
\begin{code}
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 680300abd4..862af99443 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -20,7 +20,7 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
of arguments of combining function.
\begin{code}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
{-# OPTIONS -Wall #-}
module UniqFM (
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 6d42ce7dfe..dd947ffd93 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -14,7 +14,7 @@ module Util (
-- * General list processing
zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
- zipLazy, stretchZipWith,
+ zipLazy, stretchZipWith, zipWithAndUnzip,
unzipWith,
@@ -351,6 +351,14 @@ mapAndUnzip3 f (x:xs)
in
(r1:rs1, r2:rs2, r3:rs3)
+zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d])
+zipWithAndUnzip f (a:as) (b:bs)
+ = let (r1, r2) = f a b
+ (rs1, rs2) = zipWithAndUnzip f as bs
+ in
+ (r1:rs1, r2:rs2)
+zipWithAndUnzip _ _ _ = ([],[])
+
mapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])
mapAccumL2 f s1 s2 xs = (s1', s2', ys)
where ((s1', s2'), ys) = mapAccumL (\(s1, s2) x -> case f s1 s2 x of