[commit: vector] simd: Move eq and cmp to monadic streams (2fa70a6)

Geoffrey Mainland gmainlan at ghc.haskell.org
Fri Jul 19 14:24:07 CEST 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : simd

http://hackage.haskell.org/trac/ghc/changeset/2fa70a62d64efc46abc464c2169e7980c8950e7c

>---------------------------------------------------------------

commit 2fa70a62d64efc46abc464c2169e7980c8950e7c
Author: Roman Leshchinskiy <rl at cse.unsw.edu.au>
Date:   Sun Jan 29 13:19:54 2012 +0000

    Move eq and cmp to monadic streams

>---------------------------------------------------------------

 Data/Vector/Fusion/Stream.hs         |   42 +++-------------------
 Data/Vector/Fusion/Stream/Monadic.hs |   64 ++++++++++++++++++++++++++++++++++
 2 files changed, 68 insertions(+), 38 deletions(-)

diff --git a/Data/Vector/Fusion/Stream.hs b/Data/Vector/Fusion/Stream.hs
index c872b5d..397c2c6 100644
--- a/Data/Vector/Fusion/Stream.hs
+++ b/Data/Vector/Fusion/Stream.hs
@@ -483,47 +483,13 @@ scanl1' = M.scanl1'
 
 -- | Check if two 'Stream's are equal
 eq :: Eq a => Stream v a -> Stream v a -> Bool
-{-# INLINE_STREAM eq #-}
-eq M.Stream{M.sElems = M.Unf step1 s1}
-   M.Stream{M.sElems = M.Unf step2 s2} = eq_loop0 SPEC s1 s2
-  where
-    eq_loop0 !sPEC s1 s2 = case unId (step1 s1) of
-                             Yield x s1' -> eq_loop1 SPEC x s1' s2
-                             Skip    s1' -> eq_loop0 SPEC   s1' s2
-                             Done        -> eq_null s2
-
-    eq_loop1 !sPEC x s1 s2 = case unId (step2 s2) of
-                               Yield y s2' -> x == y && eq_loop0 SPEC   s1 s2'
-                               Skip    s2' ->           eq_loop1 SPEC x s1 s2'
-                               Done        -> False
-
-    eq_null s2 = case unId (step2 s2) of
-                   Yield _ _ -> False
-                   Skip s2'  -> eq_null s2'
-                   Done      -> True
+{-# INLINE eq #-}
+eq x y = unId (M.eq x y)
 
 -- | Lexicographically compare two 'Stream's
 cmp :: Ord a => Stream v a -> Stream v a -> Ordering
-{-# INLINE_STREAM cmp #-}
-cmp M.Stream{M.sElems = M.Unf step1 s1}
-    M.Stream{M.sElems = M.Unf step2 s2} = cmp_loop0 SPEC s1 s2
-  where
-    cmp_loop0 !sPEC s1 s2 = case unId (step1 s1) of
-                              Yield x s1' -> cmp_loop1 SPEC x s1' s2
-                              Skip    s1' -> cmp_loop0 SPEC   s1' s2
-                              Done        -> cmp_null s2
-
-    cmp_loop1 !sPEC x s1 s2 = case unId (step2 s2) of
-                                Yield y s2' -> case x `compare` y of
-                                                 EQ -> cmp_loop0 SPEC s1 s2'
-                                                 c  -> c
-                                Skip    s2' -> cmp_loop1 SPEC x s1 s2'
-                                Done        -> GT
-
-    cmp_null s2 = case unId (step2 s2) of
-                    Yield _ _ -> LT
-                    Skip s2'  -> cmp_null s2'
-                    Done      -> EQ
+{-# INLINE cmp #-}
+cmp x y = unId (M.cmp x y)
 
 instance Eq a => Eq (M.Stream Id v a) where
   {-# INLINE (==) #-}
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
index df69003..697f875 100644
--- a/Data/Vector/Fusion/Stream/Monadic.hs
+++ b/Data/Vector/Fusion/Stream/Monadic.hs
@@ -41,6 +41,9 @@ module Data.Vector.Fusion.Stream.Monadic (
   zipWith, zipWith3, zipWith4, zipWith5, zipWith6,
   zip, zip3, zip4, zip5, zip6,
 
+  -- * Comparisons
+  eq, cmp,
+
   -- * Filtering
   filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
 
@@ -689,6 +692,67 @@ zip6 :: Monad m => Stream m v a -> Stream m v b -> Stream m v c -> Stream m v d
 {-# INLINE zip6 #-}
 zip6 = zipWith6 (,,,,,)
 
+-- Comparisons
+-- -----------
+
+-- | Check if two 'Stream's are equal
+eq :: (Monad m, Eq a) => Stream m v a -> Stream m v a -> m Bool
+{-# INLINE_STREAM eq #-}
+eq Stream{sElems = Unf step1 s1}
+   Stream{sElems = Unf step2 s2} = eq_loop0 SPEC s1 s2
+  where
+    eq_loop0 !sPEC s1 s2 = do
+      r <- step1 s1
+      case r of
+        Yield x s1' -> eq_loop1 SPEC x s1' s2
+        Skip    s1' -> eq_loop0 SPEC   s1' s2
+        Done        -> eq_null s2
+
+    eq_loop1 !sPEC x s1 s2 = do
+      r <- step2 s2
+      case r of
+        Yield y s2'
+          | x == y    -> eq_loop0 SPEC   s1 s2'
+          | otherwise -> return False
+        Skip    s2'   -> eq_loop1 SPEC x s1 s2'
+        Done          -> return False
+
+    eq_null s2 = do
+      r <- step2 s2
+      case r of
+        Yield _ _ -> return False
+        Skip s2'  -> eq_null s2'
+        Done      -> return True
+
+-- | Lexicographically compare two 'Stream's
+cmp :: (Monad m, Ord a) => Stream m v a -> Stream m v a -> m Ordering
+{-# INLINE_STREAM cmp #-}
+cmp Stream{sElems = Unf step1 s1}
+    Stream{sElems = Unf step2 s2} = cmp_loop0 SPEC s1 s2
+  where
+    cmp_loop0 !sPEC s1 s2 = do
+      r <- step1 s1
+      case r of
+        Yield x s1' -> cmp_loop1 SPEC x s1' s2
+        Skip    s1' -> cmp_loop0 SPEC   s1' s2
+        Done        -> cmp_null s2
+
+    cmp_loop1 !sPEC x s1 s2 = do
+      r <- step2 s2
+      case r of
+        Yield y s2' -> case x `compare` y of
+                         EQ -> cmp_loop0 SPEC s1 s2'
+                         c  -> return c
+        Skip    s2' -> cmp_loop1 SPEC x s1 s2'
+        Done        -> return GT
+
+    cmp_null s2 = do
+      r <- step2 s2
+      case r of
+        Yield _ _ -> return LT
+        Skip s2'  -> cmp_null s2'
+        Done      -> return EQ
+
 -- Filtering
 -- ---------
 






More information about the ghc-commits mailing list