1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
-- |
-- Module : Data.Vector.Internal.Check
-- Copyright : (c) Roman Leshchinskiy 2009
-- License : BSD-style
--
-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Stability : experimental
-- Portability : non-portable
--
-- Bounds checking infrastructure
--
module Data.Vector.Internal.Check (
Checks(..), doChecks,
error, emptyStream,
check, assert, checkIndex, checkLength, checkSlice
) where
import Prelude hiding( error )
import qualified Prelude as P
data Checks = Bounds | Unsafe | Internal deriving( Eq )
doBoundsChecks :: Bool
#ifdef VECTOR_BOUNDS_CHECKS
doBoundsChecks = True
#else
doBoundsChecks = False
#endif
doUnsafeChecks :: Bool
#ifdef VECTOR_UNSAFE_CHECKS
doUnsafeChecks = True
#else
doUnsafeChecks = False
#endif
doInternalChecks :: Bool
#ifdef VECTOR_INTERNAL_CHECKS
doInternalChecks = True
#else
doInternalChecks = False
#endif
doChecks :: Checks -> Bool
{-# INLINE doChecks #-}
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 ]
emptyStream :: String -> Int -> Checks -> String -> a
{-# NOINLINE emptyStream #-}
emptyStream file line kind loc
= error file line kind loc "empty stream"
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
assert_msg :: String
assert_msg = "assertion failure"
assert :: String -> Int -> Checks -> String -> Bool -> a -> a
{-# INLINE assert #-}
assert file line kind loc = check file line kind loc assert_msg
checkIndex_msg :: Int -> Int -> String
{-# NOINLINE checkIndex_msg #-}
checkIndex_msg i n = "index out of bounds " ++ show (i,n)
checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a
{-# INLINE checkIndex #-}
checkIndex file line kind loc i n x
= check file line kind loc (checkIndex_msg i n) (i >= 0 && i<n) x
checkLength_msg :: Int -> String
{-# NOINLINE checkLength_msg #-}
checkLength_msg n = "negative length " ++ show n
checkLength :: String -> Int -> Checks -> String -> Int -> a -> a
{-# INLINE checkLength #-}
checkLength file line kind loc n x
= check file line kind loc (checkLength_msg n) (n >= 0) x
checkSlice_msg :: Int -> Int -> Int -> String
{-# NOINLINE checkSlice_msg #-}
checkSlice_msg i m n = "invalid slice " ++ show (i,m,n)
checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a
{-# INLINE checkSlice #-}
checkSlice file line kind loc i m n x
= check file line kind loc (checkSlice_msg i m n)
(i >= 0 && m >= 0 && i+m <= n) x
|
