[commit: vector] master: Simplify error handling code (355008a)
Ian Lynagh
igloo at earth.li
Mon Jan 2 23:51:13 CET 2012
Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/355008a34e364a27862d8ddc16926aea3e7d1882
>---------------------------------------------------------------
commit 355008a34e364a27862d8ddc16926aea3e7d1882
Author: Roman Leshchinskiy <rl at cse.unsw.edu.au>
Date: Thu Dec 29 12:13:16 2011 +0000
Simplify error handling code
>---------------------------------------------------------------
Data/Vector/Fusion/Stream/Monadic.hs | 27 ++++++++++++++---------
Data/Vector/Internal/Check.hs | 38 +++++++++++++++++++++------------
include/vector.h | 10 ++------
3 files changed, 43 insertions(+), 32 deletions(-)
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
index 36a5d95..468dbdc 100644
--- a/Data/Vector/Fusion/Stream/Monadic.hs
+++ b/Data/Vector/Fusion/Stream/Monadic.hs
@@ -104,6 +104,11 @@ data SPEC = SPEC | SPEC2
{-# ANN type SPEC ForceSpecConstr #-}
#endif
+emptyStream :: String
+{-# NOINLINE emptyStream #-}
+emptyStream = "empty stream"
+
+#define EMPTY_STREAM (\s -> ERROR s emptyStream)
-- | Result of taking a single step in a stream
data Step s a = Yield a s -- ^ a new element and a new seed
@@ -230,7 +235,7 @@ head (Stream step s _) = head_loop SPEC s
case r of
Yield x _ -> return x
Skip s' -> head_loop SPEC s'
- Done -> BOUNDS_ERROR(emptyStream) "head"
+ Done -> EMPTY_STREAM "head"
@@ -245,7 +250,7 @@ last (Stream step s _) = last_loop0 SPEC s
case r of
Yield x s' -> last_loop1 SPEC x s'
Skip s' -> last_loop0 SPEC s'
- Done -> BOUNDS_ERROR(emptyStream) "last"
+ Done -> EMPTY_STREAM "last"
last_loop1 !sPEC x s
= do
@@ -259,7 +264,7 @@ infixl 9 !!
-- | Element at the given position
(!!) :: Monad m => Stream m a -> Int -> m a
{-# INLINE (!!) #-}
-Stream step s _ !! i | i < 0 = BOUNDS_ERROR(error) "!!" "negative index"
+Stream step s _ !! i | i < 0 = ERROR "!!" "negative index"
| otherwise = index_loop SPEC s i
where
index_loop !sPEC s i
@@ -270,7 +275,7 @@ Stream step s _ !! i | i < 0 = BOUNDS_ERROR(error) "!!" "negative index"
Yield x s' | i == 0 -> return x
| otherwise -> index_loop SPEC s' (i-1)
Skip s' -> index_loop SPEC s' i
- Done -> BOUNDS_ERROR(emptyStream) "!!"
+ Done -> EMPTY_STREAM "!!"
infixl 9 !?
-- | Element at the given position or 'Nothing' if out of bounds
@@ -309,7 +314,7 @@ init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
case r of
Yield x s' -> Skip (Just x, s')
Skip s' -> Skip (Nothing, s')
- Done -> BOUNDS_ERROR(emptyStream) "init"
+ Done -> EMPTY_STREAM "init"
) (step s)
step' (Just x, s) = liftM (\r ->
@@ -329,7 +334,7 @@ tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
case r of
Yield x s' -> Skip (Right s')
Skip s' -> Skip (Left s')
- Done -> BOUNDS_ERROR(emptyStream) "tail"
+ Done -> EMPTY_STREAM "tail"
) (step s)
step' (Right s) = liftM (\r ->
@@ -797,7 +802,7 @@ foldl1M f (Stream step s sz) = foldl1M_loop SPEC s
case r of
Yield x s' -> foldlM f x (Stream step s' (sz - 1))
Skip s' -> foldl1M_loop SPEC s'
- Done -> BOUNDS_ERROR(emptyStream) "foldl1M"
+ Done -> EMPTY_STREAM "foldl1M"
-- | Same as 'foldl1M'
fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
@@ -845,7 +850,7 @@ foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s
case r of
Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
Skip s' -> foldl1M'_loop SPEC s'
- Done -> BOUNDS_ERROR(emptyStream) "foldl1M'"
+ Done -> EMPTY_STREAM "foldl1M'"
-- | Same as 'foldl1M''
fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
@@ -886,7 +891,7 @@ foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s
case r of
Yield x s' -> foldr1M_loop1 SPEC x s'
Skip s' -> foldr1M_loop0 SPEC s'
- Done -> BOUNDS_ERROR(emptyStream) "foldr1M"
+ Done -> EMPTY_STREAM "foldr1M"
foldr1M_loop1 !sPEC x s
= do
@@ -1147,7 +1152,7 @@ scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz
case r of
Yield x s' -> return $ Yield x (s', Just x)
Skip s' -> return $ Skip (s', Nothing)
- Done -> BOUNDS_ERROR(emptyStream) "scanl1M"
+ Done -> EMPTY_STREAM "scanl1M"
step' (s, Just x) = do
r <- step s
@@ -1175,7 +1180,7 @@ scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
case r of
Yield x s' -> x `seq` return (Yield x (s', Just x))
Skip s' -> return $ Skip (s', Nothing)
- Done -> BOUNDS_ERROR(emptyStream) "scanl1M"
+ Done -> EMPTY_STREAM "scanl1M"
step' (s, Just x) = x `seq`
do
diff --git a/Data/Vector/Internal/Check.hs b/Data/Vector/Internal/Check.hs
index 2205ade..47e5819 100644
--- a/Data/Vector/Internal/Check.hs
+++ b/Data/Vector/Internal/Check.hs
@@ -15,7 +15,7 @@
module Data.Vector.Internal.Check (
Checks(..), doChecks,
- error, emptyStream,
+ error, internalError,
check, checkIndex, checkLength, checkSlice
) where
@@ -54,25 +54,35 @@ doChecks Bounds = doBoundsChecks
doChecks Unsafe = doUnsafeChecks
doChecks Internal = doInternalChecks
-error :: String -> Int -> Checks -> String -> String -> a
-error file line kind loc msg
- = P.error $ unlines $
- (if kind == Internal
- then (["*** Internal error in package vector ***"
- ,"*** Please submit a bug report at http://trac.haskell.org/vector"]++)
- else id) $
- [ file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg ]
+error_msg :: String -> Int -> String -> String -> String
+error_msg file line loc msg = file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg
-emptyStream :: String -> Int -> Checks -> String -> a
-{-# NOINLINE emptyStream #-}
-emptyStream file line kind loc
- = error file line kind loc "empty stream"
+error :: String -> Int -> String -> String -> a
+{-# NOINLINE error #-}
+error file line loc msg
+ = P.error $ error_msg file line loc msg
+
+internalError :: String -> Int -> String -> String -> a
+{-# NOINLINE internalError #-}
+internalError file line loc msg
+ = P.error $ unlines
+ ["*** Internal error in package vector ***"
+ ,"*** Please submit a bug report at http://trac.haskell.org/vector"
+ ,error_msg file line loc msg]
+
+
+checkError :: String -> Int -> Checks -> String -> String -> a
+{-# NOINLINE checkError #-}
+checkError file line kind loc msg
+ = case kind of
+ Internal -> internalError file line loc msg
+ _ -> error file line loc msg
check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a
{-# INLINE check #-}
check file line kind loc msg cond x
| not (doChecks kind) || cond = x
- | otherwise = error file line kind loc msg
+ | otherwise = checkError file line kind loc msg
checkIndex_msg :: Int -> Int -> String
{-# INLINE checkIndex_msg #-}
diff --git a/include/vector.h b/include/vector.h
index a04bc0b..d8473f5 100644
--- a/include/vector.h
+++ b/include/vector.h
@@ -8,16 +8,12 @@
import qualified Data.Vector.Internal.Check as Ck
#endif
-#define ERROR(f) (Ck.f __FILE__ __LINE__)
-#define CHECK(f) (Ck.f __FILE__ __LINE__)
+#define ERROR (Ck.error __FILE__ __LINE__)
+#define INTERNAL_ERROR (Ck.internalError __FILE__ __LINE__)
-#define BOUNDS_ERROR(f) (ERROR(f) Ck.Bounds)
+#define CHECK(f) (Ck.f __FILE__ __LINE__)
#define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds)
-
-#define UNSAFE_ERROR(f) (ERROR(f) Ck.Unsafe)
#define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe)
-
-#define INTERNAL_ERROR(f) (ERROR(f) Ck.Internal)
#define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal)
More information about the Cvs-libraries
mailing list